bug#45033: 28.0.50; New option gnus-registery-register-all-p

[Eric Abrahamsen <eric@ericabrahamsen.net>]

[-- Attachment #1: Type: text/plain, Size: 1025 bytes --]


The Gnus registry keeps track of all received messages in a series of
databases, and allows the user to split follow-up messages into the same
group as the parent, as well as associate

It currently creates database entries for all messages, which slows down
summary buffer creation, as well as Gnus' saving process.

This patch introduces a new customization option,
`gnus-registry-register-all-p', which, when nil, won't create database
entries automatically. The registry will only contain entries that the
user (or other packages) has created manually. If the user isn't using
automatic splitting, this can provide a significant speedup for general
Gnus usage.

Discussions on gnus.general lead me to believe that universal splitting
isn't used all that often, and that most users are very surprised to
find that they have a 50MB registry file on disk. Therefore I've
defaulted this option to nil, which is a change from previous behavior.
It would be perfectly easy to default to t if this seems inappropriate.

Eric



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-New-option-gnus-registry-register-all-p-default-to-n.patch --]
[-- Type: text/x-patch, Size: 8808 bytes --]

From a3083ea18bee87c805e4ef1b7883171e0bbb66ce Mon Sep 17 00:00:00 2001
From: Eric Abrahamsen <eric@ericabrahamsen.net>
Date: Thu, 3 Dec 2020 15:58:57 -0800
Subject: [PATCH] New option gnus-registry-register-all-p, default to nil

* lisp/gnus/gnus-registry.el (gnus-registry-register-all-p): If nil,
the registry won't automatically create new entries for all seen
messages.
(gnus-registry-handle-action): Don't automatically create entries; if
one doesn't exist, don't handle anything.
(gnus-registry-register-message-ids): Only register if this option is
t.
(gnus-registry-get-or-make-entry): Add optional no-create argument.
(gnus-registry-get-id-key): This "get" operation should only create an
entry if this option is t.
* doc/misc/gnus.texi: Documentation and news.
---
 doc/misc/gnus.texi         | 24 +++++++++++--
 etc/NEWS                   |  8 +++++
 lisp/gnus/gnus-registry.el | 72 +++++++++++++++++++++++---------------
 3 files changed, 72 insertions(+), 32 deletions(-)

diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 4aa07ce388..f1696bf58d 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -26260,6 +26260,16 @@ Gnus Registry Setup
 size, it will reject insertion of new entries.
 @end defvar
 
+@defvar gnus-registry-register-all-p
+If this option is non-nil, the registry will register all messages, as
+you see them.  This is important to making split-to-parent and
+Message-ID references work correctly, as the registry needs to know
+where all messages are.  But it can slow down group opening, and the
+saving of Gnus, so it is nil by default.  This means entries must be
+created manually, for instance by storing a custom flag or keyword for
+the message.
+@end defvar
+
 @defvar gnus-registry-prune-factor
 This option (a float between 0 and 1) controls how much the registry
 is cut back during pruning.  In order to prevent constant pruning, the
@@ -26349,8 +26359,14 @@ Fancy splitting to parent
       "mail")
 @end lisp
 
-in your fancy split setup.  In addition, you may want to customize the
-following variables.
+in your fancy split setup.
+
+If @code{gnus-registry-register-all-p} is non-nil, the registry will
+perform splitting for all messages.  If it is nil (the default),
+splitting will only happen for children of messages you've explicitly
+registered.
+
+In addition, you may want to customize the following variables.
 
 @defvar gnus-registry-track-extra
 This is a list of symbols, so it's best to change it from the
@@ -26423,7 +26439,9 @@ Store arbitrary data
 @end defun
 
 @defun gnus-registry-get-id-key (id key)
-Get the data under @code{key} for message @code{id}.
+Get the data under @code{key} for message @code{id}.  If the option
+@code{gnus-registry-register-all-p} is non-nil, this function will also
+create an entry for @code{id} if one doesn't exist.
 @end defun
 
 @defvar gnus-registry-extra-entries-precious
diff --git a/etc/NEWS b/etc/NEWS
index c9da296278..0782515401 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -488,6 +488,14 @@ tags to be considered as well.
 
 ** Gnus
 
++++
+*** New user option 'gnus-registry-register-all-p'.
+
+If non-nil, create registry entries for all messages.  If nil (the
+default), don't automatically create entries, they must be created
+manually.  This is a change from the previous default behavior, which
+always created entries.
+
 +++
 *** New user option 'gnus-paging-select-next'.
 This controls what happens when using commands like 'SPC' and 'DEL' to
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index 65bcd0e8a3..b4b158bd02 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -54,6 +54,9 @@
 
 ;; (: gnus-registry-split-fancy-with-parent)
 
+;; This won't work as expected unless `gnus-registry-register-all-p'
+;; is set to t.
+
 ;; You should also consider using the nnregistry backend to look up
 ;; articles.  See the Gnus manual for more information.
 
@@ -160,6 +163,11 @@ gnus-registry-install
                  (const :tag "Always Install" t)
                  (const :tag "Ask Me" ask)))
 
+(defcustom gnus-registry-register-all-p nil
+  "If non-nil, register all articles in the registry."
+  :type 'boolean
+  :version "28.1")
+
 (defvar gnus-registry-enabled nil)
 
 (defvar gnus-summary-misc-menu) ;; Avoid byte compiler warning.
@@ -478,8 +486,8 @@ gnus-registry-handle-action
   (let ((db gnus-registry-db)
         ;; if the group is ignored, set the destination to nil (same as delete)
         (to (if (gnus-registry-ignore-group-p to) nil to))
-        ;; safe if not found
-        (entry (gnus-registry-get-or-make-entry id))
+        ;; Only retrieve an existing entry, don't create a new one.
+        (entry (gnus-registry-get-or-make-entry id t))
         (subject (gnus-string-remove-all-properties
                   (gnus-registry-simplify-subject subject)))
         (sender (gnus-string-remove-all-properties sender)))
@@ -488,29 +496,30 @@ gnus-registry-handle-action
     ;; several times but it's better to bunch the transactions
     ;; together
 
-    (registry-delete db (list id) nil)
-    (when from
-      (setq entry (cons (delete from (assoc 'group entry))
-                        (assq-delete-all 'group entry))))
-    ;; Only keep the entry if the message is going to a new group, or
-    ;; it's still in some previous group.
-    (when (or to (alist-get 'group entry))
-      (dolist (kv `((group ,to)
-                    (sender ,sender)
-                    (recipient ,@recipients)
-                    (subject ,subject)))
-	(when (cadr kv)
-          (let ((new (or (assq (car kv) entry)
-			 (list (car kv)))))
-            (dolist (toadd (cdr kv))
-              (unless (member toadd new)
-		(setq new (append new (list toadd)))))
-            (setq entry (cons new
-                              (assq-delete-all (car kv) entry))))))
-      (gnus-message 10 "Gnus registry: new entry for %s is %S"
-                    id
-                    entry)
-      (gnus-registry-insert db id entry))))
+    (when entry
+      (registry-delete db (list id) nil)
+      (when from
+	(setq entry (cons (delete from (assoc 'group entry))
+                          (assq-delete-all 'group entry))))
+      ;; Only keep the entry if the message is going to a new group, or
+      ;; it's still in some previous group.
+      (when (or to (alist-get 'group entry))
+	(dolist (kv `((group ,to)
+                      (sender ,sender)
+                      (recipient ,@recipients)
+                      (subject ,subject)))
+	  (when (cadr kv)
+            (let ((new (or (assq (car kv) entry)
+			   (list (car kv)))))
+              (dolist (toadd (cdr kv))
+		(unless (member toadd new)
+		  (setq new (append new (list toadd)))))
+              (setq entry (cons new
+				(assq-delete-all (car kv) entry))))))
+	(gnus-message 10 "Gnus registry: new entry for %s is %S"
+                      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.
@@ -846,7 +855,8 @@ gnus-registry-find-keywords
 
 (defun gnus-registry-register-message-ids ()
   "Register the Message-ID of every article in the group."
-  (unless (gnus-parameter-registry-ignore gnus-newsgroup-name)
+  (unless (or (gnus-parameter-registry-ignore gnus-newsgroup-name)
+	      (null gnus-registry-register-all-p))
     (dolist (article gnus-newsgroup-articles)
       (let* ((id (gnus-registry-fetch-message-id-fast article))
              (groups (gnus-registry-get-id-key id 'group)))
@@ -1082,12 +1092,15 @@ gnus-registry-group-count
   "Get the number of groups of a message, based on the message ID."
   (length (gnus-registry-get-id-key id 'group)))
 
-(defun gnus-registry-get-or-make-entry (id)
+(defun gnus-registry-get-or-make-entry (id &optional no-create)
+  "Return registry entry for ID.
+If entry is not found, create a new one, unless NO-create is
+non-nil."
   (let* ((db gnus-registry-db)
          ;; safe if not found
          (entries (registry-lookup db (list id))))
 
-    (when (null entries)
+    (unless (or entries no-create)
       (gnus-registry-insert db id (list (list 'creation-time (current-time))
                                         '(group) '(sender) '(subject)))
       (setq entries (registry-lookup db (list id))))
@@ -1098,7 +1111,8 @@ gnus-registry-delete-entries
   (registry-delete gnus-registry-db idlist nil))
 
 (defun gnus-registry-get-id-key (id key)
-  (cdr-safe (assq key (gnus-registry-get-or-make-entry id))))
+  (cdr-safe (assq key (gnus-registry-get-or-make-entry
+		       id (null gnus-registry-register-all-p)))))
 
 (defun gnus-registry-set-id-key (id key vals)
   (let* ((db gnus-registry-db)
-- 
2.29.2