Subject: Re: bug#66394: 29.1; Make register-read-with-preview more useful

From: Thierry Volpiatto <[email-masked]>
Date: Mon, 11 Dec 2023 06:55:17 +0000

Hello Eli,

I tried to fullfill the requests on Emacs-devel about overwriting a
register with no confirmation, this will happen when
register-use-preview is nil or 'never.  Even with this configuration we
still have filtering when preview buffer is visible and in any case we
have defaults with M-n available when the register command is of type
'set'.

So now to resume the situation:

1) register-use-preview == t

We have a register-preview buffer with navigation and selected register
highlighted, when the register is selected we have to press RET to do
the action on this register.  Defaults are provided for registers of
type set.  Registers are filtered depending on the command used.

2) register-use-preview == nil

We have a register-preview buffer with no navigation and no
highlighting.  No confirmation with RET is requested, as soon as you
enter the register name, minibuffer is exited immediately.  Filtering
and defaults for register of type set are still provided.

3) register-use-preview == 'never

Same behavior as 2) but there is no preview buffer at all, however if
user type C-h, a preview buffer is provided behaving like 1) i.e. RET is
requested when selecting a register.

4) For registers which are key sequence e.g. C-a

For entering manually in minibuffer such a register one have to hit C-d
C-a.  This is now the only thing that differ from Emacs-29.1 behavior.

Let me know if I can push this patch.

I think all this is a real improvement for Emacs despite the several
complaints we had recently, however if all the arrangements I did are
not enough, we could add a new variable register-read-preview-function
and reinstall the old code exactly as it was (it's easy, let me know if
you want this I will provide the patch).

Thanks.

-- 
Thierry
From f5ded67a4e3dfe8ef96971f8018b12cf26c13af2 Mon Sep 17 00:00:00 2001
From: Thierry Volpiatto <[email-masked]>
Date: Mon, 11 Dec 2023 07:02:40 +0100
Subject: [PATCH] Don't confirm with RET even when overwriting in register
 commands

This happen when register-use-preview is nil or never.
This reproduce what we had previously in 29.1 but with filtering in
the preview and default registers are provided for the commands of
type 'set'.

This is implemented with cl-defmethod to keep the code as much as
possible configurable.

* lisp/register.el (register-preview-info): New slot.
(register-command-info): Add new methods for copy-to-register,
point-to-register, number-to-register,
window-configuration-to-register, frameset-to-register and
copy-rectangle-to-register.
(register-read-with-preview): Bind noconfirm.
---
 lisp/register.el | 67 ++++++++++++++++++++++++++++++++++++++++--------
 1 file changed, 56 insertions(+), 11 deletions(-)

diff --git a/lisp/register.el b/lisp/register.el
index ade65b5bdc2..2f2f5682e34 100644
--- a/lisp/register.el
+++ b/lisp/register.el
@@ -155,7 +155,7 @@ TYPES are the types of register supported.
 MSG is the minibuffer message to send when a register is selected.
 ACT is the type of action the command is doing on register.
 SMATCH accept a boolean value to say if command accept non matching register."
-  types msg act smatch)
+  types msg act smatch noconfirm)
 
 (cl-defgeneric register-command-info (command)
   "Returns a `register-preview-info' object storing data for COMMAND."
@@ -178,24 +178,66 @@ SMATCH accept a boolean value to say if command accept non matching register."
    :types '(all)
    :msg "View register `%s'"
    :act 'view
+   :noconfirm (memq register-preview-use-preview '(nil never))
    :smatch t))
 (cl-defmethod register-command-info ((_command (eql append-to-register)))
   (make-register-preview-info
    :types '(string number)
    :msg "Append to register `%s'"
    :act 'modify
+   :noconfirm (memq register-preview-use-preview '(nil never))
    :smatch t))
 (cl-defmethod register-command-info ((_command (eql prepend-to-register)))
   (make-register-preview-info
    :types '(string number)
    :msg "Prepend to register `%s'"
    :act 'modify
+   :noconfirm (memq register-preview-use-preview '(nil never))
    :smatch t))
 (cl-defmethod register-command-info ((_command (eql increment-register)))
   (make-register-preview-info
    :types '(string number)
    :msg "Increment register `%s'"
    :act 'modify
+   :noconfirm (memq register-preview-use-preview '(nil never))
+   :smatch t))
+(cl-defmethod register-preview-command-info ((_command (eql copy-to-register)))
+  (make-register-preview-info
+   :types '(all)
+   :msg "Copy to register `%s'"
+   :act 'set
+   :noconfirm (memq register-use-preview '(nil never))))
+(cl-defmethod register-preview-command-info ((_command (eql point-to-register)))
+  (make-register-preview-info
+   :types '(all)
+   :msg "Point to register `%s'"
+   :act 'set
+   :noconfirm (memq register-use-preview '(nil never))))
+(cl-defmethod register-preview-command-info ((_command (eql number-to-register)))
+  (make-register-preview-info
+   :types '(all)
+   :msg "Number to register `%s'"
+   :act 'set
+   :noconfirm (memq register-use-preview '(nil never))))
+(cl-defmethod register-preview-command-info
+    ((_command (eql window-configuration-to-register)))
+  (make-register-preview-info
+   :types '(all)
+   :msg "Window configuration to register `%s'"
+   :act 'set
+   :noconfirm (memq register-use-preview '(nil never))))
+(cl-defmethod register-preview-command-info ((_command (eql frameset-to-register)))
+  (make-register-preview-info
+   :types '(all)
+   :msg "Frameset to register `%s'"
+   :act 'set
+   :noconfirm (memq register-use-preview '(nil never))))
+(cl-defmethod register-preview-command-info ((_command (eql copy-rectangle-to-register)))
+  (make-register-preview-info
+   :types '(all)
+   :msg "Copy rectangle to register `%s'"
+   :act 'set
+   :noconfirm (memq register-use-preview '(nil never))
    :smatch t))
 
 (defun register-preview-forward-line (arg)
@@ -327,12 +369,13 @@ display such a window regardless."
                 m))
          (data (register-command-info this-command))
          (enable-recursive-minibuffers t)
-         types msg result timer act win strs smatch)
+         types msg result timer act win strs smatch noconfirm)
     (if data
-        (setq types  (register-preview-info-types data)
-              msg    (register-preview-info-msg   data)
-              act    (register-preview-info-act   data)
-              smatch (register-preview-info-smatch data))
+        (setq types     (register-preview-info-types data)
+              msg       (register-preview-info-msg   data)
+              act       (register-preview-info-act   data)
+              smatch    (register-preview-info-smatch data)
+              noconfirm (register-preview-info-noconfirm data))
       (setq types '(all)
             msg   "Overwrite register `%s'"
             act   'set))
@@ -399,13 +442,15 @@ display such a window regardless."
                                          "Register `%s' is empty" pat))))))
                             (unless (string= pat "")
                               (with-selected-window (minibuffer-window)
-                                (if (and (member pat strs) (memq act '(set modify)))
+                                (if (and (member pat strs)
+                                         (memq act '(set modify))
+                                         (null noconfirm))
                                     (with-selected-window (minibuffer-window)
                                       (minibuffer-message msg pat))
-                                  ;; An empty register or an existing
-                                  ;; one but the action is insert or
-                                  ;; jump, don't ask for confirmation
-                                  ;; and exit immediately (bug#66394).
+                                  ;; The action is insert or
+                                  ;; jump or noconfirm is specifed
+                                  ;; explicitely, don't ask for
+                                  ;; confirmation and exit immediately (bug#66394).
                                   (setq result pat)
                                   (exit-minibuffer)))))))))
              (setq result (read-from-minibuffer
-- 
2.34.1