Synch to No Gnus 200405122100.

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

diff --git a/lisp/gnus-registry.el b/lisp/gnus-registry.el
index 30060b4..a84ea83 100644 (file)
--- a/lisp/gnus-registry.el
+++ b/lisp/gnus-registry.el
@@ -24,11 +24,11 @@
 
 ;;; Commentary:
 
-;; This is the gnus-registry.el package, works with other backends
-;; besides nnmail.  The major issue is that it doesn't go across
-;; backends, so for instance if an article is in nnml:sys and you see
-;; a reference to it in nnimap splitting, the article will end up in
-;; nnimap:sys
+;; This is the gnus-registry.el package, which works with all
+;; backends, not just nnmail (e.g. NNTP).  The major issue is that it
+;; doesn't go across backends, so for instance if an article is in
+;; nnml:sys and you see a reference to it in nnimap splitting, the
+;; article will end up in nnimap:sys
 
 ;; gnus-registry.el intercepts article respooling, moving, deleting,
 ;; and copying for all backends.  If it doesn't work correctly for
@@ -84,7 +84,8 @@ The group names are matched, they don't have to be fully qualified."
 
 (defcustom gnus-registry-clean-empty t
   "Whether the empty registry entries should be deleted.
-Registry entries are considered empty when they have no groups."
+Registry entries are considered empty when they have no groups
+and no extra data."
   :group 'gnus-registry
   :type 'boolean)
 
@@ -212,7 +213,7 @@ way."
 ;; 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 5 "Adding whitespace to %s" filename)
+  (gnus-message 7 "Adding whitespace to %s" filename)
   (save-excursion
     (goto-char (point-min))
     (while (re-search-forward "^(\\|(\\\"" nil t)
@@ -248,7 +249,11 @@ way."
   (let ((count 0))
     (maphash
      (lambda (key value)
-       (unless (gnus-registry-fetch-group key)
+       (unless (or
+               (gnus-registry-fetch-group key)
+               ;; TODO: look for specific extra data here!
+               ;; in this example, we look for 'label
+               (gnus-registry-fetch-extra key 'label)) 
         (incf count)
         (remhash key gnus-registry-hashtb)))
      gnus-registry-hashtb)
@@ -311,7 +316,7 @@ way."
         (to (if to (gnus-group-guess-full-name-from-command-method to) nil))
         (to-name (if to to "the Bit Bucket"))
         (old-entry (gethash id gnus-registry-hashtb)))
-    (gnus-message 5 "Registry: article %s %s from %s to %s"
+    (gnus-message 7 "Registry: article %s %s from %s to %s"
                  id
                  (if method "respooling" "going")
                  from
@@ -329,7 +334,7 @@ way."
   (let ((group (gnus-group-guess-full-name-from-command-method group)))
     (when (and (stringp id) (string-match "\r$" id))
       (setq id (substring id 0 -1)))
-    (gnus-message 5 "Registry: article %s spooled to %s"
+    (gnus-message 7 "Registry: article %s spooled to %s"
                  id
                  group)
     (gnus-registry-add-group id group subject sender)))
@@ -394,7 +399,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
                 (when (and sender res)
                   (gnus-message
                    ;; raise level of messaging if gnus-registry-track-extra
-                   (if gnus-registry-track-extra 5 9)
+                   (if gnus-registry-track-extra 7 9)
                    "%s (extra tracking) traced sender %s to group %s"
                    "gnus-registry-split-fancy-with-parent"
                    sender
@@ -418,7 +423,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
                 (when (and subject res)
                   (gnus-message
                    ;; raise level of messaging if gnus-registry-track-extra
-                   (if gnus-registry-track-extra 5 9)
+                   (if gnus-registry-track-extra 7 9)
                    "%s (extra tracking) traced subject %s to group %s"
                    "gnus-registry-split-fancy-with-parent"
                    subject
@@ -426,7 +431,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
           gnus-registry-hashtb))
        (unless single-match
          (gnus-message
-          5
+          3
           "gnus-registry-split-fancy-with-parent: too many extra matches for %s"
           refstr)
          (setq res nil))))
@@ -451,7 +456,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
            (setq res short-res))
        ;; else...
        (gnus-message
-        5 
+        7
         "gnus-registry-split-fancy-with-parent ignored foreign group %s"
         res)
        (setq res nil))))