From 5eed0d127a691ec409c30fac1ea1dd0c068d14ca Mon Sep 17 00:00:00 2001 From: Teodor Zlatanov Date: Thu, 29 May 2003 20:35:10 +0000 Subject: [PATCH] * 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 --- lisp/ChangeLog | 15 ++++++++++++++- lisp/gnus-registry.el | 32 +++++++++++++++++++++++++++++--- lisp/gnus-start.el | 13 ++++++------- 3 files changed, 49 insertions(+), 11 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ad001a9af..bade54c0f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,16 @@ +2003-05-29 Teodor Zlatanov + + * 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 * 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 +2003-05-28 Teodor Zlatanov * 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 b43e48853..40b8a3338 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 f530bc6d4..caa484da0 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -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) -- 2.34.1