X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus.el;h=81944747df0c53f807eec6f839dad27f0efb3bf9;hp=0ce7a14e941ccd35a47316459466737ff060e6e4;hb=d75ad5fcb4dd6888ea4fd12cd17f27aac131ad53;hpb=4bff22e9e7b591a8c374edcaddbbc042e25e9731 diff --git a/lisp/gnus.el b/lisp/gnus.el index 0ce7a14e9..81944747d 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -226,7 +226,7 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "5.4.21" +(defconst gnus-version-number "5.4.31" "Version number for this version of Gnus.") (defconst gnus-version (format "Gnus v%s" gnus-version-number) @@ -308,7 +308,7 @@ be set in `.emacs' instead." ;; We define these group faces here to avoid the display ;; update forced when creating new faces. -(defface gnus-group-news-1-face +(defface gnus-group-news-1-face '((((class color) (background dark)) (:foreground "PaleTurquoise" :bold t)) @@ -330,7 +330,7 @@ be set in `.emacs' instead." ())) "Level 1 empty newsgroup face.") -(defface gnus-group-news-2-face +(defface gnus-group-news-2-face '((((class color) (background dark)) (:foreground "turquoise" :bold t)) @@ -352,7 +352,7 @@ be set in `.emacs' instead." ())) "Level 2 empty newsgroup face.") -(defface gnus-group-news-3-face +(defface gnus-group-news-3-face '((((class color) (background dark)) (:bold t)) @@ -374,7 +374,7 @@ be set in `.emacs' instead." ())) "Level 3 empty newsgroup face.") -(defface gnus-group-news-low-face +(defface gnus-group-news-low-face '((((class color) (background dark)) (:foreground "DarkTurquoise" :bold t)) @@ -396,7 +396,7 @@ be set in `.emacs' instead." ())) "Low level empty newsgroup face.") -(defface gnus-group-mail-1-face +(defface gnus-group-mail-1-face '((((class color) (background dark)) (:foreground "aquamarine1" :bold t)) @@ -418,7 +418,7 @@ be set in `.emacs' instead." (:italic t :bold t))) "Level 1 empty mailgroup face.") -(defface gnus-group-mail-2-face +(defface gnus-group-mail-2-face '((((class color) (background dark)) (:foreground "aquamarine2" :bold t)) @@ -440,7 +440,7 @@ be set in `.emacs' instead." (:bold t))) "Level 2 empty mailgroup face.") -(defface gnus-group-mail-3-face +(defface gnus-group-mail-3-face '((((class color) (background dark)) (:foreground "aquamarine3" :bold t)) @@ -462,7 +462,7 @@ be set in `.emacs' instead." ())) "Level 3 empty mailgroup face.") -(defface gnus-group-mail-low-face +(defface gnus-group-mail-low-face '((((class color) (background dark)) (:foreground "aquamarine4" :bold t)) @@ -486,11 +486,11 @@ be set in `.emacs' instead." ;; Summary mode faces. -(defface gnus-summary-selected-face '((t +(defface gnus-summary-selected-face '((t (:underline t))) "Face used for selected articles.") -(defface gnus-summary-cancelled-face +(defface gnus-summary-cancelled-face '((((class color)) (:foreground "yellow" :background "black"))) "Face used for cancelled articles.") @@ -502,7 +502,7 @@ be set in `.emacs' instead." (((class color) (background light)) (:foreground "firebrick" :bold t)) - (t + (t (:bold t))) "Face used for high interest ticked articles.") @@ -513,7 +513,7 @@ be set in `.emacs' instead." (((class color) (background light)) (:foreground "firebrick" :italic t)) - (t + (t (:italic t))) "Face used for low interest ticked articles.") @@ -524,10 +524,10 @@ be set in `.emacs' instead." (((class color) (background light)) (:foreground "firebrick")) - (t + (t ())) "Face used for normal interest ticked articles.") - + (defface gnus-summary-high-ancient-face '((((class color) (background dark)) @@ -535,7 +535,7 @@ be set in `.emacs' instead." (((class color) (background light)) (:foreground "RoyalBlue" :bold t)) - (t + (t (:bold t))) "Face used for high interest ancient articles.") @@ -546,7 +546,7 @@ be set in `.emacs' instead." (((class color) (background light)) (:foreground "RoyalBlue" :italic t)) - (t + (t (:italic t))) "Face used for low interest ancient articles.") @@ -557,25 +557,25 @@ be set in `.emacs' instead." (((class color) (background light)) (:foreground "RoyalBlue")) - (t + (t ())) "Face used for normal interest ancient articles.") - + (defface gnus-summary-high-unread-face - '((t + '((t (:bold t))) "Face used for high interest unread articles.") (defface gnus-summary-low-unread-face - '((t + '((t (:italic t))) "Face used for low interest unread articles.") (defface gnus-summary-normal-unread-face - '((t + '((t ())) "Face used for normal interest unread articles.") - + (defface gnus-summary-high-read-face '((((class color) (background dark)) @@ -585,7 +585,7 @@ be set in `.emacs' instead." (background light)) (:foreground "DarkGreen" :bold t)) - (t + (t (:bold t))) "Face used for high interest read articles.") @@ -598,7 +598,7 @@ be set in `.emacs' instead." (background light)) (:foreground "DarkGreen" :italic t)) - (t + (t (:italic t))) "Face used for low interest read articles.") @@ -609,7 +609,7 @@ be set in `.emacs' instead." (((class color) (background light)) (:foreground "DarkGreen")) - (t + (t ())) "Face used for normal interest read articles.") @@ -621,7 +621,7 @@ be set in `.emacs' instead." (eval-and-compile (autoload 'gnus-play-jingle "gnus-audio")) -(defface gnus-splash-face +(defface gnus-splash-face '((((class color) (background dark)) (:foreground "red")) @@ -711,7 +711,14 @@ be set in `.emacs' instead." (require 'gnus-util) (require 'nnheader) -(defcustom gnus-directory (or (getenv "SAVEDIR") "~/News/") +(defcustom gnus-home-directory "~/" + "Directory variable that specifies the \"home\" directory. +All other Gnus path variables are initialized from this variable." + :group 'gnus-files + :type 'directory) + +(defcustom gnus-directory (or (getenv "SAVEDIR") + (nnheader-concat gnus-home-directory "News/")) "Directory variable from which all other Gnus file variables are derived." :group 'gnus-files :type 'directory) @@ -797,11 +804,11 @@ see the manual for details." :group 'gnus-server :type 'gnus-select-method) -(defcustom gnus-message-archive-method +(defcustom gnus-message-archive-method `(nnfolder "archive" (nnfolder-directory ,(nnheader-concat message-directory "archive")) - (nnfolder-active-file + (nnfolder-active-file ,(nnheader-concat message-directory "archive/active")) (nnfolder-get-new-mail nil) (nnfolder-inhibit-expiry t)) @@ -817,7 +824,7 @@ server buffer." (defcustom gnus-message-archive-group nil "*Name of the group in which to save the messages you've written. -This can either be a string, a list of strings; or an alist +This can either be a string; a list of strings; or an alist of regexps/functions/forms to be evaluated to return a string (or a list of strings). The functions are called with the name of the current group (or nil) as a parameter. @@ -825,9 +832,9 @@ group (or nil) as a parameter. If you want to save your mail in one group and the news articles you write in another group, you could say something like: - \(setq gnus-message-archive-group + \(setq gnus-message-archive-group '((if (message-news-p) - \"misc-news\" + \"misc-news\" \"misc-mail\"))) Normally the group names returned by this variable should be @@ -880,19 +887,9 @@ no need to set this variable." :type '(choice (const :tag "default" nil) string)) -(defcustom gnus-local-organization nil +(defvar gnus-local-organization nil "String with a description of what organization (if any) the user belongs to. -The ORGANIZATION environment variable is used instead if it is defined. -If this variable contains a function, this function will be called -with the current newsgroup name as the argument. The function should -return a string. - -In any case, if the string (either in the variable, in the environment -variable, or returned by the function) is a file name, the contents of -this file will be used as the organization." - :group 'gnus-message - :type '(choice (const :tag "default" nil) - string)) +Obsolete variable; use `message-user-organization' instead.") ;; Customization variables @@ -1048,7 +1045,7 @@ articles. This is not a good idea." :group 'gnus-meta :type '(choice (const :tag "off" nil) integer - (sexp :format "all" + (sexp :format "all" :value t))) (defcustom gnus-use-nocem nil @@ -1076,7 +1073,7 @@ articles. This is not a good idea." :group 'gnus-meta :type 'boolean) -(defcustom gnus-summary-prepare-exit-hook +(defcustom gnus-summary-prepare-exit-hook '(gnus-summary-expire-articles) "A hook called when preparing to exit from the summary buffer. It calls `gnus-summary-expire-articles' by default." @@ -1173,7 +1170,7 @@ this variable. I think." (string :tag "Address") (editable-list :inline t (list :format "%v" - variable + variable (sexp :tag "Value"))))) (defcustom gnus-updated-mode-lines '(group article summary tree) @@ -1262,8 +1259,8 @@ It is called with three parameters -- GROUP, LEVEL and OLDLEVEL." ;;; Face thingies. -(defcustom gnus-visual - '(summary-highlight group-highlight article-highlight +(defcustom gnus-visual + '(summary-highlight group-highlight article-highlight mouse-face summary-menu group-menu article-menu tree-highlight menu highlight @@ -1623,7 +1620,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") ("gnus-picon" :interactive t gnus-article-display-picons gnus-group-display-picons gnus-picons-article-display-x-face gnus-picons-display-x-face) - ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p + ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p gnus-grouplens-mode) ("smiley" :interactive t gnus-smiley-display) ("gnus-win" gnus-configure-windows gnus-add-configuration) @@ -1653,7 +1650,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") gnus-article-hide-pem gnus-article-hide-signature gnus-article-strip-leading-blank-lines gnus-article-date-local gnus-article-date-original gnus-article-date-lapsed - gnus-article-show-all-headers + gnus-article-show-all-headers gnus-article-edit-mode gnus-article-edit-article gnus-article-edit-done gnus-decode-rfc1522 article-decode-rfc1522) ("gnus-int" gnus-request-type) @@ -1743,7 +1740,7 @@ This restriction may disappear in later versions of Gnus." (defun gnus-suppress-keymap (keymap) (suppress-keymap keymap) - (let ((keys `([delete] "\177" "\M-u"))) ;gnus-mouse-2 + (let ((keys `([delete] "\177" "\M-u"))) ;gnus-mouse-2 (while keys (define-key keymap (pop keys) 'undefined)))) @@ -1751,7 +1748,7 @@ This restriction may disappear in later versions of Gnus." (let ((keymap (make-keymap))) (gnus-suppress-keymap keymap) keymap)) -(defvar gnus-summary-mode-map +(defvar gnus-summary-mode-map (let ((keymap (make-keymap))) (gnus-suppress-keymap keymap) keymap)) @@ -1952,7 +1949,7 @@ If ARG, insert string at point." (string-to-number (if (zerop major) (format "%s00%02d%02d" - (cond + (cond ((member alpha '("(ding)" "d")) "4.99") ((member alpha '("September" "s")) "5.01") ((member alpha '("Red" "r")) "5.03")) @@ -2066,7 +2063,7 @@ that that variable is buffer-local to the summary buffers." (let ((method-name (symbol-name (car method)))) (if (and (memq 'address (assoc method-name gnus-valid-select-methods)) (not (assq (intern (concat method-name "-address")) method)) - (memq 'physical-address (assq (car method) + (memq 'physical-address (assq (car method) gnus-valid-select-methods))) (append method (list (list (intern (concat method-name "-address")) (nth 1 method)))) @@ -2089,7 +2086,7 @@ that that variable is buffer-local to the summary buffers." (defun gnus-server-to-method (server) "Map virtual server names to select methods." - (or + (or ;; Is this a method, perhaps? (and server (listp server) server) ;; Perhaps this is the native server? @@ -2140,7 +2137,7 @@ that that variable is buffer-local to the summary buffers." (defun gnus-archive-server-wanted-p () "Say whether the user wants to use the archive server." - (cond + (cond ((or (not gnus-message-archive-method) (not gnus-message-archive-group)) nil) @@ -2247,8 +2244,8 @@ If SYMBOL, return the value of that symbol in the group parameters." (defun gnus-group-add-parameter (group param) "Add parameter PARAM to GROUP." (let ((info (gnus-get-info group))) - (if (not info) - () ; This is a dead group. We just ignore it. + (when info + (gnus-group-remove-parameter group (if (consp param) (car param) param)) ;; Cons the new param to the old one and update. (gnus-group-set-info (cons param (gnus-info-params info)) group 'params)))) @@ -2256,8 +2253,8 @@ If SYMBOL, return the value of that symbol in the group parameters." (defun gnus-group-set-parameter (group name value) "Set parameter NAME to VALUE in GROUP." (let ((info (gnus-get-info group))) - (if (not info) - () ; This is a dead group. We just ignore it. + (when info + (gnus-group-remove-parameter group name) (let ((old-params (gnus-info-params info)) (new-params (list (cons name value)))) (while old-params @@ -2267,6 +2264,17 @@ If SYMBOL, return the value of that symbol in the group parameters." (setq old-params (cdr old-params))) (gnus-group-set-info new-params group 'params))))) +(defun gnus-group-remove-parameter (group name) + "Remove parameter NAME from GROUP." + (let ((info (gnus-get-info group))) + (when info + (let ((params (gnus-info-params info))) + (when params + (setq params (delq name params)) + (while (assq name params) + (setq params (delq (assq name params) params))) + (gnus-info-set-params info params)))))) + (defun gnus-group-add-score (group &optional score) "Add SCORE to the GROUP score. If SCORE is nil, add 1 to the score of GROUP." @@ -2356,7 +2364,7 @@ Returns the number of articles marked as read." (defun gnus-newsgroup-kill-file (newsgroup) "Return the name of a kill file name for NEWSGROUP. If NEWSGROUP is nil, return the global kill file name instead." - (cond + (cond ;; The global KILL file is placed at top of the directory. ((or (null newsgroup) (string-equal newsgroup "")) @@ -2388,27 +2396,27 @@ If NEWSGROUP is nil, return the global kill file name instead." (memq option (assoc (format "%s" (car method)) gnus-valid-select-methods))) +(defun gnus-similar-server-opened (method) + (let ((opened gnus-opened-servers)) + (while (and method opened) + (when (and (equal (cadr method) (cadaar opened)) + (not (equal method (caar opened)))) + (setq method nil)) + (pop opened)) + (not method))) + (defun gnus-server-extend-method (group method) ;; This function "extends" a virtual server. If the server is ;; "hello", and the select method is ("hello" (my-var "something")) ;; in the group "alt.alt", this will result in a new virtual server ;; called "hello+alt.alt". - (if (or (not (gnus-similar-server-opened method)) + (if (or (not (inline (gnus-similar-server-opened method))) (not (cddr method))) method `(,(car method) ,(concat (cadr method) "+" group) (,(intern (format "%s-address" (car method))) ,(cadr method)) ,@(cddr method)))) -(defun gnus-similar-server-opened (method) - (let ((opened gnus-opened-servers)) - (while (and method opened) - (when (and (equal (cadr method) (cadaar opened)) - (not (equal method (caar opened)))) - (setq method nil)) - (pop opened)) - (not method))) - (defun gnus-server-status (method) "Return the status of METHOD." (nth 1 (assoc method gnus-opened-servers))) @@ -2436,9 +2444,9 @@ If NEWSGROUP is nil, return the global kill file name instead." gnus-select-method (setq method (cond ((stringp method) - (gnus-server-to-method method)) + (inline (gnus-server-to-method method))) ((stringp (cadr method)) - (gnus-server-extend-method group method)) + (inline (gnus-server-extend-method group method))) (t method))) (cond ((equal (cadr method) "") @@ -2448,7 +2456,7 @@ If NEWSGROUP is nil, return the global kill file name instead." (t (gnus-server-add-address method))))))) -(defun gnus-check-backend-function (func group) +(defsubst gnus-check-backend-function (func group) "Check whether GROUP supports function FUNC. GROUP can either be a string (a group name) or a select method." (ignore-errors @@ -2492,7 +2500,7 @@ Allow completion over sensible values." prompt (append gnus-valid-select-methods gnus-predefined-server-alist gnus-server-alist) nil t nil 'gnus-method-history))) - (cond + (cond ((equal method "") (setq method gnus-select-method)) ((assoc method gnus-valid-select-methods)