X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus.el;h=ba790fb63871b872383e7fc9ec2205d550190efc;hb=9d5afe7cc44eae8d11ee8c468f496b52a6389e4c;hp=2681e538b967ef0226e87ce38691c569ebe58752;hpb=b58d62328adf02b341b460a98819a54a0d629b60;p=gnus diff --git a/lisp/gnus.el b/lisp/gnus.el index 2681e538b..ba790fb63 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, 2007 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,10 +10,10 @@ ;; 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 3, 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 @@ -20,9 +21,7 @@ ;; 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) @@ -291,7 +294,7 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "0.7" +(defconst gnus-version-number "0.11" "Version number for this version of Gnus.") (defconst gnus-version (format "No Gnus v%s" gnus-version-number) @@ -315,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) @@ -375,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) @@ -389,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) @@ -403,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) @@ -417,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) @@ -431,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) @@ -445,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) @@ -459,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) @@ -473,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) @@ -487,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) @@ -501,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) @@ -515,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) @@ -529,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) @@ -543,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) @@ -557,6 +575,7 @@ 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) @@ -571,6 +590,7 @@ 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) @@ -585,6 +605,7 @@ 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) @@ -599,6 +620,7 @@ 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) @@ -613,6 +635,7 @@ 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) @@ -627,6 +650,7 @@ 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) @@ -641,6 +665,7 @@ 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) @@ -655,6 +680,7 @@ 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) @@ -669,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. @@ -677,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)) @@ -685,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) @@ -699,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) @@ -713,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) @@ -727,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) @@ -741,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) @@ -755,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) @@ -769,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) @@ -781,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) @@ -793,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) @@ -805,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 @@ -813,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 @@ -821,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 @@ -829,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) @@ -845,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) @@ -861,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) @@ -875,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") ;;; @@ -915,8 +959,7 @@ 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) @@ -931,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 @@ -991,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. @@ -999,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)) @@ -1012,6 +1063,8 @@ 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) @@ -1311,7 +1364,7 @@ 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.0" ;; No Gnus + :version "23.1" ;; No Gnus :group 'gnus-server :group 'gnus-message :type 'boolean) @@ -1389,7 +1442,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 @@ -1401,6 +1454,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) @@ -1518,7 +1572,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. @@ -1686,19 +1740,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) @@ -1721,7 +1767,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 @@ -1757,12 +1804,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)) @@ -2635,6 +2681,7 @@ a string, be sure to use a valid format, see RFC 2616." (defvar gnus-newsgroup-name nil) (defvar gnus-ephemeral-servers nil) (defvar gnus-server-method-cache nil) +(defvar gnus-extended-servers nil) (defvar gnus-agent-fetching nil "Whether Gnus agent is in fetching mode.") @@ -2696,6 +2743,8 @@ a string, be sure to use a valid format, see RFC 2616." '((seen range) (killed range) (bookmark tuple) + (uid tuple) + (active tuple) (score tuple))) ;; Propagate flags to server, with the following exceptions: @@ -2791,9 +2840,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 "[: `'\"/]\\|^$" @@ -2832,16 +2878,16 @@ 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 - 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) @@ -2973,8 +3019,6 @@ gnus-registry.el will populate this if it's loaded.") 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 @@ -3244,12 +3288,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))) @@ -3521,7 +3565,7 @@ that that variable is buffer-local to the summary buffers." (nth 1 method)))) method))) -(defsubst gnus-method-to-server (method &optional nocache) +(defsubst gnus-method-to-server (method &optional nocache no-enter-cache) (catch 'server-name (setq method (or method gnus-select-method)) @@ -3547,7 +3591,9 @@ that that variable is buffer-local to the summary buffers." (format "%s" (car method)) (format "%s:%s" (car method) (cadr method)))) (name-method (cons name method))) - (unless (member name-method gnus-server-method-cache) + (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))) @@ -3589,11 +3635,13 @@ that that variable is buffer-local to the summary buffers." (while alist (setq method (gnus-info-method (pop alist))) (when (and (not (stringp method)) - (equal server (gnus-method-to-server method))) + (equal server + (gnus-method-to-server method nil t))) (setq match method alist nil))) match)))) - (when result + (when (and result + (not (assoc server gnus-server-method-cache))) (push (cons server result) gnus-server-method-cache)) result))) @@ -3634,6 +3682,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-list (cddr m1))) + (p2 (copy-list (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 (equalp 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) @@ -3736,6 +3822,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) "*")) @@ -3890,8 +3978,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 @@ -4050,8 +4137,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)))))) @@ -4098,13 +4184,19 @@ 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) @@ -4115,9 +4207,12 @@ If NEWSGROUP is nil, return the global kill file name instead." (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." @@ -4142,6 +4237,20 @@ 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 @@ -4164,7 +4273,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) "") @@ -4353,6 +4465,10 @@ 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 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")) (unless (byte-code-function-p (symbol-function 'gnus)) (message "You should byte-compile Gnus") (sit-for 2)) @@ -4364,5 +4480,4 @@ prompt the user for the name of an NNTP server to use." (provide 'gnus) -;;; arch-tag: acebeeab-f331-4f8f-a7ea-89c58c84f636 ;;; gnus.el ends here