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

From: Eric Abrahamsen <[email-masked]>
Date: Fri, 04 Dec 2020 09:35:52 -0800

Lars Ingebrigtsen <[email-masked]> writes:

> Eric Abrahamsen <[email-masked]> writes:
>
>> 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.
>
> Makes sense to me.  However, the option shouldn't have a name ending in
> -p -- that's for predicate functions only.  `gnus-registry-register-all'
> would be a better name.

Ah, I hesitated about that. Thanks.

>> 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.
>
> I think defaulting it to t makes more sense (besides being more
> backwards-compatible) -- the registry isn't on by default, after all.

Makes sense. Here's a new version of the patch with option name edited
and docs adjusted.

>From 1b94a5bc72ac56a132f73b5d1732800ac0ee830d Mon Sep 17 00:00:00 2001
From: Eric Abrahamsen <[email-masked]>
Date: Thu, 3 Dec 2020 15:58:57 -0800
Subject: [PATCH] New option gnus-registry-register-all

* lisp/gnus/gnus-registry.el (gnus-registry-register-all): If nil,
the registry won't automatically create new entries for all seen
messages. Defaults to t to preserve previous behavior.
(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                   |  7 ++++
 lisp/gnus/gnus-registry.el | 72 +++++++++++++++++++++++---------------
 3 files changed, 71 insertions(+), 32 deletions(-)

diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 4aa07ce388..3659134621 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
+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.  If this option is nil, 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} is non-nil (the default), the
+registry will perform splitting for all messages.  If it is nil,
+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} 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 7f18f12946..0163c43e56 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -488,6 +488,13 @@ tags to be considered as well.
 
 ** Gnus
 
++++
+*** New user option 'gnus-registry-register-all'.
+
+If non-nil (the default), create registry entries for all messages.
+If nil, don't automatically create entries, they must be created
+manually.
+
 +++
 *** 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..31aee0364c 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'
+;; 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 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))
     (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)))))
 
 (defun gnus-registry-set-id-key (id key vals)
   (let* ((db gnus-registry-db)
-- 
2.29.2