From a2b9cb73d5f9e35fd4d3e95fa5458b5f85018182 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Wed, 19 Nov 2003 22:39:56 +0000 Subject: [PATCH] Synch to Gnus 200311192236. --- lisp/ChangeLog | 15 ++++++ lisp/gnus-registry.el | 131 ++++++++++++++++++++++++++++++------------------- lisp/gnus.el | 10 +++- 3 files changed, 103 insertions(+), 53 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2f5e194..c2e70d5 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,18 @@ +2003-11-19 Teodor Zlatanov + + * 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 * 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 --- 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 bc4db72..0262463 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -2013,7 +2013,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." @@ -2036,7 +2039,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.") -- 1.7.10.4