X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus.el;h=281b9ab20fd5201b7d6daba232345ecb0d0ba151;hb=524e94faf9db4206a60cf28a34ebb564a3f410d4;hp=6697ddd6ad294bfa1290415ac0d60581d9ead072;hpb=d63b87de61bd6bb924165577f1ec56d82e5b30d8;p=gnus diff --git a/lisp/gnus.el b/lisp/gnus.el index 6697ddd6a..281b9ab20 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, 2004, 2005, 2006 Free Software Foundation, Inc. +;; 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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -30,6 +29,10 @@ (eval '(run-hooks 'gnus-load-hook)) +;; For Emacs < 22.2. +(eval-and-compile + (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) + (eval-when-compile (require 'cl)) (require 'wid-edit) (require 'mm-util) @@ -43,6 +46,8 @@ (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) @@ -51,6 +56,10 @@ :group 'news :group 'mail) +(defgroup gnus-start nil + "Starting your favorite newsreader." + :group 'gnus) + (defgroup gnus-format nil "Dealing with formatting issues." :group 'gnus) @@ -70,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) @@ -279,10 +284,6 @@ 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." :link '(custom-manual "(gnus)Exiting Gnus") @@ -293,7 +294,7 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "0.6" +(defconst gnus-version-number "0.11" "Version number for this version of Gnus.") (defconst gnus-version (format "No Gnus v%s" gnus-version-number) @@ -317,11 +318,13 @@ be set in `.emacs' instead." (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-mail-strip-quoted-names 'mail-strip-quoted-names) @@ -377,6 +380,7 @@ be set in `.emacs' instead." :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 '((((class color) @@ -391,6 +395,7 @@ be set in `.emacs' instead." :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 '((((class color) @@ -405,6 +410,7 @@ be set in `.emacs' instead." :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 '((((class color) @@ -419,6 +425,7 @@ be set in `.emacs' instead." :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 '((((class color) @@ -433,6 +440,7 @@ be set in `.emacs' instead." :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 '((((class color) @@ -447,6 +455,7 @@ be set in `.emacs' instead." :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 '((((class color) @@ -461,6 +470,7 @@ be set in `.emacs' instead." :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 '((((class color) @@ -475,6 +485,7 @@ be set in `.emacs' instead." :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 '((((class color) @@ -489,6 +500,7 @@ be set in `.emacs' instead." :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 '((((class color) @@ -503,6 +515,7 @@ be set in `.emacs' instead." :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 '((((class color) @@ -517,6 +530,7 @@ be set in `.emacs' instead." :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 '((((class color) @@ -531,6 +545,7 @@ be set in `.emacs' instead." :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 '((((class color) @@ -545,6 +560,7 @@ be set in `.emacs' instead." :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 '((((class color) @@ -559,11 +575,12 @@ be set in `.emacs' instead." :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 '((((class color) (background dark)) - (:foreground "aquamarine1" :bold t)) + (:foreground "#e1ffe1" :bold t)) (((class color) (background light)) (:foreground "DeepPink3" :bold t)) @@ -573,11 +590,12 @@ be set in `.emacs' instead." :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 '((((class color) (background dark)) - (:foreground "aquamarine1")) + (:foreground "#e1ffe1")) (((class color) (background light)) (:foreground "DeepPink3")) @@ -587,11 +605,12 @@ be set in `.emacs' instead." :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 '((((class color) (background dark)) - (:foreground "aquamarine2" :bold t)) + (:foreground "DarkSeaGreen1" :bold t)) (((class color) (background light)) (:foreground "HotPink3" :bold t)) @@ -601,11 +620,12 @@ be set in `.emacs' instead." :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 '((((class color) (background dark)) - (:foreground "aquamarine2")) + (:foreground "DarkSeaGreen1")) (((class color) (background light)) (:foreground "HotPink3")) @@ -615,11 +635,12 @@ be set in `.emacs' instead." :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 '((((class color) (background dark)) - (:foreground "aquamarine3" :bold t)) + (:foreground "aquamarine1" :bold t)) (((class color) (background light)) (:foreground "magenta4" :bold t)) @@ -629,11 +650,12 @@ be set in `.emacs' instead." :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 '((((class color) (background dark)) - (:foreground "aquamarine3")) + (:foreground "aquamarine1")) (((class color) (background light)) (:foreground "magenta4")) @@ -643,11 +665,12 @@ be set in `.emacs' instead." :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 '((((class color) (background dark)) - (:foreground "aquamarine4" :bold t)) + (:foreground "aquamarine2" :bold t)) (((class color) (background light)) (:foreground "DeepPink4" :bold t)) @@ -657,11 +680,12 @@ be set in `.emacs' instead." :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 '((((class color) (background dark)) - (:foreground "aquamarine4")) + (:foreground "aquamarine2")) (((class color) (background light)) (:foreground "DeepPink4")) @@ -671,6 +695,7 @@ be set in `.emacs' instead." :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. @@ -679,6 +704,7 @@ be set in `.emacs' instead." :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 '((((class color)) @@ -687,6 +713,7 @@ be set in `.emacs' instead." :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 '((((class color) @@ -701,6 +728,7 @@ be set in `.emacs' instead." :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 '((((class color) @@ -715,6 +743,7 @@ be set in `.emacs' instead." :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 '((((class color) @@ -729,6 +758,7 @@ be set in `.emacs' instead." :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 '((((class color) @@ -743,6 +773,7 @@ be set in `.emacs' instead." :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 '((((class color) @@ -757,6 +788,7 @@ be set in `.emacs' instead." :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 '((((class color) @@ -771,6 +803,7 @@ be set in `.emacs' instead." :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 '((((class color) @@ -783,6 +816,7 @@ be set in `.emacs' instead." :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 '((((class color) @@ -795,6 +829,7 @@ be set in `.emacs' instead." :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 '((((class color) @@ -807,6 +842,7 @@ be set in `.emacs' instead." :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 '((t @@ -815,6 +851,7 @@ be set in `.emacs' instead." :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 '((t @@ -823,6 +860,7 @@ be set in `.emacs' instead." :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 '((t @@ -831,6 +869,7 @@ be set in `.emacs' instead." :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 '((((class color) @@ -847,6 +886,7 @@ be set in `.emacs' instead." :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 '((((class color) @@ -863,6 +903,7 @@ be set in `.emacs' instead." :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 '((((class color) @@ -877,6 +918,7 @@ be set in `.emacs' instead." :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") ;;; @@ -917,13 +959,12 @@ be set in `.emacs' instead." (defvar gnus-group-buffer "*Group*") -(eval-and-compile - (autoload 'gnus-play-jingle "gnus-audio")) +(autoload 'gnus-play-jingle "gnus-audio") (defface gnus-splash '((((class color) (background dark)) - (:foreground "#888888")) + (:foreground "#cccccc")) (((class color) (background light)) (:foreground "#888888")) @@ -933,6 +974,7 @@ be set in `.emacs' instead." :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 @@ -993,6 +1035,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. @@ -1001,6 +1045,11 @@ be set in `.emacs' instead." ((and (fboundp 'find-image) (display-graphic-p) + ;; 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)) @@ -1008,7 +1057,9 @@ be set in `.emacs' instead." (symbol-value 'image-load-path)) (t load-path))) (image (find-image - `((:type xpm :file "gnus.xpm" + `((:type svg :file "gnus.svg") + (:type png :file "gnus.png") + (:type xpm :file "gnus.xpm" :color-symbols (("thing" . ,(car gnus-logo-colors)) ("shadow" . ,(cadr gnus-logo-colors)) @@ -1034,23 +1085,23 @@ be set in `.emacs' instead." (t (insert (format " %s - _ ___ _ _ - _ ___ __ ___ __ _ ___ - __ _ ___ __ ___ - _ ___ _ - _ _ __ _ - ___ __ _ - __ _ - _ _ _ - _ _ _ - _ _ _ - __ ___ - _ _ _ _ - _ _ - _ _ - _ _ - _ - __ + _ ___ _ _ + _ ___ __ ___ __ _ ___ + __ _ ___ __ ___ + _ ___ _ + _ _ __ _ + ___ __ _ + __ _ + _ _ _ + _ _ _ + _ _ _ + __ ___ + _ _ _ _ + _ _ + _ _ + _ _ + _ + __ " "")) @@ -1250,6 +1301,11 @@ Check the NNTPSERVER environment variable and the (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 (nconc @@ -1283,16 +1339,36 @@ 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-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 "23.1" ;; No Gnus + :group 'gnus-server + :group 'gnus-message + :type 'boolean) + (defcustom gnus-message-archive-group nil "*Name of the group in which to save the messages you've written. This can either be a string; a list of strings; or an alist @@ -1328,7 +1404,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) @@ -1459,6 +1535,7 @@ When FORM is evaluated `name' is bound to the name of the group." :version "22.1" :group 'gnus-group-various :type '(repeat (cons (string :tag "Hierarchy") (sexp :tag "Form")))) +(put 'gnus-group-charter-alist 'risky-local-variable t) (defcustom gnus-group-fetch-control-use-browse-url nil "*Non-nil means that control messages are displayed using `browse-url'. @@ -1471,7 +1548,7 @@ group." (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) @@ -1494,7 +1571,7 @@ If it is nil, no confirmation is required." :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. @@ -1685,7 +1762,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) @@ -1839,7 +1916,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) @@ -2767,9 +2844,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 "[: `'\"/]\\|^$" @@ -2785,7 +2859,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 @@ -2808,10 +2882,14 @@ 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) + ;; 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-audio" :interactive t gnus-audio-play) ("gnus-xmas" gnus-xmas-splash) ("gnus-soup" :interactive t @@ -2936,7 +3014,7 @@ 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 @@ -3029,7 +3107,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. @@ -3412,7 +3490,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)))) @@ -3497,33 +3575,34 @@ that that variable is buffer-local to the summary buffers." (nth 1 method)))) method))) -(defsubst gnus-method-to-server (method) +(defsubst gnus-method-to-server (method &optional nocache) (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) + (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)) + (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))) + (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)) + (push name-method gnus-server-method-cache)) name))) (defsubst gnus-server-to-method (server) @@ -3553,24 +3632,23 @@ that that variable is buffer-local to the summary buffers." (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)) + ;; 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))) + (setq match method + alist nil))) + match)))) + (when result + (push (cons server result) gnus-server-method-cache)) result))) (defsubst gnus-server-get-method (group method) @@ -3712,6 +3790,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) "*")) @@ -3837,7 +3917,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)) @@ -4084,7 +4164,7 @@ If NEWSGROUP is nil, return the global kill file name instead." (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". @@ -4123,8 +4203,13 @@ If NEWSGROUP is nil, return the global kill file name instead." (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) @@ -4226,14 +4311,16 @@ 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." - (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)))) + (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) @@ -4333,5 +4420,5 @@ prompt the user for the name of an NNTP server to use." (provide 'gnus) -;;; arch-tag: acebeeab-f331-4f8f-a7ea-89c58c84f636 +;; arch-tag: acebeeab-f331-4f8f-a7ea-89c58c84f636 ;;; gnus.el ends here