From: Teodor Zlatanov Date: Wed, 12 Nov 2003 20:54:36 +0000 (+0000) Subject: nnml.el (nnml-request-accept-article): pass sender to X-Git-Url: http://cgit.sxemacs.org/?a=commitdiff_plain;h=155db966d0279aab708a6c061b42483da01ff581;p=gnus 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 --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 00bd9681c..ceca12f34 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,33 @@ +2003-11-12 Teodor Zlatanov + + * 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 * spam.el (spam-ham-copy-routine, spam-ham-move-routine) diff --git a/lisp/gnus-registry.el b/lisp/gnus-registry.el index 18f61217c..429178264 100644 --- 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 256a7651e..9a1b3535c 100644 --- a/lisp/nnbabyl.el +++ b/lisp/nnbabyl.el @@ -351,7 +351,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))) @@ -369,7 +370,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 ae1d69674..4ac87bc2b 100644 --- a/lisp/nnfolder.el +++ b/lisp/nnfolder.el @@ -526,7 +526,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 f474d2496..c602effb3 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -1495,12 +1495,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 3a26f16fd..8afd19a31 100644 --- a/lisp/nnmbox.el +++ b/lisp/nnmbox.el @@ -333,7 +333,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 05a40a04b..414f20ab4 100644 --- a/lisp/nnmh.el +++ b/lisp/nnmh.el @@ -318,7 +318,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 7bba9a5a7..0767962ae 100644 --- a/lisp/nnml.el +++ b/lisp/nnml.el @@ -371,7 +371,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)