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.
This commit is contained in:
Eric Abrahamsen 2020-12-03 15:58:57 -08:00
parent b1f2eada47
commit 8a220d7c8f
3 changed files with 71 additions and 32 deletions

View file

@ -26287,6 +26287,16 @@ registry will keep. If the registry has reached or exceeded this
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
@ -26376,8 +26386,14 @@ have to put a rule like this:
"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
@ -26450,7 +26466,9 @@ Store @code{value} under @code{key} for message @code{id}.
@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

View file

@ -517,6 +517,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 options to customise the summary line specs %[ and %].
Four new options introduced in customisation group

View file

@ -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 @@ nnmairix groups are specifically excluded because they are ephemeral."
(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 @@ This is not required after changing `gnus-registry-cache-file'."
(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 @@ This is not required after changing `gnus-registry-cache-file'."
;; 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 @@ Overrides existing keywords with FORCE set non-nil."
(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 @@ only the last one's marks are returned."
"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 @@ only the last one's marks are returned."
(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)