[Emacs-diffs] Changes to emacs/lisp/gnus/gnus-registry.el,v

[Miles Bader]

CVSROOT:        /cvsroot/emacs
Module name:    emacs
Changes by:     Miles Bader <miles>     08/04/26 04:29:42

Index: gnus-registry.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/gnus/gnus-registry.el,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -b -r1.26 -r1.27
--- gnus-registry.el    21 Apr 2008 07:13:24 -0000      1.26
+++ gnus-registry.el    26 Apr 2008 04:29:41 -0000      1.27
@@ -161,6 +161,17 @@
     (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 @@
              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,8 +518,9 @@
             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) 
@@ -522,6 +534,7 @@
                      (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 @@
              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 @@
                      (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 @@
              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 @@
 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))