(gnus-agent-expire-unagentized-dirs): Custom fix.
[gnus] / lisp / gnus-agent.el
index e374471..28544b8 100644 (file)
   :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.
@@ -170,9 +167,12 @@ enable expiration per categories, topics, and groups."
                 (const :format "Disable " DISABLE)))
 
 (defcustom gnus-agent-expire-unagentized-dirs t
-"Have gnus-agent-expire scan the directories under
-\(gnus-agent-directory) for groups that are no longer agentized.  When
-found, offer to remove them.")
+  "*Whether expiration should expire in unagentized directories.
+Have gnus-agent-expire scan the directories under
+\(gnus-agent-directory) for groups that are no longer agentized.
+When found, offer to remove them."
+  :type 'boolean
+  :group 'gnus-agent)
 
 ;;; Internal variables
 
@@ -284,56 +284,61 @@ node `(gnus)Server Buffer'.")
                     (setq category (cdr category)))))))
   category)
 
-(defmacro gnus-agent-cat-defaccessor (name prop-name)
-  "Define accessor and setter methods for manipulating a list of the form
+(eval-when-compile
+  (defmacro gnus-agent-cat-defaccessor (name prop-name)
+    "Define accessor and setter methods for manipulating a list of the form
 \(NAME (PROPERTY1 VALUE1) ... (PROPERTY_N VALUE_N)).
 Given the call (gnus-agent-cat-defaccessor func PROPERTY1), the list may be
 manipulated as follows:
   (func LIST): Returns VALUE1
   (setf (func LIST) NEW_VALUE1): Replaces VALUE1 with NEW_VALUE1."
-  `(progn (defmacro ,name (category)
-            (list (quote cdr) (list (quote assq)
-                                    (quote (quote ,prop-name)) category)))
-
-          (define-setf-method ,name (category)
-            (let* ((--category--temp-- (gensym "--category--"))
-                   (--value--temp-- (gensym "--value--")))
-              (list (list --category--temp--) ; temporary-variables
-                    (list category)     ; value-forms
-                    (list --value--temp--) ; store-variables
-                    (let* ((category --category--temp--) ; store-form
-                           (value --value--temp--))
-                      (list (quote gnus-agent-cat-set-property)
-                            category
-                            (quote (quote ,prop-name))
-                            value))
-                    (list (quote ,name) --category--temp--) ; access-form
-                    )))))
+    `(progn (defmacro ,name (category)
+              (list (quote cdr) (list (quote assq)
+                                      (quote (quote ,prop-name)) category)))
+
+            (define-setf-method ,name (category)
+              (let* ((--category--temp-- (make-symbol "--category--"))
+                     (--value--temp-- (make-symbol "--value--")))
+                (list (list --category--temp--) ; temporary-variables
+                      (list category)   ; value-forms
+                      (list --value--temp--) ; store-variables
+                      (let* ((category --category--temp--) ; store-form
+                             (value --value--temp--))
+                        (list (quote gnus-agent-cat-set-property)
+                              category
+                              (quote (quote ,prop-name))
+                              value))
+                      (list (quote ,name) --category--temp--) ; access-form
+                      )))))
+  )
 
 (defmacro gnus-agent-cat-name (category)
   `(car ,category))
 
 (gnus-agent-cat-defaccessor
- gnus-agent-cat-days-until-old    agent-days-until-old)
+ gnus-agent-cat-days-until-old             agent-days-until-old)
+(gnus-agent-cat-defaccessor
+ gnus-agent-cat-enable-expiration          agent-enable-expiration)
 (gnus-agent-cat-defaccessor
- gnus-agent-cat-enable-expiration agent-enable-expiration)
+ gnus-agent-cat-groups                     agent-groups)
 (gnus-agent-cat-defaccessor
- gnus-agent-cat-groups            agent-groups)
+ gnus-agent-cat-high-score                 agent-high-score)
 (gnus-agent-cat-defaccessor
- gnus-agent-cat-high-score        agent-high-score)
+ gnus-agent-cat-length-when-long           agent-length-when-long)
 (gnus-agent-cat-defaccessor
- gnus-agent-cat-length-when-long  agent-length-when-long)
+ gnus-agent-cat-length-when-short          agent-length-when-short)
 (gnus-agent-cat-defaccessor
- gnus-agent-cat-length-when-short agent-length-when-short)
+ gnus-agent-cat-low-score                  agent-low-score)
 (gnus-agent-cat-defaccessor
- gnus-agent-cat-low-score         agent-low-score)
+ gnus-agent-cat-predicate                  agent-predicate)
 (gnus-agent-cat-defaccessor
- gnus-agent-cat-predicate         agent-predicate)
+ gnus-agent-cat-score-file                 agent-score-file)
 (gnus-agent-cat-defaccessor
- gnus-agent-cat-score-file        agent-score-file)
+ gnus-agent-cat-disable-undownloaded-faces agent-disable-undownloaded-faces)
 
-(defsetf gnus-agent-cat-groups (category) (groups)
-  (list 'gnus-agent-set-cat-groups category groups))
+(eval-when-compile
+  (defsetf gnus-agent-cat-groups (category) (groups)
+    (list 'gnus-agent-set-cat-groups category groups)))
 
 (defun gnus-agent-set-cat-groups (category groups)
   (unless (eq groups 'ignore)
@@ -431,7 +436,8 @@ manipulated as follows:
                                                     buffer))))
            minor-mode-map-alist))
     (when (eq major-mode 'gnus-group-mode)
-      (let ((init-plugged gnus-plugged))
+      (let ((init-plugged gnus-plugged)
+            (gnus-agent-go-online nil))
         ;; g-a-t-p does nothing when gnus-plugged isn't changed.
         ;; Therefore, make certain that the current value does not
         ;; match the desired initial value.
@@ -550,7 +556,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)))))
 
@@ -578,10 +584,10 @@ manipulated as follows:
 ;;;###autoload
 (defun gnus-agentize ()
   "Allow Gnus to be an offline newsreader.
-The normal usage of this command is to put the following as the
-last form in your `.gnus.el' file:
 
-\(gnus-agentize)
+The gnus-agentize function is now called internally by gnus when
+gnus-agent is set.  If you wish to avoid calling gnus-agentize,
+customize gnus-agent to nil.
 
 This will modify the `gnus-setup-news-hook', and
 `message-send-mail-real-function' variables, and install the Gnus agent
@@ -592,27 +598,32 @@ 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))))
-
-(defun gnus-agent-queue-setup ()
-  "Make sure the queue group exists."
-  (unless (gnus-gethash "nndraft:queue" gnus-newsrc-hashtb)
-    (gnus-request-create-group "queue" '(nndraft ""))
+    (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.
+Optional arg GROUP-NAME allows to specify another group."
+  (unless (gnus-gethash (format "nndraft:%s" (or group-name "queue"))
+                       gnus-newsrc-hashtb)
+    (gnus-request-create-group (or group-name "queue") '(nndraft ""))
     (let ((gnus-level-default-subscribed 1))
-      (gnus-subscribe-group "nndraft:queue" nil '(nndraft "")))
+      (gnus-subscribe-group (format "nndraft:%s" (or group-name "queue"))
+                           nil '(nndraft "")))
     (gnus-group-set-parameter
-     "nndraft:queue" 'gnus-dummy '((gnus-draft-mode)))))
+     (format "nndraft:%s" (or group-name "queue"))
+     'gnus-dummy '((gnus-draft-mode)))))
 
 (defun gnus-agent-send-mail ()
   (if gnus-plugged
@@ -737,7 +748,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)))))
 
@@ -745,7 +756,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)))))
 
@@ -780,46 +791,80 @@ be a select method."
 ;;; Server mode commands
 ;;;
 
-(defun gnus-agent-add-server (server)
+(defun gnus-agent-add-server ()
   "Enroll SERVER in the agent program."
-  (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))))
+  (interactive)
+  (let* ((server       (gnus-server-server-name))
+         (named-server (gnus-server-named-server))
+         (method       (and server
+                            (gnus-server-get-method nil server))))
+    (unless server
+      (error "No server on the current line"))
+
     (when (gnus-agent-method-p method)
       (error "Server already in the agent program"))
-    (push method gnus-agent-covered-methods)
+
+    (push named-server 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)))
 
-(defun gnus-agent-remove-server (server)
+(defun gnus-agent-remove-server ()
   "Remove SERVER from the agent program."
-  (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)
+  (interactive)
+  (let* ((server       (gnus-server-server-name))
+         (named-server (gnus-server-named-server)))
+    (unless server
+      (error "No server on the current line"))
+
+    (unless (member named-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 named-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)
-               (sit-for 1))))
-         (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."
@@ -827,7 +872,7 @@ be a select method."
   (let ((coding-system-for-write nnheader-file-coding-system)
        (file-name-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)))))
 
 ;;;
@@ -913,28 +958,28 @@ article's mark is toggled."
            (cond ((< a h)
                   ;; Ignore IDs in the alist that are not being
                   ;; displayed in the summary.
-                  (pop alist))
+                  (setq alist (cdr alist)))
                  ((> a h)
                    ;; Headers that are not in the alist should be
                    ;; fictious (see nnagent-retrieve-headers); they
                    ;; imply that this article isn't in the agent.
                   (gnus-agent-append-to-list tail-undownloaded h)
                   (gnus-agent-append-to-list tail-unfetched    h)
-                   (pop headers)) 
+                   (setq headers (cdr headers))) 
                  ((cdar alist)
-                  (pop alist)
-                  (pop headers)
+                  (setq alist (cdr alist))
+                  (setq headers (cdr headers))
                   nil                  ; ignore already downloaded
                   )
                  (t
-                  (pop alist)
-                  (pop headers)
+                  (setq alist (cdr alist))
+                  (setq headers (cdr headers))
                    
                    ;; This article isn't in the agent.  Check to see
                    ;; if it is in the cache.  If it is, it's been
                    ;; downloaded.
                    (while (and cached (< (car cached) a))
-                     (pop cached))
+                     (setq cached (cdr cached)))
                    (unless (equal a (car cached))
                      (gnus-agent-append-to-list tail-undownloaded a))))))
 
@@ -1166,6 +1211,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."
+  (delq nil (mapcar #'gnus-server-to-method gnus-agent-covered-methods)))
+
 ;;; History functions
 
 (defun gnus-agent-history-buffer ()
@@ -1324,7 +1373,7 @@ This can be added to `gnus-select-article-hook' or
                       (gnus-agent-append-to-list
                       tail-fetched-articles (caar pos)))
                     (widen)
-                    (pop pos))))
+                    (setq pos (cdr pos)))))
 
             (gnus-agent-save-alist group (cdr fetched-articles) date)
             (gnus-message 7 ""))
@@ -1358,7 +1407,7 @@ This can be added to `gnus-select-article-hook' or
        (insert (string-to-number (cdar crosses)))
        (insert-buffer-substring gnus-agent-overview-buffer beg end)
         (gnus-agent-check-overview-buffer))
-      (pop crosses))))
+      (setq crosses (cdr crosses)))))
 
 (defun gnus-agent-backup-overview-buffer ()
   (when gnus-newsgroup-name
@@ -1426,7 +1475,7 @@ and that there are no duplicates."
                      (gnus-agent-article-name ".overview"
                                               (caar gnus-agent-buffer-alist))
                      nil 'silent))
-      (pop gnus-agent-buffer-alist))
+      (setq gnus-agent-buffer-alist (cdr gnus-agent-buffer-alist)))
     (while gnus-agent-group-alist
       (with-temp-file (gnus-agent-article-name
                       ".agentview" (caar gnus-agent-group-alist))
@@ -1434,7 +1483,7 @@ and that there are no duplicates."
        (insert "\n")
         (princ 1 (current-buffer))
        (insert "\n"))
-      (pop gnus-agent-group-alist))))
+      (setq gnus-agent-group-alist (cdr gnus-agent-group-alist)))))
 
 (defun gnus-agent-find-parameter (group symbol)
   "Search for GROUPs SYMBOL in the group's parameters, the group's
@@ -1445,14 +1494,14 @@ variables.  Returns the first non-nil value found."
       (symbol-value
        (cdr
         (assq symbol
-         '((agent-short-article . gnus-agent-short-article)
-           (agent-long-article . gnus-agent-long-article)
-           (agent-low-score . gnus-agent-low-score)
-           (agent-high-score . gnus-agent-high-score)
-           (agent-days-until-old . gnus-agent-expire-days)
-           (agent-enable-expiration
-            . gnus-agent-enable-expiration)
-           (agent-predicate . gnus-agent-predicate)))))))
+              '((agent-short-article . gnus-agent-short-article)
+                (agent-long-article . gnus-agent-long-article)
+                (agent-low-score . gnus-agent-low-score)
+                (agent-high-score . gnus-agent-high-score)
+                (agent-days-until-old . gnus-agent-expire-days)
+                (agent-enable-expiration
+                 . gnus-agent-enable-expiration)
+                (agent-predicate . gnus-agent-predicate)))))))
 
 (defun gnus-agent-fetch-headers (group &optional force)
   "Fetch interesting headers into the agent.  The group's overview
@@ -1774,7 +1823,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
@@ -1805,7 +1854,7 @@ FILE and places the combined headers into `nntp-server-buffer'."
                                       (error-message-string err)))
                       (signal 'quit
                               "Cannot fetch articles into the Gnus agent")))))))))
-       (pop methods))
+       (setq methods (cdr methods)))
       (gnus-run-hooks 'gnus-agent-fetched-hook)
       (gnus-message 6 "Finished fetching articles into the Gnus agent"))))
 
@@ -2367,7 +2416,7 @@ The following commands are available:
   (cond
    ;; Functions are just returned as is.
    ((or (symbolp predicate)
-       (gnus-functionp predicate))
+       (functionp predicate))
     `(,(or (cdr (assq predicate gnus-category-predicate-alist))
           predicate)))
    ;; More complex predicate.
@@ -2404,7 +2453,7 @@ return only unread articles."
          nil)
         ((not function)
          nil)
-        ((gnus-functionp function)
+        ((functionp function)
          'ignore)
         ((memq (car function) '(or and not))
          (apply (car function)
@@ -2449,29 +2498,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
@@ -2484,12 +2536,18 @@ FORCE is equivalent to setting the expiration predicates to true."
            (cons dir 
                  (symbol-value 'gnus-agent-expire-current-dirs))))
 
-    (if (eq 'DISABLE (gnus-agent-find-parameter group 
-                                                'agent-enable-expiration))
+    (if (and (not force)
+             (eq 'DISABLE (gnus-agent-find-parameter group 
+                                                     'agent-enable-expiration)))
         (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)))
@@ -2529,7 +2587,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
@@ -2681,8 +2739,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
@@ -2726,8 +2784,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)
                     )
@@ -2735,7 +2796,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
@@ -2810,10 +2877,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
@@ -2838,7 +2908,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
@@ -2903,7 +2991,7 @@ articles in every agentized group."))
  deleting them?")))
           (while to-remove
             (let ((dir (pop to-remove)))
-              (if (gnus-y-or-n-p (format "Delete %s?" dir))
+              (if (gnus-y-or-n-p (format "Delete %s? " dir))
                   (let* (delete-recursive
                          (delete-recursive
                           (function
@@ -2949,7 +3037,12 @@ articles in every agentized group."))
                        (gnus-agent-append-to-list tail-unread candidate)
                        nil)
                       ((> candidate max)
-                       (pop 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)))
@@ -2977,14 +3070,14 @@ has been fetched."
               (v2 (caar ref)))
           (cond ((< v1 v2) ; v1 does not appear in the reference list
                 (gnus-agent-append-to-list tail-uncached v1)
-                 (pop arts))
+                 (setq arts (cdr arts)))
                 ((= v1 v2)
                  (unless (or cached-header (cdar ref)) ; v1 is already cached
                   (gnus-agent-append-to-list tail-uncached v1))
-                 (pop arts)
-                 (pop ref))
+                 (setq arts (cdr arts))
+                 (setq ref (cdr ref)))
                 (t ; reference article (v2) preceeds the list being filtered
-                 (pop ref)))))
+                 (setq ref (cdr ref))))))
       (while arts
        (gnus-agent-append-to-list tail-uncached (pop arts)))
       (cdr uncached))
@@ -3154,9 +3247,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)))
@@ -3205,7 +3308,7 @@ If REREAD is not nil, downloaded articles are marked as unread."
                           (gnus-message 4 "gnus-agent-regenerate-group: NOV\
  entries contained duplicate of article %s.     Duplicate deleted." l1)
                            (gnus-delete-line)
-                           (pop nov-arts)))))
+                           (setq nov-arts (cdr nov-arts))))))
                  (t
                  (gnus-message 1 "gnus-agent-regenerate-group: NOV\
  entries contained line that did not begin with an article number.  Deleted\
@@ -3251,12 +3354,12 @@ If REREAD is not nil, downloaded articles are marked as unread."
                            (nth 5 (file-attributes
                                    (concat dir (number-to-string
                                                 (car downloaded))))))) alist)
-              (pop downloaded)
-              (pop nov-arts))
+              (setq downloaded (cdr downloaded))
+              (setq nov-arts (cdr nov-arts)))
              (t
               ;; This entry in the overview has not been downloaded
               (push (cons (car nov-arts) nil) alist)
-              (pop nov-arts))))
+              (setq nov-arts (cdr nov-arts)))))
 
      ;; When gnus-agent-consider-all-articles is set,
      ;; gnus-agent-regenerate-group should NOT remove article IDs from
@@ -3280,15 +3383,15 @@ If REREAD is not nil, downloaded articles are marked as unread."
                    (oID (caar o)))
                (cond ((not nID)
                       (setq n (setcdr n (list (list oID))))
-                      (pop o))
+                      (setq o (cdr o)))
                      ((< oID nID)
                       (setcdr n (cons (list oID) (cdr n)))
-                      (pop o))
+                      (setq o (cdr o)))
                      ((= oID nID)
-                      (pop o)
-                      (pop n))
+                      (setq o (cdr o))
+                      (setq n (cdr n)))
                      (t
-                      (pop n)))))
+                      (setq n (cdr n))))))
            (setq alist (cdr merged)))
        ;; Restore the last article ID if it is not already in the new alist
        (let ((n (last alist))
@@ -3341,7 +3444,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)
@@ -3412,8 +3515,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 ()
@@ -3440,7 +3542,7 @@ If CLEAN, don't read existing active files."
                                                  (caar days)
                                                  group))
                                       (throw 'found (cadar days)))
-                                    (pop days))
+                                    (setq days (cdr days)))
                                   nil)))
                       (when day
                         (gnus-group-set-parameter group 'agent-days-until-old