* gnus-registry.el (gnus-registry-save): allow forced saving even
authorTeodor Zlatanov <tzz@lifelogs.com>
Thu, 29 May 2003 20:35:10 +0000 (20:35 +0000)
committerTeodor Zlatanov <tzz@lifelogs.com>
Thu, 29 May 2003 20:35:10 +0000 (20:35 +0000)
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

lisp/ChangeLog
lisp/gnus-registry.el
lisp/gnus-start.el

index ad001a9..bade54c 100644 (file)
@@ -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) 
index b43e488..40b8a33 100644 (file)
@@ -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                       
index f530bc6..caa484d 100644 (file)
@@ -2631,7 +2631,7 @@ If FORCE is non-nil, the .newsrc file is read."
        (gnus-dribble-delete-file)
        (gnus-group-set-mode-line)))))
 
-(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
@@ -2659,12 +2659,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)