X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus.el;h=10cf2151612cb4cf79163c358055c4c1d38ae607;hb=507b285173baa14c25dc095f5c65d05a5474a8fe;hp=48616265ef42814db5a65b01438735071aee74b9;hpb=d0f68584c310c57abb9d5ca1b129dd892ba2ba75;p=gnus diff --git a/lisp/gnus.el b/lisp/gnus.el index 48616265e..10cf21516 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -30,6 +30,7 @@ (require 'custom) (require 'gnus-load) +(require 'message) (defgroup gnus nil "The coffee-brewing, all singing, all dancing, kitchen sink newsreader." @@ -225,7 +226,7 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "5.4.18" +(defconst gnus-version-number "5.4.29" "Version number for this version of Gnus.") (defconst gnus-version (format "Gnus v%s" gnus-version-number) @@ -307,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)) @@ -329,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)) @@ -351,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)) @@ -373,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)) @@ -395,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)) @@ -417,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)) @@ -439,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)) @@ -461,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)) @@ -485,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.") @@ -501,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.") @@ -512,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.") @@ -523,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)) @@ -534,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.") @@ -545,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.") @@ -556,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)) @@ -584,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.") @@ -597,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.") @@ -608,7 +609,7 @@ be set in `.emacs' instead." (((class color) (background light)) (:foreground "DarkGreen")) - (t + (t ())) "Face used for normal interest read articles.") @@ -620,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")) @@ -710,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) @@ -796,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)) @@ -816,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. @@ -824,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 @@ -879,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 @@ -1047,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 @@ -1075,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." @@ -1172,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) @@ -1261,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 @@ -1369,8 +1367,12 @@ want." gnus-article-strip-leading-blank-lines gnus-article-strip-multiple-blank-lines gnus-article-strip-blank-lines - gnus-article-treat-overstrike - )) + gnus-article-treat-overstrike)) + +(defcustom gnus-article-save-directory gnus-directory + "*Name of the directory articles will be saved in (default \"~/News\")." + :group 'gnus-article-saving + :type 'directory) ;;; Internal variables @@ -1618,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) @@ -1637,7 +1639,8 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") gnus-article-prepare gnus-article-set-window-start gnus-article-next-page gnus-article-prev-page gnus-request-article-this-buffer gnus-article-mode - gnus-article-setup-buffer gnus-narrow-to-page) + gnus-article-setup-buffer gnus-narrow-to-page + gnus-article-delete-invisible-text) ("gnus-art" :interactive t gnus-article-hide-headers gnus-article-hide-boring-headers gnus-article-treat-overstrike gnus-article-word-wrap @@ -1647,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) @@ -1737,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)))) @@ -1745,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)) @@ -1946,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")) @@ -2060,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)))) @@ -2083,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? @@ -2134,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) @@ -2350,7 +2353,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 "")) @@ -2382,27 +2385,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))) @@ -2430,9 +2433,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) "") @@ -2442,7 +2445,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 @@ -2486,7 +2489,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)