(gnus-agent-expire-unagentized-dirs): New variable. May be

	customized to disable gnus-agent-expire-unagentized-dirs.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index a9db169..6079f27 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -8,6 +8,8 @@
        same directory.
        (gnus-agent-group-pathname): New function. Wrapper for
        nnmail-group-pathname.
        same directory.
        (gnus-agent-group-pathname): New function. Wrapper for
        nnmail-group-pathname.

+       (gnus-agent-expire-unagentized-dirs): New variable.  May be
+       customized to disable gnus-agent-expire-unagentized-dirs.

 
 2003-04-10  Jesper Harder  <harder@ifa.au.dk>
 
 
 2003-04-10  Jesper Harder  <harder@ifa.au.dk>
 

diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el
index a59f3b4..9a3202a 100644 (file)
--- a/lisp/gnus-agent.el
+++ b/lisp/gnus-agent.el
@@ -169,6 +169,11 @@ enable expiration per categories, topics, and groups."
   :type '(radio (const :format "Enable " ENABLE)
                 (const :format "Disable " DISABLE)))
 
   :type '(radio (const :format "Enable " ENABLE)
                 (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.")
+

 ;;; Internal variables
 
 (defvar gnus-agent-history-buffers nil)
 ;;; Internal variables
 
 (defvar gnus-agent-history-buffers nil)


@@ -2834,13 +2839,14 @@ articles in every agentized group."))
           (gnus-message 4 "Expiry...done")))))
 
 (defun gnus-agent-expire-unagentized-dirs ()
           (gnus-message 4 "Expiry...done")))))
 
 (defun gnus-agent-expire-unagentized-dirs ()

-  (when (boundp 'gnus-agent-expire-current-dirs)
+  (when (and gnus-agent-expire-unagentized-dirs
+             (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))
     (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)
+           dir)

 
       (gnus-sethash gnus-agent-directory t keep)
       (while gnus-agent-expire-current-dirs
 
       (gnus-sethash gnus-agent-directory t keep)
       (while gnus-agent-expire-current-dirs


@@ -2851,68 +2857,69 @@ articles in every agentized group."))
            (gnus-sethash dir t keep)
            (setq dir (file-name-directory (directory-file-name dir))))))
 
            (gnus-sethash dir t keep)
            (setq dir (file-name-directory (directory-file-name dir))))))
 

-  (let* (to-remove
-        checker
-        (checker
-         (function
-          (lambda (d)
-             "Given a directory, check it and its subdirectories for 
+      (let* (to-remove
+             checker
+             (checker
+              (function
+               (lambda (d)
+                 "Given a directory, check it and its subdirectories for 

               membership in the keep hash.  If it isn't found, add 
               it to to-remove." 
               membership in the keep hash.  If it isn't found, add 
               it to to-remove." 

-            (let ((files (directory-files d))
-                  file)
-              (while (setq file (pop files))
-                (cond ((equal file ".") ; Ignore self
-                       nil)
-                      ((equal file "..") ; Ignore parent
-                       nil)
-                      ((equal file ".overview") 
-                        ;; Directory must contain .overview to be
-                        ;; agent's cache of a group.
-                       (let ((d (file-name-as-directory d))
-                             r)
-                          ;; Search ancestor's for last directory NOT
-                          ;; found in keep hash.
-                         (while (not (gnus-gethash
-                                      (setq d (file-name-directory d)) keep))
-                           (setq r d
-                                 d (directory-file-name d)))
-                          ;; if ANY ancestor was NOT in keep hash and
-                          ;; it it's already in to-remove, add it to
-                          ;; to-remove.                          
-                         (if (and r
-                                   (not (member r to-remove)))
-                             (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\
+                 (let ((files (directory-files d))
+                       file)
+                   (while (setq file (pop files))
+                     (cond ((equal file ".") ; Ignore self
+                            nil)
+                           ((equal file "..") ; Ignore parent
+                            nil)
+                           ((equal file ".overview") 
+                            ;; Directory must contain .overview to be
+                            ;; agent's cache of a group.
+                            (let ((d (file-name-as-directory d))
+                                  r)
+                              ;; Search ancestor's for last directory NOT
+                              ;; found in keep hash.
+                              (while (not (gnus-gethash
+                                           (setq d (file-name-directory d)) keep))
+                                (setq r d
+                                      d (directory-file-name d)))
+                              ;; if ANY ancestor was NOT in keep hash and
+                              ;; it it's already in to-remove, add it to
+                              ;; to-remove.                          
+                              (if (and r
+                                       (not (member r to-remove)))
+                                  (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
+                   (or gnus-expert-user
+                       (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\
  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))))))))))
+ 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 ()
 
 ;;;###autoload
 (defun gnus-agent-batch ()