;; Put this in your startup file (~/.gnus.el for instance)
-;; (setq gnus-registry-install t
-;; gnus-registry-max-entries 2500
-;; gnus-registry-use-long-group-names t)
+;; (setq gnus-registry-max-entries 2500
+;; gnus-registry-use-long-group-names t)
-;; (require 'gnus-registry)
+;; (gnus-registry-initialize)
;; Then use this in your fancy-split:
(let* ((id (mail-header-id data-header))
(subject (gnus-registry-simplify-subject
(mail-header-subject data-header)))
- (from (gnus-group-guess-full-name from))
- (to (if to (gnus-group-guess-full-name to) nil))
+ (from (gnus-group-guess-full-name-from-command-method from))
+ (to (if to (gnus-group-guess-full-name-from-command-method to) nil))
(to-name (if to to "the Bit Bucket"))
(old-entry (gethash id gnus-registry-hashtb)))
(gnus-message 5 "Registry: article %s %s from %s to %s"
(gnus-registry-add-group id to subject)))
(defun gnus-registry-spool-action (id group &optional subject)
- ;; do not process the draft IDs
-; (unless (string-match "totally-fudged-out-message-id" id)
-; (let ((group (gnus-group-guess-full-name group)))
- (when (string-match "\r$" id)
- (setq id (substring id 0 -1)))
- (gnus-message 5 "Registry: article %s spooled to %s"
- id
- group)
- (gnus-registry-add-group id group subject))
-;)
+ (let ((group (gnus-group-guess-full-name-from-command-method group)))
+ (when (and (stringp id) (string-match "\r$" id))
+ (setq id (substring id 0 -1)))
+ (gnus-message 5 "Registry: article %s spooled to %s"
+ id
+ group)
+ (gnus-registry-add-group id group subject)))
;; Function for nn{mail|imap}-split-fancy: look up all references in
;; the cache and if a match is found, return that group.
(setq res (gnus-registry-fetch-group key))
(gnus-message
;; raise level of messaging if gnus-registry-track-extra
- (if gnus-registry-track-extra 5 9)
+ (if gnus-registry-track-extra 5 9)
"%s (extra tracking) traced subject %s to group %s"
"gnus-registry-split-fancy-with-parent"
subject
5
"gnus-registry-split-fancy-with-parent traced %s to group %s"
refstr (if res res "nil"))
+
+ (when (and res gnus-registry-use-long-group-names)
+ (let ((m1 (gnus-find-method-for-group res))
+ (m2 (or gnus-command-method
+ (gnus-find-method-for-group gnus-newsgroup-name)))
+ (short-res (gnus-group-short-name res)))
+ (if (gnus-methods-equal-p m1 m2)
+ (progn
+ (gnus-message
+ 9
+ "gnus-registry-split-fancy-with-parent stripped group %s to %s"
+ res
+ short-res)
+ (setq res short-res))
+ ;; else...
+ (gnus-message
+ 5
+ "gnus-registry-split-fancy-with-parent ignored foreign group %s"
+ res)
+ (setq res nil))))
res))
(defun gnus-registry-register-message-ids ()
nil))
(defun gnus-registry-simplify-subject (subject)
- (if (null subject)
- nil
- (gnus-simplify-subject subject)))
+ (if (stringp subject)
+ (gnus-simplify-subject subject)
+ nil))
(defun gnus-registry-fetch-simplified-message-subject-fast (article)
"Fetch the Subject quickly, using the internal gnus-data-list function"
(when (gnus-registry-group-count id)
;; we now know the trail has at least 1 group name, so it's not empty
(let ((trail (gethash id gnus-registry-hashtb))
- (old-extra (gnus-registry-fetch-extra id)))
+ (old-extra (gnus-registry-fetch-extra id))
+ entry-cache)
+ (dolist (crumb trail)
+ (unless (stringp crumb)
+ (dolist (entry crumb)
+ (setq entry-cache (gethash (car entry) gnus-registry-hashtb))
+ (when entry-cache
+ (remhash id entry-cache))))
(puthash id (cons extra (delete old-extra trail))
gnus-registry-hashtb)
- (setq gnus-registry-dirty t))))
+ (setq gnus-registry-dirty t)))))
(defun gnus-registry-store-extra-entry (id key value)
"Put a specific entry in the extras field of the registry entry for id."
(let ((trail (gethash id gnus-registry-hashtb)))
(dolist (crumb trail)
(when (stringp crumb)
- (return (gnus-group-short-name crumb)))))))
+ (return (if gnus-registry-use-long-group-names
+ crumb
+ (gnus-group-short-name crumb))))))))
(defun gnus-registry-group-count (id)
"Get the number of groups of a message, based on the message ID."
;; now, clear the entry if there are no more groups
(when gnus-registry-trim-articles-without-groups
(unless (gnus-registry-group-count id)
- (remhash id gnus-registry-hashtb)))
+ (gnus-registry-delete-id id)))
(gnus-registry-store-extra-entry id 'mtime (current-time)))))
+(defun gnus-registry-delete-id (id)
+ "Delete a message ID from the registry."
+ (when (stringp id)
+ (remhash id gnus-registry-hashtb)
+ (maphash
+ (lambda (key value)
+ (when (hash-table-p value)
+ (remhash id value)))
+ gnus-registry-hashtb)))
+
(defun gnus-registry-add-group (id group &optional subject)
"Add a group for a message, based on the message ID."
- ;; make sure there are no duplicate entries
(when group
(when (and id
(not (string-match "totally-fudged-out-message-id" id)))
group
(gnus-group-short-name group))))
(gnus-registry-delete-group id group)
- (unless gnus-registry-use-long-group-names
+
+ (unless gnus-registry-use-long-group-names ;; unnecessary in this case
(gnus-registry-delete-group id full-group))
+
(let ((trail (gethash id gnus-registry-hashtb)))
(puthash id (if trail
(cons group trail)
(setq gnus-registry-hashtb (alist-to-hashtable gnus-registry-alist))
(setq gnus-registry-dirty t))
+;;;###autoload
+(defun gnus-registry-initialize ()
+ (interactive)
+ (setq gnus-registry-install t)
+ (gnus-registry-install-hooks)
+ (gnus-registry-read))
+
+;;;###autoload
(defun gnus-registry-install-hooks ()
"Install the registry hooks."
(interactive)
projects / gnus / blobdiff