[Emacs-diffs] /srv/bzr/emacs/trunk r104190: registry.el (registry-prune-hard-candidates, registry-prune-soft-candidates): Helper methods for registry pruning.

[Katsumi Yamaoka]

------------------------------------------------------------
revno: 104190
author: Teodor Zlatanov <address@hidden>
committer: Katsumi Yamaoka <address@hidden>
branch nick: trunk
timestamp: Tue 2011-05-10 22:21:39 +0000
message:
  registry.el (registry-prune-hard-candidates, registry-prune-soft-candidates): 
Helper methods for registry pruning.
   (registry-prune): Use them.  Make the sort function optional.
modified:
  lisp/gnus/ChangeLog
  lisp/gnus/registry.el

=== modified file 'lisp/gnus/ChangeLog'
--- a/lisp/gnus/ChangeLog       2011-05-10 13:20:21 +0000
+++ b/lisp/gnus/ChangeLog       2011-05-10 22:21:39 +0000
@@ -1,3 +1,9 @@
+2011-05-10  Teodor Zlatanov  <address@hidden>
+
+       * 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  <address@hidden>
 
        * shr.el (shr-put-color-1): Do not bug out when old-props is a face

=== modified file 'lisp/gnus/registry.el'
--- a/lisp/gnus/registry.el     2011-05-09 22:27:17 +0000
+++ b/lisp/gnus/registry.el     2011-05-10 22:21:39 +0000
@@ -314,29 +314,57 @@
 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)))
-
-      ;; 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))))
+                            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")))