diff options
| author | Teodor Zlatanov | 2011-04-20 22:12:08 +0000 |
|---|---|---|
| committer | Katsumi Yamaoka | 2011-04-20 22:12:08 +0000 |
| commit | 201133802956936332f1c4ce04eac42dfd1cf1c6 (patch) | |
| tree | 238b4287ace595bbc1ee3a366e89358c086ae7aa | |
| parent | 2dbaa0806bb585dec7d678bc2bdf842847514097 (diff) | |
| download | emacs-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/ChangeLog | 9 | ||||
| -rw-r--r-- | lisp/gnus/gnus-registry.el | 36 |
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 @@ | |||
| 1 | 2011-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 | |||
| 1 | 2011-04-20 Katsumi Yamaoka <yamaoka@jpl.org> | 10 | 2011-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. | ||
| 143 | The group names are matched, they don't have to be fully | ||
| 144 | qualified. | ||
| 145 | |||
| 146 | nnmairix 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. | ||
| 660 | Consults `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. |
| 646 | Overrides existing keywords with FORCE set non-nil." | 672 | Overrides existing keywords with FORCE set non-nil." |