;; 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. Note that in more recent Gnus versions
+;; this is already the case: look at `gnus-extra-headers' to be sure.
+
+;; ;;; 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:
:group 'gnus-registry
:type '(repeat regexp))
-(defcustom gnus-registry-ignored-groups
- (mapcar (lambda (g) (list g t))
- '("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 (list regexp (choice (const :tag "Do not ignore" nil)
- (const :tag "Ignore" t)))))
-
(defcustom gnus-registry-install 'ask
"Whether the registry should be installed."
:group 'gnus-registry
(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))
(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))
(gnus-message 10 "Gnus registry: new entry for %s is %S"
id
entry)
- (registry-insert db id entry)))
+ (gnus-registry-insert db id entry)))
;; Function for nn{mail|imap}-split-fancy: look up all references in
;; the cache and if a match is found, return that group.
(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"))))
group
nnmail-split-fancy-with-parent-ignore-groups)))))
+;; note that gnus-registry-ignored-groups is defined in gnus.el as a
+;; group/topic parameter and an associated variable!
+
+;; we do special logic for ignoring to accept regular expressions and
+;; nnmail-split-fancy-with-parent-ignore-groups as well
(defun gnus-registry-ignore-group-p (group)
"Determines if a group name should be ignored.
Consults `gnus-registry-ignored-groups' and
((and (listp g) (nth 1 g))
(nth 0 g))
(t nil))) gnus-registry-ignored-groups)))
+ ;; only use `gnus-parameter-registry-ignore' if
+ ;; `gnus-registry-ignored-groups' is a list of lists
+ ;; (it can be a list of regexes)
+ (and (listp (nth 0 gnus-registry-ignored-groups))
+ (get-buffer "*Group*") ; in automatic tests this is false
+ (gnus-parameter-registry-ignore group))
(gnus-grep-in-list
group
nnmail-split-fancy-with-parent-ignore-groups))))
(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)
(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
(entries (registry-lookup db (list id))))
(when (null entries)
- (registry-insert db id (list (list 'creation-time (current-time))
- '(group) '(sender) '(subject)))
+ (gnus-registry-insert db id (list (list 'creation-time (current-time))
+ '(group) '(sender) '(subject)))
(setq entries (registry-lookup db (list id))))
(nth 1 (assoc id entries))))
(entry (gnus-registry-get-or-make-entry id)))
(registry-delete db (list id) nil)
(setq entry (cons (cons key vals) (assq-delete-all key entry)))
- (registry-insert db id entry)
+ (gnus-registry-insert db id entry)
entry))
+(defun gnus-registry-insert (db id entry)
+ "Just like `registry-insert' but tries to prune on error."
+ (when (registry-full db)
+ (message "Trying to prune the registry because it's full")
+ (registry-prune db))
+ (registry-insert db id entry)
+ entry)
+
(defun gnus-registry-import-eld (file)
(interactive "fOld registry file to import? ")
;; example content:
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))
(should (equal (gnus-registry-get-id-key "34" 'group) '("togroup")))
(should (equal (gnus-registry-get-id-key "34" 'subject) '("subject 4")))
(message "Trying to insert a duplicate key")
- (should-error (registry-insert db "55" '()))
+ (should-error (gnus-registry-insert db "55" '()))
(message "Looking up individual keys (gnus-registry-get-or-make-entry)")
(should (gnus-registry-get-or-make-entry "22"))
(message "Saving the Gnus registry to %s" tempfile)
projects / gnus / blobdiff