diff options
Diffstat (limited to 'lisp/gnus/gnus.el')
| -rw-r--r-- | lisp/gnus/gnus.el | 1796 |
1 files changed, 1468 insertions, 328 deletions
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 97a8d8587cf..5d09c4b5c3c 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -1,6 +1,7 @@ ;;; gnus.el --- a newsreader for GNU Emacs + ;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, 1997, -;; 1998, 2000, 2001, 2002 Free Software Foundation, Inc. +;; 1998, 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> ;; Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -30,13 +31,19 @@ (eval '(run-hooks 'gnus-load-hook)) (eval-when-compile (require 'cl)) +(require 'wid-edit) (require 'mm-util) +(require 'nnheader) (defgroup gnus nil "The coffee-brewing, all singing, all dancing, kitchen sink newsreader." :group 'news :group 'mail) +(defgroup gnus-format nil + "Dealing with formatting issues." + :group 'gnus) + (defgroup gnus-charset nil "Group character set issues." :link '(custom-manual "(gnus)Charsets") @@ -45,6 +52,11 @@ (defgroup gnus-cache nil "Cache interface." + :link '(custom-manual "(gnus)Article Caching") + :group 'gnus) + +(defgroup gnus-registry nil + "Article Registry." :group 'gnus) (defgroup gnus-start nil @@ -58,7 +70,7 @@ ;; These belong to gnus-group.el. (defgroup gnus-group nil "Group buffers." - :link '(custom-manual "(gnus)The Group Buffer") + :link '(custom-manual "(gnus)Group Buffer") :group 'gnus) (defgroup gnus-group-foreign nil @@ -99,7 +111,7 @@ ;; These belong to gnus-sum.el. (defgroup gnus-summary nil "Summary buffers." - :link '(custom-manual "(gnus)The Summary Buffer") + :link '(custom-manual "(gnus)Summary Buffer") :group 'gnus) (defgroup gnus-summary-exit nil @@ -132,6 +144,10 @@ :link '(custom-manual "(gnus)Summary Maneuvering") :group 'gnus-summary) +(defgroup gnus-picon nil + "Show pictures of people, domains, and newsgroups." + :group 'gnus-visual) + (defgroup gnus-summary-mail nil "Mail group commands." :link '(custom-manual "(gnus)Mail Group Commands") @@ -139,7 +155,7 @@ (defgroup gnus-summary-sort nil "Sorting the summary buffer." - :link '(custom-manual "(gnus)Sorting") + :link '(custom-manual "(gnus)Sorting the Summary Buffer") :group 'gnus-summary) (defgroup gnus-summary-visual nil @@ -207,7 +223,7 @@ ;; Other (defgroup gnus-visual nil - "Options controling the visual fluff." + "Options controlling the visual fluff." :group 'gnus :group 'faces) @@ -232,12 +248,17 @@ "Options related to newsservers and other servers used by Gnus." :group 'gnus) +(defgroup gnus-server-visual nil + "Highlighting and menus in the server buffer." + :group 'gnus-visual + :group 'gnus-server) + (defgroup gnus-message '((message custom-group)) "Composing replies and followups in Gnus." :group 'gnus) (defgroup gnus-meta nil - "Meta variables controling major portions of Gnus. + "Meta variables controlling major portions of Gnus. In general, modifying these variables does not take affect until Gnus is restarted, and sometimes reloaded." :group 'gnus) @@ -256,7 +277,12 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "5.9.0" +(defgroup gnus-fun nil + "Frivolous Gnus extensions." + :link '(custom-manual "(gnus)Exiting Gnus") + :group 'gnus) + +(defconst gnus-version-number "5.10.6" "Version number for this version of Gnus.") (defconst gnus-version (format "Gnus v%s" gnus-version-number) @@ -274,6 +300,12 @@ be set in `.emacs' instead." :group 'gnus-start :type 'boolean) +(unless (fboundp 'gnus-group-remove-excess-properties) + (defalias 'gnus-group-remove-excess-properties 'ignore)) + +(unless (fboundp 'gnus-set-text-properties) + (defalias 'gnus-set-text-properties 'set-text-properties)) + (unless (featurep 'gnus-xmas) (defalias 'gnus-make-overlay 'make-overlay) (defalias 'gnus-delete-overlay 'delete-overlay) @@ -284,11 +316,10 @@ be set in `.emacs' instead." (defalias 'gnus-overlay-end 'overlay-end) (defalias 'gnus-extent-detached-p 'ignore) (defalias 'gnus-extent-start-open 'ignore) - (defalias 'gnus-set-text-properties 'set-text-properties) - (defalias 'gnus-group-remove-excess-properties 'ignore) (defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window) (defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names) (defalias 'gnus-character-to-event 'identity) + (defalias 'gnus-assq-delete-all 'assq-delete-all) (defalias 'gnus-add-text-properties 'add-text-properties) (defalias 'gnus-put-text-property 'put-text-property) (defvar gnus-mode-line-image-cache t) @@ -308,7 +339,9 @@ be set in `.emacs' instead." (:type xbm :file "gnus-pointer.xbm" :ascent center)))) gnus-mode-line-image-cache) - 'help-echo "This is Gnus") + 'help-echo (format + "This is %s, %s." + gnus-version (gnus-emacs-version))) str) (list str)) line))) @@ -317,7 +350,8 @@ be set in `.emacs' instead." (defalias 'gnus-deactivate-mark 'deactivate-mark) (defalias 'gnus-window-edges 'window-edges) (defalias 'gnus-key-press-event-p 'numberp) - (defalias 'gnus-decode-rfc1522 'ignore)) + ;;(defalias 'gnus-decode-rfc1522 'ignore) + ) ;; We define these group faces here to avoid the display ;; update forced when creating new faces. @@ -325,10 +359,10 @@ be set in `.emacs' instead." (defface gnus-group-news-1-face '((((class color) (background dark)) - (:foreground "PaleTurquoise" :weight bold)) + (:foreground "PaleTurquoise" :bold t)) (((class color) (background light)) - (:foreground "ForestGreen" :weight bold)) + (:foreground "ForestGreen" :bold t)) (t ())) "Level 1 newsgroup face.") @@ -347,10 +381,10 @@ be set in `.emacs' instead." (defface gnus-group-news-2-face '((((class color) (background dark)) - (:foreground "turquoise" :weight bold)) + (:foreground "turquoise" :bold t)) (((class color) (background light)) - (:foreground "CadetBlue4" :weight bold)) + (:foreground "CadetBlue4" :bold t)) (t ())) "Level 2 newsgroup face.") @@ -369,10 +403,10 @@ be set in `.emacs' instead." (defface gnus-group-news-3-face '((((class color) (background dark)) - (:weight bold)) + (:bold t)) (((class color) (background light)) - (:weight bold)) + (:bold t)) (t ())) "Level 3 newsgroup face.") @@ -391,10 +425,10 @@ be set in `.emacs' instead." (defface gnus-group-news-4-face '((((class color) (background dark)) - (:weight bold)) + (:bold t)) (((class color) (background light)) - (:weight bold)) + (:bold t)) (t ())) "Level 4 newsgroup face.") @@ -413,10 +447,10 @@ be set in `.emacs' instead." (defface gnus-group-news-5-face '((((class color) (background dark)) - (:weight bold)) + (:bold t)) (((class color) (background light)) - (:weight bold)) + (:bold t)) (t ())) "Level 5 newsgroup face.") @@ -435,10 +469,10 @@ be set in `.emacs' instead." (defface gnus-group-news-6-face '((((class color) (background dark)) - (:weight bold)) + (:bold t)) (((class color) (background light)) - (:weight bold)) + (:bold t)) (t ())) "Level 6 newsgroup face.") @@ -457,10 +491,10 @@ be set in `.emacs' instead." (defface gnus-group-news-low-face '((((class color) (background dark)) - (:foreground "DarkTurquoise" :weight bold)) + (:foreground "DarkTurquoise" :bold t)) (((class color) (background light)) - (:foreground "DarkGreen" :weight bold)) + (:foreground "DarkGreen" :bold t)) (t ())) "Low level newsgroup face.") @@ -479,12 +513,12 @@ be set in `.emacs' instead." (defface gnus-group-mail-1-face '((((class color) (background dark)) - (:foreground "aquamarine1" :weight bold)) + (:foreground "aquamarine1" :bold t)) (((class color) (background light)) - (:foreground "DeepPink3" :weight bold)) + (:foreground "DeepPink3" :bold t)) (t - (:weight bold))) + (:bold t))) "Level 1 mailgroup face.") (defface gnus-group-mail-1-empty-face @@ -495,18 +529,18 @@ be set in `.emacs' instead." (background light)) (:foreground "DeepPink3")) (t - (:slant italic :weight bold))) + (:italic t :bold t))) "Level 1 empty mailgroup face.") (defface gnus-group-mail-2-face '((((class color) (background dark)) - (:foreground "aquamarine2" :weight bold)) + (:foreground "aquamarine2" :bold t)) (((class color) (background light)) - (:foreground "HotPink3" :weight bold)) + (:foreground "HotPink3" :bold t)) (t - (:weight bold))) + (:bold t))) "Level 2 mailgroup face.") (defface gnus-group-mail-2-empty-face @@ -517,18 +551,18 @@ be set in `.emacs' instead." (background light)) (:foreground "HotPink3")) (t - (:weight bold))) + (:bold t))) "Level 2 empty mailgroup face.") (defface gnus-group-mail-3-face '((((class color) (background dark)) - (:foreground "aquamarine3" :weight bold)) + (:foreground "aquamarine3" :bold t)) (((class color) (background light)) - (:foreground "magenta4" :weight bold)) + (:foreground "magenta4" :bold t)) (t - (:weight bold))) + (:bold t))) "Level 3 mailgroup face.") (defface gnus-group-mail-3-empty-face @@ -545,12 +579,12 @@ be set in `.emacs' instead." (defface gnus-group-mail-low-face '((((class color) (background dark)) - (:foreground "aquamarine4" :weight bold)) + (:foreground "aquamarine4" :bold t)) (((class color) (background light)) - (:foreground "DeepPink4" :weight bold)) + (:foreground "DeepPink4" :bold t)) (t - (:weight bold))) + (:bold t))) "Low level mailgroup face.") (defface gnus-group-mail-low-empty-face @@ -561,7 +595,7 @@ be set in `.emacs' instead." (background light)) (:foreground "DeepPink4")) (t - (:weight bold))) + (:bold t))) "Low level empty mailgroup face.") ;; Summary mode faces. @@ -578,23 +612,23 @@ be set in `.emacs' instead." (defface gnus-summary-high-ticked-face '((((class color) (background dark)) - (:foreground "pink" :weight bold)) + (:foreground "pink" :bold t)) (((class color) (background light)) - (:foreground "firebrick" :weight bold)) + (:foreground "firebrick" :bold t)) (t - (:weight bold))) + (:bold t))) "Face used for high interest ticked articles.") (defface gnus-summary-low-ticked-face '((((class color) (background dark)) - (:foreground "pink" :slant italic)) + (:foreground "pink" :italic t)) (((class color) (background light)) - (:foreground "firebrick" :slant italic)) + (:foreground "firebrick" :italic t)) (t - (:slant italic))) + (:italic t))) "Face used for low interest ticked articles.") (defface gnus-summary-normal-ticked-face @@ -611,23 +645,23 @@ be set in `.emacs' instead." (defface gnus-summary-high-ancient-face '((((class color) (background dark)) - (:foreground "SkyBlue" :weight bold)) + (:foreground "SkyBlue" :bold t)) (((class color) (background light)) - (:foreground "RoyalBlue" :weight bold)) + (:foreground "RoyalBlue" :bold t)) (t - (:weight bold))) + (:bold t))) "Face used for high interest ancient articles.") (defface gnus-summary-low-ancient-face '((((class color) (background dark)) - (:foreground "SkyBlue" :slant italic)) + (:foreground "SkyBlue" :italic t)) (((class color) (background light)) - (:foreground "RoyalBlue" :slant italic)) + (:foreground "RoyalBlue" :italic t)) (t - (:slant italic))) + (:italic t))) "Face used for low interest ancient articles.") (defface gnus-summary-normal-ancient-face @@ -641,14 +675,41 @@ be set in `.emacs' instead." ())) "Face used for normal interest ancient articles.") +(defface gnus-summary-high-undownloaded-face + '((((class color) + (background light)) + (:bold t :foreground "cyan4")) + (((class color) (background dark)) + (:bold t :foreground "LightGray")) + (t (:inverse-video t :bold t))) + "Face used for high interest uncached articles.") + +(defface gnus-summary-low-undownloaded-face + '((((class color) + (background light)) + (:italic t :foreground "cyan4" :bold nil)) + (((class color) (background dark)) + (:italic t :foreground "LightGray" :bold nil)) + (t (:inverse-video t :italic t))) + "Face used for low interest uncached articles.") + +(defface gnus-summary-normal-undownloaded-face + '((((class color) + (background light)) + (:foreground "cyan4" :bold nil)) + (((class color) (background dark)) + (:foreground "LightGray" :bold nil)) + (t (:inverse-video t))) + "Face used for normal interest uncached articles.") + (defface gnus-summary-high-unread-face '((t - (:weight bold))) + (:bold t))) "Face used for high interest unread articles.") (defface gnus-summary-low-unread-face '((t - (:slant italic))) + (:italic t))) "Face used for low interest unread articles.") (defface gnus-summary-normal-unread-face @@ -660,26 +721,26 @@ be set in `.emacs' instead." '((((class color) (background dark)) (:foreground "PaleGreen" - :weight bold)) + :bold t)) (((class color) (background light)) (:foreground "DarkGreen" - :weight bold)) + :bold t)) (t - (:weight bold))) + (:bold t))) "Face used for high interest read articles.") (defface gnus-summary-low-read-face '((((class color) (background dark)) (:foreground "PaleGreen" - :slant italic)) + :italic t)) (((class color) (background light)) (:foreground "DarkGreen" - :slant italic)) + :italic t)) (t - (:slant italic))) + (:italic t))) "Face used for low interest read articles.") (defface gnus-summary-normal-read-face @@ -709,6 +770,13 @@ be set in `.emacs' instead." "Add the current buffer to the list of Gnus buffers." (push (current-buffer) gnus-buffers)) +(defmacro gnus-kill-buffer (buffer) + "Kill BUFFER and remove from the list of Gnus buffers." + `(let ((buf ,buffer)) + (when (gnus-buffer-exists-p buf) + (setq gnus-buffers (delete (get-buffer buf) gnus-buffers)) + (kill-buffer buf)))) + (defun gnus-buffers () "Return a list of live Gnus buffers." (while (and gnus-buffers @@ -731,13 +799,13 @@ be set in `.emacs' instead." (defface gnus-splash-face '((((class color) (background dark)) - (:foreground "Brown")) + (:foreground "#888888")) (((class color) (background light)) - (:foreground "Brown")) + (:foreground "#888888")) (t ())) - "Face of the splash screen.") + "Face for the splash screen.") (defun gnus-splash () (save-excursion @@ -765,6 +833,39 @@ be set in `.emacs' instead." (defvar gnus-simple-splash nil) +;;(format "%02x%02x%02x" 114 66 20) "724214" + +(defvar gnus-logo-color-alist + '((flame "#cc3300" "#ff2200") + (pine "#c0cc93" "#f8ffb8") + (moss "#a1cc93" "#d2ffb8") + (irish "#04cc90" "#05ff97") + (sky "#049acc" "#05deff") + (tin "#6886cc" "#82b6ff") + (velvet "#7c68cc" "#8c82ff") + (grape "#b264cc" "#cf7df") + (labia "#cc64c2" "#fd7dff") + (berry "#cc6485" "#ff7db5") + (dino "#724214" "#1e3f03") + (oort "#cccccc" "#888888") + (storm "#666699" "#99ccff") + (pdino "#9999cc" "#99ccff") + (purp "#9999cc" "#666699") + (no "#000000" "#ff0000") + (neutral "#b4b4b4" "#878787") + (september "#bf9900" "#ffcc00")) + "Color alist used for the Gnus logo.") + +(defcustom gnus-logo-color-style 'oort + "*Color styles used for the Gnus logo." + :type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem))) + gnus-logo-color-alist)) + :group 'gnus-xmas) + +(defvar gnus-logo-colors + (cdr (assq gnus-logo-color-style gnus-logo-color-alist)) + "Colors used for the Gnus logo.") + (defun gnus-group-startup-message (&optional x y) "Insert startup message in current buffer." ;; Insert the message. @@ -773,16 +874,22 @@ be set in `.emacs' instead." ((and (fboundp 'find-image) (display-graphic-p) - (let ((image (find-image - `((:type xpm :file "gnus.xpm") - (:type pbm :file "gnus.pbm" - ;; Account for the pbm's blackground. - :background ,(face-foreground 'gnus-splash-face) - :foreground ,(face-background 'default)) - (:type xbm :file "gnus.xbm" - ;; Account for the xbm's blackground. - :background ,(face-foreground 'gnus-splash-face) - :foreground ,(face-background 'default)))))) + (let* ((data-directory (nnheader-find-etc-directory "gnus")) + (image (find-image + `((:type xpm :file "gnus.xpm" + :color-symbols + (("thing" . ,(car gnus-logo-colors)) + ("shadow" . ,(cadr gnus-logo-colors)) + ("oort" . "#eeeeee") + ("background" . ,(face-background 'default)))) + (:type pbm :file "gnus.pbm" + ;; Account for the pbm's blackground. + :background ,(face-foreground 'gnus-splash-face) + :foreground ,(face-background 'default)) + (:type xbm :file "gnus.xbm" + ;; Account for the xbm's blackground. + :background ,(face-foreground 'gnus-splash-face) + :foreground ,(face-background 'default)))))) (when image (let ((size (image-size image))) (insert-char ?\n (max 0 (round (- (window-height) @@ -833,16 +940,113 @@ be set in `.emacs' instead." (eval-when (load) (let ((command (format "%s" this-command))) - (if (and (string-match "gnus" command) - (not (string-match "gnus-other-frame" command))) - (gnus-splash) - (gnus-get-buffer-create gnus-group-buffer)))) + (when (string-match "gnus" command) + (if (string-match "gnus-other-frame" command) + (gnus-get-buffer-create gnus-group-buffer) + (gnus-splash))))) ;;; Do the rest. (require 'gnus-util) (require 'nnheader) +(defcustom gnus-parameters nil + "Alist of group parameters. + +For example: + ((\"mail\\\\..*\" (gnus-show-threads nil) + (gnus-use-scoring nil) + (gnus-summary-line-format + \"%U%R%z%I%(%[%d:%ub%-23,23f%]%) %s\\n\") + (gcc-self . t) + (display . all)) + (\"mail\\\\.me\" (gnus-use-scoring t)) + (\"list\\\\..*\" (total-expire . t) + (broken-reply-to . t)))" + :group 'gnus-group-various + :type '(repeat (cons regexp + (repeat sexp)))) + +(defvar gnus-group-parameters-more nil) + +(defmacro gnus-define-group-parameter (param &rest rest) + "Define a group parameter PARAM. +REST is a plist of following: +:type One of `bool', `list' or nil. +:function The name of the function. +:function-document The documentation of the function. +:parameter-type The type for customizing the parameter. +:parameter-document The documentation for the parameter. +:variable The name of the variable. +:variable-document The documentation for the variable. +:variable-group The group for customizing the variable. +:variable-type The type for customizing the variable. +:variable-default The default value of the variable." + (let* ((type (plist-get rest :type)) + (parameter-type (plist-get rest :parameter-type)) + (parameter-document (plist-get rest :parameter-document)) + (function (or (plist-get rest :function) + (intern (format "gnus-parameter-%s" param)))) + (function-document (or (plist-get rest :function-document) "")) + (variable (or (plist-get rest :variable) + (intern (format "gnus-parameter-%s-alist" param)))) + (variable-document (or (plist-get rest :variable-document) "")) + (variable-group (plist-get rest :variable-group)) + (variable-type (or (plist-get rest :variable-type) + `(quote (repeat + (list (regexp :tag "Group") + ,(car (cdr parameter-type))))))) + (variable-default (plist-get rest :variable-default))) + (list + 'progn + `(defcustom ,variable ,variable-default + ,variable-document + :group 'gnus-group-parameter + :group ',variable-group + :type ,variable-type) + `(setq gnus-group-parameters-more + (delq (assq ',param gnus-group-parameters-more) + gnus-group-parameters-more)) + `(add-to-list 'gnus-group-parameters-more + (list ',param + ,parameter-type + ,parameter-document)) + (if (eq type 'bool) + `(defun ,function (name) + ,function-document + (let ((params (gnus-group-find-parameter name)) + val) + (cond + ((memq ',param params) + t) + ((setq val (assq ',param params)) + (cdr val)) + ((stringp ,variable) + (string-match ,variable name)) + (,variable + (let ((alist ,variable) + elem value) + (while (setq elem (pop alist)) + (when (and name + (string-match (car elem) name)) + (setq alist nil + value (cdr elem)))) + (if (consp value) (car value) value)))))) + `(defun ,function (name) + ,function-document + (and name + (or (gnus-group-find-parameter name ',param ,(and type t)) + (let ((alist ,variable) + elem value) + (while (setq elem (pop alist)) + (when (and name + (string-match (car elem) name)) + (setq alist nil + value (cdr elem)))) + ,(if type + 'value + '(if (consp value) (car value) value)))))))))) + (defcustom gnus-home-directory "~/" "Directory variable that specifies the \"home\" directory. All other Gnus file and directory variables are initialized from this variable." @@ -891,21 +1095,17 @@ used to 899, you would say something along these lines: :group 'gnus-server :type 'file) -;; This function is used to check both the environment variable -;; NNTPSERVER and the /etc/nntpserver file to see whether one can find -;; an nntp server name default. (defun gnus-getenv-nntpserver () + "Find default nntp server. +Check the NNTPSERVER environment variable and the +`gnus-nntpserver-file' file." (or (getenv "NNTPSERVER") (and (file-readable-p gnus-nntpserver-file) - (save-excursion - (set-buffer (gnus-get-buffer-create " *gnus nntp*")) + (with-temp-buffer (insert-file-contents gnus-nntpserver-file) (let ((name (buffer-string))) - (prog1 - (if (string-match "\\'[ \t\n]*$" name) - nil - name) - (kill-buffer (current-buffer)))))))) + (unless (string-match "\\`[ \t\n]*$" name) + name)))))) (defcustom gnus-select-method (condition-case nil @@ -926,8 +1126,8 @@ used to 899, you would say something along these lines: This variable should be a list, where the first element is how the news is to be fetched, the second is the address. -For instance, if you want to get your news via NNTP from -\"flab.flab.edu\", you could say: +For instance, if you want to get your news via \"flab.flab.edu\" using +NNTP, you could say: \(setq gnus-select-method '(nntp \"flab.flab.edu\")) @@ -942,26 +1142,13 @@ see the manual for details." :group 'gnus-server :type 'gnus-select-method) -(defcustom gnus-message-archive-method - (progn - ;; Don't require it at top level to avoid circularity. - (require 'message) - `(nnfolder - "archive" - (nnfolder-directory ,(nnheader-concat message-directory "archive")) - (nnfolder-active-file - ,(nnheader-concat message-directory "archive/active")) - (nnfolder-get-new-mail nil) - (nnfolder-inhibit-expiry t))) +(defcustom gnus-message-archive-method "archive" "*Method used for archiving messages you've sent. -This should be a mail method. - -It's probably not very effective to change this variable once you've -run Gnus once. After doing that, you must edit this server from the -server buffer." +This should be a mail method." :group 'gnus-server :group 'gnus-message - :type 'gnus-select-method) + :type '(choice (const :tag "Default archive method" "archive") + gnus-select-method)) (defcustom gnus-message-archive-group nil "*Name of the group in which to save the messages you've written. @@ -974,9 +1161,9 @@ 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 - '((if (message-news-p) - \"misc-news\" - \"misc-mail\"))) + '((if (message-news-p) + \"misc-news\" + \"misc-mail\"))) Normally the group names returned by this variable should be unprefixed -- which implicitly means \"store on the archive server\". @@ -1009,7 +1196,7 @@ variable instead." This is a list where each element is a complete select method (see `gnus-select-method'). -If, for instance, you want to read your mail with the nnml backend, +If, for instance, you want to read your mail with the nnml back end, you could set this variable: \(setq gnus-secondary-select-methods '((nnml \"\")))" @@ -1050,27 +1237,28 @@ It can also be a list of select methods, as well as the special symbol list, Gnus will try all the methods in the list until it finds a match." :group 'gnus-server :type '(choice (const :tag "default" nil) - (const :tag "DejaNews" (nnweb "refer" (nnweb-type dejanews))) + (const current) + (const :tag "Google" (nnweb "refer" (nnweb-type google))) gnus-select-method (repeat :menu-tag "Try multiple" :tag "Multiple" - :value (current (nnweb "refer" (nnweb-type dejanews))) + :value (current (nnweb "refer" (nnweb-type google))) (choice :tag "Method" (const current) - (const :tag "DejaNews" - (nnweb "refer" (nnweb-type dejanews))) + (const :tag "Google" + (nnweb "refer" (nnweb-type google))) gnus-select-method)))) (defcustom gnus-group-faq-directory '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/" - "/ftp@sunsite.auc.dk:/pub/usenet/" "/ftp@sunsite.doc.ic.ac.uk:/pub/usenet/news-faqs/" "/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/" "/ftp@ftp.seas.gwu.edu:/pub/rtfm/" + "/ftp@ftp.pasteur.fr:/pub/FAQ/" "/ftp@rtfm.mit.edu:/pub/usenet/" "/ftp@ftp.uni-paderborn.de:/pub/FAQ/" "/ftp@ftp.sunet.se:/pub/usenet/" - "/ftp@nctuccca.edu.tw:/USENET/FAQ/" + "/ftp@nctuccca.nctu.edu.tw:/pub/Documents/rtfm/usenet-by-group/" "/ftp@hwarang.postech.ac.kr:/pub/usenet/" "/ftp@ftp.hk.super.net:/mirror/faqs/") "*Directory where the group FAQs are stored. @@ -1091,16 +1279,50 @@ If the default site is too slow, try one of these: ftp.seas.gwu.edu /pub/rtfm rtfm.mit.edu /pub/usenet Europe: ftp.uni-paderborn.de /pub/FAQ - src.doc.ic.ac.uk /usenet/news-FAQS + src.doc.ic.ac.uk /usenet/news-FAQS ftp.sunet.se /pub/usenet - sunsite.auc.dk /pub/usenet - Asia: nctuccca.edu.tw /USENET/FAQ + ftp.pasteur.fr /pub/FAQ + Asia: nctuccca.nctu.edu.tw /pub/Documents/rtfm/usenet-by-group/ hwarang.postech.ac.kr /pub/usenet ftp.hk.super.net /mirror/faqs" :group 'gnus-group-various :type '(choice directory (repeat directory))) +(defcustom gnus-group-charter-alist + '(("no" . (concat "http://no.news-admin.org/charter/" name ".txt")) + ("de" . (concat "http://purl.net/charta/" name ".html")) + ("dk" . (concat "http://www.usenet.dk/grupper.pl?get=" name)) + ("england" . (concat "http://england.news-admin.org/charters/" name)) + ("fr" . (concat "http://www.usenet-fr.net/fur/chartes/" name ".html")) + ("europa" . (concat "http://www.europa.usenet.eu.org/chartas/charta-en-" + (gnus-replace-in-string name "europa\\." "") ".html")) + ("nl" . (concat "http://www.xs4all.nl/~sister/usenet/charters/" name)) + ("aus" . (concat "http://aus.news-admin.org/groupinfo.cgi/" name)) + ("pl" . (concat "http://www.usenet.pl/opisy/" name)) + ("ch" . (concat "http://www.use-net.ch/Usenet/charter.html#" name)) + ("at" . (concat "http://www.usenet.at/chartas/" name "/charta")) + ("uk" . (concat "http://www.usenet.org.uk/" name ".html")) + ("dfw" . (concat "http://www.cirr.com/dfw/charters/" name ".html")) + ("se" . (concat "http://www.usenet-se.net/Reglementen/" + (gnus-replace-in-string name "\\." "_") ".html")) + ("milw" . (concat "http://usenet.mil.wi.us/" + (gnus-replace-in-string name "milw\\." "") "-charter")) + ("ca" . (concat "http://www.sbay.org/ca/charter-" name ".html")) + ("netins" . (concat "http://www.netins.net/usenet/charter/" + (gnus-replace-in-string name "\\." "-") "-charter.html"))) + "*An alist of (HIERARCHY . FORM) pairs used to construct the URL of a charter. +When FORM is evaluated `name' is bound to the name of the group." + :group 'gnus-group-various + :type '(repeat (cons (string :tag "Hierarchy") (sexp :tag "Form")))) + +(defcustom gnus-group-fetch-control-use-browse-url nil + "*Non-nil means that control messages are displayed using `browse-url'. +Otherwise they are fetched with ange-ftp and displayed in an ephemeral +group." + :group 'gnus-group-various + :type 'boolean) + (defcustom gnus-use-cross-reference t "*Non-nil means that cross referenced articles will be marked as read. If nil, ignore cross references. If t, mark articles as read in @@ -1121,9 +1343,11 @@ newsgroups." (defcustom gnus-large-newsgroup 200 "*The number of articles which indicates a large newsgroup. If the number of articles in a newsgroup is greater than this value, -confirmation is required for selecting the newsgroup." +confirmation is required for selecting the newsgroup. +If it is nil, no confirmation is required." :group 'gnus-group-select - :type 'integer) + :type '(choice (const :tag "No limit" nil) + integer)) (defcustom gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix))) "*Non-nil means that the default name of a file to save articles in is the group name. @@ -1139,7 +1363,14 @@ Note that the default for this variable varies according to what system type you're using. On `usg-unix-v' and `xenix' this variable defaults to nil while on all other systems it defaults to t." :group 'gnus-start - :type 'boolean) + :type '(radio (sexp :format "Non-nil\n" + :match (lambda (widget value) + (and value (not (listp value)))) + :value t) + (const nil) + (checklist (const :format "%v " not-score) + (const :format "%v " not-save) + (const not-kill)))) (defcustom gnus-kill-files-directory gnus-directory "*Name of the directory where kill files will be stored (default \"~/News\")." @@ -1188,7 +1419,7 @@ cache to the full extent of the law." :group 'gnus-meta :type 'boolean) -(defcustom gnus-keep-backlog nil +(defcustom gnus-keep-backlog 20 "*If non-nil, Gnus will keep read articles for later re-retrieval. If it is a number N, then Gnus will only keep the last N articles read. If it is neither nil nor a number, Gnus will keep all read @@ -1214,11 +1445,6 @@ articles. This is not a good idea." :group 'gnus-meta :type 'boolean) -(defcustom gnus-use-picons nil - "*If non-nil, display picons in a frame of their own." - :group 'gnus-meta - :type 'boolean) - (defcustom gnus-summary-prepare-exit-hook '(gnus-summary-expire-articles) "*A hook called when preparing to exit from the summary buffer. @@ -1227,7 +1453,7 @@ It calls `gnus-summary-expire-articles' by default." :type 'hook) (defcustom gnus-novice-user t - "*Non-nil means that you are a usenet novice. + "*Non-nil means that you are a Usenet novice. If non-nil, verbose messages may be displayed and confirmations may be required." :group 'gnus-meta @@ -1267,7 +1493,7 @@ slower." :type 'boolean) (defcustom gnus-shell-command-separator ";" - "String used to separate to shell commands." + "String used to separate shell commands." :group 'gnus-files :type 'string) @@ -1276,7 +1502,7 @@ slower." ("nnspool" post address) ("nnvirtual" post-mail virtual prompt-address) ("nnmbox" mail respool address) - ("nnml" mail respool address) + ("nnml" post-mail respool address) ("nnmh" mail respool address) ("nndir" post-mail prompt-address physical-address) ("nneething" none address prompt-address physical-address) @@ -1288,12 +1514,17 @@ slower." ("nnfolder" mail respool address) ("nngateway" post-mail address prompt-address physical-address) ("nnweb" none) + ("nngoogle" post) ("nnslashdot" post) ("nnultimate" none) + ("nnrss" none) + ("nnwfm" none) ("nnwarchive" none) ("nnlistserv" none) ("nnagent" post-mail) - ("nnimap" post-mail address prompt-address physical-address)) + ("nnimap" post-mail address prompt-address physical-address) + ("nnmaildir" mail respool address) + ("nnnil" none)) "*An alist of valid select methods. The first element of each list lists should be a string with the name of the select method. The other elements may be the category of @@ -1332,8 +1563,7 @@ this variable. I think." :inline t (list :format "%v" variable - (sexp :tag "Value")))) - )) + (sexp :tag "Value")))))) (gnus-redefine-select-method-widget) @@ -1353,29 +1583,582 @@ If this variable is nil, screen refresh may be quicker." (defcustom gnus-mode-non-string-length nil "*Max length of mode-line non-string contents. If this is nil, Gnus will take space as is needed, leaving the rest -of the modeline intact. Note that the default of nil is unlikely +of the mode line intact. Note that the default of nil is unlikely to be desirable; see the manual for further details." :group 'gnus-various :type '(choice (const nil) integer)) -(defcustom gnus-auto-expirable-newsgroups nil - "*Groups in which to automatically mark read articles as expirable. +;; There should be special validation for this. +(define-widget 'gnus-email-address 'string + "An email address.") + +(gnus-define-group-parameter + to-address + :function-document + "Return GROUP's to-address." + :variable-document + "*Alist of group regexps and correspondent to-addresses." + :parameter-type '(gnus-email-address :tag "To Address") + :parameter-document "\ +This will be used when doing followups and posts. + +This is primarily useful in mail groups that represent closed +mailing lists--mailing lists where it's expected that everybody that +writes to the mailing list is subscribed to it. Since using this +parameter ensures that the mail only goes to the mailing list itself, +it means that members won't receive two copies of your followups. + +Using `to-address' will actually work whether the group is foreign or +not. Let's say there's a group on the server that is called +`fa.4ad-l'. This is a real newsgroup, but the server has gotten the +articles from a mail-to-news gateway. Posting directly to this group +is therefore impossible--you have to send mail to the mailing list +address instead. + +The gnus-group-split mail splitting mechanism will behave as if this +address was listed in gnus-group-split Addresses (see below).") + +(gnus-define-group-parameter + to-list + :function-document + "Return GROUP's to-list." + :variable-document + "*Alist of group regexps and correspondent to-lists." + :parameter-type '(gnus-email-address :tag "To List") + :parameter-document "\ +This address will be used when doing a `a' in the group. + +It is totally ignored when doing a followup--except that if it is +present in a news group, you'll get mail group semantics when doing +`f'. + +The gnus-group-split mail splitting mechanism will behave as if this +address was listed in gnus-group-split Addresses (see below).") + +(gnus-define-group-parameter + subscribed + :type bool + :function-document + "Return GROUP's subscription status." + :variable-document + "*Groups which are automatically considered subscribed." + :parameter-type '(const :tag "Subscribed" t) + :parameter-document "\ +Gnus assumed that you are subscribed to the To/List address. + +When constructing a list of subscribed groups using +`gnus-find-subscribed-addresses', Gnus includes the To address given +above, or the list address (if the To address has not been set).") + +(gnus-define-group-parameter + auto-expire + :type bool + :function gnus-group-auto-expirable-p + :function-document + "Check whether GROUP is auto-expirable or not." + :variable gnus-auto-expirable-newsgroups + :variable-default nil + :variable-document + "*Groups in which to automatically mark read articles as expirable. If non-nil, this should be a regexp that should match all groups in which to perform auto-expiry. This only makes sense for mail groups." - :group 'nnmail-expire - :type '(choice (const nil) - regexp)) - -(defcustom gnus-total-expirable-newsgroups nil - "*Groups in which to perform expiry of all read articles. + :variable-group nnmail-expire + :variable-type '(choice (const nil) + regexp) + :parameter-type '(const :tag "Automatic Expire" t) + :parameter-document + "All articles that are read will be marked as expirable.") + +(gnus-define-group-parameter + total-expire + :type bool + :function gnus-group-total-expirable-p + :function-document + "Check whether GROUP is total-expirable or not." + :variable gnus-total-expirable-newsgroups + :variable-default nil + :variable-document + "*Groups in which to perform expiry of all read articles. Use with extreme caution. All groups that match this regexp will be expiring - which means that all read articles will be deleted after \(say) one week. (This only goes for mail groups and the like, of course.)" - :group 'nnmail-expire - :type '(choice (const nil) - regexp)) + :variable-group nnmail-expire + :variable-type '(choice (const nil) + regexp) + :parameter-type '(const :tag "Total Expire" t) + :parameter-document + "All read articles will be put through the expiry process + +This happens even if they are not marked as expirable. +Use with caution.") + +(gnus-define-group-parameter + charset + :function-document + "Return the default charset of GROUP." + :variable gnus-group-charset-alist + :variable-default + '(("\\(^\\|:\\)hk\\>\\|\\(^\\|:\\)tw\\>\\|\\<big5\\>" cn-big5) + ("\\(^\\|:\\)cn\\>\\|\\<chinese\\>" cn-gb-2312) + ("\\(^\\|:\\)fj\\>\\|\\(^\\|:\\)japan\\>" iso-2022-jp-2) + ("\\(^\\|:\\)tnn\\>\\|\\(^\\|:\\)pin\\>\\|\\(^\\|:\\)sci.lang.japan" iso-2022-7bit) + ("\\(^\\|:\\)relcom\\>" koi8-r) + ("\\(^\\|:\\)fido7\\>" koi8-r) + ("\\(^\\|:\\)\\(cz\\|hun\\|pl\\|sk\\|hr\\)\\>" iso-8859-2) + ("\\(^\\|:\\)israel\\>" iso-8859-1) + ("\\(^\\|:\\)han\\>" euc-kr) + ("\\(^\\|:\\)alt.chinese.text.big5\\>" chinese-big5) + ("\\(^\\|:\\)soc.culture.vietnamese\\>" vietnamese-viqr) + ("\\(^\\|:\\)\\(comp\\|rec\\|alt\\|sci\\|soc\\|news\\|gnu\\|bofh\\)\\>" iso-8859-1)) + :variable-document + "Alist of regexps (to match group names) and default charsets to be used when reading." + :variable-group gnus-charset + :variable-type '(repeat (list (regexp :tag "Group") + (symbol :tag "Charset"))) + :parameter-type '(symbol :tag "Charset") + :parameter-document "\ +The default charset to use in the group.") + +(gnus-define-group-parameter + post-method + :type list + :function-document + "Return a posting method for GROUP." + :variable gnus-post-method-alist + :variable-document + "Alist of regexps (to match group names) and method to be used when +posting an article." + :variable-group gnus-group-foreign + :parameter-type + '(choice :tag "Posting Method" + (const :tag "Use native server" native) + (const :tag "Use current server" current) + (list :convert-widget + (lambda (widget) + (list 'sexp :tag "Methods" + :value gnus-select-method)))) + :parameter-document + "Posting method for this group.") + +(gnus-define-group-parameter + large-newsgroup-initial + :type integer + :function-document + "Return GROUP's initial input of the number of articles." + :variable-document + "*Alist of group regexps and its initial input of the number of articles." + :parameter-type '(choice :tag "Initial Input for Large Newsgroup" + (const :tag "All" nil) + (integer)) + :parameter-document "\ + +This number will be prompted as the initial value of the number of +articles to list when the group is a large newsgroup (see +`gnus-large-newsgroup'). If it is nil, the default value is the +total number of articles in the group.") + +;; The Gnus registry's ignored groups +(gnus-define-group-parameter + registry-ignore + :type list + :function-document + "Whether this group should be ignored by the registry." + :variable gnus-registry-ignored-groups + :variable-default nil + :variable-document + "*Groups in which the registry should be turned off." + :variable-group gnus-registry + :variable-type '(repeat + (list + (regexp :tag "Group Name Regular Expression") + (boolean :tag "Ignored"))) + + :parameter-type '(boolean :tag "Group Ignored by the Registry") + :parameter-document + "Whether the Gnus Registry should ignore this group.") + +;; group parameters for spam processing added by Ted Zlatanov <tzz@lifelogs.com> +(defcustom gnus-install-group-spam-parameters t + "*Disable the group parameters for spam detection. +Enable if `G c' in XEmacs is giving you trouble, and make sure to submit a bug report." + :type 'boolean + :group 'gnus-start) + +(when gnus-install-group-spam-parameters + (defvar gnus-group-spam-classification-spam t + "Spam group classification (requires spam.el). +This group contains spam messages. On summary entry, unread messages +will be marked as spam. On summary exit, the specified spam +processors will be invoked on spam-marked messages, then those +messages will be expired, so the spam processor will only see a +spam-marked message once.") + + (defvar gnus-group-spam-classification-ham 'ask + "The ham value for the spam group parameter (requires spam.el). +On summary exit, the specified ham processors will be invoked on +ham-marked messages. Exercise caution, since the ham processor will +see the same message more than once because there is no ham message +registry.") + + (gnus-define-group-parameter + spam-contents + :type list + :function-document + "The spam type (spam, ham, or neither) of the group." + :variable gnus-spam-newsgroup-contents + :variable-default nil + :variable-document + "*Groups in which to automatically mark new articles as spam on +summary entry. If non-nil, this should be a list of group name +regexps that should match all groups in which to do automatic spam +tagging, associated with a classification (spam, ham, or neither). +This only makes sense for mail groups." + :variable-group spam + :variable-type '(repeat + (list :tag "Group contents spam/ham classification" + (regexp :tag "Group") + (choice + (variable-item gnus-group-spam-classification-spam) + (variable-item gnus-group-spam-classification-ham) + (const :tag "Unclassified" nil)))) + + :parameter-type '(list :tag "Group contents spam/ham classification" + (choice :tag "Group contents classification for spam sorting" + (variable-item gnus-group-spam-classification-spam) + (variable-item gnus-group-spam-classification-ham) + (const :tag "Unclassified" nil))) + :parameter-document + "The spam classification (spam, ham, or neither) of this group. +When a spam group is entered, all unread articles are marked as spam.") + + (defvar gnus-group-spam-exit-processor-ifile "ifile" + "OBSOLETE: The ifile summary exit spam processor.") + + (defvar gnus-group-spam-exit-processor-stat "stat" + "OBSOLETE: The spam-stat summary exit spam processor.") + + (defvar gnus-group-spam-exit-processor-bogofilter "bogofilter" + "OBSOLETE: The Bogofilter summary exit spam processor.") + + (defvar gnus-group-spam-exit-processor-blacklist "blacklist" + "OBSOLETE: The Blacklist summary exit spam processor.") + + (defvar gnus-group-spam-exit-processor-report-gmane "report-gmane" + "OBSOLETE: The Gmane reporting summary exit spam processor. +Only applicable to NNTP groups with articles from Gmane. See spam-report.el") + + (defvar gnus-group-spam-exit-processor-spamoracle "spamoracle-spam" + "OBSOLETE: The spamoracle summary exit spam processor.") + + (defvar gnus-group-ham-exit-processor-ifile "ifile-ham" + "OBSOLETE: The ifile summary exit ham processor. +Only applicable to non-spam (unclassified and ham) groups.") + + (defvar gnus-group-ham-exit-processor-bogofilter "bogofilter-ham" + "OBSOLETE: The Bogofilter summary exit ham processor. +Only applicable to non-spam (unclassified and ham) groups.") + + (defvar gnus-group-ham-exit-processor-stat "stat-ham" + "OBSOLETE: The spam-stat summary exit ham processor. +Only applicable to non-spam (unclassified and ham) groups.") + + (defvar gnus-group-ham-exit-processor-whitelist "whitelist" + "OBSOLETE: The whitelist summary exit ham processor. +Only applicable to non-spam (unclassified and ham) groups.") + + (defvar gnus-group-ham-exit-processor-BBDB "bbdb" + "OBSOLETE: The BBDB summary exit ham processor. +Only applicable to non-spam (unclassified and ham) groups.") + + (defvar gnus-group-ham-exit-processor-copy "copy" + "OBSOLETE: The ham copy exit ham processor. +Only applicable to non-spam (unclassified and ham) groups.") + + (defvar gnus-group-ham-exit-processor-spamoracle "spamoracle-ham" + "OBSOLETE: The spamoracle summary exit ham processor. +Only applicable to non-spam (unclassified and ham) groups.") + + (gnus-define-group-parameter + spam-process + :type list + :parameter-type + '(choice + :tag "Spam Summary Exit Processor" + :value nil + (list :tag "Spam Summary Exit Processor Choices" + (set + (variable-item gnus-group-spam-exit-processor-ifile) + (variable-item gnus-group-spam-exit-processor-stat) + (variable-item gnus-group-spam-exit-processor-bogofilter) + (variable-item gnus-group-spam-exit-processor-blacklist) + (variable-item gnus-group-spam-exit-processor-spamoracle) + (variable-item gnus-group-spam-exit-processor-report-gmane) + (variable-item gnus-group-ham-exit-processor-bogofilter) + (variable-item gnus-group-ham-exit-processor-ifile) + (variable-item gnus-group-ham-exit-processor-stat) + (variable-item gnus-group-ham-exit-processor-whitelist) + (variable-item gnus-group-ham-exit-processor-BBDB) + (variable-item gnus-group-ham-exit-processor-spamoracle) + (variable-item gnus-group-ham-exit-processor-copy) + (const :tag "Spam: Gmane Report" (spam spam-use-gmane)) + (const :tag "Spam: Bogofilter" (spam spam-use-bogofilter)) + (const :tag "Spam: Blacklist" (spam spam-use-blacklist)) + (const :tag "Spam: ifile" (spam spam-use-ifile)) + (const :tag "Spam: Spam-stat" (spam spam-use-stat)) + (const :tag "Spam: Spam Oracle" (spam spam-use-spamoracle)) + (const :tag "Ham: ifile" (ham spam-use-ifile)) + (const :tag "Ham: Bogofilter" (ham spam-use-bogofilter)) + (const :tag "Ham: Spam-stat" (ham spam-use-stat)) + (const :tag "Ham: Whitelist" (ham spam-use-whitelist)) + (const :tag "Ham: BBDB" (ham spam-use-BBDB)) + (const :tag "Ham: Copy" (ham spam-use-ham-copy)) + (const :tag "Ham: Spam Oracle" (ham spam-use-spamoracle))))) + :function-document + "Which spam or ham processors will be applied when the summary is exited." + :variable gnus-spam-process-newsgroups + :variable-default nil + :variable-document + "*Groups in which to automatically process spam or ham articles with +a backend on summary exit. If non-nil, this should be a list of group +name regexps that should match all groups in which to do automatic +spam processing, associated with the appropriate processor." + :variable-group spam + :variable-type + '(repeat :tag "Spam/Ham Processors" + (list :tag "Spam Summary Exit Processor Choices" + (regexp :tag "Group Regexp") + (set + :tag "Spam/Ham Summary Exit Processor" + (variable-item gnus-group-spam-exit-processor-ifile) + (variable-item gnus-group-spam-exit-processor-stat) + (variable-item gnus-group-spam-exit-processor-bogofilter) + (variable-item gnus-group-spam-exit-processor-blacklist) + (variable-item gnus-group-spam-exit-processor-spamoracle) + (variable-item gnus-group-spam-exit-processor-report-gmane) + (variable-item gnus-group-ham-exit-processor-bogofilter) + (variable-item gnus-group-ham-exit-processor-ifile) + (variable-item gnus-group-ham-exit-processor-stat) + (variable-item gnus-group-ham-exit-processor-whitelist) + (variable-item gnus-group-ham-exit-processor-BBDB) + (variable-item gnus-group-ham-exit-processor-spamoracle) + (variable-item gnus-group-ham-exit-processor-copy) + (const :tag "Spam: Gmane Report" (spam spam-use-gmane)) + (const :tag "Spam: Bogofilter" (spam spam-use-bogofilter)) + (const :tag "Spam: Blacklist" (spam spam-use-blacklist)) + (const :tag "Spam: ifile" (spam spam-use-ifile)) + (const :tag "Spam: Spam-stat" (spam spam-use-stat)) + (const :tag "Spam: Spam Oracle" (spam spam-use-spamoracle)) + (const :tag "Ham: ifile" (ham spam-use-ifile)) + (const :tag "Ham: Bogofilter" (ham spam-use-bogofilter)) + (const :tag "Ham: Spam-stat" (ham spam-use-stat)) + (const :tag "Ham: Whitelist" (ham spam-use-whitelist)) + (const :tag "Ham: BBDB" (ham spam-use-BBDB)) + (const :tag "Ham: Copy" (ham spam-use-ham-copy)) + (const :tag "Ham: Spam Oracle" (ham spam-use-spamoracle))))) + + :parameter-document + "Which spam or ham processors will be applied when the summary is exited.") + + (gnus-define-group-parameter + spam-autodetect + :type list + :parameter-type + '(boolean :tag "Spam autodetection") + :function-document + "Should spam be autodetected (with spam-split) in this group?" + :variable gnus-spam-autodetect + :variable-default nil + :variable-document + "*Groups in which spam should be autodetected when they are entered. + Only unseen articles will be examined, unless + spam-autodetect-recheck-messages is set." + :variable-group spam + :variable-type + '(repeat + :tag "Autodetection setting" + (list + (regexp :tag "Group Regexp") + boolean)) + :parameter-document + "Spam autodetection. +Only unseen articles will be examined, unless +spam-autodetect-recheck-messages is set.") + + (gnus-define-group-parameter + spam-autodetect-methods + :type list + :parameter-type + '(choice :tag "Spam autodetection-specific methods" + (const none) + (const default) + (set :tag "Use specific methods" + (variable-item spam-use-blacklist) + (variable-item spam-use-regex-headers) + (variable-item spam-use-regex-body) + (variable-item spam-use-whitelist) + (variable-item spam-use-BBDB) + (variable-item spam-use-ifile) + (variable-item spam-use-spamoracle) + (variable-item spam-use-stat) + (variable-item spam-use-blackholes) + (variable-item spam-use-hashcash) + (variable-item spam-use-bogofilter-headers) + (variable-item spam-use-bogofilter))) + :function-document + "Methods to be used for autodetection in each group" + :variable gnus-spam-autodetect-methods + :variable-default nil + :variable-document + "*Methods for autodetecting spam per group. +Requires the spam-autodetect parameter. Only unseen articles +will be examined, unless spam-autodetect-recheck-messages is +set." + :variable-group spam + :variable-type + '(repeat + :tag "Autodetection methods" + (list + (regexp :tag "Group Regexp") + (choice + (const none) + (const default) + (set :tag "Use specific methods" + (variable-item spam-use-blacklist) + (variable-item spam-use-regex-headers) + (variable-item spam-use-regex-body) + (variable-item spam-use-whitelist) + (variable-item spam-use-BBDB) + (variable-item spam-use-ifile) + (variable-item spam-use-spamoracle) + (variable-item spam-use-stat) + (variable-item spam-use-blackholes) + (variable-item spam-use-hashcash) + (variable-item spam-use-bogofilter-headers) + (variable-item spam-use-bogofilter))))) + :parameter-document + "Spam autodetection methods. +Requires the spam-autodetect parameter. Only unseen articles +will be examined, unless spam-autodetect-recheck-messages is +set.") + + (gnus-define-group-parameter + spam-process-destination + :type list + :parameter-type + '(choice :tag "Destination for spam-processed articles at summary exit" + (string :tag "Move to a group") + (repeat :tag "Move to multiple groups" + (string :tag "Destination group")) + (const :tag "Expire" nil)) + :function-document + "Where spam-processed articles will go at summary exit." + :variable gnus-spam-process-destinations + :variable-default nil + :variable-document + "*Groups in which to explicitly send spam-processed articles to +another group, or expire them (the default). If non-nil, this should +be a list of group name regexps that should match all groups in which +to do spam-processed article moving, associated with the destination +group or nil for explicit expiration. This only makes sense for +mail groups." + :variable-group spam + :variable-type + '(repeat + :tag "Spam-processed articles destination" + (list + (regexp :tag "Group Regexp") + (choice + :tag "Destination for spam-processed articles at summary exit" + (string :tag "Move to a group") + (repeat :tag "Move to multiple groups" + (string :tag "Destination group")) + (const :tag "Expire" nil)))) + :parameter-document + "Where spam-processed articles will go at summary exit.") + + (gnus-define-group-parameter + ham-process-destination + :type list + :parameter-type + '(choice + :tag "Destination for ham articles at summary exit from a spam group" + (string :tag "Move to a group") + (repeat :tag "Move to multiple groups" + (string :tag "Destination group")) + (const :tag "Respool" respool) + (const :tag "Do nothing" nil)) + :function-document + "Where ham articles will go at summary exit from a spam group." + :variable gnus-ham-process-destinations + :variable-default nil + :variable-document + "*Groups in which to explicitly send ham articles to +another group, or do nothing (the default). If non-nil, this should +be a list of group name regexps that should match all groups in which +to do ham article moving, associated with the destination +group or nil for explicit ignoring. This only makes sense for +mail groups, and only works in spam groups." + :variable-group spam + :variable-type + '(repeat + :tag "Ham articles destination" + (list + (regexp :tag "Group Regexp") + (choice + :tag "Destination for ham articles at summary exit from spam group" + (string :tag "Move to a group") + (repeat :tag "Move to multiple groups" + (string :tag "Destination group")) + (const :tag "Respool" respool) + (const :tag "Expire" nil)))) + :parameter-document + "Where ham articles will go at summary exit from a spam group.") + + (gnus-define-group-parameter + ham-marks + :type 'list + :parameter-type '(list :tag "Ham mark choices" + (set + (variable-item gnus-del-mark) + (variable-item gnus-read-mark) + (variable-item gnus-ticked-mark) + (variable-item gnus-killed-mark) + (variable-item gnus-kill-file-mark) + (variable-item gnus-low-score-mark))) + + :parameter-document + "Marks considered ham (positively not spam). Such articles will be +processed as ham (non-spam) on group exit. When nil, the global +spam-ham-marks variable takes precedence." + :variable-default '((".*" ((gnus-del-mark + gnus-read-mark + gnus-killed-mark + gnus-kill-file-mark + gnus-low-score-mark)))) + :variable-group spam + :variable-document + "*Groups in which to explicitly set the ham marks to some value.") + + (gnus-define-group-parameter + spam-marks + :type 'list + :parameter-type '(list :tag "Spam mark choices" + (set + (variable-item gnus-spam-mark) + (variable-item gnus-killed-mark) + (variable-item gnus-kill-file-mark) + (variable-item gnus-low-score-mark))) + + :parameter-document + "Marks considered spam. +Such articles will be processed as spam on group exit. When nil, the global +spam-spam-marks variable takes precedence." + :variable-default '((".*" ((gnus-spam-mark)))) + :variable-group spam + :variable-document + "*Groups in which to explicitly set the spam marks to some value.")) (defcustom gnus-group-uncollapsed-levels 1 "Number of group name elements to leave alone when making a short group name." @@ -1466,6 +2249,18 @@ and `grouplens-menu'." (const pick-menu) (const grouplens-menu))) +;; Byte-compiler warning. +(defvar gnus-visual) +;; Find out whether the gnus-visual TYPE is wanted. +(defun gnus-visual-p (&optional type class) + (and gnus-visual ; Has to be non-nil, at least. + (if (not type) ; We don't care about type. + gnus-visual + (if (listp gnus-visual) ; It's a list, so we check it. + (or (memq type gnus-visual) + (memq class gnus-visual)) + t)))) + (defcustom gnus-mouse-face (condition-case () (if (gnus-visual-p 'mouse-face 'highlight) @@ -1488,41 +2283,97 @@ face." (defvar gnus-plugged t "Whether Gnus is plugged or not.") -(defcustom gnus-default-charset 'iso-8859-1 +(defcustom gnus-agent-cache t + "Controls use of the agent cache while plugged. +When set, Gnus will prefer using the locally stored content rather +than re-fetching it from the server. You also need to enable +`gnus-agent' for this to have any affect." + :version "21.3" + :group 'gnus-agent + :type 'boolean) + +(defcustom gnus-default-charset 'undecided "Default charset assumed to be used when viewing non-ASCII characters. This variable is overridden on a group-to-group basis by the -gnus-group-charset-alist variable and is only used on groups not +`gnus-group-charset-alist' variable and is only used on groups not covered by that variable." :type 'symbol :group 'gnus-charset) -(defcustom gnus-default-posting-charset nil - "Default charset assumed to be used when posting non-ASCII characters. -This variable is overridden on a group-to-group basis by the -gnus-group-posting-charset-alist variable and is only used on groups not -covered by that variable. -If nil, no default charset is assumed when posting." - :type 'symbol - :group 'gnus-charset) +;; Fixme: Doc reference to agent. +(defcustom gnus-agent t + "Whether we want to use the Gnus agent or not. + +You may customize gnus-agent to disable its use. However, some +back ends have started to use the agent as a client-side cache. +Disabling the agent may result in noticeable loss of performance." + :version "21.3" + :group 'gnus-agent + :type 'boolean) + +(defcustom gnus-other-frame-function 'gnus + "Function called by the command `gnus-other-frame'." + :group 'gnus-start + :type '(choice (function-item gnus) + (function-item gnus-no-server) + (function-item gnus-slave) + (function-item gnus-slave-no-server))) + +(defcustom gnus-other-frame-parameters nil + "Frame parameters used by `gnus-other-frame' to create a Gnus frame. +This should be an alist for Emacs, or a plist for XEmacs." + :group 'gnus-start + :type (if (featurep 'xemacs) + '(repeat (list :inline t :format "%v" + (symbol :tag "Property") + (sexp :tag "Value"))) + '(repeat (cons :format "%v" + (symbol :tag "Parameter") + (sexp :tag "Value"))))) + +(defcustom gnus-user-agent 'emacs-gnus-type + "Which information should be exposed in the User-Agent header. + +It can be one of the symbols `gnus' \(show only Gnus version\), `emacs-gnus' +\(show only Emacs and Gnus versions\), `emacs-gnus-config' \(same as +`emacs-gnus' plus system configuration\), `emacs-gnus-type' \(same as +`emacs-gnus' plus system type\) or a custom string. If you set it to a +string, be sure to use a valid format, see RFC 2616." + :group 'gnus-message + :type '(choice + (item :tag "Show Gnus and Emacs versions and system type" + emacs-gnus-type) + (item :tag "Show Gnus and Emacs versions and system configuration" + emacs-gnus-config) + (item :tag "Show Gnus and Emacs versions" emacs-gnus) + (item :tag "Show only Gnus version" gnus) + (string :tag "Other"))) ;;; Internal variables (defvar gnus-agent-gcc-header "X-Gnus-Agent-Gcc") (defvar gnus-agent-meta-information-header "X-Gnus-Agent-Meta-Information") +(defvar gnus-agent-method-p-cache nil + ; Reset each time gnus-agent-covered-methods is changed else + ; gnus-agent-method-p may mis-report a methods status. + ) +(defvar gnus-agent-target-move-group-header "X-Gnus-Agent-Move-To") +(defvar gnus-draft-meta-information-header "X-Draft-From") (defvar gnus-group-get-parameter-function 'gnus-group-get-parameter) (defvar gnus-original-article-buffer " *Original Article*") (defvar gnus-newsgroup-name nil) (defvar gnus-ephemeral-servers nil) - -(defvar gnus-agent nil - "Whether we want to use the Gnus agent or not.") +(defvar gnus-server-method-cache nil) (defvar gnus-agent-fetching nil "Whether Gnus agent is in fetching mode.") +(defvar gnus-agent-covered-methods nil + "A list of servers, NOT methods, showing which servers are covered by the agent.") + (defvar gnus-command-method nil - "Dynamically bound variable that says what the current backend is.") + "Dynamically bound variable that says what the current back end is.") (defvar gnus-current-select-method nil "The current method for selecting a newsgroup.") @@ -1560,7 +2411,7 @@ If nil, no default charset is assumed when posting." ,(nnheader-concat gnus-cache-directory "active")))) "List of predefined (convenience) servers.") -(defvar gnus-topic-indentation "");; Obsolete variable. +(defvar gnus-topic-indentation "") ;; Obsolete variable. (defconst gnus-article-mark-lists '((marked . tick) (replied . reply) @@ -1568,7 +2419,28 @@ If nil, no default charset is assumed when posting." (bookmarks . bookmark) (dormant . dormant) (scored . score) (saved . save) (cached . cache) (downloadable . download) - (unsendable . unsend))) + (unsendable . unsend) (forwarded . forward) + (recent . recent) (seen . seen))) + +(defconst gnus-article-special-mark-lists + '((seen range) + (killed range) + (bookmark tuple) + (score tuple))) + +;; Propagate flags to server, with the following exceptions: +;; `seen' is private to each gnus installation +;; `cache' is a internal gnus flag for each gnus installation +;; `download' is a agent flag private to each gnus installation +;; `unsend' are for nndraft groups only +;; `score' is not a proper mark +;; `bookmark': don't propagated it, or fix the bug in update-mark. +(defconst gnus-article-unpropagated-mark-lists + '(seen cache download unsend score bookmark) + "Marks that shouldn't be propagated to back ends. +Typical marks are those that make no sense in a standalone back end, +such as a mark that says whether an article is stored in the cache +\(which doesn't make sense in a standalone back end).") (defvar gnus-headers-retrieved-by nil) (defvar gnus-article-reply nil) @@ -1585,10 +2457,10 @@ If nil, no default charset is assumed when posting." "The mail address of the Gnus maintainers.") (defvar gnus-info-nodes - '((gnus-group-mode "(gnus)The Group Buffer") - (gnus-summary-mode "(gnus)The Summary Buffer") - (gnus-article-mode "(gnus)The Article Buffer") - (gnus-server-mode "(gnus)The Server Buffer") + '((gnus-group-mode "(gnus)Group Buffer") + (gnus-summary-mode "(gnus)Summary Buffer") + (gnus-article-mode "(gnus)Article Buffer") + (gnus-server-mode "(gnus)Server Buffer") (gnus-browse-mode "(gnus)Browse Foreign Server") (gnus-tree-mode "(gnus)Tree Display")) "Alist of major modes and related Info nodes.") @@ -1615,16 +2487,20 @@ If nil, no default charset is assumed when posting." (defvar gnus-newsrc-alist nil "Assoc list of read articles. -gnus-newsrc-hashtb should be kept so that both hold the same information.") +`gnus-newsrc-hashtb' should be kept so that both hold the same information.") + +(defvar gnus-registry-alist nil + "Assoc list of registry data. +gnus-registry.el will populate this if it's loaded.") (defvar gnus-newsrc-hashtb nil - "Hashtable of gnus-newsrc-alist.") + "Hashtable of `gnus-newsrc-alist'.") (defvar gnus-killed-list nil "List of killed newsgroups.") (defvar gnus-killed-hashtb nil - "Hash table equivalent of gnus-killed-list.") + "Hash table equivalent of `gnus-killed-list'.") (defvar gnus-zombie-list nil "List of almost dead newsgroups.") @@ -1654,6 +2530,9 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") (defvar gnus-invalid-group-regexp "[: `'\"/]\\|^$" "Regexp matching invalid groups.") +(defvar gnus-other-frame-object nil + "A frame object which will be created by `gnus-other-frame'.") + ;;; End of variables. ;; Define some autoload functions Gnus might use. @@ -1704,6 +2583,9 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") gnus-demon-remove-handler) ("gnus-demon" :interactive t gnus-demon-init gnus-demon-cancel) + ("gnus-fun" gnus-convert-gray-x-face-to-xpm gnus-display-x-face-in-from + gnus-convert-image-to-gray-x-face gnus-convert-face-to-png + gnus-face-from-file) ("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree gnus-tree-open gnus-tree-close gnus-carpal-setup-buffer) ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close @@ -1762,7 +2644,8 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") ("gnus-msg" (gnus-summary-send-map keymap) gnus-article-mail gnus-copy-article-buffer gnus-extended-version) ("gnus-msg" :interactive t - gnus-group-post-news gnus-group-mail gnus-summary-post-news + gnus-group-post-news gnus-group-mail gnus-group-news + gnus-summary-post-news gnus-summary-news-other-window gnus-summary-followup gnus-summary-followup-with-original gnus-summary-cancel-article gnus-summary-supersede-article gnus-post-news gnus-summary-reply gnus-summary-reply-with-original @@ -1773,13 +2656,10 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") gnus-summary-wide-reply-with-original gnus-summary-post-forward gnus-summary-wide-reply-with-original gnus-summary-post-forward) - ("gnus-picon" :interactive t gnus-article-display-picons - gnus-group-display-picons gnus-picons-article-display-x-face - gnus-picons-display-x-face) - ("gnus-picon" gnus-picons-buffer-name) + ("gnus-picon" :interactive t gnus-treat-from-picon) ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p gnus-grouplens-mode) - ("smiley" :interactive t gnus-smiley-display) + ("smiley" :interactive t smiley-region) ("gnus-win" gnus-configure-windows gnus-add-configuration) ("gnus-sum" gnus-summary-insert-line gnus-summary-read-group gnus-list-of-unread-articles gnus-list-of-read-articles @@ -1809,11 +2689,11 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") gnus-article-de-base64-unreadable gnus-article-decode-HZ gnus-article-wash-html - gnus-article-hide-pgp + gnus-article-unsplit-urls 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-article-decode-encoded-words gnus-start-date-timer gnus-stop-date-timer @@ -1835,20 +2715,23 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") ("gnus-agent" gnus-open-agent gnus-agent-get-function gnus-agent-save-groups gnus-agent-save-active gnus-agent-method-p gnus-agent-get-undownloaded-list gnus-agent-fetch-session - gnus-summary-set-agent-mark gnus-agent-save-group-info) + gnus-summary-set-agent-mark gnus-agent-save-group-info + gnus-agent-request-article gnus-agent-retrieve-headers) ("gnus-agent" :interactive t gnus-unplugged gnus-agentize gnus-agent-batch) ("gnus-vm" :interactive t gnus-summary-save-in-vm gnus-summary-save-article-vm) - ("gnus-draft" :interactive t gnus-draft-mode gnus-group-send-drafts) + ("compface" uncompface) + ("gnus-draft" :interactive t gnus-draft-mode gnus-group-send-queue) ("gnus-mlspl" gnus-group-split gnus-group-split-fancy) ("gnus-mlspl" :interactive t gnus-group-split-setup - gnus-group-split-update)))) + gnus-group-split-update) + ("gnus-delay" gnus-delay-initialize)))) ;;; gnus-sum.el thingies -(defcustom gnus-summary-line-format "%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n" +(defcustom gnus-summary-line-format "%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n" "*The format specification of the lines in the summary buffer. It works along the same lines as a normal formatting string, @@ -1865,11 +2748,16 @@ with some simple extensions. %x Contents of the Xref: header (string) %D Date of the article (string) %d Date of the article (string) in DD-MMM format +%o Date of the article (string) in YYYYMMDD`T'HHMMSS format %M Message-id of the article (string) %r References of the article (string) %c Number of characters in the article (integer) +%k Pretty-printed version of the above (string) + For example, \"1.2k\" or \"0.4M\". %L Number of lines in the article (integer) %I Indentation based on thread level (a string of spaces) +%B A complex trn-style thread tree (string) + The variables `gnus-sum-thread-*' can be used for customization. %T A string with two possible values: 80 spaces if the article is on thread level two or larger and 0 spaces on level one %R \"A\" if this article has been replied to, \" \" otherwise (character) @@ -1886,6 +2774,8 @@ with some simple extensions. %V Total thread score (number). %P The line number (number). %O Download mark (character). +%* If present, indicates desired cursor position + (instead of after first colon). %u User defined specifier. The next character in the format string should be a letter. Gnus will call the function gnus-user-format-function-X, where X is the letter following %u. The function will be passed the @@ -1893,10 +2783,6 @@ with some simple extensions. will be inserted into the summary just like information from any other summary specifier. -Text between %( and %) will be highlighted with `gnus-mouse-face' -when the mouse point is placed inside the area. There can only be one -such area. - The %U (status), %R (replied) and %z (zcore) specs have to be handled with care. For reasons of efficiency, Gnus will compute what column these characters will end up in, and \"hard-code\" that. This means that @@ -1904,10 +2790,14 @@ it is invalid to have these specs after a variable-length spec. Well, you might not be arrested, but your summary buffer will look strange, which is bad enough. -The smart choice is to have these specs as for to the left as +The smart choice is to have these specs as far to the left as possible. -This restriction may disappear in later versions of Gnus." +This restriction may disappear in later versions of Gnus. + +General format specifiers can also be used. +See Info node `(gnus)Formatting Variables'." + :link '(custom-manual "(gnus)Formatting Variables") :type 'string :group 'gnus-summary-format) @@ -1951,6 +2841,12 @@ This restriction may disappear in later versions of Gnus." "Get hash value of STRING in HASHTABLE." `(symbol-value (intern-soft ,string ,hashtable))) +(defmacro gnus-gethash-safe (string hashtable) + "Get hash value of STRING in HASHTABLE. +Return nil if not defined." + `(let ((sym (intern-soft ,string ,hashtable))) + (and (boundp sym) (symbol-value sym)))) + (defmacro gnus-sethash (string value hashtable) "Set hash value. Arguments are STRING, VALUE, and HASHTABLE." `(set (intern ,string ,hashtable) ,value)) @@ -2036,18 +2932,6 @@ This restriction may disappear in later versions of Gnus." (defmacro gnus-get-info (group) `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb))) -;; Byte-compiler warning. -(defvar gnus-visual) -;; Find out whether the gnus-visual TYPE is wanted. -(defun gnus-visual-p (&optional type class) - (and gnus-visual ; Has to be non-nil, at least. - (if (not type) ; We don't care about type. - gnus-visual - (if (listp gnus-visual) ; It's a list, so we check it. - (or (memq type gnus-visual) - (memq class gnus-visual)) - t)))) - ;;; Load the compatibility functions. (require 'gnus-ems) @@ -2076,6 +2960,21 @@ This restriction may disappear in later versions of Gnus." ;;; Gnus Utility Functions ;;; +(defun gnus-find-subscribed-addresses () + "Return a regexp matching the addresses of all subscribed mail groups. +It consists of the `to-address' or `to-list' parameter of all groups +with a `subscribed' parameter." + (let (group address addresses) + (dolist (entry (cdr gnus-newsrc-alist)) + (setq group (car entry)) + (when (gnus-parameter-subscribed group) + (setq address (mail-strip-quoted-names + (or (gnus-group-fast-parameter group 'to-address) + (gnus-group-fast-parameter group 'to-list)))) + (when address + (add-to-list 'addresses address)))) + (when addresses + (list (mapconcat 'regexp-quote addresses "\\|"))))) (defmacro gnus-string-or (&rest strings) "Return the first element of STRINGS that is a non-blank string. @@ -2099,8 +2998,11 @@ If ARG, insert string at point." (insert (message gnus-version)) (message gnus-version))) -(defun gnus-continuum-version (version) +(defun gnus-continuum-version (&optional version) "Return VERSION as a floating point number." + (interactive) + (unless version + (setq version gnus-version)) (when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version) (string-match "^\\(.?\\)gnus-\\([0-9.]+\\)$" version)) (let ((alpha (and (match-beginning 1) (match-string 1 version))) @@ -2116,23 +3018,23 @@ If ARG, insert string at point." 0)) (string-to-number (if (zerop major) - (format "%s00%02d%02d" - (if (member alpha '("(ding)" "d")) - "4.99" - (+ 5 (* 0.02 - (abs - (- (mm-char-int (aref (downcase alpha) 0)) - (mm-char-int ?t)))) - -0.01)) - minor least) + (format "%s00%02d%02d" + (if (member alpha '("(ding)" "d")) + "4.99" + (+ 5 (* 0.02 + (abs + (- (mm-char-int (aref (downcase alpha) 0)) + (mm-char-int ?t)))) + -0.01)) + minor least) (format "%d.%02d%02d" major minor least)))))) -(defun gnus-info-find-node () +(defun gnus-info-find-node (&optional nodename) "Find Info documentation of Gnus." (interactive) ;; Enlarge info window if needed. (let (gnus-info-buffer) - (Info-goto-node (cadr (assq major-mode gnus-info-nodes))) + (Info-goto-node (or nodename (cadr (assq major-mode gnus-info-nodes)))) (setq gnus-info-buffer (current-buffer)) (gnus-configure-windows 'info))) @@ -2274,30 +3176,6 @@ that that variable is buffer-local to the summary buffers." (let ((group (or group gnus-newsgroup-name))) (not (gnus-check-backend-function 'request-replace-article group)))) -(defun gnus-group-total-expirable-p (group) - "Check whether GROUP is total-expirable or not." - (let ((params (gnus-group-find-parameter group)) - val) - (cond - ((memq 'total-expire params) - t) - ((setq val (assq 'total-expire params)) ; (auto-expire . t) - (cdr val)) - (gnus-total-expirable-newsgroups ; Check var. - (string-match gnus-total-expirable-newsgroups group))))) - -(defun gnus-group-auto-expirable-p (group) - "Check whether GROUP is auto-expirable or not." - (let ((params (gnus-group-find-parameter group)) - val) - (cond - ((memq 'auto-expire params) - t) - ((setq val (assq 'auto-expire params)) ; (auto-expire . t) - (cdr val)) - (gnus-auto-expirable-newsgroups ; Check var. - (string-match gnus-auto-expirable-newsgroups group))))) - (defun gnus-virtual-group-p (group) "Say whether GROUP is virtual or not." (memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group))) @@ -2305,16 +3183,18 @@ that that variable is buffer-local to the summary buffers." (defun gnus-news-group-p (group &optional article) "Return non-nil if GROUP (and ARTICLE) come from a news server." - (or (gnus-member-of-valid 'post group) ; Ordinary news group. - (and (gnus-member-of-valid 'post-mail group) ; Combined group. - (if (or (null article) - (not (< article 0))) - (eq (gnus-request-type group article) 'news) - (if (not (vectorp article)) - nil - ;; It's a real article. - (eq (gnus-request-type group (mail-header-id article)) - 'news)))))) + (cond ((gnus-member-of-valid 'post group) ;Ordinary news group + t) ;is news of course. + ((not (gnus-member-of-valid 'post-mail group)) ;Non-combined. + nil) ;must be mail then. + ((vectorp article) ;Has header info. + (eq (gnus-request-type group (mail-header-id article)) 'news)) + ((null article) ;Hasn't header info + (eq (gnus-request-type group) 'news)) ;(unknown ==> mail) + ((< article 0) ;Virtual message + nil) ;we don't know, guess mail. + (t ;Has positive number + (eq (gnus-request-type group article) 'news)))) ;use it. ;; Returns a list of writable groups. (defun gnus-writable-groups () @@ -2376,6 +3256,85 @@ that that variable is buffer-local to the summary buffers." (nth 1 method)))) method))) +(defsubst gnus-server-to-method (server) + "Map virtual server names to select methods." + (or (and server (listp server) server) + (cdr (assoc server gnus-server-method-cache)) + (let ((result + (or + ;; Perhaps this is the native server? + (and (equal server "native") gnus-select-method) + ;; It should be in the server alist. + (cdr (assoc server gnus-server-alist)) + ;; It could be in the predefined server alist. + (cdr (assoc server gnus-predefined-server-alist)) + ;; If not, we look through all the opened server + ;; to see whether we can find it there. + (let ((opened gnus-opened-servers)) + (while (and opened + (not (equal server (format "%s:%s" (caaar opened) + (cadaar opened))))) + (pop opened)) + (caar opened)) + ;; It could be a named method, search all servers + (let ((servers gnus-secondary-select-methods)) + (while (and servers + (not (equal server (format "%s:%s" (caar servers) + (cadar servers))))) + (pop servers)) + (car servers)) + ;; This could be some sort of foreign server that I + ;; simply haven't opened (yet). Do a brute-force scan + ;; of the entire gnus-newsrc-alist for the server name + ;; of every method. As a side-effect, loads the + ;; gnus-server-method-cache so this only happens once, + ;; if at all. + (let (match) + (mapcar + (lambda (info) + (let ((info-method (gnus-info-method info))) + (unless (stringp info-method) + (let ((info-server (gnus-method-to-server info-method))) + (when (equal server info-server) + (setq match info-method)))))) + (cdr gnus-newsrc-alist)) + match)))) + (when result + (push (cons server result) gnus-server-method-cache)) + result))) + +(defsubst gnus-method-to-server (method) + (catch 'server-name + (setq method (or method gnus-select-method)) + + ;; Perhaps it is already in the cache. + (mapc (lambda (name-method) + (if (equal (cdr name-method) method) + (throw 'server-name (car name-method)))) + gnus-server-method-cache) + + (mapc + (lambda (server-alist) + (mapc (lambda (name-method) + (when (gnus-methods-equal-p (cdr name-method) method) + (unless (member name-method gnus-server-method-cache) + (push name-method gnus-server-method-cache)) + (throw 'server-name (car name-method)))) + server-alist)) + (let ((alists (list gnus-server-alist + gnus-predefined-server-alist))) + (if gnus-select-method + (push (list (cons "native" gnus-select-method)) alists)) + alists)) + + (let* ((name (if (member (cadr method) '(nil "")) + (format "%s" (car method)) + (format "%s:%s" (car method) (cadr method)))) + (name-method (cons name method))) + (unless (member name-method gnus-server-method-cache) + (push name-method gnus-server-method-cache)) + name))) + (defsubst gnus-server-get-method (group method) ;; Input either a server name, and extended server name, or a ;; select method, and return a select method. @@ -2393,33 +3352,6 @@ that that variable is buffer-local to the summary buffers." (t (gnus-server-add-address method)))) -(defun gnus-server-to-method (server) - "Map virtual server names to select methods." - (or - ;; Is this a method, perhaps? - (and server (listp server) server) - ;; Perhaps this is the native server? - (and (equal server "native") gnus-select-method) - ;; It should be in the server alist. - (cdr (assoc server gnus-server-alist)) - ;; It could be in the predefined server alist. - (cdr (assoc server gnus-predefined-server-alist)) - ;; If not, we look through all the opened server - ;; to see whether we can find it there. - (let ((opened gnus-opened-servers)) - (while (and opened - (not (equal server (format "%s:%s" (caaar opened) - (cadaar opened))))) - (pop opened)) - (caar opened)) - ;; It could be a named method, search all servers - (let ((servers gnus-secondary-select-methods)) - (while (and servers - (not (equal server (format "%s:%s" (caar servers) - (cadar servers))))) - (pop servers)) - (car servers)))) - (defmacro gnus-method-equal (ss1 ss2) "Say whether two servers are equal." `(let ((s1 ,ss1) @@ -2474,27 +3406,77 @@ that that variable is buffer-local to the summary buffers." (and active (file-exists-p active)))))) -(defun gnus-group-prefixed-name (group method) - "Return the whole name from GROUP and METHOD." - (and (stringp method) (setq method (gnus-server-to-method method))) +(defsubst gnus-method-to-server-name (method) + (concat + (format "%s" (car method)) + (when (and + (or (assoc (format "%s" (car method)) + (gnus-methods-using 'address)) + (gnus-server-equal method gnus-message-archive-method)) + (nth 1 method) + (not (string= (nth 1 method) ""))) + (concat "+" (nth 1 method))))) + +(defsubst gnus-method-to-full-server-name (method) + (format "%s+%s" (car method) (nth 1 method))) + +(defun gnus-group-prefixed-name (group method &optional full) + "Return the whole name from GROUP and METHOD. +Call with full set to get the fully qualified group name (even if the +server is native)." + (when (stringp method) + (setq method (gnus-server-to-method method))) (if (or (not method) - (gnus-server-equal method "native")) + (and (not full) (gnus-server-equal method "native")) + ;;;!!! This might not be right. We'll see... + ;(string-match ":" group) + ) group - (concat (format "%s" (car method)) - (when (and - (or (assoc (format "%s" (car method)) - (gnus-methods-using 'address)) - (gnus-server-equal method gnus-message-archive-method)) - (nth 1 method) - (not (string= (nth 1 method) ""))) - (concat "+" (nth 1 method))) - ":" group))) + (concat (gnus-method-to-server-name method) ":" group))) + +(defun gnus-group-guess-prefixed-name (group) + "Guess the whole name from GROUP and METHOD." + (gnus-group-prefixed-name group (gnus-find-method-for-group + group))) + +(defun gnus-group-full-name (group method) + "Return the full name from GROUP and METHOD, even if the method is native." + (gnus-group-prefixed-name group method t)) + +(defun gnus-group-guess-full-name (group) + "Guess the full name from GROUP, even if the method is native." + (if (gnus-group-prefixed-p group) + group + (gnus-group-full-name group (gnus-find-method-for-group group)))) + +(defun gnus-group-guess-full-name-from-command-method (group) + "Guess the full name from GROUP, even if the method is native." + (if (gnus-group-prefixed-p group) + group + (gnus-group-full-name group gnus-command-method))) (defun gnus-group-real-prefix (group) "Return the prefix of the current group name." - (if (string-match "^[^:]+:" group) - (substring group 0 (match-end 0)) - "")) + (if (stringp group) + (if (string-match "^[^:]+:" group) + (substring group 0 (match-end 0)) + "") + nil)) + +(defun gnus-group-short-name (group) + "Return the short group name." + (let ((prefix (gnus-group-real-prefix group))) + (if (< 0 (length prefix)) + (substring group (length prefix) nil) + group))) + +(defun gnus-group-prefixed-p (group) + "Return the prefix of the current group name." + (< 0 (length (gnus-group-real-prefix group)))) + +(defun gnus-summary-buffer-name (group) + "Return the summary buffer name of GROUP." + (concat "*Summary " (gnus-group-decoded-name group) "*")) (defun gnus-group-method (group) "Return the server or method used for selecting GROUP. @@ -2528,10 +3510,10 @@ You should probably use `gnus-find-method-for-group' instead." (defsubst gnus-secondary-method-p (method) "Return whether METHOD is a secondary select method." (let ((methods gnus-secondary-select-methods) - (gmethod (gnus-server-get-method nil method))) + (gmethod (inline (gnus-server-get-method nil method)))) (while (and methods (not (gnus-method-equal - (gnus-server-get-method nil (car methods)) + (inline (gnus-server-get-method nil (car methods))) gmethod))) (setq methods (cdr methods))) methods)) @@ -2569,15 +3551,88 @@ You should probably use `gnus-find-method-for-group' instead." "Say whether the group is secondary or not." (gnus-secondary-method-p (gnus-find-method-for-group group))) +(defun gnus-parameters-get-parameter (group) + "Return the group parameters for GROUP from `gnus-parameters'." + (let (params-list) + (dolist (elem gnus-parameters) + (when (string-match (car elem) group) + (setq params-list + (nconc (gnus-expand-group-parameters + (car elem) (cdr elem) group) + params-list)))) + params-list)) + +(defun gnus-expand-group-parameter (match value group) + "Use MATCH to expand VALUE in GROUP." + (with-temp-buffer + (insert group) + (goto-char (point-min)) + (while (re-search-forward match nil t) + (replace-match value)) + (buffer-string))) + +(defun gnus-expand-group-parameters (match parameters group) + "Go through PARAMETERS and expand them according to the match data." + (let (new) + (dolist (elem parameters) + (if (and (stringp (cdr elem)) + (string-match "\\\\[0-9&]" (cdr elem))) + (push (cons (car elem) + (gnus-expand-group-parameter match (cdr elem) group)) + new) + (push elem new))) + new)) + +(defun gnus-group-fast-parameter (group symbol &optional allow-list) + "For GROUP, return the value of SYMBOL. + +You should call this in the `gnus-group-buffer' buffer. +The function `gnus-group-find-parameter' will do that for you." + ;; The speed trick: No cons'ing and quit early. + (let* ((params (funcall gnus-group-get-parameter-function group)) + ;; Start easy, check the "real" group parameters. + (simple-results + (gnus-group-parameter-value params symbol allow-list t))) + (if simple-results + ;; Found results; return them. + (car simple-results) + ;; We didn't found it there, try `gnus-parameters'. + (let ((result nil) + (head nil) + (tail gnus-parameters)) + ;; A good old-fashioned non-cl loop. + (while tail + (setq head (car tail) + tail (cdr tail)) + ;; The car is regexp matching for matching the group name. + (when (string-match (car head) group) + ;; The cdr is the parameters. + (setq result (gnus-group-parameter-value (cdr head) + symbol allow-list)) + (when result + ;; Expand if necessary. + (if (and (stringp result) (string-match "\\\\[0-9&]" result)) + (setq result (gnus-expand-group-parameter (car head) + result group))) + ;; Exit the loop early. + (setq tail nil)))) + ;; Done. + result)))) + (defun gnus-group-find-parameter (group &optional symbol allow-list) "Return the group parameters for GROUP. -If SYMBOL, return the value of that symbol in the group parameters." +If SYMBOL, return the value of that symbol in the group parameters. + +If you call this function inside a loop, consider using the faster +`gnus-group-fast-parameter' instead." (save-excursion (set-buffer gnus-group-buffer) - (let ((parameters (funcall gnus-group-get-parameter-function group))) - (if symbol - (gnus-group-parameter-value parameters symbol allow-list) - parameters)))) + (if symbol + (gnus-group-fast-parameter group symbol allow-list) + (nconc + (copy-sequence + (funcall gnus-group-get-parameter-function group)) + (gnus-parameters-get-parameter group))))) (defun gnus-group-get-parameter (group &optional symbol allow-list) "Return the group parameters for GROUP. @@ -2589,7 +3644,8 @@ also examines the topic parameters." (gnus-group-parameter-value params symbol allow-list) params))) -(defun gnus-group-parameter-value (params symbol &optional allow-list) +(defun gnus-group-parameter-value (params symbol &optional + allow-list present-p) "Return the value of SYMBOL in group PARAMS." ;; We only wish to return group parameters (dotted lists) and ;; not local variables, which may have the same names. @@ -2603,7 +3659,8 @@ also examines the topic parameters." (eq (car elem) symbol) (or allow-list (atom (cdr elem)))) - (throw 'found (cdr elem)))))))) + (throw 'found (if present-p (list (cdr elem)) + (cdr elem))))))))) (defun gnus-group-add-parameter (group param) "Add parameter PARAM to GROUP." @@ -2662,7 +3719,7 @@ just the host name." depth (+ depth 1))) depth)))) ;; Separate foreign select method from group name and collapse. - ;; If method contains a server, collapse to non-domain server name, + ;; If method contains a server, collapse to non-domain server name, ;; otherwise collapse to select method. (let* ((colon (string-match ":" group)) (server (and colon (substring group 0 colon))) @@ -2809,12 +3866,21 @@ If NEWSGROUP is nil, return the global kill file name instead." (list (intern server) ""))) gnus-select-method)) +(defun gnus-server-string (server) + "Return a readable string that describes SERVER." + (let* ((server (gnus-server-to-method server)) + (address (nth 1 server))) + (if (and address + (not (zerop (length address)))) + (format "%s using %s" address (car server)) + (format "%s" (car server))))) + (defun gnus-find-method-for-group (group &optional info) "Find the select method that GROUP uses." (or gnus-override-method (and (not group) gnus-select-method) - (and (not (gnus-group-entry group));; a new group + (and (not (gnus-group-entry group)) ;; a new group (gnus-group-name-to-method group)) (let ((info (or info (gnus-get-info group))) method) @@ -2857,18 +3923,40 @@ Disallow invalid group names." (setq group (read-string (concat prefix prompt) (cons (or default "") 0) 'gnus-group-history))) - (setq prefix (format "Invalid group name: \"%s\". " group) - group nil))) + (let ((match (match-string 0 group))) + ;; Might be okay (e.g. for nnimap), so ask the user: + (unless (and (not (string-match "^$\\|:" match)) + (message-y-or-n-p + "Proceed and create group anyway? " t +"The group name \"" group "\" contains a forbidden character: \"" match "\". + +Usually, it's dangerous to create a group with this name, because it's not +supported by all back ends and servers. On IMAP servers it should work, +though. If you are really sure, you can proceed anyway and create the group. + +You may customize the variable `gnus-invalid-group-regexp', which currently is +set to \"" gnus-invalid-group-regexp +"\", if you want to get rid of this query permanently.")) + (setq prefix (format "Invalid group name: \"%s\". " group) + group nil))))) group)) (defun gnus-read-method (prompt) "Prompt the user for a method. Allow completion over sensible values." - (let* ((servers - (append gnus-valid-select-methods - (mapcar (lambda (i) (list (format "%s:%s" (caar i) - (cadar i)))) - gnus-opened-servers) + (let* ((open-servers + (mapcar (lambda (i) (cons (format "%s:%s" (caar i) (cadar i)) i)) + gnus-opened-servers)) + (valid-methods + (let (methods) + (dolist (method gnus-valid-select-methods) + (if (or (memq 'prompt-address method) + (not (assoc (format "%s:" (car method)) open-servers))) + (push method methods))) + methods)) + (servers + (append valid-methods + open-servers gnus-predefined-server-alist gnus-server-alist)) (method @@ -2883,35 +3971,48 @@ Allow completion over sensible values." (assoc method gnus-valid-select-methods)) (read-string "Address: ") ""))) - (or (let ((opened gnus-opened-servers)) - (while (and opened - (not (equal (format "%s:%s" method address) - (format "%s:%s" (caaar opened) - (cadaar opened))))) - (pop opened)) - (caar opened)) + (or (cadr (assoc (format "%s:%s" method address) open-servers)) (list (intern method) address)))) ((assoc method servers) method) (t (list (intern method) ""))))) +;;; Agent functions + +(defun gnus-agent-method-p (method) + "Say whether METHOD is covered by the agent." + (or (eq (car gnus-agent-method-p-cache) method) + (setq gnus-agent-method-p-cache + (cons method + (member (if (stringp method) + method + (gnus-method-to-server method)) gnus-agent-covered-methods)))) + (cdr gnus-agent-method-p-cache)) + +(defun gnus-online (method) + (not + (if gnus-plugged + (eq (cadr (assoc method gnus-opened-servers)) 'offline) + (gnus-agent-method-p method)))) + ;;; User-level commands. ;;;###autoload (defun gnus-slave-no-server (&optional arg) - "Read network news as a slave, without connecting to local server." + "Read network news as a slave, without connecting to the local server." (interactive "P") (gnus-no-server arg t)) ;;;###autoload (defun gnus-no-server (&optional arg slave) "Read network news. -If ARG is a positive number, Gnus will use that as the -startup level. If ARG is nil, Gnus will be started at level 2. -If ARG is non-nil and not a positive number, Gnus will -prompt the user for the name of an NNTP server to use. -As opposed to `gnus', this command will not connect to the local server." +If ARG is a positive number, Gnus will use that as the startup +level. If ARG is nil, Gnus will be started at level 2. If ARG is +non-nil and not a positive number, Gnus will prompt the user for the +name of an NNTP server to use. +As opposed to `gnus', this command will not connect to the local +server." (interactive "P") (gnus-no-server-1 arg slave)) @@ -2922,15 +4023,51 @@ As opposed to `gnus', this command will not connect to the local server." (gnus arg nil 'slave)) ;;;###autoload -(defun gnus-other-frame (&optional arg) - "Pop up a frame to read news." +(defun gnus-other-frame (&optional arg display) + "Pop up a frame to read news. +This will call one of the Gnus commands which is specified by the user +option `gnus-other-frame-function' (default `gnus') with the argument +ARG if Gnus is not running, otherwise just pop up a Gnus frame. The +optional second argument DISPLAY should be a standard display string +such as \"unix:0\" to specify where to pop up a frame. If DISPLAY is +omitted or the function `make-frame-on-display' is not available, the +current display is used." (interactive "P") - (let ((window (get-buffer-window gnus-group-buffer))) - (cond (window - (select-frame (window-frame window))) - (t - (select-frame (make-frame))))) - (gnus arg)) + (if (fboundp 'make-frame-on-display) + (unless display + (setq display (gnus-frame-or-window-display-name (selected-frame)))) + (setq display nil)) + (let ((alive (gnus-alive-p))) + (unless (and alive + (catch 'found + (walk-windows + (lambda (window) + (when (and (or (not display) + (equal display + (gnus-frame-or-window-display-name + window))) + (with-current-buffer (window-buffer window) + (string-match "\\`gnus-" + (symbol-name major-mode)))) + (gnus-select-frame-set-input-focus + (setq gnus-other-frame-object (window-frame window))) + (select-window window) + (throw 'found t))) + 'ignore t))) + (gnus-select-frame-set-input-focus + (setq gnus-other-frame-object + (if display + (make-frame-on-display display gnus-other-frame-parameters) + (make-frame gnus-other-frame-parameters)))) + (if alive + (switch-to-buffer gnus-group-buffer) + (funcall gnus-other-frame-function arg) + (add-hook 'gnus-exit-gnus-hook + '(lambda nil + (when (and (frame-live-p gnus-other-frame-object) + (cdr (frame-list))) + (delete-frame gnus-other-frame-object)) + (setq gnus-other-frame-object nil))))))) ;;(setq thing ? ; this is a comment ;; more 'yes) @@ -2939,9 +4076,12 @@ As opposed to `gnus', this command will not connect to the local server." (defun gnus (&optional arg dont-connect slave) "Read network news. If ARG is non-nil and a positive number, Gnus will use that as the -startup level. If ARG is non-nil and not a positive number, Gnus will +startup level. If ARG is non-nil and not a positive number, Gnus will prompt the user for the name of an NNTP server to use." (interactive "P") + (unless (byte-code-function-p (symbol-function 'gnus)) + (message "You should byte-compile Gnus") + (sit-for 2)) (gnus-1 arg dont-connect slave)) ;; Allow redefinition of Gnus functions. |