diff options
| author | Teodor Zlatanov | 2011-04-21 22:06:12 +0000 |
|---|---|---|
| committer | Katsumi Yamaoka | 2011-04-21 22:06:12 +0000 |
| commit | c024b0212914973d24d6b6d579c5b1024861db57 (patch) | |
| tree | 2892c481deb1967e81bc6909f635b7ce79b23924 | |
| parent | 121656e9e3bd049f75d979360295a60944ff19d6 (diff) | |
| download | emacs-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/ChangeLog | 15 | ||||
| -rw-r--r-- | lisp/gnus/gnus-registry.el | 65 | ||||
| -rw-r--r-- | lisp/gnus/gnus.el | 5 |
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 @@ | |||
| 1 | 2011-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 | |||
| 1 | 2011-04-21 Lars Magne Ingebrigtsen <larsi@gnus.org> | 16 | 2011-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. | ||
| 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 | |||
| 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. |
| 660 | Consults `gnus-registry-ignored-groups' and | 665 | Consults `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 |