aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorTeodor Zlatanov2011-04-20 22:12:08 +0000
committerKatsumi Yamaoka2011-04-20 22:12:08 +0000
commit201133802956936332f1c4ce04eac42dfd1cf1c6 (patch)
tree238b4287ace595bbc1ee3a366e89358c086ae7aa
parent2dbaa0806bb585dec7d678bc2bdf842847514097 (diff)
downloademacs-201133802956936332f1c4ce04eac42dfd1cf1c6.tar.gz
emacs-201133802956936332f1c4ce04eac42dfd1cf1c6.zip
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.
-rw-r--r--lisp/gnus/ChangeLog9
-rw-r--r--lisp/gnus/gnus-registry.el36
2 files changed, 40 insertions, 5 deletions
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 @@
12011-04-20 Teodor Zlatanov <tzz@lifelogs.com>
2
3 * gnus-registry.el
4 (gnus-registry--split-fancy-with-parent-internal): Fix loop bugs.
5 (gnus-registry-ignored-groups): New variable.
6 (gnus-registry-ignore-group-p): Use it.
7 (gnus-registry-handle-action): Use `gnus-registry-ignore-group-p' and
8 set the destination group to nil (same as delete) if it's ignored.
9
12011-04-20 Katsumi Yamaoka <yamaoka@jpl.org> 102011-04-20 Katsumi Yamaoka <yamaoka@jpl.org>
2 11
3 * gnus-registry.el (gnus-registry-action) 12 * 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
@@ -137,6 +137,16 @@ nnmairix groups are specifically excluded because they are ephemeral."
137 :group 'gnus-registry 137 :group 'gnus-registry
138 :type '(repeat regexp)) 138 :type '(repeat regexp))
139 139
140(defcustom gnus-registry-ignored-groups
141 '("delayed$" "drafts$" "queue$" "INBOX$" "^nnmairix:" "archive")
142 "List of groups that the Gnus Registry will ignore.
143The group names are matched, they don't have to be fully
144qualified.
145
146nnmairix groups are specifically excluded because they are ephemeral."
147 :group 'gnus-registry
148 :type '(repeat regexp))
149
140(defcustom gnus-registry-install 'ask 150(defcustom gnus-registry-install 'ask
141 "Whether the registry should be installed." 151 "Whether the registry should be installed."
142 :group 'gnus-registry 152 :group 'gnus-registry
@@ -341,6 +351,8 @@ This is not required after changing `gnus-registry-cache-file'."
341 10 351 10
342 "gnus-registry-handle-action %S" (list id from to subject sender recipients)) 352 "gnus-registry-handle-action %S" (list id from to subject sender recipients))
343 (let ((db gnus-registry-db) 353 (let ((db gnus-registry-db)
354 ;; if the group is ignored, set the destination to nil (same as delete)
355 (to (if (gnus-registry-ignore-group-p to) nil to))
344 ;; safe if not found 356 ;; safe if not found
345 (entry (gnus-registry-get-or-make-entry id)) 357 (entry (gnus-registry-get-or-make-entry id))
346 (subject (gnus-string-remove-all-properties 358 (subject (gnus-string-remove-all-properties
@@ -442,8 +454,10 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
442 (gnus-message 9 "%s is looking up %s" log-agent reference) 454 (gnus-message 9 "%s is looking up %s" log-agent reference)
443 (loop for group in (gnus-registry-get-id-key reference 'group) 455 (loop for group in (gnus-registry-get-id-key reference 'group)
444 when (gnus-registry-follow-group-p group) 456 when (gnus-registry-follow-group-p group)
445 do (gnus-message 7 "%s traced %s to %s" log-agent reference group) 457 do
446 do (push group found))) 458 (progn
459 (gnus-message 7 "%s traced %s to %s" log-agent reference group)
460 (push group found))))
447 ;; filter the found groups and return them 461 ;; filter the found groups and return them
448 ;; the found groups are the full groups 462 ;; the found groups are the full groups
449 (setq found (gnus-registry-post-process-groups 463 (setq found (gnus-registry-post-process-groups
@@ -468,7 +482,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
468 (if gnus-registry-track-extra 7 9) 482 (if gnus-registry-track-extra 7 9)
469 "%s (extra tracking) traced subject '%s' to %s" 483 "%s (extra tracking) traced subject '%s' to %s"
470 log-agent subject group) 484 log-agent subject group)
471 collect group)) 485 and collect group))
472 ;; filter the found groups and return them 486 ;; filter the found groups and return them
473 ;; the found groups are NOT the full groups 487 ;; the found groups are NOT the full groups
474 (setq found (gnus-registry-post-process-groups 488 (setq found (gnus-registry-post-process-groups
@@ -495,7 +509,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
495 (if gnus-registry-track-extra 7 9) 509 (if gnus-registry-track-extra 7 9)
496 "%s (extra tracking) traced sender '%s' to %s" 510 "%s (extra tracking) traced sender '%s' to %s"
497 log-agent sender group) 511 log-agent sender group)
498 collect group))) 512 and collect group)))
499 513
500 ;; filter the found groups and return them 514 ;; filter the found groups and return them
501 ;; the found groups are NOT the full groups 515 ;; the found groups are NOT the full groups
@@ -525,7 +539,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
525 (if gnus-registry-track-extra 7 9) 539 (if gnus-registry-track-extra 7 9)
526 "%s (extra tracking) traced recipient '%s' to %s" 540 "%s (extra tracking) traced recipient '%s' to %s"
527 log-agent recp group) 541 log-agent recp group)
528 collect group))))) 542 and collect group)))))
529 543
530 ;; filter the found groups and return them 544 ;; filter the found groups and return them
531 ;; the found groups are NOT the full groups 545 ;; the found groups are NOT the full groups
@@ -641,6 +655,18 @@ Consults `gnus-registry-unfollowed-groups' and
641 group 655 group
642 nnmail-split-fancy-with-parent-ignore-groups))))) 656 nnmail-split-fancy-with-parent-ignore-groups)))))
643 657
658(defun gnus-registry-ignore-group-p (group)
659 "Determines if a group name should be ignored.
660Consults `gnus-registry-ignored-groups' and
661`nnmail-split-fancy-with-parent-ignore-groups'."
662 (and group
663 (not (or (gnus-grep-in-list
664 group
665 gnus-registry-ignored-groups)
666 (gnus-grep-in-list
667 group
668 nnmail-split-fancy-with-parent-ignore-groups)))))
669
644(defun gnus-registry-wash-for-keywords (&optional force) 670(defun gnus-registry-wash-for-keywords (&optional force)
645 "Get the keywords of the current article. 671 "Get the keywords of the current article.
646Overrides existing keywords with FORCE set non-nil." 672Overrides existing keywords with FORCE set non-nil."