aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorTeodor Zlatanov2011-04-21 22:06:12 +0000
committerKatsumi Yamaoka2011-04-21 22:06:12 +0000
commitc024b0212914973d24d6b6d579c5b1024861db57 (patch)
tree2892c481deb1967e81bc6909f635b7ce79b23924
parent121656e9e3bd049f75d979360295a60944ff19d6 (diff)
downloademacs-c024b0212914973d24d6b6d579c5b1024861db57.tar.gz
emacs-c024b0212914973d24d6b6d579c5b1024861db57.zip
gnus.el (gnus-registry-ignored-groups): Provide default in gnus.el, not gnus-registry.el.
gnus-registry.el (gnus-registry-ignored-groups): Remove defcustom. Explain why in comments. (gnus-registry-action): Fix data-header reference to use the extra headers. Explain in package commentary how to add To and Cc headers to the gnus-extra-headers. (gnus-registry-ignored-groups): Adjust defaults to match the parameter. (gnus-registry-ignore-group-p): Adjust to take either a group/topic parameter list or a string list in `gnus-registry-ignored-groups'. Fix logic error.
-rw-r--r--lisp/gnus/ChangeLog15
-rw-r--r--lisp/gnus/gnus-registry.el65
-rw-r--r--lisp/gnus/gnus.el5
3 files changed, 57 insertions, 28 deletions
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 5803fe7d0fd..601f1823d96 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,18 @@
12011-04-21 Teodor Zlatanov <tzz@lifelogs.com>
2
3 * gnus.el (gnus-registry-ignored-groups): Provide default in gnus.el,
4 not gnus-registry.el.
5
6 * gnus-registry.el (gnus-registry-ignored-groups): Remove defcustom.
7 Explain why in comments.
8 (gnus-registry-action): Fix data-header reference to use the extra
9 headers. Explain in package commentary how to add To and Cc headers to
10 the gnus-extra-headers.
11 (gnus-registry-ignored-groups): Adjust defaults to match the parameter.
12 (gnus-registry-ignore-group-p): Adjust to take either a group/topic
13 parameter list or a string list in `gnus-registry-ignored-groups'. Fix
14 logic error.
15
12011-04-21 Lars Magne Ingebrigtsen <larsi@gnus.org> 162011-04-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
2 17
3 * shr.el (shr-expand-url): Protect against null urls. 18 * shr.el (shr-expand-url): Protect against null urls.
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index 21cec5f2b42..68c6e0a2678 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -31,7 +31,16 @@
31;; gnus-registry.el intercepts article respooling, moving, deleting, 31;; gnus-registry.el intercepts article respooling, moving, deleting,
32;; and copying for all backends. If it doesn't work correctly for 32;; and copying for all backends. If it doesn't work correctly for
33;; you, submit a bug report and I'll be glad to fix it. It needs 33;; you, submit a bug report and I'll be glad to fix it. It needs
34;; documentation in the manual (also on my to-do list). 34;; better documentation in the manual (also on my to-do list).
35
36;; If you want to track recipients (and you should to make the
37;; gnus-registry splitting work better), you need the To and Cc
38;; headers collected by Gnus:
39
40;; ;;; you may also want Gcc Newsgroups Keywords X-Face
41;; (add-to-list 'gnus-extra-headers 'To)
42;; (add-to-list 'gnus-extra-headers 'Cc)
43;; (setq nnmail-extra-headers gnus-extra-headers)
35 44
36;; Put this in your startup file (~/.gnus.el for instance) or use Customize: 45;; Put this in your startup file (~/.gnus.el for instance) or use Customize:
37 46
@@ -137,16 +146,6 @@ nnmairix groups are specifically excluded because they are ephemeral."
137 :group 'gnus-registry 146 :group 'gnus-registry
138 :type '(repeat regexp)) 147 :type '(repeat regexp))
139 148
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
150(defcustom gnus-registry-install 'ask 149(defcustom gnus-registry-install 'ask
151 "Whether the registry should be installed." 150 "Whether the registry should be installed."
152 :group 'gnus-registry 151 :group 'gnus-registry
@@ -313,9 +312,10 @@ This is not required after changing `gnus-registry-cache-file'."
313(defun gnus-registry-action (action data-header from &optional to method) 312(defun gnus-registry-action (action data-header from &optional to method)
314 (let* ((id (mail-header-id data-header)) 313 (let* ((id (mail-header-id data-header))
315 (subject (mail-header-subject data-header)) 314 (subject (mail-header-subject data-header))
315 (extra (mail-header-extra data-header))
316 (recipients (gnus-registry-sort-addresses 316 (recipients (gnus-registry-sort-addresses
317 (or (cdr (assq "Cc" data-header)) "") 317 (or (cdr-safe (assq 'Cc extra)) "")
318 (or (cdr (assq "To" data-header)) ""))) 318 (or (cdr-safe (assq 'To extra)) "")))
319 (sender (nth 0 (gnus-registry-extract-addresses 319 (sender (nth 0 (gnus-registry-extract-addresses
320 (mail-header-from data-header)))) 320 (mail-header-from data-header))))
321 (from (gnus-group-guess-full-name-from-command-method from)) 321 (from (gnus-group-guess-full-name-from-command-method from))
@@ -333,9 +333,9 @@ This is not required after changing `gnus-registry-cache-file'."
333(defun gnus-registry-spool-action (id group &optional subject sender recipients) 333(defun gnus-registry-spool-action (id group &optional subject sender recipients)
334 (let ((to (gnus-group-guess-full-name-from-command-method group)) 334 (let ((to (gnus-group-guess-full-name-from-command-method group))
335 (recipients (or recipients 335 (recipients (or recipients
336 (gnus-registry-sort-addresses 336 (gnus-registry-sort-addresses
337 (or (message-fetch-field "cc") "") 337 (or (message-fetch-field "cc") "")
338 (or (message-fetch-field "to") "")))) 338 (or (message-fetch-field "to") ""))))
339 (subject (or subject (message-fetch-field "subject"))) 339 (subject (or subject (message-fetch-field "subject")))
340 (sender (or sender (message-fetch-field "from")))) 340 (sender (or sender (message-fetch-field "from"))))
341 (when (and (stringp id) (string-match "\r$" id)) 341 (when (and (stringp id) (string-match "\r$" id))
@@ -414,8 +414,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
414 (sender (gnus-string-remove-all-properties 414 (sender (gnus-string-remove-all-properties
415 (message-fetch-field "from"))) 415 (message-fetch-field "from")))
416 (recipients (gnus-registry-sort-addresses 416 (recipients (gnus-registry-sort-addresses
417 (or (message-fetch-field "cc") "") 417 (or (message-fetch-field "cc") "")
418 (or (message-fetch-field "to") ""))) 418 (or (message-fetch-field "to") "")))
419 (subject (gnus-string-remove-all-properties 419 (subject (gnus-string-remove-all-properties
420 (gnus-registry-simplify-subject 420 (gnus-registry-simplify-subject
421 (message-fetch-field "subject")))) 421 (message-fetch-field "subject"))))
@@ -655,17 +655,28 @@ Consults `gnus-registry-unfollowed-groups' and
655 group 655 group
656 nnmail-split-fancy-with-parent-ignore-groups))))) 656 nnmail-split-fancy-with-parent-ignore-groups)))))
657 657
658;; note that gnus-registry-ignored-groups is defined in gnus.el as a
659;; group/topic parameter and an associated variable!
660
661;; we do special logic for ignoring to accept regular expressions and
662;; nnmail-split-fancy-with-parent-ignore-groups as well
658(defun gnus-registry-ignore-group-p (group) 663(defun gnus-registry-ignore-group-p (group)
659 "Determines if a group name should be ignored. 664 "Determines if a group name should be ignored.
660Consults `gnus-registry-ignored-groups' and 665Consults `gnus-registry-ignored-groups' and
661`nnmail-split-fancy-with-parent-ignore-groups'." 666`nnmail-split-fancy-with-parent-ignore-groups'."
662 (and group 667 (and group
663 (not (or (gnus-grep-in-list 668 (or (gnus-parameter-registry-ignore group)
664 group 669 (gnus-grep-in-list
665 gnus-registry-ignored-groups) 670 group
666 (gnus-grep-in-list 671 (delq nil (mapcar (lambda (g)
667 group 672 (cond
668 nnmail-split-fancy-with-parent-ignore-groups))))) 673 ((stringp g) g)
674 ((and (listp g) (nth 1 g))
675 (nth 0 g))
676 (t nil))) gnus-registry-ignored-groups)))
677 (gnus-grep-in-list
678 group
679 nnmail-split-fancy-with-parent-ignore-groups))))
669 680
670(defun gnus-registry-wash-for-keywords (&optional force) 681(defun gnus-registry-wash-for-keywords (&optional force)
671 "Get the keywords of the current article. 682 "Get the keywords of the current article.
@@ -738,7 +749,7 @@ Addresses without a name will say \"noname\"."
738(defun gnus-registry-sort-addresses (&rest addresses) 749(defun gnus-registry-sort-addresses (&rest addresses)
739 "Return a normalized and sorted list of ADDRESSES." 750 "Return a normalized and sorted list of ADDRESSES."
740 (sort (apply 'nconc (mapcar 'gnus-registry-extract-addresses addresses)) 751 (sort (apply 'nconc (mapcar 'gnus-registry-extract-addresses addresses))
741 'string-lessp)) 752 'string-lessp))
742 753
743(defun gnus-registry-simplify-subject (subject) 754(defun gnus-registry-simplify-subject (subject)
744 (if (stringp subject) 755 (if (stringp subject)
@@ -769,7 +780,7 @@ Addresses without a name will say \"noname\"."
769 (assoc article (gnus-data-list nil))) 780 (assoc article (gnus-data-list nil)))
770 (gnus-string-remove-all-properties 781 (gnus-string-remove-all-properties
771 (cdr (assq header (gnus-data-header 782 (cdr (assq header (gnus-data-header
772 (assoc article (gnus-data-list nil)))))) 783 (assoc article (gnus-data-list nil))))))
773 nil)) 784 nil))
774 785
775;; registry marks glue 786;; registry marks glue
@@ -998,7 +1009,7 @@ only the last one's marks are returned."
998 extra-cell key val) 1009 extra-cell key val)
999 ;; remove all the strings from the entry 1010 ;; remove all the strings from the entry
1000 (dolist (elem rest) 1011 (dolist (elem rest)
1001 (if (stringp elem) (setq rest (delq elem rest)))) 1012 (if (stringp elem) (setq rest (delq elem rest))))
1002 (gnus-registry-set-id-key id 'group groups) 1013 (gnus-registry-set-id-key id 'group groups)
1003 ;; just use the first extra element 1014 ;; just use the first extra element
1004 (setq rest (car-safe rest)) 1015 (setq rest (car-safe rest))
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index f68ea41e6bd..5ff03572832 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -1875,7 +1875,10 @@ total number of articles in the group.")
1875 :function-document 1875 :function-document
1876 "Whether this group should be ignored by the registry." 1876 "Whether this group should be ignored by the registry."
1877 :variable gnus-registry-ignored-groups 1877 :variable gnus-registry-ignored-groups
1878 :variable-default nil 1878 :variable-default (mapcar
1879 (lambda (g) (list g t))
1880 '("delayed$" "drafts$" "queue$" "INBOX$"
1881 "^nnmairix:" "archive"))
1879 :variable-document 1882 :variable-document
1880 "*Groups in which the registry should be turned off." 1883 "*Groups in which the registry should be turned off."
1881 :variable-group gnus-registry 1884 :variable-group gnus-registry