Fix data header reference for the Gnus registry so To and Cc headers are collected...
authorTeodor Zlatanov <tzz@lifelogs.com>
Thu, 21 Apr 2011 20:20:25 +0000 (15:20 -0500)
committerTed Zlatanov <tzz@lifelogs.com>
Thu, 21 Apr 2011 20:20:25 +0000 (15:20 -0500)
* gnus-registry.el (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.

lisp/ChangeLog
lisp/gnus-registry.el

index 7c087cf..aa7c4ba 100644 (file)
@@ -1,13 +1,14 @@
-2011-04-21  Teodor Zlatanov  <tzlatanov@jumptrading.com>
-
-       * gnus-registry.el (gnus-registry-ignored-groups): Remove defcustom.
-       Explain why in comments.
+2011-04-21  Teodor Zlatanov  <tzz@lifelogs.com>
 
        * gnus.el (gnus-registry-ignored-groups): Provide default in gnus.el,
        not gnus-registry.el.
 
-       * gnus-registry.el (gnus-registry-ignored-groups): Adjust defaults to
-       match the parameter.
+       * 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.
index 306f29d..68c6e0a 100644 (file)
 ;; gnus-registry.el intercepts article respooling, moving, deleting,
 ;; and copying for all backends.  If it doesn't work correctly for
 ;; you, submit a bug report and I'll be glad to fix it.  It needs
-;; documentation in the manual (also on my to-do list).
+;; better documentation in the manual (also on my to-do list).
+
+;; If you want to track recipients (and you should to make the
+;; gnus-registry splitting work better), you need the To and Cc
+;; headers collected by Gnus:
+
+;; ;;; you may also want Gcc Newsgroups Keywords X-Face
+;; (add-to-list 'gnus-extra-headers 'To)
+;; (add-to-list 'gnus-extra-headers 'Cc)
+;; (setq nnmail-extra-headers gnus-extra-headers)
 
 ;; Put this in your startup file (~/.gnus.el for instance) or use Customize:
 
@@ -303,9 +312,10 @@ This is not required after changing `gnus-registry-cache-file'."
 (defun gnus-registry-action (action data-header from &optional to method)
   (let* ((id (mail-header-id data-header))
          (subject (mail-header-subject data-header))
+         (extra (mail-header-extra data-header))
          (recipients (gnus-registry-sort-addresses
-                     (or (cdr (assq "Cc" data-header)) "")
-                     (or (cdr (assq "To" data-header)) "")))
+                      (or (cdr-safe (assq 'Cc extra)) "")
+                      (or (cdr-safe (assq 'To extra)) "")))
          (sender (nth 0 (gnus-registry-extract-addresses
                          (mail-header-from data-header))))
          (from (gnus-group-guess-full-name-from-command-method from))
@@ -323,9 +333,9 @@ This is not required after changing `gnus-registry-cache-file'."
 (defun gnus-registry-spool-action (id group &optional subject sender recipients)
   (let ((to (gnus-group-guess-full-name-from-command-method group))
         (recipients (or recipients
-                       (gnus-registry-sort-addresses
-                        (or (message-fetch-field "cc") "")
-                        (or (message-fetch-field "to") ""))))
+                        (gnus-registry-sort-addresses
+                         (or (message-fetch-field "cc") "")
+                         (or (message-fetch-field "to") ""))))
         (subject (or subject (message-fetch-field "subject")))
         (sender (or sender (message-fetch-field "from"))))
     (when (and (stringp id) (string-match "\r$" id))
@@ -404,8 +414,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
          (sender (gnus-string-remove-all-properties
                   (message-fetch-field "from")))
          (recipients (gnus-registry-sort-addresses
-                     (or (message-fetch-field "cc") "")
-                     (or (message-fetch-field "to") "")))
+                      (or (message-fetch-field "cc") "")
+                      (or (message-fetch-field "to") "")))
          (subject (gnus-string-remove-all-properties
                    (gnus-registry-simplify-subject
                     (message-fetch-field "subject"))))
@@ -739,7 +749,7 @@ Addresses without a name will say \"noname\"."
 (defun gnus-registry-sort-addresses (&rest addresses)
   "Return a normalized and sorted list of ADDRESSES."
   (sort (apply 'nconc (mapcar 'gnus-registry-extract-addresses addresses))
-       'string-lessp))
+        'string-lessp))
 
 (defun gnus-registry-simplify-subject (subject)
   (if (stringp subject)
@@ -770,7 +780,7 @@ Addresses without a name will say \"noname\"."
            (assoc article (gnus-data-list nil)))
       (gnus-string-remove-all-properties
        (cdr (assq header (gnus-data-header
-                         (assoc article (gnus-data-list nil))))))
+                          (assoc article (gnus-data-list nil))))))
     nil))
 
 ;; registry marks glue
@@ -999,7 +1009,7 @@ only the last one's marks are returned."
                extra-cell key val)
           ;; remove all the strings from the entry
           (dolist (elem rest)
-           (if (stringp elem) (setq rest (delq elem rest))))
+            (if (stringp elem) (setq rest (delq elem rest))))
           (gnus-registry-set-id-key id 'group groups)
           ;; just use the first extra element
           (setq rest (car-safe rest))