* mail-source.el: Load auth-source.el.

[gnus] / lisp / gnus-registry.el

diff --git a/lisp/gnus-registry.el b/lisp/gnus-registry.el
index 687a8a2..93ee0ef 100644 (file)
--- a/lisp/gnus-registry.el
+++ b/lisp/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))
@@ -1123,5 +1161,5 @@ Returns the first place where the trail finds a group name."
 
 (provide 'gnus-registry)
 
-;;; arch-tag: 5cba0a32-718a-4a97-8c91-0a15af21da94
+;; arch-tag: 5cba0a32-718a-4a97-8c91-0a15af21da94
 ;;; gnus-registry.el ends here