[Emacs-diffs] /srv/bzr/emacs/trunk r103961: gnus-registry.el (gnus-registry--split-fancy-with-parent-internal): Fix loop bugs.

[Katsumi Yamaoka]

------------------------------------------------------------
revno: 103961
author: Teodor Zlatanov <address@hidden>
committer: Katsumi Yamaoka <address@hidden>
branch nick: trunk
timestamp: Wed 2011-04-20 22:12:08 +0000
message:
  gnus-registry.el (gnus-registry--split-fancy-with-parent-internal): Fix loop 
bugs.
   (gnus-registry-ignored-groups): New variable.
   (gnus-registry-ignore-group-p): Use it.
   (gnus-registry-handle-action): Use `gnus-registry-ignore-group-p' and set 
the destination group to nil (same as delete) if it's ignored.
modified:
  lisp/gnus/ChangeLog
  lisp/gnus/gnus-registry.el

=== modified file 'lisp/gnus/ChangeLog'
--- a/lisp/gnus/ChangeLog       2011-04-20 00:43:48 +0000
+++ b/lisp/gnus/ChangeLog       2011-04-20 22:12:08 +0000
@@ -1,3 +1,12 @@
+2011-04-20  Teodor Zlatanov  <address@hidden>
+
+       * gnus-registry.el
+       (gnus-registry--split-fancy-with-parent-internal): Fix loop bugs.
+       (gnus-registry-ignored-groups): New variable.
+       (gnus-registry-ignore-group-p): Use it.
+       (gnus-registry-handle-action): Use `gnus-registry-ignore-group-p' and
+       set the destination group to nil (same as delete) if it's ignored.
+
 2011-04-20  Katsumi Yamaoka  <address@hidden>
 
        * gnus-registry.el (gnus-registry-action)

=== modified file 'lisp/gnus/gnus-registry.el'
--- a/lisp/gnus/gnus-registry.el        2011-04-20 00:43:48 +0000
+++ b/lisp/gnus/gnus-registry.el        2011-04-20 22:12:08 +0000
@@ -137,6 +137,16 @@
   :group 'gnus-registry
   :type '(repeat regexp))
 
+(defcustom gnus-registry-ignored-groups
+  '("delayed$" "drafts$" "queue$" "INBOX$" "^nnmairix:" "archive")
+  "List of groups that the Gnus Registry will ignore.
+The group names are matched, they don't have to be fully
+qualified.
+
+nnmairix groups are specifically excluded because they are ephemeral."
+  :group 'gnus-registry
+  :type '(repeat regexp))
+
 (defcustom gnus-registry-install 'ask
   "Whether the registry should be installed."
   :group 'gnus-registry
@@ -341,6 +351,8 @@
    10
    "gnus-registry-handle-action %S" (list id from to subject sender 
recipients))
   (let ((db gnus-registry-db)
+        ;; if the group is ignored, set the destination to nil (same as delete)
+        (to (if (gnus-registry-ignore-group-p to) nil to))
         ;; safe if not found
         (entry (gnus-registry-get-or-make-entry id))
         (subject (gnus-string-remove-all-properties
@@ -442,8 +454,10 @@
         (gnus-message 9 "%s is looking up %s" log-agent reference)
         (loop for group in (gnus-registry-get-id-key reference 'group)
               when (gnus-registry-follow-group-p group)
-              do (gnus-message 7 "%s traced %s to %s" log-agent reference 
group)
-              do (push group found)))
+              do
+              (progn
+                (gnus-message 7 "%s traced %s to %s" log-agent reference 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
@@ -468,7 +482,7 @@
                          (if gnus-registry-track-extra 7 9)
                          "%s (extra tracking) traced subject '%s' to %s"
                          log-agent subject group)
-                     collect group))
+                    and collect group))
          ;; filter the found groups and return them
          ;; the found groups are NOT the full groups
          (setq found (gnus-registry-post-process-groups
@@ -495,7 +509,7 @@
                          (if gnus-registry-track-extra 7 9)
                          "%s (extra tracking) traced sender '%s' to %s"
                          log-agent sender group)
-                     collect group)))
+                     and collect group)))
 
        ;; filter the found groups and return them
        ;; the found groups are NOT the full groups
@@ -525,7 +539,7 @@
                              (if gnus-registry-track-extra 7 9)
                              "%s (extra tracking) traced recipient '%s' to %s"
                              log-agent recp group)
-                         collect group)))))
+                        and collect group)))))
 
        ;; filter the found groups and return them
        ;; the found groups are NOT the full groups
@@ -641,6 +655,18 @@
                  group
                  nnmail-split-fancy-with-parent-ignore-groups)))))
 
+(defun gnus-registry-ignore-group-p (group)
+  "Determines if a group name should be ignored.
+Consults `gnus-registry-ignored-groups' and
+`nnmail-split-fancy-with-parent-ignore-groups'."
+  (and group
+       (not (or (gnus-grep-in-list
+                 group
+                 gnus-registry-ignored-groups)
+                (gnus-grep-in-list
+                 group
+                 nnmail-split-fancy-with-parent-ignore-groups)))))
+
 (defun gnus-registry-wash-for-keywords (&optional force)
   "Get the keywords of the current article.
 Overrides existing keywords with FORCE set non-nil."