Revision: miles@gnu.org--gnu-2005/gnus--devo--0--patch-37

[gnus] / lisp / gnus-registry.el

diff --git a/lisp/gnus-registry.el b/lisp/gnus-registry.el
index 401358d..879b670 100644 (file)
--- a/lisp/gnus-registry.el
+++ b/lisp/gnus-registry.el
@@ -66,7 +66,7 @@
 
 (defgroup gnus-registry nil
   "The Gnus registry."
-  :version "21.4"
+  :version "22.1"
   :group 'gnus)
 
 (defvar gnus-registry-hashtb (make-hash-table                      
@@ -102,7 +102,7 @@ and no extra data."
 The Subject and Sender (From:) headers are currently tracked this
 way."
   :group 'gnus-registry
-  :type      
+  :type
   '(set :tag "Tracking choices"
     (const :tag "Track by subject (Subject: header)" subject)
     (const :tag "Track by sender (From: header)"  sender)))
@@ -187,12 +187,12 @@ way."
                                 "%s#tmp#%d"))
                             working-dir (setq i (1+ i))))
                      (file-exists-p working-file)))
-       
+
        (unwind-protect
            (progn
              (gnus-with-output-to-file working-file
                (gnus-gnus-to-quick-newsrc-format t "gnus registry startup file" 'gnus-registry-alist))
-             
+
              ;; These bindings will mislead the current buffer
              ;; into thinking that it is visiting the startup
              ;; file.
@@ -202,14 +202,14 @@ way."
                    (setmodes (file-modes startup-file)))
                ;; Backup the current version of the startup file.
                (backup-buffer)
-               
+
                ;; Replace the existing startup file with the temp file.
                (rename-file working-file startup-file t)
                (gnus-set-file-modes startup-file setmodes)))
          (condition-case nil
              (delete-file working-file)
            (file-error nil)))))
-    
+
     (gnus-kill-buffer (current-buffer))
     (gnus-message 5 "Saving %s...done" file))))
 
@@ -237,10 +237,10 @@ way."
             (remhash key gnus-registry-hashtb)))
        gnus-registry-hashtb)
       ;; remove empty entries
-      (when gnus-registry-clean-empty 
+      (when gnus-registry-clean-empty
        (gnus-registry-clean-empty-function))
       ;; now trim the registry appropriately
-      (setq gnus-registry-alist (gnus-registry-trim 
+      (setq gnus-registry-alist (gnus-registry-trim
                                 (hashtable-to-alist gnus-registry-hashtb)))
       ;; really save
       (gnus-registry-cache-save)
@@ -294,7 +294,7 @@ way."
 
 (defun alist-to-hashtable (alist)
   "Build a hashtable from the values in ALIST."
-  (let ((ht (make-hash-table                       
+  (let ((ht (make-hash-table
             :size 4096
             :test 'equal)))
     (mapc
@@ -314,7 +314,7 @@ way."
 
 (defun gnus-registry-action (action data-header from &optional to method)
   (let* ((id (mail-header-id data-header))
-        (subject (gnus-registry-simplify-subject 
+        (subject (gnus-registry-simplify-subject
                   (mail-header-subject data-header)))
         (sender (mail-header-from data-header))
         (from (gnus-group-guess-full-name-from-command-method from))
@@ -330,7 +330,7 @@ way."
     ;; All except copy will need a delete
     (gnus-registry-delete-group id from)
 
-    (when (equal 'copy action) 
+    (when (equal 'copy action)
       (gnus-registry-add-group id from subject sender)) ; undo the delete
 
     (gnus-registry-add-group id to subject sender)))
@@ -350,7 +350,7 @@ way."
   "Split this message into the same group as its parent.  The parent
 is obtained from the registry.  This function can be used as an entry
 in `nnmail-split-fancy' or `nnimap-split-fancy', for example like
-this: (: gnus-registry-split-fancy-with-parent) 
+this: (: gnus-registry-split-fancy-with-parent)
 
 This function tracks ALL backends, unlike
 `nnmail-split-fancy-with-parent' which tracks only nnmail
@@ -381,7 +381,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
                    (when (or (gnus-registry-grep-in-list
                               res
                               gnus-registry-unfollowed-groups)
-                             (gnus-registry-grep-in-list 
+                             (gnus-registry-grep-in-list
                               res
                               nnmail-split-fancy-with-parent-ignore-groups))
                      (setq res nil)))
@@ -421,7 +421,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
                   (< gnus-registry-minimum-subject-length (length subject)))
          (maphash
           (lambda (key value)
-            (let ((this-subject (cdr 
+            (let ((this-subject (cdr
                                  (gnus-registry-fetch-extra key 'subject))))
               (when (and single-match
                          this-subject
@@ -453,13 +453,13 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
 
     (when (and res gnus-registry-use-long-group-names)
       (let ((m1 (gnus-find-method-for-group res))
-           (m2 (or gnus-command-method 
+           (m2 (or gnus-command-method
                    (gnus-find-method-for-group gnus-newsgroup-name)))
            (short-res (gnus-group-short-name res)))
       (if (gnus-methods-equal-p m1 m2)
          (progn
            (gnus-message
-            9 
+            9
             "gnus-registry-split-fancy-with-parent stripped group %s to %s"
             res
             short-res)
@@ -478,9 +478,9 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
     (dolist (article gnus-newsgroup-articles)
       (let ((id (gnus-registry-fetch-message-id-fast article)))
        (unless (gnus-registry-fetch-group id)
-         (gnus-message 9 "Registry: Registering article %d with group %s" 
+         (gnus-message 9 "Registry: Registering article %d with group %s"
                        article gnus-newsgroup-name)
-         (gnus-registry-add-group 
+         (gnus-registry-add-group
           (gnus-registry-fetch-message-id-fast article)
           gnus-newsgroup-name
           (gnus-registry-fetch-simplified-message-subject-fast article)
@@ -519,7 +519,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
   (when word
     (memq nil
          (mapcar 'not
-                 (mapcar 
+                 (mapcar
                   (lambda (x)
                     (string-match x word))
                   list)))))
@@ -555,7 +555,7 @@ Update the entry cache if needed."
 
          ;; get the entree from the hash table or from the alist
          (setq entree (gethash id entry-cache)))
-       
+
        (unless entree
          (setq entree (assq entry alist))
          (when gnus-registry-entry-caching
@@ -596,8 +596,8 @@ 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 (if gnus-registry-use-long-group-names 
-                      crumb 
+         (return (if gnus-registry-use-long-group-names
+                      crumb
                     (gnus-group-short-name crumb))))))))
 
 (defun gnus-registry-group-count (id)
@@ -621,7 +621,9 @@ Returns the first place where the trail finds a group name."
       (when gnus-registry-trim-articles-without-groups
        (unless (gnus-registry-group-count id)
          (gnus-registry-delete-id id)))
-      (gnus-registry-store-extra-entry id 'mtime (current-time)))))
+      ;; is this ID still in the registry?
+      (when (gethash id gnus-registry-hashtb)
+       (gnus-registry-store-extra-entry id 'mtime (current-time))))))
 
 (defun gnus-registry-delete-id (id)
   "Delete a message ID from the registry."
@@ -639,8 +641,8 @@ Returns the first place where the trail finds a group name."
     (when (and id
               (not (string-match "totally-fudged-out-message-id" id)))
       (let ((full-group group)
-           (group (if gnus-registry-use-long-group-names 
-                      group 
+           (group (if gnus-registry-use-long-group-names
+                      group
                     (gnus-group-short-name group))))
        (gnus-registry-delete-group id group)
 
@@ -656,16 +658,16 @@ Returns the first place where the trail finds a group name."
          (when (and (gnus-registry-track-subject-p)
                     subject)
            (gnus-registry-store-extra-entry
-            id 
-            'subject 
+            id
+            'subject
             (gnus-registry-simplify-subject subject)))
          (when (and (gnus-registry-track-sender-p)
                     sender)
            (gnus-registry-store-extra-entry
-            id 
+            id
             'sender
             sender))
-         
+
          (gnus-registry-store-extra-entry id 'mtime (current-time)))))))
 
 (defun gnus-registry-clear ()
@@ -686,11 +688,11 @@ Returns the first place where the trail finds a group name."
 (defun gnus-registry-install-hooks ()
   "Install the registry hooks."
   (interactive)
-  (add-hook 'gnus-summary-article-move-hook 'gnus-registry-action) 
+  (add-hook 'gnus-summary-article-move-hook 'gnus-registry-action)
   (add-hook 'gnus-summary-article-delete-hook 'gnus-registry-action)
   (add-hook 'gnus-summary-article-expire-hook 'gnus-registry-action)
   (add-hook 'nnmail-spool-hook 'gnus-registry-spool-action)
-  
+
   (add-hook 'gnus-save-newsrc-hook 'gnus-registry-save)
   (add-hook 'gnus-read-newsrc-el-hook 'gnus-registry-read)
 
@@ -699,11 +701,11 @@ Returns the first place where the trail finds a group name."
 (defun gnus-registry-unload-hook ()
   "Uninstall the registry hooks."
   (interactive)
-  (remove-hook 'gnus-summary-article-move-hook 'gnus-registry-action) 
+  (remove-hook 'gnus-summary-article-move-hook 'gnus-registry-action)
   (remove-hook 'gnus-summary-article-delete-hook 'gnus-registry-action)
   (remove-hook 'gnus-summary-article-expire-hook 'gnus-registry-action)
   (remove-hook 'nnmail-spool-hook 'gnus-registry-spool-action)
-  
+
   (remove-hook 'gnus-save-newsrc-hook 'gnus-registry-save)
   (remove-hook 'gnus-read-newsrc-el-hook 'gnus-registry-read)