Try to prune the Gnus registry if it's full.

[gnus] / lisp / gnus-registry.el

diff --git a/lisp/gnus-registry.el b/lisp/gnus-registry.el
index 68c6e0a..02e4ce7 100644 (file)
--- a/lisp/gnus-registry.el
+++ b/lisp/gnus-registry.el
@@ -35,7 +35,8 @@
 
 ;; If you want to track recipients (and you should to make the
 ;; gnus-registry splitting work better), you need the To and Cc
-;; headers collected by Gnus:
+;; headers collected by Gnus.  Note that in more recent Gnus versions
+;; this is already the case: look at `gnus-extra-headers' to be sure.
 
 ;; ;;; you may also want Gcc Newsgroups Keywords X-Face
 ;; (add-to-list 'gnus-extra-headers 'To)
@@ -382,7 +383,7 @@ This is not required after changing `gnus-registry-cache-file'."
     (gnus-message 10 "Gnus registry: new entry for %s is %S"
                   id
                   entry)
-    (registry-insert db id entry)))
+    (gnus-registry-insert db id entry)))
 
 ;; Function for nn{mail|imap}-split-fancy: look up all references in
 ;; the cache and if a match is found, return that group.
@@ -665,8 +666,7 @@ Consults `gnus-registry-unfollowed-groups' and
 Consults `gnus-registry-ignored-groups' and
 `nnmail-split-fancy-with-parent-ignore-groups'."
   (and group
-       (or (gnus-parameter-registry-ignore group)
-           (gnus-grep-in-list
+       (or (gnus-grep-in-list
             group
             (delq nil (mapcar (lambda (g)
                                 (cond
@@ -674,6 +674,12 @@ Consults `gnus-registry-ignored-groups' and
                                  ((and (listp g) (nth 1 g))
                                   (nth 0 g))
                                  (t nil))) gnus-registry-ignored-groups)))
+           ;; only use `gnus-parameter-registry-ignore' if
+           ;; `gnus-registry-ignored-groups' is a list of lists
+           ;; (it can be a list of regexes)
+           (and (listp (nth 0 gnus-registry-ignored-groups))
+                (get-buffer "*Group*")  ; in automatic tests this is false
+                (gnus-parameter-registry-ignore group))
            (gnus-grep-in-list
             group
             nnmail-split-fancy-with-parent-ignore-groups))))
@@ -956,8 +962,8 @@ only the last one's marks are returned."
          (entries (registry-lookup db (list id))))
 
     (when (null entries)
-      (registry-insert db id (list (list 'creation-time (current-time))
-                                   '(group) '(sender) '(subject)))
+      (gnus-registry-insert db id (list (list 'creation-time (current-time))
+                                        '(group) '(sender) '(subject)))
       (setq entries (registry-lookup db (list id))))
 
     (nth 1 (assoc id entries))))
@@ -973,9 +979,17 @@ only the last one's marks are returned."
          (entry (gnus-registry-get-or-make-entry id)))
     (registry-delete db (list id) nil)
     (setq entry (cons (cons key vals) (assq-delete-all key entry)))
-    (registry-insert db id entry)
+    (gnus-registry-insert db id entry)
     entry))
 
+(defun gnus-registry-insert (db id entry)
+  "Just like `registry-insert' but tries to prune on error."
+  (when (registry-full db)
+    (message "Trying to prune the registry because it's full")
+    (registry-prune db))
+  (registry-insert db id entry)
+  entry)
+
 (defun gnus-registry-import-eld (file)
   (interactive "fOld registry file to import? ")
   ;; example content:
@@ -1069,7 +1083,7 @@ only the last one's marks are returned."
     (should (equal (gnus-registry-get-id-key "34" 'group) '("togroup")))
     (should (equal (gnus-registry-get-id-key "34" 'subject) '("subject 4")))
     (message "Trying to insert a duplicate key")
-    (should-error (registry-insert db "55" '()))
+    (should-error (gnus-registry-insert db "55" '()))
     (message "Looking up individual keys (gnus-registry-get-or-make-entry)")
     (should (gnus-registry-get-or-make-entry "22"))
     (message "Saving the Gnus registry to %s" tempfile)