Synch to Gnus 200311211553.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index ade3500..25d9780 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,56 @@
+2003-11-20  Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+       * gnus.el (gnus-agent-covered-methods): Documented use of
+       named servers, not methods, to identity agentized groups.
+       Users may now change their server configurations without having
+       the server become "unagentized".
+       (gnus-agent-covered-methods): Removed from gnus-variable-list to
+       avoid storing two copies of gnus-agent-covered-methods, one in
+       .newsrc.eld and the other in agent/lib/servers.
+       (gnus-server-to-method): Do not cache server for the nil method.
+       (gnus-method-to-server): New function.  Associate named server
+       with all, even foreign, methods.
+       (gnus-agent-method-p, gnus-agent-method-p-cache): Incorporated
+       simple last-response cache to offset performance lose of having to
+       always convert methods to named servers.
+       * gnus-agent.el (gnus-agent-expire-days): Removed obsolete
+       documentation.
+       (gnus-agentize, gnus-agent-add-server, gnus-agent-remove-server):
+       Modified to support new definition of gnus-agent-covered-method.
+       (gnus-agent-read-servers): Rewritten to convert old method data
+       into server names.
+       (gnus-agent-read-servers-validate)
+       (gnus-agent-read-servers-validate-native): New functions.
+       (gnus-agent-write-servers): No longer use gnus-method-simplify as
+       it failed to simplify foreign methods.
+       (gnus-agent-close-connections, gnus-agent-synchronize-flags)
+       (gnus-agent-possibly-synchronize-flags, gnus-agent-fetch-session)
+       (gnus-agent-regenerate): Uses new gnus-agent-covered-methods
+       function as gnus-agent-covered-methods variable no longer provides
+       methods.
+       (gnus-agent-covered-methods): New function
+       (gnus-agent-expire-group, gnus-agent-expire): Final message will,
+       if gnus-verbose is greater than 4, report statistics of NOV
+       entries and files deleted as well as total bytes recovered.
+       (gnus-agent-expire-done-message): New function
+       (gnus-agent-unread-articles): Bug fix.  No longer drops last
+       unread article onto read list.
+       (gnus-agent-regenerate-group): Changed prompt to use typical
+       style.
+       (gnus-agent-group-covered-p): Rewrote to internally use
+       gnus-agent-method-p.
+       * gnus-int.el (gnus-start-news-server): Partially convert old
+       gnus-agent-covered-methods to new format so that gnus-open-server
+       functions correctly.
+       * gnus-srvr.el (gnus-server-insert-server-line): Replaced
+       gnus-agent-covered-methods with gnus-agent-method-p.
+       * gnus-start.el (gnus-clear-system): Added
+       gnus-agent-covered-methods to compensate for removing it from
+       gnus-variable-list.
+       (gnus-setup-news): Complete conversion of old
+       gnus-agent-covered-methods to new format so that secondary and
+       foreign servers can be correctly opened.
+
 2003-11-20  Teodor Zlatanov  <tzz@lifelogs.com>
 
        * spam.el (spam-ham-copy-or-move-routine): add respooling

diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el
index 0d12140..c477f04 100644 (file)
--- a/lisp/gnus-agent.el
+++ b/lisp/gnus-agent.el
@@ -73,12 +73,9 @@
   :type 'integer)
 
 (defcustom gnus-agent-expire-days 7
-  "Read articles older than this will be expired.
-This can also be a list of regexp/day pairs.  The regexps will be
-matched against group names."
+  "Read articles older than this will be expired."
   :group 'gnus-agent
-  :type '(choice (number :tag "days")
-                (sexp :tag "List" nil)))
+  :type '(number :tag "days"))
 
 (defcustom gnus-agent-expire-all nil
   "If non-nil, also expire unread, ticked and dormant articles.
@@ -569,7 +566,7 @@ manipulated as follows:
 
 (defun gnus-agent-close-connections ()
   "Close all methods covered by the Gnus agent."
-  (let ((methods gnus-agent-covered-methods))
+  (let ((methods (gnus-agent-covered-methods)))
     (while methods
       (gnus-close-server (pop methods)))))
 
@@ -611,18 +608,19 @@ minor mode in all Gnus buffers."
   (unless gnus-agent-send-mail-function
     (setq gnus-agent-send-mail-function
          (or message-send-mail-real-function
-                                        message-send-mail-function)
+              message-send-mail-function)
          message-send-mail-real-function 'gnus-agent-send-mail))
 
   (unless gnus-agent-covered-methods
-    (mapcar
-     (lambda (server)
-       (if (memq (car (gnus-server-to-method server)) 
-                gnus-agent-auto-agentize-methods)
-          (setq gnus-agent-covered-methods 
-                (cons (gnus-server-to-method server)
-                      gnus-agent-covered-methods ))))
-     (append (list gnus-select-method) gnus-secondary-select-methods))))
+    (mapc
+     (lambda (server-or-method)
+       (let ((method (gnus-server-to-method server-or-method)))
+         (when (memq (car method)
+                     gnus-agent-auto-agentize-methods)
+           (push (gnus-method-to-server method)
+                 gnus-agent-covered-methods)
+           (setq gnus-agent-method-p-cache nil))))
+     (cons gnus-select-method gnus-secondary-select-methods))))
 
 (defun gnus-agent-queue-setup (&optional group-name)
   "Make sure the queue group exists.
@@ -760,7 +758,7 @@ be a select method."
   "Synchronize unplugged flags with servers."
   (interactive)
   (save-excursion
-    (dolist (gnus-command-method gnus-agent-covered-methods)
+    (dolist (gnus-command-method (gnus-agent-covered-methods))
       (when (file-exists-p (gnus-agent-lib-file "flags"))
        (gnus-agent-synchronize-flags-server gnus-command-method)))))
 
@@ -768,7 +766,7 @@ be a select method."
   "Synchronize flags according to `gnus-agent-synchronize-flags'."
   (interactive)
   (save-excursion
-    (dolist (gnus-command-method gnus-agent-covered-methods)
+    (dolist (gnus-command-method (gnus-agent-covered-methods))
       (when (file-exists-p (gnus-agent-lib-file "flags"))
        (gnus-agent-possibly-synchronize-flags-server gnus-command-method)))))
 
@@ -811,7 +809,8 @@ be a select method."
   (let ((method (gnus-server-get-method nil (gnus-server-server-name))))
     (when (gnus-agent-method-p method)
       (error "Server already in the agent program"))
-    (push method gnus-agent-covered-methods)
+    (push (gnus-method-to-server method) gnus-agent-covered-methods)
+    (setq gnus-agent-method-p-cache nil)
     (gnus-server-update-server server)
     (gnus-agent-write-servers)
     (gnus-message 1 "Entered %s into the Agent" server)))
@@ -821,27 +820,52 @@ be a select method."
   (interactive (list (gnus-server-server-name)))
   (unless server
     (error "No server on the current line"))
-  (let ((method (gnus-server-get-method nil (gnus-server-server-name))))
-    (unless (gnus-agent-method-p method)
+  (let* ((server (gnus-server-server-name)))
+    (unless (member server gnus-agent-covered-methods)
       (error "Server not in the agent program"))
-    (setq gnus-agent-covered-methods
-         (delete method gnus-agent-covered-methods))
+    (setq gnus-agent-covered-methods 
+          (delete server gnus-agent-covered-methods)
+          gnus-agent-method-p-cache nil)
+
     (gnus-server-update-server server)
     (gnus-agent-write-servers)
     (gnus-message 1 "Removed %s from the agent" server)))
 
 (defun gnus-agent-read-servers ()
   "Read the alist of covered servers."
-  (mapcar (lambda (m)
-           (let ((method (gnus-server-get-method
-                          nil
-                          (or m "native"))))
-             (if method
-                  (unless (member method gnus-agent-covered-methods)
-                    (push method gnus-agent-covered-methods))
-               (gnus-message 1 "Ignoring disappeared server `%s'" m))))
-         (gnus-agent-read-file
-          (nnheader-concat gnus-agent-directory "lib/servers"))))
+  (setq gnus-agent-covered-methods 
+        (gnus-agent-read-file
+         (nnheader-concat gnus-agent-directory "lib/servers"))
+        gnus-agent-method-p-cache nil)
+
+  ;; I am called so early in start-up that I can not validate server
+  ;; names.  When that is the case, I skip the validation.  That is
+  ;; alright as the gnus startup code calls the validate methods
+  ;; directly.
+  (if gnus-server-alist
+      (gnus-agent-read-servers-validate)))
+
+(defun gnus-agent-read-servers-validate ()
+  (mapcar (lambda (server-or-method)
+            (let* ((server (if (stringp server-or-method)
+                               server-or-method
+                             (gnus-method-to-server server-or-method)))
+                   (method (gnus-server-to-method server)))
+              (if method
+                  (unless (member server gnus-agent-covered-methods)
+                    (push server gnus-agent-covered-methods)
+                    (setq gnus-agent-method-p-cache nil))
+                (gnus-message 1 "Ignoring disappeared server `%s'" server))))
+          (prog1 gnus-agent-covered-methods
+            (setq gnus-agent-covered-methods nil))))
+
+(defun gnus-agent-read-servers-validate-native (native-method)
+  (setq gnus-agent-covered-methods
+        (mapcar (lambda (method)
+                  (if (or (not method)
+                          (equal method native-method))
+                      "native"
+                    method)) gnus-agent-covered-methods)))
 
 (defun gnus-agent-write-servers ()
   "Write the alist of covered servers."
@@ -851,7 +875,7 @@ be a select method."
        (file-name-coding-system nnmail-pathname-coding-system)
        (pathname-coding-system nnmail-pathname-coding-system))
     (with-temp-file (nnheader-concat gnus-agent-directory "lib/servers")
-      (prin1 (mapcar 'gnus-method-simplify gnus-agent-covered-methods)
+      (prin1 gnus-agent-covered-methods
             (current-buffer)))))
 
 ;;;
@@ -1192,6 +1216,10 @@ This can be added to `gnus-select-article-hook' or
     (require 'nnagent)
     'nnagent))
 
+(defun gnus-agent-covered-methods ()
+  "Return the subset of methods that are covered by the agent."
+  (mapcar #'gnus-server-to-method gnus-agent-covered-methods))
+
 ;;; History functions
 
 (defun gnus-agent-history-buffer ()
@@ -1805,7 +1833,7 @@ FILE and places the combined headers into `nntp-server-buffer'."
     (error "No servers are covered by the Gnus agent"))
   (unless gnus-plugged
     (error "Can't fetch articles while Gnus is unplugged"))
-  (let ((methods gnus-agent-covered-methods)
+  (let ((methods (gnus-agent-covered-methods))
        groups group gnus-command-method)
     (save-excursion
       (while methods
@@ -2480,29 +2508,32 @@ FORCE is equivalent to setting the expiration predicates to true."
 
   (if (not group)
       (gnus-agent-expire articles group force)
-    (if (or (not (eq articles t))
-            (yes-or-no-p
-             (concat "Are you sure that you want to "
-                     "expire all articles in " group ".")))
-        (let ((gnus-command-method (gnus-find-method-for-group group))
-              (overview (gnus-get-buffer-create " *expire overview*"))
-              orig)
-          (unwind-protect
-              (let ((active-file (gnus-agent-lib-file "active")))
-                (when (file-exists-p active-file)
-                  (with-temp-buffer
-                    (nnheader-insert-file-contents active-file)
-                    (gnus-active-to-gnus-format
-                     gnus-command-method
-                     (setq orig (gnus-make-hashtable
-                                 (count-lines (point-min) (point-max))))))
-                  (save-excursion
-                    (gnus-agent-expire-group-1
-                     group overview (gnus-gethash-safe group orig)
-                     articles force))
-                  (gnus-agent-write-active active-file orig t)))
-            (kill-buffer overview))))
-    (gnus-message 4 "Expiry...done")))
+    (let ( ;; Bind gnus-agent-expire-stats to enable tracking of
+          ;; expiration statistics of this single group
+          (gnus-agent-expire-stats (list 0 0 0.0)))
+      (if (or (not (eq articles t))
+              (yes-or-no-p
+               (concat "Are you sure that you want to "
+                       "expire all articles in " group ".")))
+          (let ((gnus-command-method (gnus-find-method-for-group group))
+                (overview (gnus-get-buffer-create " *expire overview*"))
+                orig)
+            (unwind-protect
+                (let ((active-file (gnus-agent-lib-file "active")))
+                  (when (file-exists-p active-file)
+                    (with-temp-buffer
+                      (nnheader-insert-file-contents active-file)
+                      (gnus-active-to-gnus-format
+                       gnus-command-method
+                       (setq orig (gnus-make-hashtable
+                                   (count-lines (point-min) (point-max))))))
+                    (save-excursion
+                      (gnus-agent-expire-group-1
+                       group overview (gnus-gethash-safe group orig)
+                       articles force))
+                    (gnus-agent-write-active active-file orig t)))
+              (kill-buffer overview))))
+      (gnus-message 4 (gnus-agent-expire-done-message)))))
 
 (defun gnus-agent-expire-group-1 (group overview active articles force)
   ;; Internal function - requires caller to have set
@@ -2521,7 +2552,12 @@ FORCE is equivalent to setting the expiration predicates to true."
         (gnus-message 5 "Expiry skipping over %s" group)
       (gnus-message 5 "Expiring articles in %s" group)
       (gnus-agent-load-alist group)
-      (let* ((info (gnus-get-info group))
+      (let* ((stats (if (boundp 'gnus-agent-expire-stats)
+                        ;; Use the list provided by my caller
+                        (symbol-value 'gnus-agent-expire-stats)
+                      ;; otherwise use my own temporary list
+                      (list 0 0 0.0)))
+             (info (gnus-get-info group))
              (alist gnus-agent-article-alist)
              (day (- (time-to-days (current-time))
                      (gnus-agent-find-parameter group 'agent-days-until-old)))
@@ -2561,7 +2597,7 @@ FORCE is equivalent to setting the expiration predicates to true."
                        (cons (caar alist)
                              (caar (last alist))))
                       (sort articles '<)))))
-             (marked ;; More articles that are exluded from the
+             (marked ;; More articles that are excluded from the
               ;; expiration process
               (cond (gnus-agent-expire-all
                      ;; All articles are unmarked by global decree
@@ -2713,8 +2749,8 @@ line." (point) nov-file)))
                ;; Kept articles are unread, marked, or special.
                (keep
                 (gnus-agent-message 10
-                                    "gnus-agent-expire: Article %d: Kept %s article."
-                                    article-number keep)
+                                    "gnus-agent-expire: Article %d: Kept %s article%s."
+                                    article-number keep (if fetch-date " and file" ""))
                 (when fetch-date
                   (unless (file-exists-p
                            (concat dir (number-to-string
@@ -2758,8 +2794,11 @@ missing NOV entry.  Run gnus-agent-regenerate-group to restore it.")))
                 (let ((actions nil))
                   (when (memq type '(forced expired))
                     (ignore-errors      ; Just being paranoid.
-                      (delete-file (concat dir (number-to-string
-                                                article-number)))
+                      (let ((file-name (concat dir (number-to-string
+                                                article-number))))
+                        (incf (nth 2 stats) (nth 7 (file-attributes file-name)))
+                        (incf (nth 1 stats))
+                        (delete-file file-name))
                       (push "expired cached article" actions))
                     (setf (nth 1 entry) nil)
                     )
@@ -2767,7 +2806,13 @@ missing NOV entry.  Run gnus-agent-regenerate-group to restore it.")))
                   (when marker
                     (push "NOV entry removed" actions)
                     (goto-char marker)
-                    (gnus-delete-line))
+
+                    (incf (nth 0 stats))
+
+                    (let ((from (gnus-point-at-bol))
+                          (to (progn (forward-line 1) (point))))
+                      (incf (nth 2 stats) (- to from))
+                      (delete-region from to)))
 
                   ;; If considering all articles is set, I can only
                   ;; expire article IDs that are no longer in the
@@ -2841,10 +2886,13 @@ FORCE is equivalent to setting the expiration predicates to true."
     (if (or (not (eq articles t))
             (yes-or-no-p "Are you sure that you want to expire all \
 articles in every agentized group."))
-        (let ((methods gnus-agent-covered-methods)
+        (let ((methods (gnus-agent-covered-methods))
               ;; Bind gnus-agent-expire-current-dirs to enable tracking
               ;; of agent directories.
               (gnus-agent-expire-current-dirs nil)
+              ;; Bind gnus-agent-expire-stats to enable tracking of
+              ;; expiration statistics across all groups
+              (gnus-agent-expire-stats (list 0 0 0.0))
               gnus-command-method overview orig)
           (setq overview (gnus-get-buffer-create " *expire overview*"))
           (unwind-protect
@@ -2869,7 +2917,25 @@ articles in every agentized group."))
                     (gnus-agent-write-active active-file orig t))))
             (kill-buffer overview))
           (gnus-agent-expire-unagentized-dirs)
-          (gnus-message 4 "Expiry...done")))))
+          (gnus-message 4 (gnus-agent-expire-done-message))))))
+
+(defun gnus-agent-expire-done-message ()
+  (if (and (> gnus-verbose 4)
+           (boundp 'gnus-agent-expire-stats))
+      (let* ((stats (symbol-value 'gnus-agent-expire-stats))
+             (size (nth 2 stats))
+            (units '(B KB MB GB)))
+        (while (and (> size 1024.0)
+                    (cdr units))
+          (setq size (/ size 1024.0)
+                units (cdr units)))
+
+        (format "Expiry recovered %d NOV entries, deleted %d files,\
+ and freed %f %s." 
+                (nth 0 stats) 
+                (nth 1 stats) 
+                size (car units)))
+    "Expiry...done"))
 
 (defun gnus-agent-expire-unagentized-dirs ()
   (when (and gnus-agent-expire-unagentized-dirs
@@ -2980,7 +3046,12 @@ articles in every agentized group."))
                        (gnus-agent-append-to-list tail-unread candidate)
                        nil)
                       ((> candidate max)
-                       (setq read (cdr read))))))))
+                       (setq read (cdr read))
+                        ;; return t so that I always loop one more
+                        ;; time.  If I just iterated off the end of
+                        ;; read, min will become nil and the current
+                        ;; candidate will be added to the unread list.
+                        t))))))
     (while known
       (gnus-agent-append-to-list tail-unread (car (pop known))))
     (cdr unread)))
@@ -3184,9 +3255,19 @@ If REREAD is not nil, downloaded articles are marked as unread."
                       def)
                  def
                select)))
-         (intern-soft
-          (read-string
-           "Reread (nil)? (t=>all, nil=>none, some=>all downloaded): "))))
+         (catch 'mark
+           (while (let ((c (read-char-exclusive 
+                            "Mark as unread: (n)one / (a)ll / all (d)ownloaded articles? (n)"
+                            )))
+                    (cond ((or (eq c ?\r) (eq c ?n) (eq c ?N))
+                           (throw 'mark nil))
+                          ((or (eq c ?a) (eq c ?A))
+                           (throw 'mark t))
+                          ((or (eq c ?d) (eq c ?D))
+                           (throw 'mark 'some)))
+                    (message "Ignoring unexpected input")
+                    (sit-for 1)
+                    t)))))
   (gnus-message 5 "Regenerating in %s" group)
   (let* ((gnus-command-method (or gnus-command-method
                                   (gnus-find-method-for-group group)))
@@ -3372,7 +3453,7 @@ If CLEAN, don't read existing active files."
   (interactive "P")
   (let (regenerated)
     (gnus-message 4 "Regenerating Gnus agent files...")
-    (dolist (gnus-command-method gnus-agent-covered-methods)
+    (dolist (gnus-command-method (gnus-agent-covered-methods))
       (let ((active-file (gnus-agent-lib-file "active"))
             active-hashtb active-changed
             point)
@@ -3443,8 +3524,7 @@ If CLEAN, don't read existing active files."
             (if (eq status 'offline) 'online 'offline))))
 
 (defun gnus-agent-group-covered-p (group)
-  (member (gnus-group-method group)
-         gnus-agent-covered-methods))
+  (gnus-agent-method-p (gnus-group-method group)))
 
 (add-hook 'gnus-group-prepare-hook
           (lambda ()

diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el
index 073b461..08944e4 100644 (file)
--- a/lisp/gnus-int.el
+++ b/lisp/gnus-int.el
@@ -34,6 +34,7 @@
 (require 'gnus-range)
 
 (autoload 'gnus-agent-expire "gnus-agent")
+(autoload 'gnus-agent-read-servers-validate-native "gnus-agent")
 
 (defcustom gnus-open-server-hook nil
   "Hook called just before opening connection to the news server."
@@ -106,6 +107,18 @@ If CONFIRM is non-nil, the user will be asked for an NNTP server."
        (require 'nntp)))
       (setq gnus-current-select-method gnus-select-method)
       (gnus-run-hooks 'gnus-open-server-hook)
+
+      ;; Partially validate agent covered methods now that the
+      ;; gnus-select-method is known.
+
+      (if gnus-agent
+          ;; NOTE: This is here for one purpose only.  By validating
+          ;; the current select method, it converts the old 5.10.3,
+          ;; and earlier, format to the current format.  That enables
+          ;; the agent code within gnus-open-server to function
+          ;; correctly.
+          (gnus-agent-read-servers-validate-native gnus-select-method))
+
       (or
        ;; gnus-open-server-hook might have opened it
        (gnus-server-opened gnus-select-method)

diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el
index 3bfa7ee..4fd1d48 100644 (file)
--- a/lisp/gnus-srvr.el
+++ b/lisp/gnus-srvr.el
@@ -281,8 +281,7 @@ The following commands are available:
                  "(closed)")
              ((error) "(error)")))))
         (gnus-tmp-agent (if (and gnus-agent
-                                 (member method
-                                         gnus-agent-covered-methods))
+                                 (gnus-agent-method-p method))
                             " (agent)"
                           "")))
     (beginning-of-line)

diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el
index 0c06267..f47b590 100644 (file)
--- a/lisp/gnus-start.el
+++ b/lisp/gnus-start.el
@@ -36,6 +36,7 @@
 (require 'gnus-range)
 (require 'gnus-util)
 (autoload 'message-make-date "message")
+(autoload 'gnus-agent-read-servers-validate "gnus-agent")
 
 (defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc")
   "Your `.newsrc' file.
@@ -681,6 +682,7 @@ the first newsgroup."
   ;; Clear other internal variables.
   (setq gnus-list-of-killed-groups nil
        gnus-have-read-active-file nil
+        gnus-agent-covered-methods nil
        gnus-newsrc-alist nil
        gnus-newsrc-hashtb nil
        gnus-killed-list nil
@@ -977,6 +979,15 @@ If LEVEL is non-nil, the news will be set up at level LEVEL."
              (eq gnus-read-active-file 'some))
       (gnus-update-active-hashtb-from-killed))
 
+    ;; Validate agent covered methods now that gnus-server-alist has
+    ;; been initialized.
+    ;; NOTE: This is here for one purpose only.  By validating the
+    ;; agentized server's, it converts the old 5.10.3, and earlier,
+    ;; format to the current format.  That enables the agent code
+    ;; within gnus-read-active-file to function correctly.
+    (if gnus-agent
+        (gnus-agent-read-servers-validate))
+
     ;; Read the active file and create `gnus-active-hashtb'.
     ;; If `gnus-read-active-file' is nil, then we just create an empty
     ;; hash table.  The partial filling out of the hash table will be

diff --git a/lisp/gnus.el b/lisp/gnus.el
index e87781b..16420c4 100644 (file)
--- a/lisp/gnus.el
+++ b/lisp/gnus.el
@@ -2263,6 +2263,10 @@ This should be an alist for Emacs, or a plist for XEmacs."
 
 (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)
@@ -2274,7 +2278,8 @@ This should be an alist for Emacs, or a plist for XEmacs."
 (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.")
@@ -2395,8 +2400,7 @@ This variable can be nil, gnus or gnus-ja."
                        gnus-newsrc-last-checked-date
                        gnus-newsrc-alist gnus-server-alist
                        gnus-killed-list gnus-zombie-list
-                       gnus-topic-topology gnus-topic-alist
-                       gnus-agent-covered-methods)
+                       gnus-topic-topology gnus-topic-alist)
   "Gnus variables saved in the quick startup file.")
 
 (defvar gnus-product-variable-file-list
@@ -3238,9 +3242,42 @@ that that variable is buffer-local to the summary buffers."
                                                       (cadar servers)))))
                  (pop servers))
                (car servers)))))
-       (push (cons server result) gnus-server-method-cache)
+        (when result
+          (push (cons server result) gnus-server-method-cache))
        result)))
 
+(defsubst gnus-method-to-server (method)
+  (catch 'server-name
+    (setq method (or method gnus-select-method))
+
+    ;; Perhaps it is already in the cache.
+    (mapc (lambda (name-method)
+            (if (equal (cdr name-method) method)
+                (throw 'server-name (car name-method))))
+          gnus-server-method-cache)
+
+    (mapc
+     (lambda (server-alist)
+       (mapc (lambda (name-method)
+               (when (gnus-methods-equal-p (cdr name-method) method)
+                 (unless (member name-method gnus-server-method-cache)
+                   (push name-method gnus-server-method-cache))
+                 (throw 'server-name (car name-method))))
+             server-alist))
+     (let ((alists (list gnus-server-alist
+                         gnus-predefined-server-alist)))
+       (if gnus-select-method
+           (push (list (cons "native" gnus-select-method)) alists))
+       alists))
+
+    (let* ((name (if (member (cadr method) '(nil ""))
+                     (format "%s" (car method))
+                   (format "%s:%s" (car method) (cadr method))))
+           (name-method (cons name method)))
+      (unless (member name-method gnus-server-method-cache)
+        (push name-method gnus-server-method-cache))
+      name)))
+
 (defsubst gnus-server-get-method (group method)
   ;; Input either a server name, and extended server name, or a
   ;; select method, and return a select method.
@@ -3890,7 +3927,11 @@ Allow completion over sensible values."
 
 (defun gnus-agent-method-p (method)
   "Say whether METHOD is covered by the agent."
-  (member method gnus-agent-covered-methods))
+  (or (eq (car gnus-agent-method-p-cache) method)
+      (setq gnus-agent-method-p-cache 
+            (cons method
+                  (member (gnus-method-to-server method) gnus-agent-covered-methods))))
+  (cdr gnus-agent-method-p-cache))
 
 (defun gnus-online (method)
   (not