diff options
Diffstat (limited to 'lisp/gnus/gnus-registry.el')
| -rw-r--r-- | lisp/gnus/gnus-registry.el | 52 |
1 files changed, 45 insertions, 7 deletions
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index fd08d4d1e3..93ee0efce8 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -161,6 +161,17 @@ way." (const :tag "Track by subject (Subject: header)" subject) (const :tag "Track by sender (From: header)" sender))) +(defcustom gnus-registry-split-strategy nil + "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 + '(choice :tag "Tracking choices" + (const :tag "Only use single choices, discard multiple matches" nil) + (const :tag "Majority of matches wins" majority) + (const :tag "First found wins" first))) + (defcustom gnus-registry-entry-caching t "Whether the registry should cache extra information." :group 'gnus-registry @@ -486,7 +497,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." nnmail-split-fancy-with-parent-ignore-groups (list nnmail-split-fancy-with-parent-ignore-groups))) (log-agent "gnus-registry-split-fancy-with-parent") - found) + found found-full) ;; this is a big if-else statement. it uses ;; gnus-registry-post-process-groups to filter the results after @@ -507,9 +518,10 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." log-agent reference refstr group) (push group found)))) ;; filter the found groups and return them + ;; the found groups are the full groups (setq found (gnus-registry-post-process-groups - "references" refstr found))) - + "references" refstr found found))) + ;; else: there were no matches, now try the extra tracking by sender ((and (gnus-registry-track-sender-p) sender) @@ -522,6 +534,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (equal sender this-sender)) (let ((groups (gnus-registry-fetch-groups key))) (dolist (group groups) + (push group found-full) (setq found (append (list group) (delete group found))))) (push key matches) (gnus-message @@ -531,7 +544,9 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." log-agent sender found matches)))) gnus-registry-hashtb) ;; filter the found groups and return them - (setq found (gnus-registry-post-process-groups "sender" sender found))) + ;; the found groups are NOT the full groups + (setq found (gnus-registry-post-process-groups + "sender" sender found found-full))) ;; else: there were no matches, now try the extra tracking by subject ((and (gnus-registry-track-subject-p) @@ -546,6 +561,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (equal subject this-subject)) (let ((groups (gnus-registry-fetch-groups key))) (dolist (group groups) + (push group found-full) (setq found (append (list group) (delete group found))))) (push key matches) (gnus-message @@ -555,10 +571,13 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." log-agent subject found matches)))) gnus-registry-hashtb) ;; filter the found groups and return them + ;; the found groups are NOT the full groups (setq found (gnus-registry-post-process-groups - "subject" subject found)))))) + "subject" subject found found-full)))) + ;; after the (cond) we extract the actual value safely + (car-safe found))) -(defun gnus-registry-post-process-groups (mode key groups) +(defun gnus-registry-post-process-groups (mode key groups groups-full) "Modifies GROUPS found by MODE for KEY to determine which ones to follow. MODE can be 'subject' or 'sender' for example. The KEY is the @@ -572,9 +591,28 @@ This is not possible if gnus-registry-use-long-group-names is false. Foreign methods are not supported so they are rejected. Reduces the list to a single group, or complains if that's not -possible." +possible. Uses `gnus-registry-split-strategy' and GROUPS-FULL if +necessary." (let ((log-agent "gnus-registry-post-process-group") out) + + ;; the strategy can be 'first, 'majority, or nil + (when (eq gnus-registry-split-strategy 'first) + (when groups + (setq groups (list (car-safe groups))))) + + (when (eq gnus-registry-split-strategy 'majority) + (let ((freq (make-hash-table + :size 256 + :test 'equal))) + (mapc (lambda(x) (puthash x (1+ (gethash x freq 0)) freq)) groups-full) + (setq groups (list (car-safe + (sort + groups + (lambda (a b) + (> (gethash a freq 0) + (gethash b freq 0))))))))) + (if gnus-registry-use-long-group-names (dolist (group groups) (let ((m1 (gnus-find-method-for-group group)) |