Changes committed gnus/lisp (ChangeLog gnus-registry.el)

Modified: ChangeLog gnus-registry.el

(gnus-registry-max-track-groups): New variable to
prevent tracking too many groups.
(gnus-registry-split-fancy-with-parent, gnus-registry-fetch-groups):
Use it.


Index: ChangeLog
diff -u gnus/lisp/ChangeLog:7.1900 gnus/lisp/ChangeLog:7.1901
--- ChangeLog:7.1900	Tue Aug 12 00:54:25 2008
+++ ChangeLog	Thu Aug 21 18:44:25 2008
@@ -1,3 +1,10 @@
+2008-08-21  Teodor Zlatanov  <[email protected]>
+
+	* gnus-registry.el (gnus-registry-max-track-groups): New variable to
+	prevent tracking too many groups.
+	(gnus-registry-split-fancy-with-parent, gnus-registry-fetch-groups):
+	Use it.
+
 2008-08-11  Ralf Angeli  <[email protected]>
 
 	* gnus-art.el (gnus-article-next-page): Respect `scroll-margin' when
Index: gnus-registry.el
diff -u gnus/lisp/gnus-registry.el:7.63 gnus/lisp/gnus-registry.el:7.64
--- gnus-registry.el:7.63	Mon May 19 10:47:42 2008
+++ gnus-registry.el	Thu Aug 21 18:44:25 2008
@@ -149,6 +149,12 @@
   :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
@@ -508,7 +514,9 @@
 	 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
@@ -532,7 +540,9 @@
 	       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)))))
@@ -559,7 +569,9 @@
 	       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)))))
@@ -1004,8 +1016,8 @@
 		       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)
@@ -1017,7 +1029,9 @@
 	  (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))