Synch to Oort Gnus 200303231904.
authoryamaoka <yamaoka>
Mon, 24 Mar 2003 00:45:50 +0000 (00:45 +0000)
committeryamaoka <yamaoka>
Mon, 24 Mar 2003 00:45:50 +0000 (00:45 +0000)
ChangeLog
GNUS-NEWS
lisp/ChangeLog
lisp/gnus-agent.el
lisp/message.el

index 6d15112..dded8a4 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+2003-03-23  Simon Josefsson  <jas@extundo.com>
+
+       * GNUS-NEWS: Add IDNA.  Add TLS.  Fix USEFOR reference.
+
 2003-03-22  Frank Schmitt  <ich@frank-schmitt.net> 
 
        * make.bat: Redone from scratch; supports both Emacs and XEmacs
index c7cd2e8..2a7a921 100644 (file)
--- a/GNUS-NEWS
+++ b/GNUS-NEWS
@@ -301,7 +301,7 @@ function filters out other articles.
 
 ** Group names are treated as UTF-8 by default.
 
-This is supposedly what USEFOR wants to migrate to.  See
+This is supposedly what USEFOR wanted to migrate to.  See
 `gnus-group-name-charset-group-alist' and
 `gnus-group-name-charset-method-alist' for customization.
 
index f5358bb..31ad817 100644 (file)
@@ -1,5 +1,15 @@
+2003-03-23  Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+       * gnus-agent.el (gnus-agent-expire-unagentized-dirs): Provides
+       option of deleting agent directories for groups/servers that are
+       not currently agentized.
+       (gnus-agent-expire): Use gnus-agent-expire-unagentized-dirs.
+       
 2003-03-23  Simon Josefsson  <jas@extundo.com>
 
+       * message.el (message-idna-to-ascii-rhs-1): Don't continue outside
+       header.
+
        * rfc2047.el (rfc2047-header-encoding-alist): Make Followup-To
        same as Newsgroups.
 
index a897188..a4c9408 100644 (file)
@@ -2452,308 +2452,315 @@ FORCE is equivalent to setting the expiration predicates to true."
   ;; gnus-command-method, initialized overview buffer, and to have
   ;; provided a non-nil active
 
-  (if (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))
-           (alist gnus-agent-article-alist)
-           (dir (concat
-                 (gnus-agent-directory)
-                 (gnus-agent-group-path group)
-                 "/"))
-           (day (- (time-to-days (current-time))
-                   (gnus-agent-find-parameter group 'agent-days-until-old)))
-           (specials (if (and alist
-                              (not force))
-                         ;; This could be a bit of a problem.  I need to
-                         ;; keep the last article to avoid refetching
-                         ;; headers when using nntp in the backend.  At
-                         ;; the same time, if someone uses a backend
-                         ;; that supports article moving then I may have
-                         ;; to remove the last article to complete the
-                         ;; move.  Right now, I'm going to assume that
-                         ;; FORCE overrides specials.
-                         (list (caar (last alist)))))
-           (unreads ;; Articles that are excluded from the
-            ;; expiration process
-            (cond (gnus-agent-expire-all
-                   ;; All articles are marked read by global decree
-                   nil)
-                  ((eq articles t)
-                   ;; All articles are marked read by function
-                   ;; parameter
-                   nil)
-                  ((not articles)
-                   ;; Unread articles are marked protected from
-                   ;; expiration Don't call
-                   ;; gnus-list-of-unread-articles as it returns
-                   ;; articles that have not been fetched into the
-                   ;; agent.
-                   (ignore-errors
-                    (gnus-agent-unread-articles group)))
-                  (t
-                   ;; All articles EXCEPT those named by the caller
-                   ;; are protected from expiration
-                   (gnus-sorted-difference
-                    (gnus-uncompress-range
-                     (cons (caar alist)
-                           (caar (last alist))))
-                    (sort articles '<)))))
-           (marked ;; More articles that are exluded from the
-            ;; expiration process
-            (cond (gnus-agent-expire-all
-                   ;; All articles are unmarked by global decree
-                   nil)
-                  ((eq articles t)
-                   ;; All articles are unmarked by function
-                   ;; parameter
-                   nil)
-                  (articles
-                   ;; All articles may as well be unmarked as the
-                   ;; unreads list already names the articles we are
-                   ;; going to keep
-                   nil)
-                  (t
-                   ;; Ticked and/or dormant articles are excluded
-                   ;; from expiration
-                   (nconc
-                    (gnus-uncompress-range
-                     (cdr (assq 'tick (gnus-info-marks info))))
-                    (gnus-uncompress-range
-                     (cdr (assq 'dormant
-                                (gnus-info-marks info))))))))
-           (nov-file (concat dir ".overview"))
-           (cnt 0)
-           (completed -1)
-           dlist
-           type)
-
-      ;; The normal article alist contains elements that look like
-      ;; (article# .  fetch_date) I need to combine other
-      ;; information with this list.  For example, a flag indicating
-      ;; that a particular article MUST BE KEPT.  To do this, I'm
-      ;; going to transform the elements to look like (article#
-      ;; fetch_date keep_flag NOV_entry_marker) Later, I'll reverse
-      ;; the process to generate the expired article alist.
-
-      ;; Convert the alist elements to (article# fetch_date nil
-      ;; nil).
-      (setq dlist (mapcar (lambda (e)
-                            (list (car e) (cdr e) nil nil)) alist))
-
-      ;; Convert the keep lists to elements that look like (article#
-      ;; nil keep_flag nil) then append it to the expanded dlist
-      ;; These statements are sorted by ascending precidence of the
-      ;; keep_flag.
-      (setq dlist (nconc dlist
-                         (mapcar (lambda (e)
-                                   (list e nil 'unread  nil))
-                                 unreads)))
-      (setq dlist (nconc dlist
-                         (mapcar (lambda (e)
-                                   (list e nil 'marked  nil))
-                                 marked)))
-      (setq dlist (nconc dlist
-                         (mapcar (lambda (e)
-                                   (list e nil 'special nil))
-                                 specials)))
-
-      (set-buffer overview)
-      (erase-buffer)
-      (buffer-disable-undo)
-      (when (file-exists-p nov-file)
-        (gnus-message 7 "gnus-agent-expire: Loading overview...")
-        (nnheader-insert-file-contents nov-file)
-        (goto-char (point-min))
-
-        (let (p)
-          (while (< (setq p (point)) (point-max))
-            (condition-case nil
-                ;; If I successfully read an integer (the plus zero
-                ;; ensures a numeric type), prepend a marker entry
-                ;; to the list
-                (push (list (+ 0 (read (current-buffer))) nil nil
-                            (set-marker (make-marker) p))
-                      dlist)
-              (error
-               (gnus-message 1 "gnus-agent-expire: read error \
+  (let ((dir (concat
+              (gnus-agent-directory)
+              (gnus-agent-group-path group)
+              "/")))
+    (when (boundp 'gnus-agent-expire-current-dirs)
+      (set 'gnus-agent-expire-current-dirs 
+           (cons dir 
+                 (symbol-value 'gnus-agent-expire-current-dirs))))
+
+    (if (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))
+             (alist gnus-agent-article-alist)
+             (day (- (time-to-days (current-time))
+                     (gnus-agent-find-parameter group 'agent-days-until-old)))
+             (specials (if (and alist
+                                (not force))
+                           ;; This could be a bit of a problem.  I need to
+                           ;; keep the last article to avoid refetching
+                           ;; headers when using nntp in the backend.  At
+                           ;; the same time, if someone uses a backend
+                           ;; that supports article moving then I may have
+                           ;; to remove the last article to complete the
+                           ;; move.  Right now, I'm going to assume that
+                           ;; FORCE overrides specials.
+                           (list (caar (last alist)))))
+             (unreads ;; Articles that are excluded from the
+              ;; expiration process
+              (cond (gnus-agent-expire-all
+                     ;; All articles are marked read by global decree
+                     nil)
+                    ((eq articles t)
+                     ;; All articles are marked read by function
+                     ;; parameter
+                     nil)
+                    ((not articles)
+                     ;; Unread articles are marked protected from
+                     ;; expiration Don't call
+                     ;; gnus-list-of-unread-articles as it returns
+                     ;; articles that have not been fetched into the
+                     ;; agent.
+                     (ignore-errors
+                       (gnus-agent-unread-articles group)))
+                    (t
+                     ;; All articles EXCEPT those named by the caller
+                     ;; are protected from expiration
+                     (gnus-sorted-difference
+                      (gnus-uncompress-range
+                       (cons (caar alist)
+                             (caar (last alist))))
+                      (sort articles '<)))))
+             (marked ;; More articles that are exluded from the
+              ;; expiration process
+              (cond (gnus-agent-expire-all
+                     ;; All articles are unmarked by global decree
+                     nil)
+                    ((eq articles t)
+                     ;; All articles are unmarked by function
+                     ;; parameter
+                     nil)
+                    (articles
+                     ;; All articles may as well be unmarked as the
+                     ;; unreads list already names the articles we are
+                     ;; going to keep
+                     nil)
+                    (t
+                     ;; Ticked and/or dormant articles are excluded
+                     ;; from expiration
+                     (nconc
+                      (gnus-uncompress-range
+                       (cdr (assq 'tick (gnus-info-marks info))))
+                      (gnus-uncompress-range
+                       (cdr (assq 'dormant
+                                  (gnus-info-marks info))))))))
+             (nov-file (concat dir ".overview"))
+             (cnt 0)
+             (completed -1)
+             dlist
+             type)
+
+        ;; The normal article alist contains elements that look like
+        ;; (article# .  fetch_date) I need to combine other
+        ;; information with this list.  For example, a flag indicating
+        ;; that a particular article MUST BE KEPT.  To do this, I'm
+        ;; going to transform the elements to look like (article#
+        ;; fetch_date keep_flag NOV_entry_marker) Later, I'll reverse
+        ;; the process to generate the expired article alist.
+
+        ;; Convert the alist elements to (article# fetch_date nil
+        ;; nil).
+        (setq dlist (mapcar (lambda (e)
+                              (list (car e) (cdr e) nil nil)) alist))
+
+        ;; Convert the keep lists to elements that look like (article#
+        ;; nil keep_flag nil) then append it to the expanded dlist
+        ;; These statements are sorted by ascending precidence of the
+        ;; keep_flag.
+        (setq dlist (nconc dlist
+                           (mapcar (lambda (e)
+                                     (list e nil 'unread  nil))
+                                   unreads)))
+        (setq dlist (nconc dlist
+                           (mapcar (lambda (e)
+                                     (list e nil 'marked  nil))
+                                   marked)))
+        (setq dlist (nconc dlist
+                           (mapcar (lambda (e)
+                                     (list e nil 'special nil))
+                                   specials)))
+
+        (set-buffer overview)
+        (erase-buffer)
+        (buffer-disable-undo)
+        (when (file-exists-p nov-file)
+          (gnus-message 7 "gnus-agent-expire: Loading overview...")
+          (nnheader-insert-file-contents nov-file)
+          (goto-char (point-min))
+
+          (let (p)
+            (while (< (setq p (point)) (point-max))
+              (condition-case nil
+                  ;; If I successfully read an integer (the plus zero
+                  ;; ensures a numeric type), prepend a marker entry
+                  ;; to the list
+                  (push (list (+ 0 (read (current-buffer))) nil nil
+                              (set-marker (make-marker) p))
+                        dlist)
+                (error
+                 (gnus-message 1 "gnus-agent-expire: read error \
 occurred when reading expression at %s in %s.  Skipping to next \
 line." (point) nov-file)))
-            ;; Whether I succeeded, or failed, it doesn't matter.
-            ;; Move to the next line then try again.
-            (forward-line 1)))
-        (gnus-message
-         7 "gnus-agent-expire: Loading overview... Done"))
-      (set-buffer-modified-p nil)
-
-      ;; At this point, all of the information is in dlist.  The
-      ;; only problem is that much of it is spread across multiple
-      ;; entries.  Sort then MERGE!!
-      (gnus-message 7 "gnus-agent-expire: Sorting entries... ")
-      ;; If two entries have the same article-number then sort by
-      ;; ascending keep_flag.
-      (let ((special 0)
-            (marked 1)
-            (unread 2))
-        (setq dlist
-              (sort dlist
-                    (lambda (a b)
-                      (cond ((< (nth 0 a) (nth 0 b))
-                             t)
-                            ((> (nth 0 a) (nth 0 b))
-                             nil)
-                            (t
-                             (let ((a (or (symbol-value (nth 2 a))
-                                          3))
-                                   (b (or (symbol-value (nth 2 b))
-                                          3)))
-                               (<= a b))))))))
-      (gnus-message 7 "gnus-agent-expire: Sorting entries... Done")
-      (gnus-message 7 "gnus-agent-expire: Merging entries... ")
-      (let ((dlist dlist))
-        (while (cdr dlist)              ; I'm not at the end-of-list
-          (if (eq (caar dlist) (caadr dlist))
-              (let ((first (cdr (car dlist)))
-                    (secnd (cdr (cadr dlist))))
-                (setcar first (or (car first)
-                                  (car secnd))) ; fetch_date
-                (setq first (cdr first)
-                      secnd (cdr secnd))
-                (setcar first (or (car first)
-                                  (car secnd))) ; Keep_flag
-                (setq first (cdr first)
-                      secnd (cdr secnd))
-                (setcar first (or (car first)
-                                  (car secnd))) ; NOV_entry_marker
-
-                (setcdr dlist (cddr dlist)))
-            (setq dlist (cdr dlist)))))
-      (gnus-message 7 "gnus-agent-expire: Merging entries... Done")
-
-      (let* ((len (float (length dlist)))
-             (alist (list nil))
-             (tail-alist alist))
-        (while dlist
-          (let ((new-completed (truncate (* 100.0
-                                            (/ (setq cnt (1+ cnt))
-                                               len)))))
-            (when (> new-completed completed)
-              (setq completed new-completed)
-              (gnus-message 7 "%3d%% completed..."  completed)))
-          (let* ((entry          (car dlist))
-                 (article-number (nth 0 entry))
-                 (fetch-date     (nth 1 entry))
-                 (keep           (nth 2 entry))
-                 (marker         (nth 3 entry)))
-
-            (cond
-             ;; Kept articles are unread, marked, or special.
-             (keep
-              (gnus-agent-message 10
-                            "gnus-agent-expire: Article %d: Kept %s article."
-                            article-number keep)
-              (when fetch-date
-                (unless (file-exists-p
-                         (concat dir (number-to-string
-                                      article-number)))
-                  (setf (nth 1 entry) nil)
-                  (gnus-agent-message 3 "gnus-agent-expire cleared \
+              ;; Whether I succeeded, or failed, it doesn't matter.
+              ;; Move to the next line then try again.
+              (forward-line 1)))
+
+          (gnus-message
+           7 "gnus-agent-expire: Loading overview... Done"))
+        (set-buffer-modified-p nil)
+
+        ;; At this point, all of the information is in dlist.  The
+        ;; only problem is that much of it is spread across multiple
+        ;; entries.  Sort then MERGE!!
+        (gnus-message 7 "gnus-agent-expire: Sorting entries... ")
+        ;; If two entries have the same article-number then sort by
+        ;; ascending keep_flag.
+        (let ((special 0)
+              (marked 1)
+              (unread 2))
+          (setq dlist
+                (sort dlist
+                      (lambda (a b)
+                        (cond ((< (nth 0 a) (nth 0 b))
+                               t)
+                              ((> (nth 0 a) (nth 0 b))
+                               nil)
+                              (t
+                               (let ((a (or (symbol-value (nth 2 a))
+                                            3))
+                                     (b (or (symbol-value (nth 2 b))
+                                            3)))
+                                 (<= a b))))))))
+        (gnus-message 7 "gnus-agent-expire: Sorting entries... Done")
+        (gnus-message 7 "gnus-agent-expire: Merging entries... ")
+        (let ((dlist dlist))
+          (while (cdr dlist)            ; I'm not at the end-of-list
+            (if (eq (caar dlist) (caadr dlist))
+                (let ((first (cdr (car dlist)))
+                      (secnd (cdr (cadr dlist))))
+                  (setcar first (or (car first)
+                                    (car secnd))) ; fetch_date
+                  (setq first (cdr first)
+                        secnd (cdr secnd))
+                  (setcar first (or (car first)
+                                    (car secnd))) ; Keep_flag
+                  (setq first (cdr first)
+                        secnd (cdr secnd))
+                  (setcar first (or (car first)
+                                    (car secnd))) ; NOV_entry_marker
+
+                  (setcdr dlist (cddr dlist)))
+              (setq dlist (cdr dlist)))))
+        (gnus-message 7 "gnus-agent-expire: Merging entries... Done")
+
+        (let* ((len (float (length dlist)))
+               (alist (list nil))
+               (tail-alist alist))
+          (while dlist
+            (let ((new-completed (truncate (* 100.0
+                                              (/ (setq cnt (1+ cnt))
+                                                 len)))))
+              (when (> new-completed completed)
+                (setq completed new-completed)
+                (gnus-message 7 "%3d%% completed..."  completed)))
+            (let* ((entry          (car dlist))
+                   (article-number (nth 0 entry))
+                   (fetch-date     (nth 1 entry))
+                   (keep           (nth 2 entry))
+                   (marker         (nth 3 entry)))
+
+              (cond
+               ;; Kept articles are unread, marked, or special.
+               (keep
+                (gnus-agent-message 10
+                                    "gnus-agent-expire: Article %d: Kept %s article."
+                                    article-number keep)
+                (when fetch-date
+                  (unless (file-exists-p
+                           (concat dir (number-to-string
+                                        article-number)))
+                    (setf (nth 1 entry) nil)
+                    (gnus-agent-message 3 "gnus-agent-expire cleared \
 download flag on article %d as the cached article file is missing."
-                                (caar dlist)))
-                (unless marker
-                  (gnus-message 1 "gnus-agent-expire detected a \
+                                        (caar dlist)))
+                  (unless marker
+                    (gnus-message 1 "gnus-agent-expire detected a \
 missing NOV entry.  Run gnus-agent-regenerate-group to restore it.")))
-              (gnus-agent-append-to-list
-               tail-alist
-               (cons article-number fetch-date)))
-
-             ;; The following articles are READ, UNMARKED, and
-             ;; ORDINARY.  See if they can be EXPIRED!!!
-             ((setq type
-                    (cond
-                     ((not (integerp fetch-date))
-                      'read) ;; never fetched article (may expire
-                     ;; right now)
-                     ((not (file-exists-p
-                            (concat dir (number-to-string
-                                         article-number))))
-                      (setf (nth 1 entry) nil)
-                      'externally-expired) ;; Can't find the cached
-                     ;; article.  Handle case
-                     ;; as though this article
-                     ;; was never fetched.
-
-                     ;; We now have the arrival day, so we see
-                     ;; whether it's old enough to be expired.
-                     ((< fetch-date day)
-                      'expired)
-                     (force
-                      'forced)))
-
-              ;; I found some reason to expire this entry.
-
-              (let ((actions nil))
-                (when (memq type '(forced expired))
-                  (ignore-errors        ; Just being paranoid.
-                   (delete-file (concat dir (number-to-string
-                                             article-number)))
-                   (push "expired cached article" actions))
-                  (setf (nth 1 entry) nil)
-                  )
-
-                (when marker
-                  (push "NOV entry removed" actions)
-                  (goto-char marker)
-                  (gnus-delete-line))
-
-                ;; If considering all articles is set, I can only
-                ;; expire article IDs that are no longer in the
-                ;; active range.
-                (if (and gnus-agent-consider-all-articles
-                         (>= article-number (car active)))
-                    ;; I have to keep this ID in the alist
-                    (gnus-agent-append-to-list
-                     tail-alist (cons article-number fetch-date))
-                  (push (format "Removed %s article number from \
+                (gnus-agent-append-to-list
+                 tail-alist
+                 (cons article-number fetch-date)))
+
+               ;; The following articles are READ, UNMARKED, and
+               ;; ORDINARY.  See if they can be EXPIRED!!!
+               ((setq type
+                      (cond
+                       ((not (integerp fetch-date))
+                        'read) ;; never fetched article (may expire
+                       ;; right now)
+                       ((not (file-exists-p
+                              (concat dir (number-to-string
+                                           article-number))))
+                        (setf (nth 1 entry) nil)
+                        'externally-expired) ;; Can't find the cached
+                       ;; article.  Handle case
+                       ;; as though this article
+                       ;; was never fetched.
+
+                       ;; We now have the arrival day, so we see
+                       ;; whether it's old enough to be expired.
+                       ((< fetch-date day)
+                        'expired)
+                       (force
+                        'forced)))
+
+                ;; I found some reason to expire this entry.
+
+                (let ((actions nil))
+                  (when (memq type '(forced expired))
+                    (ignore-errors      ; Just being paranoid.
+                      (delete-file (concat dir (number-to-string
+                                                article-number)))
+                      (push "expired cached article" actions))
+                    (setf (nth 1 entry) nil)
+                    )
+
+                  (when marker
+                    (push "NOV entry removed" actions)
+                    (goto-char marker)
+                    (gnus-delete-line))
+
+                  ;; If considering all articles is set, I can only
+                  ;; expire article IDs that are no longer in the
+                  ;; active range.
+                  (if (and gnus-agent-consider-all-articles
+                           (>= article-number (car active)))
+                      ;; I have to keep this ID in the alist
+                      (gnus-agent-append-to-list
+                       tail-alist (cons article-number fetch-date))
+                    (push (format "Removed %s article number from \
 article alist" type) actions))
 
-                (gnus-agent-message 8 "gnus-agent-expire: Article %d: %s"
-                              article-number
-                              (mapconcat 'identity actions ", "))))
-             (t
-              (gnus-agent-message
-               10 "gnus-agent-expire: Article %d: Article kept as \
+                  (gnus-agent-message 8 "gnus-agent-expire: Article %d: %s"
+                                      article-number
+                                      (mapconcat 'identity actions ", "))))
+               (t
+                (gnus-agent-message
+                 10 "gnus-agent-expire: Article %d: Article kept as \
 expiration tests failed." article-number)
-              (gnus-agent-append-to-list
-               tail-alist (cons article-number fetch-date)))
-             )
+                (gnus-agent-append-to-list
+                 tail-alist (cons article-number fetch-date)))
+               )
 
-            ;; Clean up markers as I want to recycle this buffer
-            ;; over several groups.
-            (when marker
-              (set-marker marker nil))
+              ;; Clean up markers as I want to recycle this buffer
+              ;; over several groups.
+              (when marker
+                (set-marker marker nil))
 
-            (setq dlist (cdr dlist))))
+              (setq dlist (cdr dlist))))
 
-        (setq alist (cdr alist))
+          (setq alist (cdr alist))
 
-        (let ((inhibit-quit t))
-          (unless (equal alist gnus-agent-article-alist)
-            (setq gnus-agent-article-alist alist)
-            (gnus-agent-save-alist group))
+          (let ((inhibit-quit t))
+            (unless (equal alist gnus-agent-article-alist)
+              (setq gnus-agent-article-alist alist)
+              (gnus-agent-save-alist group))
 
-          (when (buffer-modified-p)
-           (gnus-make-directory dir)
-           (write-region-as-coding-system gnus-agent-file-coding-system
-                                          (point-min) (point-max) nov-file
-                                          nil 'silent)
-            ;; clear the modified flag as that I'm not confused by
-            ;; its status on the next pass through this routine.
-           (set-buffer-modified-p nil))
+            (when (buffer-modified-p)
+             (gnus-make-directory dir)
+             (write-region-as-coding-system gnus-agent-file-coding-system
+                                            (point-min) (point-max) nov-file
+                                            nil 'silent)
+             ;; clear the modified flag as that I'm not confused by
+             ;; its status on the next pass through this routine.
+             (set-buffer-modified-p nil))
 
-          (when (eq articles t)
-            (gnus-summary-update-info)))))))
+            (when (eq articles t)
+              (gnus-summary-update-info))))))))
 
 (defun gnus-agent-expire (&optional articles group force)
   "Expire all old articles.
@@ -2774,6 +2781,9 @@ FORCE is equivalent to setting the expiration predicates to true."
             (yes-or-no-p "Are you sure that you want to expire all \
 articles in every agentized group."))
         (let ((methods gnus-agent-covered-methods)
+              ;; Bind gnus-agent-expire-current-dirs to enable tracking
+              ;; of agent directories.
+              (gnus-agent-expire-current-dirs nil)
               gnus-command-method overview orig)
           (setq overview (gnus-get-buffer-create " *expire overview*"))
           (unwind-protect
@@ -2796,8 +2806,79 @@ articles in every agentized group."))
                           (gnus-agent-expire-group-1
                            expiring-group overview active articles force)))))))
             (kill-buffer overview))
+          (gnus-agent-expire-unagentized-dirs)
           (gnus-message 4 "Expiry...done")))))
 
+(defun gnus-agent-expire-unagentized-dirs ()
+  (when (boundp 'gnus-agent-expire-current-dirs)
+    (let* ((keep (gnus-make-hashtable))
+          ;; Formally bind gnus-agent-expire-current-dirs so that the
+          ;; compiler will not complain about free references.
+          (gnus-agent-expire-current-dirs
+           (symbol-value 'gnus-agent-expire-current-dirs))
+         dir)
+
+      (gnus-sethash gnus-agent-directory t keep)
+      (while gnus-agent-expire-current-dirs
+       (setq dir (pop gnus-agent-expire-current-dirs))
+       (when (and (stringp dir)
+                  (file-directory-p dir))
+         (while (not (gnus-gethash dir keep))
+           (gnus-sethash dir t keep)
+           (setq dir (file-name-directory (directory-file-name dir))))))
+
+  (let* (to-remove
+        checker
+        (checker
+         (function
+          (lambda (d)
+            (let ((files (directory-files d))
+                  file)
+              (while (setq file (pop files))
+                (cond ((equal file ".")
+                       nil)
+                      ((equal file "..")
+                       nil)
+                      ((equal file ".overview")
+                       (let ((d (file-name-as-directory d))
+                             r)
+                         (while (not (gnus-gethash
+                                      (setq d (file-name-directory d)) keep))
+                           (setq r d
+                                 d (directory-file-name d)))
+                         (if r
+                             (push r to-remove))))
+                      ((file-directory-p (setq file (nnheader-concat d file)))
+                       (funcall checker file)))))))))
+    (funcall checker gnus-agent-directory)
+
+    (when (and to-remove
+              (gnus-y-or-n-p
+               "gnus-agent-expire has identified local directories that are\
+ not currently required by any agentized group.         Do you wish to consider\
+ deleting them?"))
+      (while to-remove
+       (let ((dir (pop to-remove)))
+         (if (gnus-y-or-n-p (format "Delete %s?" dir))
+             (let* (delete-recursive
+                    (delete-recursive
+                     (function
+                      (lambda (f-or-d)
+                        (ignore-errors
+                         (if (file-directory-p f-or-d)
+                             (condition-case nil
+                                 (delete-directory f-or-d)
+                               (file-error
+                                (mapcar (lambda (f)
+                                          (or (member f '("." ".."))
+                                              (funcall delete-recursive
+                                                       (nnheader-concat
+                                                        f-or-d f))))
+                                        (directory-files f-or-d))
+                                (delete-directory f-or-d)))
+                           (delete-file f-or-d)))))))
+               (funcall delete-recursive dir))))))))))
+
 ;;;###autoload
 (defun gnus-agent-batch ()
   "Start Gnus, send queue and fetch session."
index a34f417..5e2b137 100644 (file)
@@ -5292,13 +5292,14 @@ I.e., calling it on a Subject: header is useless."
 
 (defun message-idna-to-ascii-rhs-1 (header)
   "Interactively potentially IDNA encode domain names in HEADER."
-  (let (rhs ace start end startpos endpos ovl)
+  (let (rhs ace start startpos endpos ovl)
     (goto-char (point-min))
-    (setq start (re-search-forward (concat "^" header) nil t)
-         end (or (save-excursion (re-search-forward "^[ \t]" nil t))
-                 (point-max)))
-    (when (and start end)
-      (while (re-search-forward "@\\([^ \t\r\n>]+\\)" end t)
+    (while (re-search-forward (concat "^" header) nil t)
+      (while (re-search-forward "@\\([^ \t\r\n>]+\\)"
+                               (or (save-excursion
+                                     (re-search-forward "^[^ \t]" nil t))
+                                   (point-max))
+                               t)
        (setq rhs (match-string-no-properties 1)
              startpos (match-beginning 1)
              endpos (match-end 1))