* gnus-registry.el (gnus-registry-track-extra): make it a set of

choices instead of a boolean
(gnus-registry-track-subject-p, gnus-registry-track-sender-p):
new convenience functions
(gnus-registry-split-fancy-with-parent): use convenience
functions, also don't return extra tracking info if sender or
subject is found in more than one groups
(gnus-registry-add-group): use new convenience functions to
decide if sender and subject should be tracked

* gnus.el (ham-process-destination): add 'respool option,
unused by spam.el yet

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 2f5e194..c2e70d5 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,18 @@
+2003-11-19  Teodor Zlatanov  <tzz@lifelogs.com>
+
+       * gnus-registry.el (gnus-registry-track-extra): make it a set of
+       choices instead of a boolean
+       (gnus-registry-track-subject-p, gnus-registry-track-sender-p):
+       new convenience functions
+       (gnus-registry-split-fancy-with-parent): use convenience
+       functions, also don't return extra tracking info if sender or
+       subject is found in more than one groups
+       (gnus-registry-add-group): use new convenience functions to
+       decide if sender and subject should be tracked
+
+       * gnus.el (ham-process-destination): add 'respool option,
+       unused by spam.el yet
+
 2003-11-19  Katsumi Yamaoka  <yamaoka@jpl.org>
 
        * gnus-score.el (gnus-decay-score): Return a surely smaller value

diff --git a/lisp/gnus-registry.el b/lisp/gnus-registry.el
index 4291782..900eeab 100644 (file)
--- a/lisp/gnus-registry.el
+++ b/lisp/gnus-registry.el
@@ -94,11 +94,14 @@ Registry entries are considered empty when they have no groups."
   :type 'boolean)
 
 (defcustom gnus-registry-track-extra nil
-  "Whether the registry should track other things about a message.
+  "Whether the registry should track extra data about a message.
 The Subject and Sender (From:) headers are currently tracked this
 way."
   :group 'gnus-registry
-  :type 'boolean)
+  :type      
+  '(set :tag "Tracking choices"
+    (const :tag "Track by subject (Subject: header)" subject)
+    (const :tag "Track by sender (From: header)"  sender)))
 
 (defcustom gnus-registry-entry-caching t
   "Whether the registry should cache extra information."
@@ -133,6 +136,12 @@ way."
     ;; alias puthash is missing from Emacs 20 cl-extra.el
     (defalias 'puthash 'cl-puthash)))
 
+(defun gnus-registry-track-subject-p ()
+  (memq 'subject gnus-registry-track-extra))
+
+(defun gnus-registry-track-sender-p ()
+  (memq 'sender gnus-registry-track-extra))
+
 (defun gnus-registry-cache-read ()
   "Read the registry cache file."
   (interactive)
@@ -362,44 +371,63 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
                               nnmail-split-fancy-with-parent-ignore-groups))
                      (setq res nil)))
                  references))
-      ;; there were no references, now try the extra tracking
-      (when gnus-registry-track-extra
-       (let ((sender (message-fetch-field "from"))
-             (subject (gnus-registry-simplify-subject
-                       (message-fetch-field "subject"))))
-         (when (and subject
-                    (< gnus-registry-minimum-subject-length (length subject)))
-           (maphash
-            (lambda (key value)
-              (let ((this-subject (cdr 
-                                   (gnus-registry-fetch-extra key 'subject))))
-                (when (and this-subject
-                           (equal subject this-subject))
-                  (setq res (gnus-registry-fetch-group key))
-                  (gnus-message
-                   ;; raise level of messaging if gnus-registry-track-extra
-                   (if gnus-registry-track-extra 5 9)
-                   "%s (extra tracking) traced subject %s to group %s"
-                   "gnus-registry-split-fancy-with-parent"
-                   subject
-                   (if res res "nil")))))
-            gnus-registry-hashtb))
-         (when sender
-           (maphash
-            (lambda (key value)
-              (let ((this-sender (cdr 
-                                   (gnus-registry-fetch-extra key 'sender))))
-                (when (and this-sender
-                           (equal sender this-sender))
-                  (setq res (gnus-registry-fetch-group key))
-                  (gnus-message
-                   ;; raise level of messaging if gnus-registry-track-extra
-                   (if gnus-registry-track-extra 5 9)
-                   "%s (extra tracking) traced sender %s to group %s"
-                   "gnus-registry-split-fancy-with-parent"
-                   sender
-                   (if res res "nil")))))
-            gnus-registry-hashtb)))))
+
+      ;; else: there were no references, now try the extra tracking
+      (let ((sender (message-fetch-field "from"))
+           (subject (gnus-registry-simplify-subject
+                     (message-fetch-field "subject")))
+           (single-match t))
+       (when (and single-match
+                  (gnus-registry-track-sender-p)
+                  sender)
+         (maphash
+          (lambda (key value)
+            (let ((this-sender (cdr 
+                                (gnus-registry-fetch-extra key 'sender))))
+              (when (and single-match
+                         this-sender
+                         (equal sender this-sender))
+                ;; too many matches, bail
+                (unless (equal res (gnus-registry-fetch-group key))
+                  (setq single-match nil))
+                (setq res (gnus-registry-fetch-group key))
+                (gnus-message
+                 ;; raise level of messaging if gnus-registry-track-extra
+                 (if gnus-registry-track-extra 5 9)
+                 "%s (extra tracking) traced sender %s to group %s"
+                 "gnus-registry-split-fancy-with-parent"
+                 sender
+                 (if res res "nil")))))
+          gnus-registry-hashtb))
+       (when (and single-match
+                  (gnus-registry-track-subject-p)
+                  subject
+                  (< gnus-registry-minimum-subject-length (length subject)))
+         (maphash
+          (lambda (key value)
+            (let ((this-subject (cdr 
+                                 (gnus-registry-fetch-extra key 'subject))))
+              (when (and single-match
+                         this-subject
+                         (equal subject this-subject))
+                ;; too many matches, bail
+                (unless (equal res (gnus-registry-fetch-group key))
+                  (setq single-match nil))
+                (setq res (gnus-registry-fetch-group key))
+                (gnus-message
+                 ;; raise level of messaging if gnus-registry-track-extra
+                 (if gnus-registry-track-extra 5 9)
+                 "%s (extra tracking) traced subject %s to group %s"
+                 "gnus-registry-split-fancy-with-parent"
+                 subject
+                 (if res res "nil")))))
+          gnus-registry-hashtb))
+       (unless single-match
+         (gnus-message
+          5
+          "gnus-registry-split-fancy-with-parent: too many extra matches for %s"
+          refstr)
+         (setq res nil))))
     (gnus-message
      5 
      "gnus-registry-split-fancy-with-parent traced %s to group %s"
@@ -607,17 +635,18 @@ Returns the first place where the trail finds a group name."
                        (list group))
                   gnus-registry-hashtb)
 
-         (when gnus-registry-track-extra
-           (when subject
-             (gnus-registry-store-extra-entry
-              id 
-              'subject 
-              (gnus-registry-simplify-subject subject)))
-           (when sender
-             (gnus-registry-store-extra-entry
-              id 
-              'sender
-              sender)))
+         (when (and (gnus-registry-track-subject-p)
+                    subject)
+           (gnus-registry-store-extra-entry
+            id 
+            'subject 
+            (gnus-registry-simplify-subject subject)))
+         (when (and (gnus-registry-track-sender-p)
+                    sender)
+           (gnus-registry-store-extra-entry
+            id 
+            'sender
+            sender))
          
          (gnus-registry-store-extra-entry id 'mtime (current-time)))))))
 

diff --git a/lisp/gnus.el b/lisp/gnus.el
index 5fa1720..d4f2193 100644 (file)
--- a/lisp/gnus.el
+++ b/lisp/gnus.el
@@ -1975,7 +1975,10 @@ mail groups."
      :tag "Destination for ham articles at summary exit from a spam group"
      (string :tag "Move to a group")
      (repeat :tag "Move to multiple groups"
-            (string :tag "Destination group"))
+            (choice
+             (string :tag "Destination group")
+             (const  :tag "Respool" respool)))
+     (const :tag "Respool" respool)
      (const :tag "Do nothing" nil))
    :function-document
    "Where ham articles will go at summary exit from a spam group."
@@ -1998,7 +2001,10 @@ mail groups, and only works in spam groups."
        :tag "Destination for ham articles at summary exit from spam group"
        (string :tag "Move to a group")
        (repeat :tag "Move to multiple groups"
-              (string :tag "Destination group"))
+              (choice
+               (string :tag "Destination group")
+               (const  :tag "Respool" respool)))
+       (const :tag "Respool" respool)
        (const :tag "Expire" nil))))
    :parameter-document
    "Where ham articles will go at summary exit from a spam group.")