Mercurial > hg > xemacs-beta

comparison lisp/gnus/gnus.el @ 110:fe104dbd9147 r20-1b7

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b7
author cvs
date Mon, 13 Aug 2007 09:19:45 +0200
parents 360340f9fd5f
children 48d667d6f17f
comparison
equal deleted inserted replaced
109:e183fc049578 110:fe104dbd9147
224 (defgroup gnus-exit nil 224 (defgroup gnus-exit nil
225 "Exiting gnus." 225 "Exiting gnus."
226 :link '(custom-manual "(gnus)Exiting Gnus") 226 :link '(custom-manual "(gnus)Exiting Gnus")
227 :group 'gnus) 227 :group 'gnus)
228 228
229 (defconst gnus-version-number "5.4.23" 229 (defconst gnus-version-number "5.4.26"
230 "Version number for this version of Gnus.") 230 "Version number for this version of Gnus.")
231 231
232 (defconst gnus-version (format "Gnus v%s" gnus-version-number) 232 (defconst gnus-version (format "Gnus v%s" gnus-version-number)
233 "Version string for this version of Gnus.") 233 "Version string for this version of Gnus.")
234 234
709 709
710 (require 'custom) 710 (require 'custom)
711 (require 'gnus-util) 711 (require 'gnus-util)
712 (require 'nnheader) 712 (require 'nnheader)
713 713
714 (defcustom gnus-directory (or (getenv "SAVEDIR") "~/News/") 714 (defcustom gnus-home-directory "~/"
715 "Directory variable that specifies the \"home\" directory.
716 All other Gnus path variables are initialized from this variable."
717 :group 'gnus-files
718 :type 'directory)
719
720 (defcustom gnus-directory (or (getenv "SAVEDIR")
721 (nnheader-concat gnus-home-directory "News/"))
715 "Directory variable from which all other Gnus file variables are derived." 722 "Directory variable from which all other Gnus file variables are derived."
716 :group 'gnus-files 723 :group 'gnus-files
717 :type 'directory) 724 :type 'directory)
718 725
719 (defcustom gnus-default-directory nil 726 (defcustom gnus-default-directory nil
2376 (when (stringp method) 2383 (when (stringp method)
2377 (setq method (gnus-server-to-method method))) 2384 (setq method (gnus-server-to-method method)))
2378 (memq option (assoc (format "%s" (car method)) 2385 (memq option (assoc (format "%s" (car method))
2379 gnus-valid-select-methods))) 2386 gnus-valid-select-methods)))
2380 2387
2381 (defun gnus-server-extend-method (group method)
2382 ;; This function "extends" a virtual server. If the server is
2383 ;; "hello", and the select method is ("hello" (my-var "something"))
2384 ;; in the group "alt.alt", this will result in a new virtual server
2385 ;; called "hello+alt.alt".
2386 (if (or (not (gnus-similar-server-opened method))
2387 (not (cddr method)))
2388 method
2389 `(,(car method) ,(concat (cadr method) "+" group)
2390 (,(intern (format "%s-address" (car method))) ,(cadr method))
2391 ,@(cddr method))))
2392
2393 (defun gnus-similar-server-opened (method) 2388 (defun gnus-similar-server-opened (method)
2394 (let ((opened gnus-opened-servers)) 2389 (let ((opened gnus-opened-servers))
2395 (while (and method opened) 2390 (while (and method opened)
2396 (when (and (equal (cadr method) (cadaar opened)) 2391 (when (and (equal (cadr method) (cadaar opened))
2397 (not (equal method (caar opened)))) 2392 (not (equal method (caar opened))))
2398 (setq method nil)) 2393 (setq method nil))
2399 (pop opened)) 2394 (pop opened))
2400 (not method))) 2395 (not method)))
2396
2397 (defun gnus-server-extend-method (group method)
2398 ;; This function "extends" a virtual server. If the server is
2399 ;; "hello", and the select method is ("hello" (my-var "something"))
2400 ;; in the group "alt.alt", this will result in a new virtual server
2401 ;; called "hello+alt.alt".
2402 (if (or (not (inline (gnus-similar-server-opened method)))
2403 (not (cddr method)))
2404 method
2405 `(,(car method) ,(concat (cadr method) "+" group)
2406 (,(intern (format "%s-address" (car method))) ,(cadr method))
2407 ,@(cddr method))))
2401 2408
2402 (defun gnus-server-status (method) 2409 (defun gnus-server-status (method)
2403 "Return the status of METHOD." 2410 "Return the status of METHOD."
2404 (nth 1 (assoc method gnus-opened-servers))) 2411 (nth 1 (assoc method gnus-opened-servers)))
2405 2412
2424 (not (setq method (gnus-info-method info))) 2431 (not (setq method (gnus-info-method info)))
2425 (equal method "native")) 2432 (equal method "native"))
2426 gnus-select-method 2433 gnus-select-method
2427 (setq method 2434 (setq method
2428 (cond ((stringp method) 2435 (cond ((stringp method)
2429 (gnus-server-to-method method)) 2436 (inline (gnus-server-to-method method)))
2430 ((stringp (cadr method)) 2437 ((stringp (cadr method))
2431 (gnus-server-extend-method group method)) 2438 (inline (gnus-server-extend-method group method)))
2432 (t 2439 (t
2433 method))) 2440 method)))
2434 (cond ((equal (cadr method) "") 2441 (cond ((equal (cadr method) "")
2435 method) 2442 method)
2436 ((null (cadr method)) 2443 ((null (cadr method))
2437 (list (car method) "")) 2444 (list (car method) ""))
2438 (t 2445 (t
2439 (gnus-server-add-address method))))))) 2446 (gnus-server-add-address method)))))))
2440 2447
2441 (defun gnus-check-backend-function (func group) 2448 (defsubst gnus-check-backend-function (func group)
2442 "Check whether GROUP supports function FUNC. 2449 "Check whether GROUP supports function FUNC.
2443 GROUP can either be a string (a group name) or a select method." 2450 GROUP can either be a string (a group name) or a select method."
2444 (ignore-errors 2451 (ignore-errors
2445 (let ((method (if (stringp group) 2452 (let ((method (if (stringp group)
2446 (car (gnus-find-method-for-group group)) 2453 (car (gnus-find-method-for-group group))