X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus.el;h=da186a85590abad27ddecde6c2812364c1ffbf7e;hp=236fdac5a530a58b845690f42a4dd90d55f558f8;hb=eb9ffe5f5c902295d74ae6dd40c360b9ae80b0a6;hpb=47981ad581c973d32f3378354dc2e3da009a3067 diff --git a/lisp/gnus.el b/lisp/gnus.el index 236fdac5a..43af5534d 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -1,7 +1,8 @@ ;;; gnus.el --- a newsreader for GNU Emacs -;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, 1997, -;; 1998, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. +;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, 1997, 1998, +;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen @@ -9,20 +10,18 @@ ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -30,16 +29,37 @@ (eval '(run-hooks 'gnus-load-hook)) +;; For Emacs <22.2 and XEmacs. +(eval-and-compile + (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) + (eval-when-compile (require 'cl)) (require 'wid-edit) (require 'mm-util) (require 'nnheader) +;; These are defined afterwards with gnus-define-group-parameter +(defvar gnus-ham-process-destinations) +(defvar gnus-parameter-ham-marks-alist) +(defvar gnus-parameter-spam-marks-alist) +(defvar gnus-spam-autodetect) +(defvar gnus-spam-autodetect-methods) +(defvar gnus-spam-newsgroup-contents) +(defvar gnus-spam-process-destinations) +(defvar gnus-spam-resend-to) +(defvar gnus-ham-resend-to) +(defvar gnus-spam-process-newsgroups) + + (defgroup gnus nil "The coffee-brewing, all singing, all dancing, kitchen sink newsreader." :group 'news :group 'mail) +(defgroup gnus-start nil + "Starting your favorite newsreader." + :group 'gnus) + (defgroup gnus-format nil "Dealing with formatting issues." :group 'gnus) @@ -59,10 +79,6 @@ "Article Registry." :group 'gnus) -(defgroup gnus-start nil - "Starting your favorite newsreader." - :group 'gnus) - (defgroup gnus-start-server nil "Server options at startup." :group 'gnus-start) @@ -70,7 +86,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 @@ -111,7 +127,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 @@ -155,7 +171,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 @@ -268,12 +284,8 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Various Various") :group 'gnus) -(defgroup gnus-mime nil - "Variables for controlling the Gnus MIME interface." - :group 'gnus) - (defgroup gnus-exit nil - "Exiting gnus." + "Exiting Gnus." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) @@ -282,10 +294,10 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "5.10.3" +(defconst gnus-version-number "0.11" "Version number for this version of Gnus.") -(defconst gnus-version (format "Gnus v%s" gnus-version-number) +(defconst gnus-version (format "No Gnus v%s" gnus-version-number) "Version string for this version of Gnus.") (defcustom gnus-inhibit-startup-message nil @@ -295,28 +307,21 @@ be set in `.emacs' instead." :group 'gnus-start :type 'boolean) -(defcustom gnus-play-startup-jingle nil - "If non-nil, play the Gnus jingle at startup." - :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) + (defalias 'gnus-overlay-get 'overlay-get) (defalias 'gnus-overlay-put 'overlay-put) (defalias 'gnus-move-overlay 'move-overlay) (defalias 'gnus-overlay-buffer 'overlay-buffer) (defalias 'gnus-overlay-start 'overlay-start) (defalias 'gnus-overlay-end 'overlay-end) + (defalias 'gnus-overlays-in 'overlays-in) (defalias 'gnus-extent-detached-p 'ignore) (defalias 'gnus-extent-start-open '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) @@ -325,7 +330,8 @@ be set in `.emacs' instead." (defvar gnus-mode-line-image-cache t) (if (fboundp 'find-image) (defun gnus-mode-line-buffer-identification (line) - (let ((str (car-safe line))) + (let ((str (car-safe line)) + (load-path (mm-image-load-path))) (if (and (stringp str) (string-match "^Gnus:" str)) (progn (add-text-properties @@ -339,7 +345,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))) @@ -354,7 +362,7 @@ be set in `.emacs' instead." ;; We define these group faces here to avoid the display ;; update forced when creating new faces. -(defface gnus-group-news-1-face +(defface gnus-group-news-1 '((((class color) (background dark)) (:foreground "PaleTurquoise" :bold t)) @@ -363,9 +371,13 @@ be set in `.emacs' instead." (:foreground "ForestGreen" :bold t)) (t ())) - "Level 1 newsgroup face.") + "Level 1 newsgroup face." + :group 'gnus-group) +;; backward-compatibility alias +(put 'gnus-group-news-1-face 'face-alias 'gnus-group-news-1) +(put 'gnus-group-news-1-face 'obsolete-face "22.1") -(defface gnus-group-news-1-empty-face +(defface gnus-group-news-1-empty '((((class color) (background dark)) (:foreground "PaleTurquoise")) @@ -374,9 +386,13 @@ be set in `.emacs' instead." (:foreground "ForestGreen")) (t ())) - "Level 1 empty newsgroup face.") + "Level 1 empty newsgroup face." + :group 'gnus-group) +;; backward-compatibility alias +(put 'gnus-group-news-1-empty-face 'face-alias 'gnus-group-news-1-empty) +(put 'gnus-group-news-1-empty-face 'obsolete-face "22.1") -(defface gnus-group-news-2-face +(defface gnus-group-news-2 '((((class color) (background dark)) (:foreground "turquoise" :bold t)) @@ -385,9 +401,13 @@ be set in `.emacs' instead." (:foreground "CadetBlue4" :bold t)) (t ())) - "Level 2 newsgroup face.") + "Level 2 newsgroup face." + :group 'gnus-group) +;; backward-compatibility alias +(put 'gnus-group-news-2-face 'face-alias 'gnus-group-news-2) +(put 'gnus-group-news-2-face 'obsolete-face "22.1") -(defface gnus-group-news-2-empty-face +(defface gnus-group-news-2-empty '((((class color) (background dark)) (:foreground "turquoise")) @@ -396,9 +416,13 @@ be set in `.emacs' instead." (:foreground "CadetBlue4")) (t ())) - "Level 2 empty newsgroup face.") + "Level 2 empty newsgroup face." + :group 'gnus-group) +;; backward-compatibility alias +(put 'gnus-group-news-2-empty-face 'face-alias 'gnus-group-news-2-empty) +(put 'gnus-group-news-2-empty-face 'obsolete-face "22.1") -(defface gnus-group-news-3-face +(defface gnus-group-news-3 '((((class color) (background dark)) (:bold t)) @@ -407,9 +431,13 @@ be set in `.emacs' instead." (:bold t)) (t ())) - "Level 3 newsgroup face.") + "Level 3 newsgroup face." + :group 'gnus-group) +;; backward-compatibility alias +(put 'gnus-group-news-3-face 'face-alias 'gnus-group-news-3) +(put 'gnus-group-news-3-face 'obsolete-face "22.1") -(defface gnus-group-news-3-empty-face +(defface gnus-group-news-3-empty '((((class color) (background dark)) ()) @@ -418,9 +446,13 @@ be set in `.emacs' instead." ()) (t ())) - "Level 3 empty newsgroup face.") + "Level 3 empty newsgroup face." + :group 'gnus-group) +;; backward-compatibility alias +(put 'gnus-group-news-3-empty-face 'face-alias 'gnus-group-news-3-empty) +(put 'gnus-group-news-3-empty-face 'obsolete-face "22.1") -(defface gnus-group-news-4-face +(defface gnus-group-news-4 '((((class color) (background dark)) (:bold t)) @@ -429,9 +461,13 @@ be set in `.emacs' instead." (:bold t)) (t ())) - "Level 4 newsgroup face.") + "Level 4 newsgroup face." + :group 'gnus-group) +;; backward-compatibility alias +(put 'gnus-group-news-4-face 'face-alias 'gnus-group-news-4) +(put 'gnus-group-news-4-face 'obsolete-face "22.1") -(defface gnus-group-news-4-empty-face +(defface gnus-group-news-4-empty '((((class color) (background dark)) ()) @@ -440,9 +476,13 @@ be set in `.emacs' instead." ()) (t ())) - "Level 4 empty newsgroup face.") + "Level 4 empty newsgroup face." + :group 'gnus-group) +;; backward-compatibility alias +(put 'gnus-group-news-4-empty-face 'face-alias 'gnus-group-news-4-empty) +(put 'gnus-group-news-4-empty-face 'obsolete-face "22.1") -(defface gnus-group-news-5-face +(defface gnus-group-news-5 '((((class color) (background dark)) (:bold t)) @@ -451,9 +491,13 @@ be set in `.emacs' instead." (:bold t)) (t ())) - "Level 5 newsgroup face.") + "Level 5 newsgroup face." + :group 'gnus-group) +;; backward-compatibility alias +(put 'gnus-group-news-5-face 'face-alias 'gnus-group-news-5) +(put 'gnus-group-news-5-face 'obsolete-face "22.1") -(defface gnus-group-news-5-empty-face +(defface gnus-group-news-5-empty '((((class color) (background dark)) ()) @@ -462,9 +506,13 @@ be set in `.emacs' instead." ()) (t ())) - "Level 5 empty newsgroup face.") + "Level 5 empty newsgroup face." + :group 'gnus-group) +;; backward-compatibility alias +(put 'gnus-group-news-5-empty-face 'face-alias 'gnus-group-news-5-empty) +(put 'gnus-group-news-5-empty-face 'obsolete-face "22.1") -(defface gnus-group-news-6-face +(defface gnus-group-news-6 '((((class color) (background dark)) (:bold t)) @@ -473,9 +521,13 @@ be set in `.emacs' instead." (:bold t)) (t ())) - "Level 6 newsgroup face.") + "Level 6 newsgroup face." + :group 'gnus-group) +;; backward-compatibility alias +(put 'gnus-group-news-6-face 'face-alias 'gnus-group-news-6) +(put 'gnus-group-news-6-face 'obsolete-face "22.1") -(defface gnus-group-news-6-empty-face +(defface gnus-group-news-6-empty '((((class color) (background dark)) ()) @@ -484,9 +536,13 @@ be set in `.emacs' instead." ()) (t ())) - "Level 6 empty newsgroup face.") + "Level 6 empty newsgroup face." + :group 'gnus-group) +;; backward-compatibility alias +(put 'gnus-group-news-6-empty-face 'face-alias 'gnus-group-news-6-empty) +(put 'gnus-group-news-6-empty-face 'obsolete-face "22.1") -(defface gnus-group-news-low-face +(defface gnus-group-news-low '((((class color) (background dark)) (:foreground "DarkTurquoise" :bold t)) @@ -495,9 +551,13 @@ be set in `.emacs' instead." (:foreground "DarkGreen" :bold t)) (t ())) - "Low level newsgroup face.") + "Low level newsgroup face." + :group 'gnus-group) +;; backward-compatibility alias +(put 'gnus-group-news-low-face 'face-alias 'gnus-group-news-low) +(put 'gnus-group-news-low-face 'obsolete-face "22.1") -(defface gnus-group-news-low-empty-face +(defface gnus-group-news-low-empty '((((class color) (background dark)) (:foreground "DarkTurquoise")) @@ -506,108 +566,151 @@ be set in `.emacs' instead." (:foreground "DarkGreen")) (t ())) - "Low level empty newsgroup face.") + "Low level empty newsgroup face." + :group 'gnus-group) +;; backward-compatibility alias +(put 'gnus-group-news-low-empty-face 'face-alias 'gnus-group-news-low-empty) +(put 'gnus-group-news-low-empty-face 'obsolete-face "22.1") -(defface gnus-group-mail-1-face +(defface gnus-group-mail-1 '((((class color) (background dark)) - (:foreground "aquamarine1" :bold t)) + (:foreground "#e1ffe1" :bold t)) (((class color) (background light)) (:foreground "DeepPink3" :bold t)) (t (:bold t))) - "Level 1 mailgroup face.") + "Level 1 mailgroup face." + :group 'gnus-group) +;; backward-compatibility alias +(put 'gnus-group-mail-1-face 'face-alias 'gnus-group-mail-1) +(put 'gnus-group-mail-1-face 'obsolete-face "22.1") -(defface gnus-group-mail-1-empty-face +(defface gnus-group-mail-1-empty '((((class color) (background dark)) - (:foreground "aquamarine1")) + (:foreground "#e1ffe1")) (((class color) (background light)) (:foreground "DeepPink3")) (t (:italic t :bold t))) - "Level 1 empty mailgroup face.") + "Level 1 empty mailgroup face." + :group 'gnus-group) +;; backward-compatibility alias +(put 'gnus-group-mail-1-empty-face 'face-alias 'gnus-group-mail-1-empty) +(put 'gnus-group-mail-1-empty-face 'obsolete-face "22.1") -(defface gnus-group-mail-2-face +(defface gnus-group-mail-2 '((((class color) (background dark)) - (:foreground "aquamarine2" :bold t)) + (:foreground "DarkSeaGreen1" :bold t)) (((class color) (background light)) (:foreground "HotPink3" :bold t)) (t (:bold t))) - "Level 2 mailgroup face.") + "Level 2 mailgroup face." + :group 'gnus-group) +;; backward-compatibility alias +(put 'gnus-group-mail-2-face 'face-alias 'gnus-group-mail-2) +(put 'gnus-group-mail-2-face 'obsolete-face "22.1") -(defface gnus-group-mail-2-empty-face +(defface gnus-group-mail-2-empty '((((class color) (background dark)) - (:foreground "aquamarine2")) + (:foreground "DarkSeaGreen1")) (((class color) (background light)) (:foreground "HotPink3")) (t (:bold t))) - "Level 2 empty mailgroup face.") + "Level 2 empty mailgroup face." + :group 'gnus-group) +;; backward-compatibility alias +(put 'gnus-group-mail-2-empty-face 'face-alias 'gnus-group-mail-2-empty) +(put 'gnus-group-mail-2-empty-face 'obsolete-face "22.1") -(defface gnus-group-mail-3-face +(defface gnus-group-mail-3 '((((class color) (background dark)) - (:foreground "aquamarine3" :bold t)) + (:foreground "aquamarine1" :bold t)) (((class color) (background light)) (:foreground "magenta4" :bold t)) (t (:bold t))) - "Level 3 mailgroup face.") + "Level 3 mailgroup face." + :group 'gnus-group) +;; backward-compatibility alias +(put 'gnus-group-mail-3-face 'face-alias 'gnus-group-mail-3) +(put 'gnus-group-mail-3-face 'obsolete-face "22.1") -(defface gnus-group-mail-3-empty-face +(defface gnus-group-mail-3-empty '((((class color) (background dark)) - (:foreground "aquamarine3")) + (:foreground "aquamarine1")) (((class color) (background light)) (:foreground "magenta4")) (t ())) - "Level 3 empty mailgroup face.") + "Level 3 empty mailgroup face." + :group 'gnus-group) +;; backward-compatibility alias +(put 'gnus-group-mail-3-empty-face 'face-alias 'gnus-group-mail-3-empty) +(put 'gnus-group-mail-3-empty-face 'obsolete-face "22.1") -(defface gnus-group-mail-low-face +(defface gnus-group-mail-low '((((class color) (background dark)) - (:foreground "aquamarine4" :bold t)) + (:foreground "aquamarine2" :bold t)) (((class color) (background light)) (:foreground "DeepPink4" :bold t)) (t (:bold t))) - "Low level mailgroup face.") + "Low level mailgroup face." + :group 'gnus-group) +;; backward-compatibility alias +(put 'gnus-group-mail-low-face 'face-alias 'gnus-group-mail-low) +(put 'gnus-group-mail-low-face 'obsolete-face "22.1") -(defface gnus-group-mail-low-empty-face +(defface gnus-group-mail-low-empty '((((class color) (background dark)) - (:foreground "aquamarine4")) + (:foreground "aquamarine2")) (((class color) (background light)) (:foreground "DeepPink4")) (t (:bold t))) - "Low level empty mailgroup face.") + "Low level empty mailgroup face." + :group 'gnus-group) +;; backward-compatibility alias +(put 'gnus-group-mail-low-empty-face 'face-alias 'gnus-group-mail-low-empty) +(put 'gnus-group-mail-low-empty-face 'obsolete-face "22.1") ;; Summary mode faces. -(defface gnus-summary-selected-face '((t - (:underline t))) - "Face used for selected articles.") +(defface gnus-summary-selected '((t (:underline t))) + "Face used for selected articles." + :group 'gnus-summary) +;; backward-compatibility alias +(put 'gnus-summary-selected-face 'face-alias 'gnus-summary-selected) +(put 'gnus-summary-selected-face 'obsolete-face "22.1") -(defface gnus-summary-cancelled-face +(defface gnus-summary-cancelled '((((class color)) (:foreground "yellow" :background "black"))) - "Face used for cancelled articles.") + "Face used for cancelled articles." + :group 'gnus-summary) +;; backward-compatibility alias +(put 'gnus-summary-cancelled-face 'face-alias 'gnus-summary-cancelled) +(put 'gnus-summary-cancelled-face 'obsolete-face "22.1") -(defface gnus-summary-high-ticked-face +(defface gnus-summary-high-ticked '((((class color) (background dark)) (:foreground "pink" :bold t)) @@ -616,9 +719,13 @@ be set in `.emacs' instead." (:foreground "firebrick" :bold t)) (t (:bold t))) - "Face used for high interest ticked articles.") + "Face used for high interest ticked articles." + :group 'gnus-summary) +;; backward-compatibility alias +(put 'gnus-summary-high-ticked-face 'face-alias 'gnus-summary-high-ticked) +(put 'gnus-summary-high-ticked-face 'obsolete-face "22.1") -(defface gnus-summary-low-ticked-face +(defface gnus-summary-low-ticked '((((class color) (background dark)) (:foreground "pink" :italic t)) @@ -627,9 +734,13 @@ be set in `.emacs' instead." (:foreground "firebrick" :italic t)) (t (:italic t))) - "Face used for low interest ticked articles.") + "Face used for low interest ticked articles." + :group 'gnus-summary) +;; backward-compatibility alias +(put 'gnus-summary-low-ticked-face 'face-alias 'gnus-summary-low-ticked) +(put 'gnus-summary-low-ticked-face 'obsolete-face "22.1") -(defface gnus-summary-normal-ticked-face +(defface gnus-summary-normal-ticked '((((class color) (background dark)) (:foreground "pink")) @@ -638,9 +749,13 @@ be set in `.emacs' instead." (:foreground "firebrick")) (t ())) - "Face used for normal interest ticked articles.") + "Face used for normal interest ticked articles." + :group 'gnus-summary) +;; backward-compatibility alias +(put 'gnus-summary-normal-ticked-face 'face-alias 'gnus-summary-normal-ticked) +(put 'gnus-summary-normal-ticked-face 'obsolete-face "22.1") -(defface gnus-summary-high-ancient-face +(defface gnus-summary-high-ancient '((((class color) (background dark)) (:foreground "SkyBlue" :bold t)) @@ -649,9 +764,13 @@ be set in `.emacs' instead." (:foreground "RoyalBlue" :bold t)) (t (:bold t))) - "Face used for high interest ancient articles.") + "Face used for high interest ancient articles." + :group 'gnus-summary) +;; backward-compatibility alias +(put 'gnus-summary-high-ancient-face 'face-alias 'gnus-summary-high-ancient) +(put 'gnus-summary-high-ancient-face 'obsolete-face "22.1") -(defface gnus-summary-low-ancient-face +(defface gnus-summary-low-ancient '((((class color) (background dark)) (:foreground "SkyBlue" :italic t)) @@ -660,9 +779,13 @@ be set in `.emacs' instead." (:foreground "RoyalBlue" :italic t)) (t (:italic t))) - "Face used for low interest ancient articles.") + "Face used for low interest ancient articles." + :group 'gnus-summary) +;; backward-compatibility alias +(put 'gnus-summary-low-ancient-face 'face-alias 'gnus-summary-low-ancient) +(put 'gnus-summary-low-ancient-face 'obsolete-face "22.1") -(defface gnus-summary-normal-ancient-face +(defface gnus-summary-normal-ancient '((((class color) (background dark)) (:foreground "SkyBlue")) @@ -671,51 +794,79 @@ be set in `.emacs' instead." (:foreground "RoyalBlue")) (t ())) - "Face used for normal interest ancient articles.") + "Face used for normal interest ancient articles." + :group 'gnus-summary) +;; backward-compatibility alias +(put 'gnus-summary-normal-ancient-face 'face-alias 'gnus-summary-normal-ancient) +(put 'gnus-summary-normal-ancient-face 'obsolete-face "22.1") -(defface gnus-summary-high-undownloaded-face +(defface gnus-summary-high-undownloaded '((((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.") + "Face used for high interest uncached articles." + :group 'gnus-summary) +;; backward-compatibility alias +(put 'gnus-summary-high-undownloaded-face 'face-alias 'gnus-summary-high-undownloaded) +(put 'gnus-summary-high-undownloaded-face 'obsolete-face "22.1") -(defface gnus-summary-low-undownloaded-face +(defface gnus-summary-low-undownloaded '((((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.") + "Face used for low interest uncached articles." + :group 'gnus-summary) +;; backward-compatibility alias +(put 'gnus-summary-low-undownloaded-face 'face-alias 'gnus-summary-low-undownloaded) +(put 'gnus-summary-low-undownloaded-face 'obsolete-face "22.1") -(defface gnus-summary-normal-undownloaded-face +(defface gnus-summary-normal-undownloaded '((((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.") + "Face used for normal interest uncached articles." + :group 'gnus-summary) +;; backward-compatibility alias +(put 'gnus-summary-normal-undownloaded-face 'face-alias 'gnus-summary-normal-undownloaded) +(put 'gnus-summary-normal-undownloaded-face 'obsolete-face "22.1") -(defface gnus-summary-high-unread-face +(defface gnus-summary-high-unread '((t (:bold t))) - "Face used for high interest unread articles.") + "Face used for high interest unread articles." + :group 'gnus-summary) +;; backward-compatibility alias +(put 'gnus-summary-high-unread-face 'face-alias 'gnus-summary-high-unread) +(put 'gnus-summary-high-unread-face 'obsolete-face "22.1") -(defface gnus-summary-low-unread-face +(defface gnus-summary-low-unread '((t (:italic t))) - "Face used for low interest unread articles.") + "Face used for low interest unread articles." + :group 'gnus-summary) +;; backward-compatibility alias +(put 'gnus-summary-low-unread-face 'face-alias 'gnus-summary-low-unread) +(put 'gnus-summary-low-unread-face 'obsolete-face "22.1") -(defface gnus-summary-normal-unread-face +(defface gnus-summary-normal-unread '((t ())) - "Face used for normal interest unread articles.") + "Face used for normal interest unread articles." + :group 'gnus-summary) +;; backward-compatibility alias +(put 'gnus-summary-normal-unread-face 'face-alias 'gnus-summary-normal-unread) +(put 'gnus-summary-normal-unread-face 'obsolete-face "22.1") -(defface gnus-summary-high-read-face +(defface gnus-summary-high-read '((((class color) (background dark)) (:foreground "PaleGreen" @@ -726,9 +877,13 @@ be set in `.emacs' instead." :bold t)) (t (:bold t))) - "Face used for high interest read articles.") + "Face used for high interest read articles." + :group 'gnus-summary) +;; backward-compatibility alias +(put 'gnus-summary-high-read-face 'face-alias 'gnus-summary-high-read) +(put 'gnus-summary-high-read-face 'obsolete-face "22.1") -(defface gnus-summary-low-read-face +(defface gnus-summary-low-read '((((class color) (background dark)) (:foreground "PaleGreen" @@ -739,9 +894,13 @@ be set in `.emacs' instead." :italic t)) (t (:italic t))) - "Face used for low interest read articles.") + "Face used for low interest read articles." + :group 'gnus-summary) +;; backward-compatibility alias +(put 'gnus-summary-low-read-face 'face-alias 'gnus-summary-low-read) +(put 'gnus-summary-low-read-face 'obsolete-face "22.1") -(defface gnus-summary-normal-read-face +(defface gnus-summary-normal-read '((((class color) (background dark)) (:foreground "PaleGreen")) @@ -750,7 +909,11 @@ be set in `.emacs' instead." (:foreground "DarkGreen")) (t ())) - "Face used for normal interest read articles.") + "Face used for normal interest read articles." + :group 'gnus-summary) +;; backward-compatibility alias +(put 'gnus-summary-normal-read-face 'face-alias 'gnus-summary-normal-read) +(put 'gnus-summary-normal-read-face 'obsolete-face "22.1") ;;; @@ -791,19 +954,20 @@ be set in `.emacs' instead." (defvar gnus-group-buffer "*Group*") -(eval-and-compile - (autoload 'gnus-play-jingle "gnus-audio")) - -(defface gnus-splash-face +(defface gnus-splash '((((class color) (background dark)) - (:foreground "#888888")) + (:foreground "#cccccc")) (((class color) (background light)) (:foreground "#888888")) (t ())) - "Face for the splash screen.") + "Face for the splash screen." + :group 'gnus-start) +;; backward-compatibility alias +(put 'gnus-splash-face 'face-alias 'gnus-splash) +(put 'gnus-splash-face 'obsolete-face "22.1") (defun gnus-splash () (save-excursion @@ -812,9 +976,7 @@ be set in `.emacs' instead." (erase-buffer) (unless gnus-inhibit-startup-message (gnus-group-startup-message) - (sit-for 0) - (when gnus-play-startup-jingle - (gnus-play-jingle)))))) + (sit-for 0))))) (defun gnus-indent-rigidly (start end arg) "Indent rigidly using only spaces and no tabs." @@ -849,12 +1011,12 @@ be set in `.emacs' instead." (storm "#666699" "#99ccff") (pdino "#9999cc" "#99ccff") (purp "#9999cc" "#666699") - (no "#000000" "#ff0000") + (no "#ff0000" "#ffff00") (neutral "#b4b4b4" "#878787") (september "#bf9900" "#ffcc00")) "Color alist used for the Gnus logo.") -(defcustom gnus-logo-color-style 'oort +(defcustom gnus-logo-color-style 'no "*Color styles used for the Gnus logo." :type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem))) gnus-logo-color-alist)) @@ -864,6 +1026,8 @@ be set in `.emacs' instead." (cdr (assq gnus-logo-color-style gnus-logo-color-alist)) "Colors used for the Gnus logo.") +(declare-function image-size "image.c" (spec &optional pixels frame)) + (defun gnus-group-startup-message (&optional x y) "Insert startup message in current buffer." ;; Insert the message. @@ -872,7 +1036,17 @@ be set in `.emacs' instead." ((and (fboundp 'find-image) (display-graphic-p) - (let* ((data-directory (nnheader-find-etc-directory "gnus")) + ;; Make sure the library defining `image-load-path' is loaded + ;; (`find-image' is autoloaded) (and discard the result). Else, we may + ;; get "defvar ignored because image-load-path is let-bound" when calling + ;; `find-image' below. + (or (find-image '(nil (:type xpm :file "gnus.xpm"))) t) + (let* ((data-directory (nnheader-find-etc-directory "images/gnus")) + (image-load-path (cond (data-directory + (list data-directory)) + ((boundp 'image-load-path) + (symbol-value 'image-load-path)) + (t load-path))) (image (find-image `((:type xpm :file "gnus.xpm" :color-symbols @@ -880,13 +1054,15 @@ be set in `.emacs' instead." ("shadow" . ,(cadr gnus-logo-colors)) ("oort" . "#eeeeee") ("background" . ,(face-background 'default)))) + (:type svg :file "gnus.svg") + (:type png :file "gnus.png") (:type pbm :file "gnus.pbm" ;; Account for the pbm's blackground. - :background ,(face-foreground 'gnus-splash-face) + :background ,(face-foreground 'gnus-splash) :foreground ,(face-background 'default)) (:type xbm :file "gnus.xbm" ;; Account for the xbm's blackground. - :background ,(face-foreground 'gnus-splash-face) + :background ,(face-foreground 'gnus-splash) :foreground ,(face-background 'default)))))) (when image (let ((size (image-size image))) @@ -900,23 +1076,23 @@ be set in `.emacs' instead." (t (insert (format " %s - _ ___ _ _ - _ ___ __ ___ __ _ ___ - __ _ ___ __ ___ - _ ___ _ - _ _ __ _ - ___ __ _ - __ _ - _ _ _ - _ _ _ - _ _ _ - __ ___ - _ _ _ _ - _ _ - _ _ - _ _ - _ - __ + _ ___ _ _ + _ ___ __ ___ __ _ ___ + __ _ ___ __ ___ + _ ___ _ + _ _ __ _ + ___ __ _ + __ _ + _ _ _ + _ _ _ + _ _ _ + __ ___ + _ _ _ _ + _ _ + _ _ + _ _ + _ + __ " "")) @@ -930,7 +1106,7 @@ be set in `.emacs' instead." (rest (- wheight pheight))) (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))) ;; Fontify some. - (put-text-property (point-min) (point-max) 'face 'gnus-splash-face) + (put-text-property (point-min) (point-max) 'face 'gnus-splash) (setq gnus-simple-splash t))) (goto-char (point-min)) (setq mode-line-buffer-identification (concat " " gnus-version)) @@ -938,10 +1114,10 @@ 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. @@ -961,10 +1137,22 @@ For example: (\"mail\\\\.me\" (gnus-use-scoring t)) (\"list\\\\..*\" (total-expire . t) (broken-reply-to . t)))" + :version "22.1" :group 'gnus-group-various :type '(repeat (cons regexp (repeat sexp)))) +(defcustom gnus-parameters-case-fold-search 'default + "If it is t, ignore case of group names specified in `gnus-parameters'. +If it is nil, don't ignore case. If it is `default', which is for the +backward compatibility, use the value of `case-fold-search'." + :version "22.1" + :group 'gnus-group-various + :type '(choice :format "%{%t%}:\n %[Value Menu%] %v" + (const :tag "Use `case-fold-search'" default) + (const nil) + (const t))) + (defvar gnus-group-parameters-more nil) (defmacro gnus-define-group-parameter (param &rest rest) @@ -1101,9 +1289,13 @@ Check the NNTPSERVER environment variable and the (and (file-readable-p gnus-nntpserver-file) (with-temp-buffer (insert-file-contents gnus-nntpserver-file) - (let ((name (buffer-string))) - (unless (string-match "\\`[ \t\n]*$" name) - name)))))) + (when (re-search-forward "[^ \t\n\r]+" nil t) + (match-string 0)))))) + +;; `M-x customize-variable RET gnus-select-method RET' should work without +;; starting or even loading Gnus. +;;;###autoload(when (fboundp 'custom-autoload) +;;;###autoload (custom-autoload 'gnus-select-method "gnus")) (defcustom gnus-select-method (condition-case nil @@ -1138,17 +1330,37 @@ If you use this variable, you must set `gnus-nntp-server' to nil. There is a lot more to know about select methods and virtual servers - see the manual for details." :group 'gnus-server + :group 'gnus-start + :initialize 'custom-initialize-default :type 'gnus-select-method) (defcustom gnus-message-archive-method "archive" "*Method used for archiving messages you've sent. -This should be a mail method." +This should be a mail method. + +See also `gnus-update-message-archive-method'." :group 'gnus-server :group 'gnus-message :type '(choice (const :tag "Default archive method" "archive") gnus-select-method)) -(defcustom gnus-message-archive-group nil +(defcustom gnus-update-message-archive-method nil + "Non-nil means always update the saved \"archive\" method. + +The archive method is initially set according to the value of +`gnus-message-archive-method' and is saved in the \"~/.newsrc.eld\" file +so that it may be used as a real method of the server which is named +\"archive\" ever since. If it once has been saved, it will never be +updated if the value of this variable is nil, even if you change the +value of `gnus-message-archive-method' afterward. If you want the +saved \"archive\" method to be updated whenever you change the value of +`gnus-message-archive-method', set this variable to a non-nil value." + :version "24.1" + :group 'gnus-server + :group 'gnus-message + :type 'boolean) + +(defcustom gnus-message-archive-group '((format-time-string "sent.%Y-%m")) "*Name of the group in which to save the messages you've written. This can either be a string; a list of strings; or an alist of regexps/functions/forms to be evaluated to return a string (or a list @@ -1170,6 +1382,9 @@ that case, just return a fully prefixed name of the group -- \"nnml+private:mail.misc\", for instance." :group 'gnus-message :type '(choice (const :tag "none" nil) + (const :tag "Weekly" ((format-time-string "sent.%Yw%U"))) + (const :tag "Monthly" ((format-time-string "sent.%Y-%m"))) + (const :tag "Yearly" ((format-time-string "sent.%Y"))) function sexp string)) @@ -1183,7 +1398,7 @@ non-numeric prefix - `C-u M-x gnus', in short." (defcustom gnus-nntp-server nil "*The name of the host running the NNTP server. -This variable is semi-obsolete. Use the `gnus-select-method' +This variable is semi-obsolete. Use the `gnus-select-method' variable instead." :group 'gnus-server :type '(choice (const :tag "disable" nil) @@ -1214,6 +1429,7 @@ no need to set this variable." :group 'gnus-message :type '(choice (const :tag "default" nil) string)) +(make-obsolete-variable 'gnus-local-domain nil "Emacs 24.1") (defvar gnus-local-organization nil "String with a description of what organization (if any) the user belongs to. @@ -1221,7 +1437,7 @@ Obsolete variable; use `message-user-organization' instead.") ;; Customization variables -(defcustom gnus-refer-article-method nil +(defcustom gnus-refer-article-method 'current "Preferred method for fetching an article by Message-ID. If you are reading news from the local spool (with nnspool), fetching articles by Message-ID is painfully slow. By setting this method to an @@ -1233,6 +1449,7 @@ in the documentation of `gnus-select-method'. It can also be a list of select methods, as well as the special symbol `current', which means to use the current select method. If it is a list, Gnus will try all the methods in the list until it finds a match." + :version "24.1" :group 'gnus-server :type '(choice (const :tag "default" nil) (const current) @@ -1247,84 +1464,18 @@ list, Gnus will try all the methods in the list until it finds a match." (nnweb "refer" (nnweb-type google))) gnus-select-method)))) -(defcustom gnus-group-faq-directory - '("/ftp@mirrors.aol.com:/pub/rtfm/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.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. -This will most commonly be on a remote machine, and the file will be -fetched by ange-ftp. - -This variable can also be a list of directories. In that case, the -first element in the list will be used by default. The others can -be used when being prompted for a site. - -Note that Gnus uses an aol machine as the default directory. If this -feels fundamentally unclean, just think of it as a way to finally get -something of value back from them. - -If the default site is too slow, try one of these: - - North America: mirrors.aol.com /pub/rtfm/usenet - 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 - ftp.sunet.se /pub/usenet - 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." + :version "22.1" :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 -subscribed newsgroups. If neither t nor nil, mark as read in all +subscribed newsgroups. If neither t nor nil, mark as read in all newsgroups." :group 'gnus-server :type '(choice (const :tag "off" nil) @@ -1342,12 +1493,14 @@ newsgroups." "*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. -If it is nil, no confirmation is required." +If it is nil, no confirmation is required. + +Also see `gnus-large-ephemeral-newsgroup'." :group 'gnus-group-select :type '(choice (const :tag "No limit" nil) integer)) -(defcustom gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix))) +(defcustom gnus-use-long-file-name (not (memq system-type '(usg-unix-v))) "*Non-nil means that the default name of a file to save articles in is the group name. If it's nil, the directory form of the group name is used instead. @@ -1412,11 +1565,6 @@ cache to the full extent of the law." :group 'gnus-meta :type 'boolean) -(defcustom gnus-use-grouplens nil - "*If non-nil, use GroupLens ratings." - :group 'gnus-meta - :type 'boolean) - (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 @@ -1428,11 +1576,6 @@ articles. This is not a good idea." (sexp :format "all" :value t))) -(defcustom gnus-use-nocem nil - "*If non-nil, Gnus will read NoCeM cancel messages." - :group 'gnus-meta - :type 'boolean) - (defcustom gnus-suppress-duplicates nil "*If non-nil, Gnus will mark duplicate copies of the same article as read." :group 'gnus-meta @@ -1485,11 +1628,6 @@ slower." (function-item mail-extract-address-components) (function :tag "Other"))) -(defcustom gnus-carpal nil - "*If non-nil, display clickable icons." - :group 'gnus-meta - :type 'boolean) - (defcustom gnus-shell-command-separator ";" "String used to separate shell commands." :group 'gnus-files @@ -1506,19 +1644,11 @@ slower." ("nneething" none address prompt-address physical-address) ("nndoc" none address prompt-address) ("nnbabyl" mail address respool) - ("nnkiboze" post virtual) - ("nnsoup" post-mail address) ("nndraft" post-mail) ("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) ("nnmaildir" mail respool address) @@ -1529,7 +1659,7 @@ of the select method. The other elements may be the category of this method (i. e., `post', `mail', `none' or whatever) or other properties that this method has (like being respoolable). If you implement a new select method, all you should have to change is -this variable. I think." +this variable. I think." :group 'gnus-server :type '(repeat (group (string :tag "Name") (radio-button-choice (const :format "%v " post) @@ -1541,7 +1671,8 @@ this variable. I think." (const :format "%v " prompt-address) (const :format "%v " physical-address) (const :format "%v " virtual) - (const respool))))) + (const respool)))) + :version "24.1") (defun gnus-redefine-select-method-widget () "Recomputes the select-method widget based on the value of @@ -1577,12 +1708,11 @@ If this variable is nil, screen refresh may be quicker." (const summary) (const tree))) -;; Added by Keinonen Kari . -(defcustom gnus-mode-non-string-length nil +(defcustom gnus-mode-non-string-length 30 "*Max length of mode-line non-string contents. If this is nil, Gnus will take space as is needed, leaving the rest -of the mode line intact. Note that the default of nil is unlikely -to be desirable; see the manual for further details." +of the mode line intact." + :version "24.1" :group 'gnus-various :type '(choice (const nil) integer)) @@ -1597,6 +1727,7 @@ to be desirable; see the manual for further details." "Return GROUP's to-address." :variable-document "*Alist of group regexps and correspondent to-addresses." + :variable-group gnus-group-parameter :parameter-type '(gnus-email-address :tag "To Address") :parameter-document "\ This will be used when doing followups and posts. @@ -1623,6 +1754,7 @@ address was listed in gnus-group-split Addresses (see below).") "Return GROUP's to-list." :variable-document "*Alist of group regexps and correspondent to-lists." + :variable-group gnus-group-parameter :parameter-type '(gnus-email-address :tag "To List") :parameter-document "\ This address will be used when doing a `a' in the group. @@ -1641,6 +1773,7 @@ address was listed in gnus-group-split Addresses (see below).") "Return GROUP's subscription status." :variable-document "*Groups which are automatically considered subscribed." + :variable-group gnus-group-parameter :parameter-type '(const :tag "Subscribed" t) :parameter-document "\ Gnus assumed that you are subscribed to the To/List address. @@ -1680,7 +1813,7 @@ which to perform auto-expiry. This only makes sense for mail groups." "*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 +\(say) one week. (This only goes for mail groups and the like, of course.)" :variable-group nnmail-expire :variable-type '(choice (const nil) @@ -1747,6 +1880,7 @@ posting an article." "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." + :variable-group gnus-group-parameter :parameter-type '(choice :tag "Initial Input for Large Newsgroup" (const :tag "All" nil) (integer)) @@ -1772,7 +1906,7 @@ total number of articles in the group.") (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.") @@ -1781,6 +1915,7 @@ total number of articles in the group.") (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." + :version "22.1" :type 'boolean :group 'gnus-start) @@ -1808,11 +1943,12 @@ registry.") :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." + "*Group classification (spam, ham, or neither). Only +meaningful when spam.el is loaded. If non-nil, this should be a +list of group name regexps associated with a classification for +each one. In spam groups, new articles are marked as spam on +summary entry. There is other behavior associated with ham and +no classification when spam.el is loaded - see the manual." :variable-group spam :variable-type '(repeat (list :tag "Group contents spam/ham classification" @@ -1829,77 +1965,136 @@ This only makes sense for mail groups." (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.") +When a spam group is entered, all unread articles are marked as +spam. There is other behavior associated with ham and no +classification when spam.el is loaded - see the manual.") + + (gnus-define-group-parameter + spam-resend-to + :type list + :function-document + "The address to get spam resent (through spam-report-resend)." + :variable gnus-spam-resend-to + :variable-default nil + :variable-document + "The address to get spam resent (through spam-report-resend)." + :variable-group spam + :variable-type '(repeat + (list :tag "Group address for resending spam" + (regexp :tag "Group") + (string :tag "E-mail address for resending spam (requires the spam-use-resend exit processor)"))) + :parameter-type 'string :tag "E-mail address for resending spam (requires the spam-use-resend exit processor)" + :parameter-document + "The address to get spam resent (through spam-report-resend).") + + (gnus-define-group-parameter + ham-resend-to + :type list + :function-document + "The address to get ham resent (through spam-report-resend)." + :variable gnus-ham-resend-to + :variable-default nil + :variable-document + "The address to get ham resent (through spam-report-resend)." + :variable-group spam + :variable-type '(repeat + (list :tag "Group address for resending ham" + (regexp :tag "Group") + (string :tag "E-mail address for resending ham (requires the spam-use-resend exit processor)"))) + :parameter-type 'string :tag "E-mail address for resending ham (requires the spam-use-resend exit processor)" + :parameter-document + "The address to get ham resent (through spam-report-resend).") (defvar gnus-group-spam-exit-processor-ifile "ifile" - "The ifile summary exit spam processor.") + "OBSOLETE: The ifile summary exit spam processor.") (defvar gnus-group-spam-exit-processor-stat "stat" - "The spam-stat summary exit spam processor.") + "OBSOLETE: The spam-stat summary exit spam processor.") (defvar gnus-group-spam-exit-processor-bogofilter "bogofilter" - "The Bogofilter summary exit spam processor.") + "OBSOLETE: The Bogofilter summary exit spam processor.") (defvar gnus-group-spam-exit-processor-blacklist "blacklist" - "The Blacklist summary exit spam processor.") + "OBSOLETE: The Blacklist summary exit spam processor.") (defvar gnus-group-spam-exit-processor-report-gmane "report-gmane" - "The Gmane reporting summary exit spam processor. + "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" - "The spamoracle summary exit spam processor.") + "OBSOLETE: The spamoracle summary exit spam processor.") (defvar gnus-group-ham-exit-processor-ifile "ifile-ham" - "The ifile summary exit ham processor. + "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" - "The Bogofilter summary exit ham processor. + "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" - "The spam-stat summary exit ham processor. + "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" - "The whitelist summary exit ham processor. + "OBSOLETE: The whitelist summary exit ham processor. Only applicable to non-spam (unclassified and ham) groups.") (defvar gnus-group-ham-exit-processor-BBDB "bbdb" - "The BBDB summary exit ham processor. + "OBSOLETE: The BBDB summary exit ham processor. Only applicable to non-spam (unclassified and ham) groups.") (defvar gnus-group-ham-exit-processor-copy "copy" - "The ham copy exit ham processor. + "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" - "The spamoracle summary exit ham processor. + "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 + :parameter-type + '(choice :tag "Spam Summary Exit Processor" :value nil (list :tag "Spam Summary Exit Processor Choices" (set + (const :tag "Spam: Bogofilter" (spam spam-use-bogofilter)) + (const :tag "Spam: Blacklist" (spam spam-use-blacklist)) + (const :tag "Spam: Bsfilter" (spam spam-use-bsfilter)) + (const :tag "Spam: Gmane Report" (spam spam-use-gmane)) + (const :tag "Spam: Resend Message"(spam spam-use-resend)) + (const :tag "Spam: ifile" (spam spam-use-ifile)) + (const :tag "Spam: Spam Oracle" (spam spam-use-spamoracle)) + (const :tag "Spam: Spam-stat" (spam spam-use-stat)) + (const :tag "Spam: SpamAssassin" (spam spam-use-spamassassin)) + (const :tag "Spam: CRM114" (spam spam-use-crm114)) + (const :tag "Ham: BBDB" (ham spam-use-BBDB)) + (const :tag "Ham: Bogofilter" (ham spam-use-bogofilter)) + (const :tag "Ham: Bsfilter" (ham spam-use-bsfilter)) + (const :tag "Ham: Copy" (ham spam-use-ham-copy)) + (const :tag "Ham: Resend Message" (ham spam-use-resend)) + (const :tag "Ham: ifile" (ham spam-use-ifile)) + (const :tag "Ham: Spam Oracle" (ham spam-use-spamoracle)) + (const :tag "Ham: Spam-stat" (ham spam-use-stat)) + (const :tag "Ham: SpamAssassin" (ham spam-use-spamassassin)) + (const :tag "Ham: CRM114" (ham spam-use-crm114)) + (const :tag "Ham: Whitelist" (ham spam-use-whitelist)) (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-report-gmane) (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-copy) - (variable-item gnus-group-ham-exit-processor-spamoracle)))) + (variable-item gnus-group-ham-exit-processor-spamoracle) + (variable-item gnus-group-ham-exit-processor-copy)))) :function-document "Which spam or ham processors will be applied when the summary is exited." :variable gnus-spam-process-newsgroups @@ -1910,12 +2105,33 @@ 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 + :variable-type '(repeat :tag "Spam/Ham Processors" (list :tag "Spam Summary Exit Processor Choices" (regexp :tag "Group Regexp") - (set + (set :tag "Spam/Ham Summary Exit Processor" + (const :tag "Spam: Bogofilter" (spam spam-use-bogofilter)) + (const :tag "Spam: Blacklist" (spam spam-use-blacklist)) + (const :tag "Spam: Bsfilter" (spam spam-use-bsfilter)) + (const :tag "Spam: Gmane Report" (spam spam-use-gmane)) + (const :tag "Spam: Resend Message"(spam spam-use-resend)) + (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 "Spam: SpamAssassin" (spam spam-use-spamassassin)) + (const :tag "Spam: CRM114" (spam spam-use-crm114)) + (const :tag "Ham: BBDB" (ham spam-use-BBDB)) + (const :tag "Ham: Bogofilter" (ham spam-use-bogofilter)) + (const :tag "Ham: Bsfilter" (ham spam-use-bsfilter)) + (const :tag "Ham: Copy" (ham spam-use-ham-copy)) + (const :tag "Ham: Resend Message" (ham spam-use-resend)) + (const :tag "Ham: ifile" (ham spam-use-ifile)) + (const :tag "Ham: Spam-stat" (ham spam-use-stat)) + (const :tag "Ham: Spam Oracle" (ham spam-use-spamoracle)) + (const :tag "Ham: SpamAssassin" (ham spam-use-spamassassin)) + (const :tag "Ham: CRM114" (ham spam-use-crm114)) + (const :tag "Ham: Whitelist" (ham spam-use-whitelist)) (variable-item gnus-group-spam-exit-processor-ifile) (variable-item gnus-group-spam-exit-processor-stat) (variable-item gnus-group-spam-exit-processor-bogofilter) @@ -1929,13 +2145,108 @@ spam processing, associated with the appropriate processor." (variable-item gnus-group-ham-exit-processor-BBDB) (variable-item gnus-group-ham-exit-processor-spamoracle) (variable-item gnus-group-ham-exit-processor-copy)))) + :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-gmane-xref) + (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-crm114) + (variable-item spam-use-spamassassin) + (variable-item spam-use-spamassassin-headers) + (variable-item spam-use-bsfilter) + (variable-item spam-use-bsfilter-headers) + (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-gmane-xref) + (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-crm114) + (variable-item spam-use-stat) + (variable-item spam-use-blackholes) + (variable-item spam-use-hashcash) + (variable-item spam-use-spamassassin) + (variable-item spam-use-spamassassin-headers) + (variable-item spam-use-bsfilter) + (variable-item spam-use-bsfilter-headers) + (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 + :parameter-type '(choice :tag "Destination for spam-processed articles at summary exit" (string :tag "Move to a group") (repeat :tag "Move to multiple groups" @@ -1953,7 +2264,7 @@ 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 + :variable-type '(repeat :tag "Spam-processed articles destination" (list @@ -1966,11 +2277,11 @@ mail groups." (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 + :parameter-type '(choice :tag "Destination for ham articles at summary exit from a spam group" (string :tag "Move to a group") @@ -1990,7 +2301,7 @@ 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 + :variable-type '(repeat :tag "Ham articles destination" (list @@ -2091,7 +2402,8 @@ following hook: "Function run when a group level is changed. It is called with three parameters -- GROUP, LEVEL and OLDLEVEL." :group 'gnus-group-levels - :type 'function) + :type '(choice (const nil) + function)) ;;; Face thingies. @@ -2101,8 +2413,7 @@ It is called with three parameters -- GROUP, LEVEL and OLDLEVEL." summary-menu group-menu article-menu tree-highlight menu highlight browse-menu server-menu - page-marker tree-menu binary-menu pick-menu - grouplens-menu) + page-marker tree-menu binary-menu pick-menu) "*Enable visual features. If `visual' is disabled, there will be no menus and few faces. Most of the visual customization options below will be ignored. Gnus will use @@ -2116,8 +2427,7 @@ instance, to switch off all visual things except menus, you can say: Valid elements include `summary-highlight', `group-highlight', `article-highlight', `mouse-face', `summary-menu', `group-menu', `article-menu', `tree-highlight', `menu', `highlight', `browse-menu', -`server-menu', `page-marker', `tree-menu', `binary-menu', `pick-menu', -and `grouplens-menu'." +`server-menu', `page-marker', `tree-menu', `binary-menu', and`pick-menu'." :group 'gnus-meta :group 'gnus-visual :type '(set (const summary-highlight) @@ -2135,8 +2445,7 @@ and `grouplens-menu'." (const page-marker) (const tree-menu) (const binary-menu) - (const pick-menu) - (const grouplens-menu))) + (const pick-menu))) ;; Byte-compiler warning. (defvar gnus-visual) @@ -2177,7 +2486,7 @@ face." 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" + :version "22.1" :group 'gnus-agent :type 'boolean) @@ -2196,7 +2505,7 @@ covered by that variable." 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" + :version "22.1" :group 'gnus-agent :type 'boolean) @@ -2220,11 +2529,55 @@ This should be an alist for Emacs, or a plist for XEmacs." (symbol :tag "Parameter") (sexp :tag "Value"))))) +(defcustom gnus-user-agent '(emacs gnus type) + "Which information should be exposed in the User-Agent header. + +Can be a list of symbols or a string. Valid symbols are `gnus' +\(show Gnus version\) and `emacs' \(show Emacs version\). In +addition to the Emacs version, you can add `codename' \(show +\(S\)XEmacs codename\) or either `config' \(show system +configuration\) or `type' \(show system type\). If you set it to +a string, be sure to use a valid format, see RFC 2616." + + :version "22.1" + :group 'gnus-message + :type '(choice (list (set :inline t + (const gnus :tag "Gnus version") + (const emacs :tag "Emacs version") + (choice :tag "system" + (const type :tag "system type") + (const config :tag "system configuration")) + (const codename :tag "Emacs codename"))) + (string))) + +;; Convert old (< 2005-01-10) symbol type values: +(when (symbolp gnus-user-agent) + (setq gnus-user-agent + (cond ((eq gnus-user-agent 'emacs-gnus-config) + '(emacs gnus config)) + ((eq gnus-user-agent 'emacs-gnus-type) + '(emacs gnus type)) + ((eq gnus-user-agent 'emacs-gnus) + '(emacs gnus)) + ((eq gnus-user-agent 'gnus) + '(gnus)) + (t gnus-user-agent))) + (gnus-message 1 "Converted `gnus-user-agent' to `%s'." gnus-user-agent) + (sit-for 1) + (if (get 'gnus-user-agent 'saved-value) + (customize-save-variable 'gnus-user-agent gnus-user-agent) + (gnus-message 1 "Edit your init file to make this change permanent.") + (sit-for 2))) + ;;; 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) @@ -2232,11 +2585,18 @@ This should be an alist for Emacs, or a plist for XEmacs." (defvar gnus-newsgroup-name nil) (defvar gnus-ephemeral-servers nil) (defvar gnus-server-method-cache nil) +(defvar gnus-extended-servers nil) + +;; The carpal mode has been removed, but define the variable for +;; backwards compatability. +(defvar gnus-carpal nil) +(make-obsolete-variable 'gnus-carpal nil "Emacs 24.1") (defvar gnus-agent-fetching nil "Whether Gnus agent is in fetching mode.") -(defvar gnus-agent-covered-methods nil) +(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 back end is.") @@ -2247,9 +2607,6 @@ This should be an alist for Emacs, or a plist for XEmacs." (defvar gnus-tree-buffer "*Tree*" "Buffer where Gnus thread trees are displayed.") -;; Dummy variable. -(defvar gnus-use-generic-from nil) - ;; Variable holding the user answers to all method prompts. (defvar gnus-method-history nil) @@ -2277,8 +2634,6 @@ This should be an alist for Emacs, or a plist for XEmacs." ,(nnheader-concat gnus-cache-directory "active")))) "List of predefined (convenience) servers.") -(defvar gnus-topic-indentation "") ;; Obsolete variable. - (defconst gnus-article-mark-lists '((marked . tick) (replied . reply) (expirable . expire) (killed . killed) @@ -2292,6 +2647,8 @@ This should be an alist for Emacs, or a plist for XEmacs." '((seen range) (killed range) (bookmark tuple) + (uid tuple) + (active tuple) (score tuple))) ;; Propagate flags to server, with the following exceptions: @@ -2311,7 +2668,6 @@ such as a mark that says whether an article is stored in the cache (defvar gnus-headers-retrieved-by nil) (defvar gnus-article-reply nil) (defvar gnus-override-method nil) -(defvar gnus-article-check-size nil) (defvar gnus-opened-servers nil) (defvar gnus-current-kill-article nil) @@ -2348,7 +2704,7 @@ such as a mark that says whether an article is stored in the cache gnus-newsrc-alist gnus-server-alist gnus-killed-list gnus-zombie-list gnus-topic-topology gnus-topic-alist - gnus-agent-covered-methods gnus-format-specs) + gnus-format-specs) "Gnus variables saved in the quick startup file.") (defvar gnus-newsrc-alist nil @@ -2388,9 +2744,6 @@ gnus-registry.el will populate this if it's loaded.") (defvar gnus-reffed-article-number nil) -;;; Let the byte-compiler know that we know about this variable. -(defvar rmail-default-rmail-file) - (defvar gnus-dead-summary nil) (defvar gnus-invalid-group-regexp "[: `'\"/]\\|^$" @@ -2406,7 +2759,7 @@ gnus-registry.el will populate this if it's loaded.") ;; This little mapcar goes through the list below and marks the ;; symbols in question as autoloaded functions. - (mapcar + (mapc (lambda (package) (let ((interactive (nth 1 (memq ':interactive package)))) (mapcar @@ -2429,21 +2782,20 @@ gnus-registry.el will populate this if it's loaded.") ("babel" babel-as-string) ("nnmail" nnmail-split-fancy nnmail-article-group) ("nnvirtual" nnvirtual-catchup-group nnvirtual-convert-headers) - ("rmailout" rmail-output rmail-output-to-rmail-file) - ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages - rmail-show-message rmail-summary-exists - rmail-select-summary rmail-update-summary) - ("gnus-audio" :interactive t gnus-audio-play) + ;; This is only used in message.el, which has an autoload. + ("rmailout" rmail-output) + ;; Next two used in gnus-util, which has autoloads, and contrib/sendmail. + ("rmail" rmail-count-new-messages rmail-show-message + ;; Next two only used in gnus-util. + rmail-summary-exists rmail-select-summary) + ;; Only used in gnus-util, which has an autoload. + ("rmailsum" rmail-update-summary) ("gnus-xmas" gnus-xmas-splash) - ("gnus-soup" :interactive t - gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article - gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet) - ("nnsoup" nnsoup-pack-replies) ("score-mode" :interactive t gnus-score-mode) ("gnus-mh" gnus-summary-save-article-folder gnus-Folder-save-name gnus-folder-save-name) ("gnus-mh" :interactive t gnus-summary-save-in-folder) - ("gnus-demon" gnus-demon-add-nocem gnus-demon-add-scanmail + ("gnus-demon" gnus-demon-add-scanmail gnus-demon-add-rescan gnus-demon-add-scan-timestamps gnus-demon-add-disconnection gnus-demon-add-handler gnus-demon-remove-handler) @@ -2453,9 +2805,7 @@ gnus-registry.el will populate this if it's loaded.") 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 - gnus-nocem-unwanted-article-p) + gnus-tree-open gnus-tree-close) ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info gnus-server-server-name) ("gnus-srvr" gnus-browse-foreign-server) @@ -2505,7 +2855,7 @@ gnus-registry.el will populate this if it's loaded.") gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view gnus-uu-decode-binhex-view gnus-uu-unmark-thread - gnus-uu-mark-over gnus-uu-post-news) + gnus-uu-mark-over gnus-uu-post-news gnus-uu-invert-processable) ("gnus-uu" gnus-uu-delete-work-dir gnus-uu-unmark-thread) ("gnus-msg" (gnus-summary-send-map keymap) gnus-article-mail gnus-copy-article-buffer gnus-extended-version) @@ -2523,8 +2873,6 @@ gnus-registry.el will populate this if it's loaded.") gnus-summary-post-forward gnus-summary-wide-reply-with-original gnus-summary-post-forward) ("gnus-picon" :interactive t gnus-treat-from-picon) - ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p - gnus-grouplens-mode) ("smiley" :interactive t smiley-region) ("gnus-win" gnus-configure-windows gnus-add-configuration) ("gnus-sum" gnus-summary-insert-line gnus-summary-read-group @@ -2559,27 +2907,27 @@ gnus-registry.el will populate this if it's loaded.") 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 gnus-mime-view-all-parts) ("gnus-int" gnus-request-type) + ("gnus-html" gnus-html-show-images) ("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1 - gnus-dribble-enter gnus-read-init-file gnus-dribble-touch) + gnus-dribble-enter gnus-read-init-file gnus-dribble-touch + gnus-check-reasonable-setup) ("gnus-dup" gnus-dup-suppress-articles gnus-dup-unsuppress-article gnus-dup-enter-articles) ("gnus-range" gnus-copy-sequence) ("gnus-eform" gnus-edit-form) - ("gnus-move" :interactive t - gnus-group-move-group-to-server gnus-change-server) ("gnus-logic" gnus-score-advanced) ("gnus-undo" gnus-undo-mode gnus-undo-register) ("gnus-async" gnus-async-request-fetched-article gnus-async-prefetch-next gnus-async-prefetch-article gnus-async-prefetch-remove-group gnus-async-halt-prefetch) ("gnus-agent" gnus-open-agent gnus-agent-get-function - gnus-agent-save-groups gnus-agent-save-active gnus-agent-method-p + 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-agent-request-article gnus-agent-retrieve-headers) @@ -2636,7 +2984,6 @@ with some simple extensions. %z Article zcore (character) %t Number of articles under the current thread (number). %e Whether the thread is empty or not (character). -%l GroupLens score (string). %V Total thread score (number). %P The line number (number). %O Download mark (character). @@ -2652,7 +2999,7 @@ with some simple extensions. 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 -it is invalid to have these specs after a variable-length spec. Well, +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. @@ -2815,11 +3162,9 @@ Return nil if not defined." (defun gnus-shutdown (symbol) "Shut down everything that waits for SYMBOL." - (let ((alist gnus-shutdown-alist) - entry) - (while (setq entry (pop alist)) - (when (memq symbol (cdr entry)) - (funcall (car entry)))))) + (dolist (entry gnus-shutdown-alist) + (when (memq symbol (cdr entry)) + (funcall (car entry))))) ;;; @@ -2845,12 +3190,12 @@ with a `subscribed' parameter." (defmacro gnus-string-or (&rest strings) "Return the first element of STRINGS that is a non-blank string. STRINGS will be evaluated in normal `or' order." - `(gnus-string-or-1 ',strings)) + `(gnus-string-or-1 (list ,@strings))) (defun gnus-string-or-1 (strings) (let (string) (while strings - (setq string (eval (pop strings))) + (setq string (pop strings)) (if (string-match "^[ \t]*$" string) (setq string nil) (setq strings nil))) @@ -2866,7 +3211,6 @@ If ARG, insert string at point." (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) @@ -3037,7 +3381,7 @@ GROUP can either be a string (a group name) or a select method." (defun gnus-group-read-only-p (&optional group) "Check whether GROUP supports editing or not. -If GROUP is nil, `gnus-newsgroup-name' will be checked instead. Note +If GROUP is nil, `gnus-newsgroup-name' will be checked instead. Note 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)))) @@ -3050,14 +3394,14 @@ 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." (cond ((gnus-member-of-valid 'post group) ;Ordinary news group - t) ;is news of course. + 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 + ((null article) ;Hasn't header info (eq (gnus-request-type group) 'news)) ;(unknown ==> mail) - ((< article 0) ;Virtual message + ((< article 0) ;Virtual message nil) ;we don't know, guess mail. (t ;Has positive number (eq (gnus-request-type group article) 'news)))) ;use it. @@ -3085,7 +3429,7 @@ that that variable is buffer-local to the summary buffers." (defun gnus-generate-new-group-name (leaf) (let ((name leaf) (num 0)) - (while (gnus-gethash name gnus-newsrc-hashtb) + (while (gnus-group-entry name) (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">"))) name)) @@ -3122,6 +3466,38 @@ that that variable is buffer-local to the summary buffers." (nth 1 method)))) method))) +(defsubst gnus-method-to-server (method &optional nocache no-enter-cache) + (catch 'server-name + (setq method (or method gnus-select-method)) + + ;; Perhaps it is already in the cache. + (unless nocache + (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)) + (list gnus-server-alist + gnus-predefined-server-alist)) + + (let* ((name (if (member (cadr method) '(nil "")) + (format "%s" (car method)) + (format "%s:%s" (car method) (cadr method)))) + (name-method (cons name method))) + (when (and (not (member name-method gnus-server-method-cache)) + (not no-enter-cache) + (not (assoc (car name-method) gnus-server-method-cache))) + (push name-method gnus-server-method-cache)) + name))) + (defsubst gnus-server-to-method (server) "Map virtual server names to select methods." (or (and server (listp server) server) @@ -3148,8 +3524,26 @@ that that variable is buffer-local to the summary buffers." (not (equal server (format "%s:%s" (caar servers) (cadar servers))))) (pop servers)) - (car servers))))) - (push (cons server result) gnus-server-method-cache) + (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 ((alist (cdr gnus-newsrc-alist)) + method match) + (while alist + (setq method (gnus-info-method (pop alist))) + (when (and (not (stringp method)) + (equal server + (gnus-method-to-server method nil t))) + (setq match method + alist nil))) + match)))) + (when (and result + (not (assoc server gnus-server-method-cache))) + (push (cons server result) gnus-server-method-cache)) result))) (defsubst gnus-server-get-method (group method) @@ -3189,6 +3583,44 @@ that that variable is buffer-local to the summary buffers." gnus-valid-select-methods))) (equal (nth 1 m1) (nth 1 m2))))))) +(defun gnus-methods-sloppily-equal (m1 m2) + ;; Same method. + (or + (eq m1 m2) + ;; Type and name are equal. + (and + (eq (car m1) (car m2)) + (equal (cadr m1) (cadr m2)) + (gnus-sloppily-equal-method-parameters m1 m2)))) + +(defsubst gnus-sloppily-equal-method-parameters (m1 m2) + ;; Check parameters for sloppy equalness. + (let ((p1 (copy-sequence (cddr m1))) + (p2 (copy-sequence (cddr m2))) + e1 e2) + (block nil + (while (setq e1 (pop p1)) + (unless (setq e2 (assq (car e1) p2)) + ;; The parameter doesn't exist in p2. + (return nil)) + (setq p2 (delq e2 p2)) + (unless (equal e1 e2) + (if (not (and (stringp (cadr e1)) + (stringp (cadr e2)))) + (return nil) + ;; Special-case string parameter comparison so that we + ;; can uniquify them. + (let ((s1 (cadr e1)) + (s2 (cadr e2))) + (when (string-match "/$" s1) + (setq s1 (directory-file-name s1))) + (when (string-match "/$" s2) + (setq s2 (directory-file-name s2))) + (unless (equal s1 s2) + (return nil)))))) + ;; If p2 now is empty, they were equal. + (null p2)))) + (defun gnus-server-equal (m1 m2) "Say whether two methods are equal." (let ((m1 (cond ((null m1) gnus-select-method) @@ -3291,6 +3723,8 @@ server is native)." "Return the prefix of the current group name." (< 0 (length (gnus-group-real-prefix group)))) +(declare-function gnus-group-decoded-name "gnus-group" (string)) + (defun gnus-summary-buffer-name (group) "Return the summary buffer name of GROUP." (concat "*Summary " (gnus-group-decoded-name group) "*")) @@ -3327,10 +3761,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)) @@ -3370,7 +3804,10 @@ You should probably use `gnus-find-method-for-group' instead." (defun gnus-parameters-get-parameter (group) "Return the group parameters for GROUP from `gnus-parameters'." - (let (params-list) + (let ((case-fold-search (if (eq gnus-parameters-case-fold-search 'default) + case-fold-search + gnus-parameters-case-fold-search)) + params-list) (dolist (elem gnus-parameters) (when (string-match (car elem) group) (setq params-list @@ -3381,12 +3818,13 @@ You should probably use `gnus-find-method-for-group' instead." (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))) + (let ((start (string-match match group))) + (if start + (let ((matched-string (substring group start (match-end 0)))) + ;; Build match groups + (string-match match matched-string) + (replace-match value nil nil matched-string)) + group))) (defun gnus-expand-group-parameters (match parameters group) "Go through PARAMETERS and expand them according to the match data." @@ -3413,7 +3851,7 @@ The function `gnus-group-find-parameter' will do that for you." (if simple-results ;; Found results; return them. (car simple-results) - ;; We didn't found it there, try `gnus-parameters'. + ;; We didn't find it there, try `gnus-parameters'. (let ((result nil) (head nil) (tail gnus-parameters)) @@ -3430,9 +3868,7 @@ The function `gnus-group-find-parameter' will do that for you." ;; 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)))) + result group)))))) ;; Done. result)))) @@ -3442,8 +3878,7 @@ 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) + (with-current-buffer gnus-group-buffer (if symbol (gnus-group-fast-parameter group symbol allow-list) (nconc @@ -3454,6 +3889,7 @@ If you call this function inside a loop, consider using the faster (defun gnus-group-get-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 ALLOW-LIST, also allow list as a result. Most functions should use `gnus-group-find-parameter', which also examines the topic parameters." (let ((params (gnus-info-params (gnus-get-info group)))) @@ -3463,7 +3899,8 @@ also examines the topic parameters." (defun gnus-group-parameter-value (params symbol &optional allow-list present-p) - "Return the value of SYMBOL in group PARAMS." + "Return the value of SYMBOL in group PARAMS. +If ALLOW-LIST, also allow list as a result." ;; We only wish to return group parameters (dotted lists) and ;; not local variables, which may have the same names. ;; But first we handle single elements... @@ -3489,8 +3926,11 @@ also examines the topic parameters." group 'params)))) (defun gnus-group-set-parameter (group name value) - "Set parameter NAME to VALUE in GROUP." - (let ((info (gnus-get-info group))) + "Set parameter NAME to VALUE in GROUP. +GROUP can also be an INFO structure." + (let ((info (if (listp group) + group + (gnus-get-info group)))) (when info (gnus-group-remove-parameter group name) (let ((old-params (gnus-info-params info)) @@ -3500,17 +3940,22 @@ also examines the topic parameters." (not (eq (caar old-params) name))) (setq new-params (append new-params (list (car old-params))))) (setq old-params (cdr old-params))) - (gnus-group-set-info new-params group 'params))))) + (if (listp group) + (gnus-info-set-params info new-params t) + (gnus-group-set-info new-params (gnus-info-group info) 'params)))))) (defun gnus-group-remove-parameter (group name) - "Remove parameter NAME from GROUP." - (let ((info (gnus-get-info group))) + "Remove parameter NAME from GROUP. +GROUP can also be an INFO structure." + (let ((info (if (listp group) + group + (gnus-get-info group)))) (when info (let ((params (gnus-info-params info))) (when params (setq params (delq name params)) (while (assq name params) - (gnus-pull name params)) + (gnus-alist-pull name params)) (gnus-info-set-params info params)))))) (defun gnus-group-add-score (group &optional score) @@ -3600,8 +4045,7 @@ Returns the number of articles marked as read." (defun gnus-kill-save-kill-buffer () (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name))) (when (get-file-buffer file) - (save-excursion - (set-buffer (get-file-buffer file)) + (with-current-buffer (get-file-buffer file) (when (buffer-modified-p) (save-buffer)) (kill-buffer (current-buffer)))))) @@ -3648,26 +4092,35 @@ If NEWSGROUP is nil, return the global kill file name instead." gnus-valid-select-methods))) (defun gnus-similar-server-opened (method) - (let ((opened gnus-opened-servers)) + "Return non-nil if we have a similar server opened. +This is defined as a server with the same name, but different +parameters." + (let ((opened gnus-opened-servers) + open) (while (and method opened) - (when (and (equal (cadr method) (cadaar opened)) - (equal (car method) (caaar opened)) - (not (equal method (caar opened)))) - (setq method nil)) - (pop opened)) + (setq open (car (pop opened))) + ;; Type and name are the same... + (when (and (equal (car method) (car open)) + (equal (cadr method) (cadr open)) + ;; ... but the rest of the parameters differ. + (not (gnus-methods-sloppily-equal method open))) + (setq method nil))) (not method))) (defun gnus-server-extend-method (group method) - ;; This function "extends" a virtual server. If the server is + ;; This function "extends" a virtual server. If the server is ;; "hello", and the select method is ("hello" (my-var "something")) ;; in the group "alt.alt", this will result in a new virtual server ;; called "hello+alt.alt". (if (or (not (inline (gnus-similar-server-opened method))) (not (cddr method))) method - `(,(car method) ,(concat (cadr method) "+" group) - (,(intern (format "%s-address" (car method))) ,(cadr method)) - ,@(cddr method)))) + (setq method + `(,(car method) ,(concat (cadr method) "+" group) + (,(intern (format "%s-address" (car method))) ,(cadr method)) + ,@(cddr method))) + (push method gnus-extended-servers) + method)) (defun gnus-server-status (method) "Return the status of METHOD." @@ -3692,13 +4145,32 @@ If NEWSGROUP is nil, return the global kill file name instead." (format "%s using %s" address (car server)) (format "%s" (car server))))) +(defun gnus-same-method-different-name (method) + (let ((slot (intern (concat (symbol-name (car method)) "-address")))) + (unless (assq slot (cddr method)) + (setq method + (append method (list (list slot (nth 1 method))))))) + (let ((methods gnus-extended-servers) + open found) + (while (and (not found) + (setq open (pop methods))) + (when (and (eq (car method) (car open)) + (gnus-sloppily-equal-method-parameters method open)) + (setq found open))) + found)) + (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 - (gnus-group-name-to-method group)) + (and (not (gnus-group-entry group)) + ;; Killed or otherwise unknown group. + (or + ;; If we know a virtual server by that name, return its method. + (gnus-server-to-method (gnus-group-server group)) + ;; Guess a new method as last resort. + (gnus-group-name-to-method group))) (let ((info (or info (gnus-get-info group))) method) (if (or (not info) @@ -3709,7 +4181,10 @@ If NEWSGROUP is nil, return the global kill file name instead." (cond ((stringp method) (inline (gnus-server-to-method method))) ((stringp (cadr method)) - (inline (gnus-server-extend-method group method))) + (or + (inline + (gnus-same-method-different-name method)) + (inline (gnus-server-extend-method group method)))) (t method))) (cond ((equal (cadr method) "") @@ -3729,6 +4204,9 @@ If NEWSGROUP is nil, return the global kill file name instead." (setq valids (cdr valids))) outs)) +(eval-and-compile + (autoload 'message-y-or-n-p "message" nil nil 'macro)) + (defun gnus-read-group (prompt &optional default) "Prompt the user for a group name. Disallow invalid group names." @@ -3741,21 +4219,19 @@ Disallow invalid group names." (cons (or default "") 0) 'gnus-group-history))) (let ((match (match-string 0 group))) - ;; `/' may be okay (e.g. for nnimap), so ask the user: - (unless (and (string-match "/" match) + ;; 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 some IMAP servers, it's valid to -use the character \"/\". - -If you are really sure, you can proceed anyway and create the group. +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.")) +"\", if you want to get rid of this query permanently.")) (setq prefix (format "Invalid group name: \"%s\". " group) group nil))))) group)) @@ -3779,9 +4255,9 @@ Allow completion over sensible values." gnus-predefined-server-alist gnus-server-alist)) (method - (completing-read - prompt servers - nil t nil 'gnus-method-history))) + (gnus-completing-read + prompt (mapcar 'car servers) + t nil 'gnus-method-history))) (cond ((equal method "") (setq method gnus-select-method)) @@ -3799,9 +4275,17 @@ Allow completion over sensible values." ;;; Agent functions -(defun gnus-agent-method-p (method) +(defun gnus-agent-method-p (method-or-server) "Say whether METHOD is covered by the agent." - (member method gnus-agent-covered-methods)) + (or (eq (car gnus-agent-method-p-cache) method-or-server) + (let* ((method (if (stringp method-or-server) + (gnus-server-to-method method-or-server) + method-or-server)) + (server (gnus-method-to-server method t))) + (setq gnus-agent-method-p-cache + (cons method-or-server + (member server gnus-agent-covered-methods))))) + (cdr gnus-agent-method-p-cache)) (defun gnus-online (method) (not @@ -3882,20 +4366,23 @@ current display is used." (delete-frame gnus-other-frame-object)) (setq gnus-other-frame-object nil))))))) -;;(setq thing ? ; this is a comment -;; more 'yes) - ;;;###autoload (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") + ;; When using the development version of Gnus, load the gnus-load + ;; file. + (unless (string-match "^Gnus" gnus-version) + (load "gnus-load" nil t)) (unless (byte-code-function-p (symbol-function 'gnus)) (message "You should byte-compile Gnus") (sit-for 2)) - (gnus-1 arg dont-connect slave)) + (let ((gnus-action-message-log (list nil))) + (gnus-1 arg dont-connect slave) + (gnus-final-warning))) ;; Allow redefinition of Gnus functions.