From: Teodor Zlatanov Date: Wed, 20 Apr 2011 22:12:08 +0000 (+0000) Subject: gnus-registry.el (gnus-registry--split-fancy-with-parent-internal): Fix loop bugs. X-Git-Tag: emacs-pretest-24.0.90~104^2~275^2~215^2~52 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=201133802956936332f1c4ce04eac42dfd1cf1c6;p=emacs.git 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. --- diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 35531df0ad2..73e7345e07d 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,12 @@ +2011-04-20 Teodor Zlatanov + + * 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 * gnus-registry.el (gnus-registry-action) diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index 009786dec80..21cec5f2b42 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -133,6 +133,16 @@ qualified. This parameter tells the Gnus registry 'never split a message into a group that matches one of these, regardless of references.' +nnmairix groups are specifically excluded because they are ephemeral." + :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)) @@ -341,6 +351,8 @@ This is not required after changing `gnus-registry-cache-file'." 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 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (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 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (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 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (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 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (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 @@ Consults `gnus-registry-unfollowed-groups' and 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."