From 15cc1ab1f0607f32ac76fa689df140cb1b3e27bd Mon Sep 17 00:00:00 2001 From: Teodor Zlatanov Date: Tue, 10 May 2011 22:21:39 +0000 Subject: [PATCH] registry.el (registry-prune-hard-candidates, registry-prune-soft-candidates): Helper methods for registry pruning. (registry-prune): Use them. Make the sort function optional. --- lisp/gnus/ChangeLog | 6 +++++ lisp/gnus/registry.el | 54 ++++++++++++++++++++++++++++++++----------- 2 files changed, 47 insertions(+), 13 deletions(-) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 657700a6343..ad69b292a7f 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,9 @@ +2011-05-10 Teodor Zlatanov + + * registry.el (registry-prune-hard-candidates) + (registry-prune-soft-candidates): Helper methods for registry pruning. + (registry-prune): Use them. Make the sort function optional. + 2011-05-10 Julien Danjou * shr.el (shr-put-color-1): Do not bug out when old-props is a face diff --git a/lisp/gnus/registry.el b/lisp/gnus/registry.el index 4beafd4b845..ffba2e10e6a 100644 --- a/lisp/gnus/registry.el +++ b/lisp/gnus/registry.el @@ -314,29 +314,57 @@ Errors out if the key exists already." This is the key count of the :data slot." (hash-table-count (oref db :data))) - (defmethod registry-prune ((db registry-db)) + (defmethod registry-prune ((db registry-db) &optional sortfun) "Prunes the registry-db object THIS. -Removes only entries without the :precious keys." +Removes only entries without the :precious keys if it can, +then removes oldest entries first. +Returns the number of deleted entries. +If SORTFUN is given, tries to keep entries that sort *higher*. +SORTFUN is passed only the two keys so it must look them up directly." + (dolist (collector '(registry-prune-soft-candidates + registry-prune-hard-candidates)) + (let* ((size (registry-size db)) + (collected (funcall collector db)) + (limit (nth 0 collected)) + (candidates (nth 1 collected)) + ;; sort the candidates if SORTFUN was given + (candidates (if sortfun (sort candidates sortfun) candidates)) + (candidates-count (length candidates)) + ;; are we over max-soft? + (prune-needed (> size limit))) + + ;; while we have more candidates than we need to remove... + (while (and (> candidates-count (- size limit)) candidates) + (decf candidates-count) + (setq candidates (cdr candidates))) + + (registry-delete db candidates nil) + (length candidates)))) + + (defmethod registry-prune-soft-candidates ((db registry-db)) + "Collects pruning candidates from the registry-db object THIS. +Proposes only entries without the :precious keys." (let* ((precious (oref db :precious)) (precious-p (lambda (entry-key) (cdr (memq (car entry-key) precious)))) (data (oref db :data)) (limit (oref db :max-soft)) - (size (registry-size db)) (candidates (loop for k being the hash-keys of data using (hash-values v) when (notany precious-p v) - collect k)) - (candidates-count (length candidates)) - ;; are we over max-soft? - (prune-needed (> size limit))) + collect k))) + (list limit candidates))) - ;; while we have more candidates than we need to remove... - (while (and (> candidates-count (- size limit)) candidates) - (decf candidates-count) - (setq candidates (cdr candidates))) - - (registry-delete db candidates nil)))) + (defmethod registry-prune-hard-candidates ((db registry-db)) + "Collects pruning candidates from the registry-db object THIS. +Proposes any entries over the max-hard limit minus 10." + (let* ((data (oref db :data)) + ;; prune to 10 below the max-hard limit so we're not + ;; pruning all the time + (limit (- (oref db :max-hard) 10)) + (candidates (loop for k being the hash-keys of data + collect k))) + (list limit candidates)))) (ert-deftest registry-instantiation-test () (should (registry-db "Testing"))) -- 2.39.2