Synch to Gnus 200308070200.

[elisp/gnus.git-] / lisp / gnus-registry.el

diff --git a/lisp/gnus-registry.el b/lisp/gnus-registry.el
index 4180aa1..8b7ecaf 100644 (file)
--- a/lisp/gnus-registry.el
+++ b/lisp/gnus-registry.el
@@ -54,6 +54,12 @@ The group names are matched, they don't have to be fully qualified."
   :group 'gnus-registry
   :type 'boolean)
 
+(defcustom gnus-registry-clean-empty t
+  "Whether the empty registry entries should be deleted.
+Registry entries are considered empty when they have no groups."
+  :group 'gnus-registry
+  :type 'boolean)
+
 (defcustom gnus-registry-use-long-group-names nil
   "Whether the registry should use long group names (BUGGY)."
   :group 'gnus-registry
@@ -72,7 +78,8 @@ The group names are matched, they don't have to be fully qualified."
 (defcustom gnus-registry-max-entries nil
   "Maximum number of entries in the registry, nil for unlimited."
   :group 'gnus-registry
-  :type 'integer)
+  :type '(radio (const :format "Unlimited " nil)
+               (integer :format "Maximum number: %v\n" :size 0)))
 
 ;; Function(s) missing in Emacs 20
 (when (memq nil (mapcar 'fboundp '(puthash)))
@@ -155,7 +162,7 @@ The group names are matched, they don't have to be fully qualified."
 ;; Idea from Dan Christensen <jdc@chow.mat.jhu.edu>
 ;; Save the gnus-registry file with extra line breaks.
 (defun gnus-registry-cache-whitespace (filename)
-  (gnus-message 4 "Adding whitespace to %s" filename)
+  (gnus-message 5 "Adding whitespace to %s" filename)
   (save-excursion
     (goto-char (point-min))
     (while (re-search-forward "^(\\|(\\\"" nil t)
@@ -165,13 +172,28 @@ The group names are matched, they don't have to be fully qualified."
       (replace-match "" t t))))
 
 (defun gnus-registry-save (&optional force)
-;; TODO: delete entries with 0 groups
   (when (or gnus-registry-dirty force)
+    ;; remove empty entries
+    (when gnus-registry-clean-empty 
+      (gnus-registry-clean-empty-function))
+    ;; now trim the registry appropriately
     (setq gnus-registry-alist (gnus-registry-trim 
                               (hashtable-to-alist gnus-registry-hashtb)))
+    ;; really save
     (gnus-registry-cache-save)
     (setq gnus-registry-dirty nil)))
 
+(defun gnus-registry-clean-empty-function ()
+  "Remove all empty entries from the registry.  Returns count thereof."
+  (let ((count 0))
+    (maphash
+     (lambda (key value)
+       (unless (gnus-registry-fetch-group key)
+        (incf count)
+        (remhash key gnus-registry-hashtb)))
+     gnus-registry-hashtb)
+    count))
+
 (defun gnus-registry-read ()
   (gnus-registry-cache-read)
   (setq gnus-registry-hashtb (alist-to-hashtable gnus-registry-alist))
@@ -179,7 +201,9 @@ The group names are matched, they don't have to be fully qualified."
 
 (defun gnus-registry-trim (alist)
   "Trim alist to size, using gnus-registry-max-entries."
-  (unless (null gnus-registry-max-entries)
+  (if (null gnus-registry-max-entries)
+      alist                            ; just return the alist
+    ;; else, when given max-entries, trim the alist
     (let ((timehash (make-hash-table                       
                     :size 4096
                     :test 'equal)))
@@ -188,6 +212,7 @@ The group names are matched, they don't have to be fully qualified."
         (puthash key (gnus-registry-fetch-extra key 'mtime) timehash))
        gnus-registry-hashtb)
 
+      ;; we use the return value of this setq, which is the trimmed alist
       (setq alist
            (nthcdr
             (- (length alist) gnus-registry-max-entries)
@@ -354,7 +379,7 @@ Returns the first place where the trail finds a group name."
     (let ((trail (gethash id gnus-registry-hashtb)))
       (dolist (crumb trail)
        (when (stringp crumb)
-         (return crumb))))))
+         (return (gnus-group-short-name crumb)))))))
 
 (defun gnus-registry-group-count (id)
   "Get the number of groups of a message, based on the message ID."
@@ -434,7 +459,8 @@ Returns the first place where the trail finds a group name."
   (remove-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids))
 
 (when gnus-registry-install
-  (gnus-registry-install-hooks))
+  (gnus-registry-install-hooks)
+  (gnus-registry-read))
 
 ;; TODO: a lot of things