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

From: Thierry Volpiatto <[email-masked]>
Date: Mon, 11 Dec 2023 09:30:50 +0000

Hello Eli, 

here the last patch that provide Emacs-29 previous behavior as asked on emacs-dev,
I made it the default for now.
The only customization one have to do to make a change is through
register-use-preview which have now three options:

- basic (default - same as Emacs-29- )
- nil (simple preview with filtering, default and no confirm)
- never (same as nil but without any preview)
- t  (the improved version with navigation etc...)

I don't know if you want to restore previous behavior (emacs-29), if so this patch
will apply against the previous one.
(0001-Don-t-confirm-with-RET-even-when-overwriting-in-regi.patch).

Thanks.

-- 
Thierry
From 1b85a30f0150b0427b8efb3dee9ea4d740f3254b Mon Sep 17 00:00:00 2001
From: Thierry Volpiatto <[email-masked]>
Date: Mon, 11 Dec 2023 09:02:58 +0100
Subject: [PATCH] Provide emacs-29 behavior for register-preview

It is now the default with a value of register-use-preview eq to
basic.
To change this one have now to customize register-use-preview to
another value.

* lisp/register.el (register-preview-delay): Remove obsolescence.
(register--read-with-preview-function): New.
(register-use-preview): New option basic, it is now the default.
(register-preview-default-1): New the register-preview-default used by
`register-read-with-preview-fancy`.
(register-preview-default): Restored (same as Emacs-29).
(register--preview-function): Generic fn that return the right
function for register--preview-function.
(register-preview): Restored (same behavior as Emacs-29).
(register-preview-1): Used by `register-read-with-preview-fancy'.
(register-read-with-preview-basic): The old
register-read-with-preview.
(register-read-with-preview-fancy): The new
register-read-with-preview.
---
 lisp/register.el | 133 ++++++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 121 insertions(+), 12 deletions(-)

diff --git a/lisp/register.el b/lisp/register.el
index 2f2f5682e34..5818e818787 100644
--- a/lisp/register.el
+++ b/lisp/register.el
@@ -100,24 +100,49 @@ If nil, do not show register previews, unless `help-char' (or a member of
   :version "24.4"
   :type '(choice number (const :tag "No preview unless requested" nil))
   :group 'register)
-(make-obsolete-variable 'register-preview-delay "No longer used." "30.1")
 
 (defcustom register-preview-default-keys (mapcar #'string (number-sequence ?a ?z))
   "Default keys for setting a new register."
-  :type '(repeat string))
-
-(defcustom register-use-preview t
+  :type '(repeat string)
+  :version 30.1)
+
+(defvar register--read-with-preview-function nil
+  "The register read preview function to use.
+Two functions are provided, one that provide navigation and
+highlighting of the register selected, filtering of register
+according to command in use, defaults register to use when
+setting a new register, confirmation and notification when you
+are about to overwrite a register and generic functions to
+configure how each existing commands behave.  The other function
+provided is the same as what was used in Emacs-29, no filtering,
+no navigation, no defaults.")
+
+(defcustom register-use-preview 'basic
   "Maybe show register preview.
 
+This have no effect when `register--read-with-preview-function' value
+is `register-read-with-preview-basic'.
+
 When set to `t' show a preview buffer with navigation and highlighting.
 When nil show a basic preview buffer and exit minibuffer
 immediately after insertion in minibuffer.
 When set to \\='never behave as above but with no preview buffer at
-all."
+all.
+When set to \\='basic provide a much more basic preview according to
+`register-preview-delay', it have the exact same behavior as in Emacs-29."
   :type '(choice
           (const :tag "Use preview" t)
           (const :tag "Use quick preview" nil)
-          (const :tag "Never use preview" never)))
+          (const :tag "Never use preview" never)
+          (const :tag "Basic preview like Emacs-29" basic))
+  :version 30.1
+  :set (lambda (var val)
+         (set var val)
+         (setq register--read-with-preview-function
+               (if (eq val 'basic)
+                   #'register-read-with-preview-basic
+                 #'register-read-with-preview-fancy))
+         (setq register-preview-function nil)))
 
 (defun get-register (register)
   "Return contents of Emacs register named REGISTER, or nil if none."
@@ -137,17 +162,34 @@ See the documentation of the variable `register-alist' for possible VALUEs."
         (substring d (match-end 0))
       d)))
 
-(defun register-preview-default (r)
+(defun register-preview-default-1 (r)
   "Function that is the default value of the variable `register-preview-function'."
   (format "%s: %s\n"
 	  (propertize (string (car r))
                       'display (single-key-description (car r)))
 	  (register-describe-oneline (car r))))
 
-(defvar register-preview-function #'register-preview-default
+(defun register-preview-default (r)
+  "Function that is the default value of the variable `register-preview-function'."
+  (format "%s: %s\n"
+	  (single-key-description (car r))
+	  (register-describe-oneline (car r))))
+
+(defvar register-preview-function nil
   "Function to format a register for previewing.
 Called with one argument, a cons (NAME . CONTENTS) as found in `register-alist'.
-The function should return a string, the description of the argument.")
+The function should return a string, the description of the argument.
+It is set according to the value of `register--read-with-preview-function'.")
+
+(cl-defgeneric register--preview-function (read-preview-function)
+  "Returns a function to format a register for previewing.
+This accorfing to the value of read-preview-function.")
+(cl-defmethod register--preview-function ((read-preview-function
+                                           (eql 'register-read-with-preview-basic)))
+  #'register-preview-default)
+(cl-defmethod register--preview-function ((read-preview-function
+                                           (eql 'register-read-with-preview-fancy)))
+  #'register-preview-default-1)
 
 (cl-defstruct register-preview-info
   "Store data for a specific register command.
@@ -326,12 +368,39 @@ satisfy `cl-typep' otherwise the new type should be defined with
              when (memq (register-type register) types)
              collect register)))
 
-(defun register-preview (buffer &optional show-empty types)
+(defun register-preview (buffer &optional show-empty)
+  "Pop up a window showing the registers preview in BUFFER.
+If SHOW-EMPTY is non-nil, show the window even if no registers.
+Format of each entry is controlled by the variable `register-preview-function'."
+  (unless register-preview-function
+    (setq register-preview-function (register--preview-function
+                                     register--read-with-preview-function)))
+  (when (or show-empty (consp register-alist))
+    (with-current-buffer-window
+     buffer
+     (cons 'display-buffer-below-selected
+	   '((window-height . fit-window-to-buffer)
+	     (preserve-size . (nil . t))))
+     nil
+     (with-current-buffer standard-output
+       (setq cursor-in-non-selected-windows nil)
+       (mapc (lambda (elem)
+               (when (get-register (car elem))
+                 (insert (funcall register-preview-function elem))))
+             register-alist)))))
+
+(defun register-preview-1 (buffer &optional show-empty types)
   "Pop up a window showing the registers preview in BUFFER.
+
+This is the preview function use with
+`register-read-with-preview-fancy' function.
 If SHOW-EMPTY is non-nil, show the window even if no registers.
 Argument TYPES (a list) specify the types of register to show, when nil show all
 registers, see `register-type' for suitable types.
 Format of each entry is controlled by the variable `register-preview-function'."
+  (unless register-preview-function
+    (setq register-preview-function (register--preview-function
+                                     register--read-with-preview-function)))
   (let ((registers (register-of-type-alist (or types '(all)))))
     (when (or show-empty (consp registers))
       (with-current-buffer-window
@@ -359,6 +428,46 @@ Format of each entry is controlled by the variable `register-preview-function'."
   "Read and return a register name, possibly showing existing registers.
 Prompt with the string PROMPT.
 If `help-char' (or a member of `help-event-list') is pressed,
+display such a window regardless."
+  (funcall register--read-with-preview-function prompt))
+
+(defun register-read-with-preview-basic (prompt)
+  "Read and return a register name, possibly showing existing registers.
+Prompt with the string PROMPT.  If `register-alist' and
+`register-preview-delay' are both non-nil, display a window
+listing existing registers after `register-preview-delay' seconds.
+If `help-char' (or a member of `help-event-list') is pressed,
+display such a window regardless."
+  (let* ((buffer "*Register Preview*")
+	 (timer (when (numberp register-preview-delay)
+		  (run-with-timer register-preview-delay nil
+				  (lambda ()
+				    (unless (get-buffer-window buffer)
+				      (register-preview buffer))))))
+	 (help-chars (cl-loop for c in (cons help-char help-event-list)
+			      when (not (get-register c))
+			      collect c)))
+    (unwind-protect
+	(progn
+	  (while (memq (read-key (propertize prompt 'face 'minibuffer-prompt))
+		       help-chars)
+	    (unless (get-buffer-window buffer)
+	      (register-preview buffer 'show-empty)))
+          (when (or (eq ?\C-g last-input-event)
+                    (eq 'escape last-input-event)
+                    (eq ?\C-\[ last-input-event))
+            (keyboard-quit))
+	  (if (characterp last-input-event) last-input-event
+	    (error "Non-character input-event")))
+      (and (timerp timer) (cancel-timer timer))
+      (let ((w (get-buffer-window buffer)))
+        (and (window-live-p w) (delete-window w)))
+      (and (get-buffer buffer) (kill-buffer buffer)))))
+
+(defun register-read-with-preview-fancy (prompt)
+  "Read and return a register name, possibly showing existing registers.
+Prompt with the string PROMPT.
+If `help-char' (or a member of `help-event-list') is pressed,
 display such a window regardless."
   (let* ((buffer "*Register Preview*")
          (buffer1 "*Register quick preview*")
@@ -391,13 +500,13 @@ display such a window regardless."
                        ;; Do nothing when buffer1 is in use.
                        (unless (get-buffer-window buf)
                          (with-selected-window (minibuffer-selected-window)
-                           (register-preview buffer 'show-empty types))))))
+                           (register-preview-1 buffer 'show-empty types))))))
     (define-key map (kbd "<down>") 'register-preview-next)
     (define-key map (kbd "<up>")   'register-preview-previous)
     (define-key map (kbd "C-n")    'register-preview-next)
     (define-key map (kbd "C-p")    'register-preview-previous)
     (unless (or executing-kbd-macro (eq register-use-preview 'never))
-      (register-preview buf nil types))
+      (register-preview-1 buf nil types))
     (unwind-protect
          (progn
            (minibuffer-with-setup-hook
-- 
2.34.1