X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-registry.el;h=62d438fc43ffdfd44da4b6d20596a6dc388d77e7;hb=48990ac593481a0fad129fc4d426fada65143c4a;hp=bce77295d22313eb301e195af850e9004ff93373;hpb=6d70ee5b48003576c48a0bd05d8ec225e741cac2;p=elisp%2Fgnus.git-

diff --git a/lisp/gnus-registry.el b/lisp/gnus-registry.el
index bce7729..62d438f 100644
--- a/lisp/gnus-registry.el
+++ b/lisp/gnus-registry.el
@@ -202,7 +202,7 @@ way."
 		
 		;; 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)))))
@@ -213,7 +213,7 @@ way."
 ;; 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)
@@ -267,20 +267,22 @@ way."
 (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 
@@ -316,7 +318,7 @@ way."
 	 (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
@@ -334,7 +336,7 @@ way."
   (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)))
@@ -356,16 +358,21 @@ References or In-Reply-To header and then looks in the registry to
 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
@@ -387,7 +394,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
 		   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
@@ -399,7 +406,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
 		 (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
@@ -423,7 +430,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
 		 (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
@@ -431,7 +438,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
 	   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))))
@@ -456,7 +463,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
 	    (setq res short-res))
 	;; else...
 	(gnus-message
-	 5 
+	 7
 	 "gnus-registry-split-fancy-with-parent ignored foreign group %s"
 	 res)
 	(setq res nil))))