From: yamaoka <yamaoka>
Date: Fri, 30 May 2003 07:11:38 +0000 (+0000)
Subject: Synch to Gnus 200305292035.
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=ae2258be1b5bda7a9954a605508943c52300efd4;p=elisp%2Fgnus.git-

Synch to Gnus 200305292035.
---

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index ad001a9..bade54c 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,16 @@
+2003-05-29  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	* gnus-registry.el (gnus-registry-save): allow forced saving even
+	when registry is not dirty.  Use gnus-registry-trim to shorten the
+	gnus-registry-alist.
+	(gnus-registry-max-entries): new variable
+	(gnus-registry-trim): new function, trim gnus-registry-alist to
+	size gnus-registry-max-entries, sorting by entry mtime so the
+	newest entries stick around
+
+	* gnus-start.el (gnus-gnus-to-quick-newsrc-format): instead of
+	just one specific variable, allow a list of specific variables
+
 2003-05-28  Dave Love  <fx@gnu.org>
 
 	* rfc2047.el (rfc2047-encode-region): Skip ASCII at beginning and
@@ -7,7 +20,7 @@
 
 	* lpath.el: Add put-char-table and get-char-table.
 
-2003-05-28  Teodor Zlatanov  <tzz@bwh.harvard.edu>
+2003-05-28  Teodor Zlatanov  <tzz@lifelogs.com>
 
 	* gnus-registry.el (gnus-registry-dirty): flag for modified registry
 	(gnus-registry-save, gnus-registry-read) 
diff --git a/lisp/gnus-registry.el b/lisp/gnus-registry.el
index b43e488..40b8a33 100644
--- a/lisp/gnus-registry.el
+++ b/lisp/gnus-registry.el
@@ -59,6 +59,11 @@ The group names are matched, they don't have to be fully qualified."
   :group 'gnus-registry
   :type 'file)
 
+(defcustom gnus-registry-max-entries nil
+  "Maximum number of entries in the registry, nil for unlimited."
+  :group 'gnus-registry
+  :type 'integer)
+
 ;; Function(s) missing in Emacs 20
 (when (memq nil (mapcar 'fboundp '(puthash)))
   (require 'cl)
@@ -149,10 +154,11 @@ The group names are matched, they don't have to be fully qualified."
     (while (re-search-forward " $" nil t)
       (replace-match "" t t))))
 
-(defun gnus-registry-save ()
+(defun gnus-registry-save (&optional force)
 ;; TODO: delete entries with 0 groups
-  (when gnus-registry-dirty
-    (setq gnus-registry-alist (hashtable-to-alist gnus-registry-hashtb))
+  (when (or gnus-registry-dirty force)
+    (setq gnus-registry-alist (gnus-registry-trim 
+			       (hashtable-to-alist gnus-registry-hashtb)))
     (gnus-registry-cache-save)
     (setq gnus-registry-dirty nil)))
 
@@ -161,6 +167,26 @@ The group names are matched, they don't have to be fully qualified."
   (setq gnus-registry-hashtb (alist-to-hashtable gnus-registry-alist))
   (setq gnus-registry-dirty nil))
 
+(defun gnus-registry-trim (alist)
+  "Trim alist to size, using gnus-registry-max-entries."
+  (unless (null gnus-registry-max-entries)
+    (let ((timehash (make-hash-table 			    
+		     :size 4096
+		     :test 'equal)))
+      (maphash
+       (lambda (key value)
+	 (puthash key (gnus-registry-fetch-extra key 'mtime) timehash))
+       gnus-registry-hashtb)
+
+      (setq alist
+	    (nthcdr
+	     (- (length alist) gnus-registry-max-entries)
+	     (sort alist 
+		   (lambda (a b)
+		     (time-less-p 
+		      (cdr (gethash (car a) timehash))
+		      (cdr (gethash (car b) timehash))))))))))
+
 (defun alist-to-hashtable (alist)
   "Build a hashtable from the values in ALIST."
   (let ((ht (make-hash-table 			    
diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el
index d3e5bfe..77ef2b3 100644
--- a/lisp/gnus-start.el
+++ b/lisp/gnus-start.el
@@ -2715,7 +2715,7 @@ If FORCE is non-nil, the .newsrc file is read."
     (gnus-offer-save-summaries)
     (gnus-save-newsrc-file)))
 
-(defun gnus-gnus-to-quick-newsrc-format (&optional minimal name specific-variable)
+(defun gnus-gnus-to-quick-newsrc-format (&optional minimal name &rest specific-variables)
   "Print Gnus variables such as gnus-newsrc-alist in lisp format."
     (princ ";; -*- emacs-lisp -*-\n")
     (if name
@@ -2743,12 +2743,11 @@ If FORCE is non-nil, the .newsrc file is read."
 		(gnus-strip-killed-list)
 	      gnus-killed-list))
 	   (variables 
-	    (if specific-variable
-		(list specific-variable)
-	      (if gnus-save-killed-list gnus-variable-list
-		;; Remove the `gnus-killed-list' from the list of variables
-		;; to be saved, if required.
-		(delq 'gnus-killed-list (copy-sequence gnus-variable-list)))))
+	    (or specific-variables
+		(if gnus-save-killed-list gnus-variable-list
+		  ;; Remove the `gnus-killed-list' from the list of variables
+		  ;; to be saved, if required.
+		  (delq 'gnus-killed-list (copy-sequence gnus-variable-list)))))
 	   ;; Peel off the "dummy" group.
 	   (gnus-newsrc-alist (cdr gnus-newsrc-alist))
 	   variable)