Fix doc.

[gnus] / lisp / gnus-registry.el

diff --git a/lisp/gnus-registry.el b/lisp/gnus-registry.el
index cec3ffd..901e09d 100644 (file)
--- a/lisp/gnus-registry.el
+++ b/lisp/gnus-registry.el
@@ -1,27 +1,25 @@
 ;;; gnus-registry.el --- article registry for Gnus
 
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 
+;;; Free Software Foundation, Inc.
 
 ;; Author: Ted Zlatanov <tzz@lifelogs.com>
-;; Keywords: news
+;; Keywords: news registry
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.         See the
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -146,11 +144,17 @@ and no extra data."
   :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
@@ -260,9 +264,7 @@ considered precious) will not be trimmed."
                             (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)))
 
@@ -510,7 +512,9 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
         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
@@ -525,7 +529,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
      ;; else: there were no matches, now try the extra tracking by sender
      ((and (gnus-registry-track-sender-p)
           sender
-          (not (equal sender user-mail-address)))
+          (not (equal (gnus-extract-address-component-email sender)
+                      user-mail-address)))
       (maphash
        (lambda (key value)
         (let ((this-sender (cdr
@@ -533,7 +538,9 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
               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)))))
@@ -560,7 +567,9 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
               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)))))
@@ -1005,8 +1014,8 @@ Returns the first place where the trail finds a group name."
                       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)
@@ -1018,7 +1027,9 @@ Returns the first place where the trail finds a group name."
          (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))