Registry extra tracking bug fix: map references to group names.

* gnus-registry.el (gnus-registry--split-fancy-with-parent-internal): Map
references to actual group names with sender and subject tracking.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 4150693..51a8ef3 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,13 +1,5 @@
 2011-04-05  Teodor Zlatanov  <tzz@lifelogs.com>
 
-       * registry.el (registry-db, initialize-instance): Set up constructor
-       instead of :initform arguments for the sake of older Emacsen.
-       (registry-lookup-breaks-before-lexbind): New method to demonstrate
-       pre-lexbind merge bug.
-       (registry-usage-test): Use it.
-       (initialize-instance, registry-db): Move the non-function initforms
-       back to the class definition.
-
        * gnus-registry.el (gnus-registry-fixup-registry): New function to
        fixup the parameters that can be customized by the user between
        save/read cycles.
@@ -15,10 +7,19 @@
        (gnus-registry-make-db): Use it.
        (gnus-registry-spool-action, gnus-registry-handle-action): Fix
        messaging.
-       (gnus-registry--split-fancy-with-parent-internal): Fix loop.
+       (gnus-registry--split-fancy-with-parent-internal): Fix loop.  Map
+       references to actual group names with sender and subject tracking.
        (gnus-registry-post-process-groups): Use `cond' for better messaging.
        (gnus-registry-usage-test): Add subject lookup test.
 
+       * registry.el (registry-db, initialize-instance): Set up constructor
+       instead of :initform arguments for the sake of older Emacsen.
+       (registry-lookup-breaks-before-lexbind): New method to demonstrate
+       pre-lexbind merge bug.
+       (registry-usage-test): Use it.
+       (initialize-instance, registry-db): Move the non-function initforms
+       back to the class definition.
+
 2011-04-03  Teodor Zlatanov  <tzz@lifelogs.com>
 
        * registry.el: New library to manage gnus-registry-style data.

diff --git a/lisp/gnus-registry.el b/lisp/gnus-registry.el
index 504e39a..3ab8400 100644 (file)
--- a/lisp/gnus-registry.el
+++ b/lisp/gnus-registry.el
@@ -424,18 +424,21 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
            (gnus-grep-in-list
             sender
             gnus-registry-unfollowed-addresses))
-      (setq found
-            (loop for group
-                  in (registry-lookup-secondary-value db 'sender sender)
-
-                  when (gnus-registry-follow-group-p group)
-
+      (let ((groups (apply
+                     'append
+                     (mapcar
+                      (lambda (reference)
+                        (gnus-registry-get-id-key reference 'group))
+                      (registry-lookup-secondary-value db 'sender sender)))))
+        (setq found
+              (loop for group in groups
+                    when (gnus-registry-follow-group-p group)
                   do (gnus-message
                       ;; raise level of messaging if gnus-registry-track-extra
                       (if gnus-registry-track-extra 7 9)
                       "%s (extra tracking) traced sender '%s' to groups %s"
                       log-agent sender found)
-                  collect group))
+                  collect group)))
 
       ;; filter the found groups and return them
       ;; the found groups are NOT the full groups
@@ -446,22 +449,25 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
      ((and (memq 'subject gnus-registry-track-extra)
            subject
            (< gnus-registry-minimum-subject-length (length subject)))
-      (setq found
-            (loop for group
-                  in (registry-lookup-secondary-value db 'subject subject)
-
-                  when (gnus-registry-follow-group-p group)
-
-                  do (gnus-message
-                      ;; raise level of messaging if gnus-registry-track-extra
-                      (if gnus-registry-track-extra 7 9)
-                      "%s (extra tracking) traced subject '%s' to groups %s"
-                      log-agent subject found)
-                  collect group))
+      (let ((groups (apply
+                     'append
+                     (mapcar
+                      (lambda (reference)
+                        (gnus-registry-get-id-key reference 'group))
+                      (registry-lookup-secondary-value db 'subject subject)))))
+        (setq found
+              (loop for group in groups
+                    when (gnus-registry-follow-group-p group)
+                    do (gnus-message
+                        ;; raise level of messaging if gnus-registry-track-extra
+                        (if gnus-registry-track-extra 7 9)
+                        "%s (extra tracking) traced subject '%s' to groups %s"
+                        log-agent subject found)
+                    collect group))
       ;; 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)))))
     ;; after the (cond) we extract the actual value safely
     (car-safe found)))