Synch to Gnus 200311122054.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 00bd968..ceca12f 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,33 @@
+2003-11-12  Teodor Zlatanov  <tzz@lifelogs.com>
+
+       * nnml.el (nnml-request-accept-article): pass sender to
+       nnmail-cache-insert
+
+       * nnmh.el (nnmh-request-accept-article): pass sender to
+       nnmail-cache-insert 
+
+       * nnmbox.el (nnmbox-request-accept-article): pass sender to
+       nnmail-cache-insert 
+
+       * nnfolder.el (nnfolder-request-accept-article): pass sender to
+       nnmail-cache-insert 
+
+       * nnbabyl.el (nnbabyl-request-accept-article): pass sender to
+       nnmail-cache-insert 
+
+       * nnmail.el (nnmail-cache-insert): accept sender parameter and
+       pass it to the nnmail-spool-hook
+
+       * gnus-registry.el (gnus-registry-track-extra): clarify doc
+       (gnus-registry-action): add sender lexical var and pass it to
+       gnus-registry-add-group
+       (gnus-registry-spool-action): take a sender parameter, pass to
+       gnus-registry-add-group
+       (gnus-registry-split-fancy-with-parent): trace by sender in
+       addition to subject
+       (gnus-registry-fetch-sender-fast): new function
+       (gnus-registry-add-group): accept sender parameter
+
 2003-11-11  Teodor Zlatanov  <tzz@lifelogs.com>
 
        * spam.el (spam-ham-copy-routine, spam-ham-move-routine)

diff --git a/lisp/gnus-registry.el b/lisp/gnus-registry.el
index 18f6121..4291782 100644 (file)
--- a/lisp/gnus-registry.el
+++ b/lisp/gnus-registry.el
@@ -95,8 +95,8 @@ Registry entries are considered empty when they have no groups."
 
 (defcustom gnus-registry-track-extra nil
   "Whether the registry should track other things about a message.
-The Subject header is currently the only thing that can be
-tracked this way."
+The Subject and Sender (From:) headers are currently tracked this
+way."
   :group 'gnus-registry
   :type 'boolean)
 
@@ -301,10 +301,11 @@ tracked this way."
   (let* ((id (mail-header-id data-header))
         (subject (gnus-registry-simplify-subject 
                   (mail-header-subject data-header)))
-       (from (gnus-group-guess-full-name-from-command-method from))
-       (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)))
+        (sender (mail-header-from data-header))
+        (from (gnus-group-guess-full-name-from-command-method from))
+        (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"
                  id
                  (if method "respooling" "going")
@@ -315,18 +316,18 @@ tracked this way."
     (gnus-registry-delete-group id from)
 
     (when (equal 'copy action) 
-      (gnus-registry-add-group id from subject)) ; undo the delete
+      (gnus-registry-add-group id from subject sender)) ; undo the delete
 
-    (gnus-registry-add-group id to subject)))
+    (gnus-registry-add-group id to subject sender)))
 
-(defun gnus-registry-spool-action (id group &optional subject)
+(defun gnus-registry-spool-action (id group &optional subject sender)
   (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"
                  id
                  group)
-    (gnus-registry-add-group id group subject)))
+    (gnus-registry-add-group id group subject sender)))
 
 ;; Function for nn{mail|imap}-split-fancy: look up all references in
 ;; the cache and if a match is found, return that group.
@@ -363,7 +364,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
                  references))
       ;; there were no references, now try the extra tracking
       (when gnus-registry-track-extra
-       (let ((subject (gnus-registry-simplify-subject 
+       (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)))
@@ -381,6 +383,22 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
                    "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)))))
     (gnus-message
      5 
@@ -419,7 +437,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
          (gnus-registry-add-group 
           (gnus-registry-fetch-message-id-fast article)
           gnus-newsgroup-name
-          (gnus-registry-fetch-simplified-message-subject-fast article)))))))
+          (gnus-registry-fetch-simplified-message-subject-fast article)
+          (gnus-registry-fetch-sender-fast article)))))))
 
 (defun gnus-registry-fetch-message-id-fast (article)
   "Fetch the Message-ID quickly, using the internal gnus-data-list function"
@@ -442,6 +461,14 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
                             (assoc article (gnus-data-list nil)))))
     nil))
 
+(defun gnus-registry-fetch-sender-fast (article)
+  "Fetch the Sender quickly, using the internal gnus-data-list function"
+  (if (and (numberp article)
+          (assoc article (gnus-data-list nil)))
+      (mail-header-from (gnus-data-header
+                        (assoc article (gnus-data-list nil))))
+    nil))
+
 (defun gnus-registry-grep-in-list (word list)
   (when word
     (memq nil
@@ -560,7 +587,7 @@ Returns the first place where the trail finds a group name."
         (remhash id value)))
      gnus-registry-hashtb)))
 
-(defun gnus-registry-add-group (id group &optional subject)
+(defun gnus-registry-add-group (id group &optional subject sender)
   "Add a group for a message, based on the message ID."
   (when group
     (when (and id
@@ -580,11 +607,17 @@ Returns the first place where the trail finds a group name."
                        (list group))
                   gnus-registry-hashtb)
 
-         (when gnus-registry-track-extra 
-           (gnus-registry-store-extra-entry 
-            id 
-            'subject 
-            (gnus-registry-simplify-subject subject)))
+         (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)))
          
          (gnus-registry-store-extra-entry id 'mtime (current-time)))))))
 

diff --git a/lisp/nnbabyl.el b/lisp/nnbabyl.el
index 62fc067..0dd568d 100644 (file)
--- a/lisp/nnbabyl.el
+++ b/lisp/nnbabyl.el
@@ -352,7 +352,8 @@
        (when nnmail-cache-accepted-message-ids
         (nnmail-cache-insert (nnmail-fetch-field "message-id") 
                              group
-                             (nnmail-fetch-field "subject")))
+                             (nnmail-fetch-field "subject")
+                             (nnmail-fetch-field "from")))
        (setq result
             (if (stringp group)
                 (list (cons group (nnbabyl-active-number group)))
@@ -370,7 +371,8 @@
         (when nnmail-cache-accepted-message-ids
           (nnmail-cache-insert (nnmail-fetch-field "message-id") 
                                group
-                               (nnmail-fetch-field "subject")))
+                               (nnmail-fetch-field "subject")
+                               (nnmail-fetch-field "from")))
         (save-buffer)
         (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))
        result))))

diff --git a/lisp/nnfolder.el b/lisp/nnfolder.el
index 8f16553..1102078 100644 (file)
--- a/lisp/nnfolder.el
+++ b/lisp/nnfolder.el
@@ -528,7 +528,8 @@ the group.  Then the marks file will be regenerated properly by Gnus.")
        (when nnmail-cache-accepted-message-ids
          (nnmail-cache-insert (nnmail-fetch-field "message-id") 
                               group
-                              (nnmail-fetch-field "subject")))
+                              (nnmail-fetch-field "subject")
+                              (nnmail-fetch-field "from")))
        (setq result (if (stringp group)
                         (list (cons group (nnfolder-active-number group)))
                       (setq art-group

diff --git a/lisp/nnmail.el b/lisp/nnmail.el
index 6912cf3..8665edf 100644 (file)
--- a/lisp/nnmail.el
+++ b/lisp/nnmail.el
@@ -1496,12 +1496,12 @@ See the documentation for the variable `nnmail-split-fancy' for details."
 (defvar group)
 (defvar group-art-list)
 (defvar group-art)
-(defun nnmail-cache-insert (id grp &optional subject)
+(defun nnmail-cache-insert (id grp &optional subject sender)
   (when (stringp id)
     ;; this will handle cases like `B r' where the group is nil
     (let ((grp (or grp gnus-newsgroup-name "UNKNOWN")))
       (run-hook-with-args 'nnmail-spool-hook 
-                         id grp subject))
+                         id grp subject sender))
     (when nnmail-treat-duplicates
       ;; Store some information about the group this message is written
       ;; to.  This is passed in as the grp argument -- all locations this

diff --git a/lisp/nnmbox.el b/lisp/nnmbox.el
index 20d49d4..efa5e5a 100644 (file)
--- a/lisp/nnmbox.el
+++ b/lisp/nnmbox.el
@@ -335,7 +335,8 @@
        (when nnmail-cache-accepted-message-ids
         (nnmail-cache-insert (nnmail-fetch-field "message-id") 
                              group
-                             (nnmail-fetch-field "subject")))
+                             (nnmail-fetch-field "subject")
+                             (nnmail-fetch-field "from")))
        (setq result (if (stringp group)
                        (list (cons group (nnmbox-active-number group)))
                      (nnmail-article-group 'nnmbox-active-number)))

diff --git a/lisp/nnmh.el b/lisp/nnmh.el
index 0d3623d..cfefeb4 100644 (file)
--- a/lisp/nnmh.el
+++ b/lisp/nnmh.el
@@ -327,7 +327,8 @@ as unread by Gnus.")
   (when nnmail-cache-accepted-message-ids
     (nnmail-cache-insert (nnmail-fetch-field "message-id") 
                         group
-                        (nnmail-fetch-field "subject")))
+                        (nnmail-fetch-field "subject")
+                        (nnmail-fetch-field "from")))
   (nnheader-init-server-buffer)
   (prog1
       (if (stringp group)

diff --git a/lisp/nnml.el b/lisp/nnml.el
index f59c7c7..9657e78 100644 (file)
--- a/lisp/nnml.el
+++ b/lisp/nnml.el
@@ -377,7 +377,8 @@ marks file will be regenerated properly by Gnus.")
     (when nnmail-cache-accepted-message-ids
       (nnmail-cache-insert (nnmail-fetch-field "message-id") 
                           group
-                          (nnmail-fetch-field "subject")))
+                          (nnmail-fetch-field "subject")
+                          (nnmail-fetch-field "from")))
     (if (stringp group)
        (and
         (nnmail-activate 'nnml)