;;; Commentary:
-;; This is the gnus-registry.el package, works with other backends
-;; besides nnmail. The major issue is that it doesn't go across
-;; backends, so for instance if an article is in nnml:sys and you see
-;; a reference to it in nnimap splitting, the article will end up in
-;; nnimap:sys
+;; This is the gnus-registry.el package, which works with all
+;; backends, not just nnmail (e.g. NNTP). The major issue is that it
+;; doesn't go across backends, so for instance if an article is in
+;; nnml:sys and you see a reference to it in nnimap splitting, the
+;; article will end up in nnimap:sys
;; gnus-registry.el intercepts article respooling, moving, deleting,
;; and copying for all backends. If it doesn't work correctly for
(defcustom gnus-registry-clean-empty t
"Whether the empty registry entries should be deleted.
-Registry entries are considered empty when they have no groups."
+Registry entries are considered empty when they have no groups
+and no extra data."
:group 'gnus-registry
:type 'boolean)
;; Replace the existing startup file with the temp file.
(rename-file working-file startup-file t)
- (set-file-modes startup-file setmodes)))
+ (gnus-set-file-modes startup-file setmodes)))
(condition-case nil
(delete-file working-file)
(file-error nil)))))
;; Idea from Dan Christensen <jdc@chow.mat.jhu.edu>
;; Save the gnus-registry file with extra line breaks.
(defun gnus-registry-cache-whitespace (filename)
- (gnus-message 5 "Adding whitespace to %s" filename)
+ (gnus-message 7 "Adding whitespace to %s" filename)
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^(\\|(\\\"" nil t)
(let ((count 0))
(maphash
(lambda (key value)
- (unless (gnus-registry-fetch-group key)
+ (unless (or
+ (gnus-registry-fetch-group key)
+ ;; TODO: look for specific extra data here!
+ ;; in this example, we look for 'label
+ (gnus-registry-fetch-extra key 'label))
(incf count)
(remhash key gnus-registry-hashtb)))
gnus-registry-hashtb)
(defun gnus-registry-trim (alist)
"Trim alist to size, using gnus-registry-max-entries."
(if (null gnus-registry-max-entries)
- alist ; just return the alist
+ alist ; just return the alist
;; else, when given max-entries, trim the alist
- (let ((timehash (make-hash-table
- :size 4096
- :test 'equal)))
+ (let* ((timehash (make-hash-table
+ :size 4096
+ :test 'equal))
+ (trim-length (- (length alist) gnus-registry-max-entries))
+ (trim-length (if (natnump trim-length) trim-length 0)))
(maphash
(lambda (key value)
- (puthash key (gnus-registry-fetch-extra key 'mtime) timehash))
+ (puthash key (gnus-registry-fetch-extra key 'mtime) timehash))
gnus-registry-hashtb)
;; we use the return value of this setq, which is the trimmed alist
(setq alist
(nthcdr
- (- (length alist) gnus-registry-max-entries)
+ trim-length
(sort alist
(lambda (a b)
(time-less-p
(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-message 7 "Registry: article %s %s from %s to %s"
id
(if method "respooling" "going")
from
(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"
+ (gnus-message 7 "Registry: article %s spooled to %s"
id
group)
(gnus-registry-add-group id group subject sender)))
see which group that message was put in. This group is returned.
See the Info node `(gnus)Fancy Mail Splitting' for more details."
- (let ((refstr (or (message-fetch-field "references")
- (message-fetch-field "in-reply-to")))
+ (let* ((refstr (or (message-fetch-field "references") "")) ; guarantee string
+ (reply-to (message-fetch-field "in-reply-to")) ; grab reply-to
+ ;; now, if reply-to is valid, append it to the References
+ (refstr (if reply-to
+ (concat refstr " " reply-to)
+ refstr))
(nnmail-split-fancy-with-parent-ignore-groups
(if (listp nnmail-split-fancy-with-parent-ignore-groups)
nnmail-split-fancy-with-parent-ignore-groups
(list nnmail-split-fancy-with-parent-ignore-groups)))
references res)
- (if refstr
+ ;; the references string must be valid and parse to valid references
+ (if (and refstr (gnus-extract-references refstr))
(progn
- (setq references (nreverse (gnus-split-references refstr)))
+ (setq references (nreverse (gnus-extract-references refstr)))
(mapcar (lambda (x)
(setq res (or (gnus-registry-fetch-group x) res))
(when (or (gnus-registry-grep-in-list
sender)
(maphash
(lambda (key value)
- (let ((this-sender (cdr
+ (let ((this-sender (cdr
(gnus-registry-fetch-extra key 'sender))))
(when (and single-match
this-sender
(when (and sender res)
(gnus-message
;; raise level of messaging if gnus-registry-track-extra
- (if gnus-registry-track-extra 5 9)
+ (if gnus-registry-track-extra 7 9)
"%s (extra tracking) traced sender %s to group %s"
"gnus-registry-split-fancy-with-parent"
sender
(when (and subject res)
(gnus-message
;; raise level of messaging if gnus-registry-track-extra
- (if gnus-registry-track-extra 5 9)
+ (if gnus-registry-track-extra 7 9)
"%s (extra tracking) traced subject %s to group %s"
"gnus-registry-split-fancy-with-parent"
subject
gnus-registry-hashtb))
(unless single-match
(gnus-message
- 5
+ 3
"gnus-registry-split-fancy-with-parent: too many extra matches for %s"
refstr)
(setq res nil))))
(setq res short-res))
;; else...
(gnus-message
- 5
+ 7
"gnus-registry-split-fancy-with-parent ignored foreign group %s"
res)
(setq res nil))))
(provide 'gnus-registry)
+;;; arch-tag: 5cba0a32-718a-4a97-8c91-0a15af21da94
;;; gnus-registry.el ends here
projects / gnus / blobdiff