procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

gnus-registry.el (gnus-registry--split-fancy-with-parent-internal): Fix loop bugs.

Browse source 
(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.
This commit is contained in:
Teodor Zlatanov 2011-04-20 22:12:08 +00:00 • committed by Katsumi Yamaoka
parent 2dbaa0806b
commit 2011338029
2 changed files with 40 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
lisp/gnus/ChangeLog
View file

@ -1,3 +1,12 @@
2011-04-20 Teodor Zlatanov <tzz@lifelogs.com>
* 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 <yamaoka@jpl.org>
* gnus-registry.el (gnus-registry-action)

36
lisp/gnus/gnus-registry.el
View file

@ -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."