[gnus git] branch master updated: n0-17-31-g2864a2e =1= Prune the registry to the soft and hard limits and accept a sort function.

       via  2864a2e689bc57a2e0f72f530a7f0e42f82508bb (commit)
      from  cc11b74fe0292f59afb59162d6ee8e381933b50c (commit)


- Log -----------------------------------------------------------------
commit 2864a2e689bc57a2e0f72f530a7f0e42f82508bb
Author: Ted Zlatanov <[email protected]>
Date:   Tue May 10 12:38:41 2011 -0500

    Prune the registry to the soft and hard limits and accept a sort function.
    
    * registry.el (registry-prune-hard-candidates)
    (registry-prune-soft-candidates): Helper methods for registry pruning.
    (registry-prune): Use them.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 8e5177b..8147867 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
+2011-05-10  Teodor Zlatanov  <[email protected]>
+
+	* registry.el (registry-prune-hard-candidates)
+	(registry-prune-soft-candidates): Helper methods for registry pruning.
+	(registry-prune): Use them.
+
 2011-05-10  Julien Danjou  <[email protected]>
 
 	* shr.el (shr-put-color-1): Do not bug out when old-props is a face
diff --git a/lisp/registry.el b/lisp/registry.el
index 4beafd4..b3123f6 100644
--- a/lisp/registry.el
+++ b/lisp/registry.el
@@ -314,19 +314,21 @@ 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) sortfun)
     "Prunes the registry-db object THIS.
-Removes 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))
+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)))
@@ -336,7 +338,33 @@ Removes only entries without the :precious keys."
 	(decf candidates-count)
 	(setq candidates (cdr candidates)))
 
-      (registry-delete db candidates nil))))
+        (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))
+	   (candidates (loop for k being the hash-keys of data
+			     using (hash-values v)
+			     when (notany precious-p v)
+			     collect k)))
+      (list limit candidates)))
+
+  (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")))

-----------------------------------------------------------------------
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we listed those
revisions in full, above.

Summary of changes:
 lisp/ChangeLog   |    6 ++++++
 lisp/registry.el |   54 +++++++++++++++++++++++++++++++++++++++++-------------
 2 files changed, 47 insertions(+), 13 deletions(-)

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "Gnus Project".

The branch, master has been updated


hooks/post-receive
-- 
Gnus Project