;;; gnus-registry.el --- article registry for Gnus
-;;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
+;;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
;;; Free Software Foundation, Inc.
;; Author: Ted Zlatanov <tzz@lifelogs.com>
:group 'gnus-registry
:type 'boolean)
-(defcustom gnus-registry-use-long-group-names nil
- "Whether the registry should use long group names (BUGGY)."
+(defcustom gnus-registry-use-long-group-names t
+ "Whether the registry should use long group names."
:group 'gnus-registry
:type 'boolean)
+(defcustom gnus-registry-max-track-groups 20
+ "The maximum number of non-unique group matches to check for a message ID."
+ :group 'gnus-registry
+ :type '(radio (const :format "Unlimited " nil)
+ (integer :format "Maximum non-unique matches: %v")))
+
(defcustom gnus-registry-track-extra nil
"Whether the registry should track extra data about a message.
The Subject and Sender (From:) headers are currently tracked this
(if (and (eq system-type 'ms-dos)
(not (gnus-long-file-names)))
"%s#%d.tm#" ; MSDOS limits files to 8+3
- (if (memq system-type '(vax-vms axp-vms))
- "%s$tmp$%d"
- "%s#tmp#%d"))
+ "%s#tmp#%d")
working-dir (setq i (1+ i))))
(file-exists-p working-file)))
9
"%s is looking for matches for reference %s from [%s]"
log-agent reference refstr)
- (dolist (group (gnus-registry-fetch-groups reference))
+ (dolist (group (gnus-registry-fetch-groups
+ reference
+ gnus-registry-max-track-groups))
(when (and group (gnus-registry-follow-group-p group))
(gnus-message
7
matches)
(when (and this-sender
(equal sender this-sender))
- (let ((groups (gnus-registry-fetch-groups key)))
+ (let ((groups (gnus-registry-fetch-groups
+ key
+ gnus-registry-max-track-groups)))
(dolist (group groups)
(push group found-full)
(setq found (append (list group) (delete group found)))))
matches)
(when (and this-subject
(equal subject this-subject))
- (let ((groups (gnus-registry-fetch-groups key)))
+ (let ((groups (gnus-registry-fetch-groups
+ key
+ gnus-registry-max-track-groups)))
(dolist (group groups)
(push group found-full)
(setq found (append (list group) (delete group found)))))
crumb
(gnus-group-short-name crumb))))))))
-(defun gnus-registry-fetch-groups (id)
- "Get the groups of a message, based on the message ID."
+(defun gnus-registry-fetch-groups (id &optional max)
+ "Get the groups (up to MAX, if given) of a message, based on the message ID."
(let ((trail (gethash id gnus-registry-hashtb))
groups)
(dolist (crumb trail)
(if (or (not (stringp crumb)) gnus-registry-use-long-group-names)
crumb
(gnus-group-short-name crumb))
- groups))))
+ groups))
+ (when (and max (> (length groups) max))
+ (return))))
;; return the list of groups
groups))