Only show applicable registers in *Register preview* buffer

* lisp/register.el (register-preview-default): Doc fix.
(register-read-with-preview): Preserve 'last-input-event' when calling
'y-or-n-p'.  New optional argument PRED, pass it to...
(register-preview): New optional argument PRED.
(register-jump-p, register-insert-p, register-increment-p): New func.
(jump-to-register, increment-register, insert-register)
(append-to-register, prepend-to-register): Update.
* doc/lispref/text.texi (Registers): Update
'register-read-with-preview' documentation.
* etc/NEWS: Announce it.

diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 9f9c7ed0783e098b892cc821b85a0f40d68674ca..d29def5f102d91e4f756ebd2e099dbd88f768047 100644 (file)
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -4713,7 +4713,7 @@ a rectangle (a list), currently useless things happen.  This may be
 changed in the future.
 @end deffn
 
-@defun register-read-with-preview prompt &optional confirm
+@defun register-read-with-preview prompt &optional confirm pred
 @cindex register preview
 This function reads and returns a register name, prompting with
 @var{prompt} and possibly showing a preview of the existing registers
@@ -4723,8 +4723,11 @@ if its value and @code{register-alist} are both non-@code{nil}.  The
 preview is also shown if the user requests help (e.g., by typing the
 help character).  If optional argument @var{confirm} is
 non-@code{nil}, this function asks for confirmation before returning a
-register that is already in use.  We recommend that all interactive
-commands which read register names use this function.
+register that is already in use.  Optional argument @var{pred}, if
+non-@code{nil}, is a function that takes the contents of a register
+and returns non-@code{nil} if that register should appear in the
+preview.  We recommend that all interactive commands which read
+register names use this function.
 @end defun
 
 @node Transposition

diff --git a/etc/NEWS b/etc/NEWS
index 93d8a70d55b6aad84d785b7c01e163fb3127ac0d..3a10e17d03804c9185c3637a0852a1f0e52f9ce0 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -258,6 +258,19 @@ called in the '--eval' expression, which is useful when those
 arguments contain arbitrary characters that otherwise might require
 elaborate and error-prone escaping (to protect them from the shell).
 
+** Registers
+
++++
+*** New user option 'register-confirm-overwrite'.
+Emacs now defaults to asking for confirmation before overwriting
+registers with existing contents.  To disable such confirmation,
+customize this option to nil.
+
++++
+*** Commands that use register contents now preview only relevant registers.
+For example, 'jump-to-register' now only shows registers that you can
+actually jump to in the *Register Preview* buffer.
+
 \f
 * Editing Changes in Emacs 30.1
 
@@ -1115,12 +1128,6 @@ macros with many lines, such as from 'kmacro-edit-lossage'.
 
 ** Miscellaneous
 
-+++
-*** New user option 'register-confirm-overwrite'.
-Emacs now defaults to asking for confirmation before overwriting
-registers with existing contents.  To disable such confirmation,
-customize this option to nil.
-
 ---
 *** Webjump now assumes URIs are HTTPS instead of HTTP.
 For links in 'webjump-sites' without an explicit URI scheme, it was

diff --git a/lisp/register.el b/lisp/register.el
index 4e400fbff2cd43281844680e13192246198dadeb..3df5a5d5abc0ee1ab74ad8eaad02d81576682d09 100644 (file)
--- a/lisp/register.el
+++ b/lisp/register.el
@@ -124,7 +124,10 @@ See the documentation of the variable `register-alist' for possible VALUEs."
       d)))
 
 (defun register-preview-default (r)
-  "Function that is the default value of the variable `register-preview-function'."
+  "Return a string describing the register R.
+
+This function is the default value of
+`register-preview-function', which see."
   (format "%s: %s\n"
          (single-key-description (car r))
          (register-describe-oneline (car r))))
@@ -134,46 +137,59 @@ See the documentation of the variable `register-alist' for possible VALUEs."
 Called with one argument, a cons (NAME . CONTENTS) as found in `register-alist'.
 The function should return a string, the description of the argument.")
 
-(defun register-preview (buffer &optional show-empty highlight)
+(defun register-preview (buffer &optional show-empty highlight pred)
   "Pop up a window showing the registers preview in BUFFER.
 If SHOW-EMPTY is non-nil, show the window even if no registers.
-Optional argument HIGHLIGHT says to highlight the description of
-a register with that name.  Format of each entry is controlled by
-the variable `register-preview-function'."
+Third optional argument HIGHLIGHT says to highlight the
+description of a register with that name.
+
+Fourth optional argument PRED, if non-nil, is a function that
+takes the contents of a register and returns non-nil if the
+corresponding register should appear in the preview (see
+`register-preview' for the format of the register contents).
+
+The the variable `register-preview-function' controls the
+format of each entry in the preview."
   (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
-       (delete-region (point-min) (point-max))
-       (setq cursor-in-non-selected-windows nil)
-       (mapc (lambda (elem)
-               (when-let ((name (car elem))
-                          (reg (get-register name))
-                          (desc (funcall register-preview-function elem)))
-                 (when (equal highlight name)
-                   (add-face-text-property 0 (length desc) 'match nil desc))
-                 (insert desc)))
-             register-alist)))))
-
-(defun register-read-with-preview (prompt &optional confirm)
+        buffer
+        (cons 'display-buffer-below-selected
+             '((window-height . fit-window-to-buffer)
+               (preserve-size . (nil . t))))
+        nil
+      (with-current-buffer standard-output
+        (delete-region (point-min) (point-max))
+        (setq cursor-in-non-selected-windows nil)
+        (mapc (lambda (elem)
+                (let ((hilit nil)
+                      (name (car elem))
+                      (desc (funcall register-preview-function elem)))
+                  (when (equal highlight name)
+                    (add-face-text-property 0 (length desc) 'match nil desc)
+                    (setq hilit t))
+                  (when (or hilit
+                            (null pred)
+                            (funcall pred (cdr elem)))
+                    (insert desc))))
+              register-alist)))))
+
+(defun register-read-with-preview (prompt &optional confirm pred)
   "Read and return a register name, possibly showing existing registers.
-Prompt with the string PROMPT.  Optional argument CONFIRM says to
-ask for confirmation if the register is already in use and
-`register-confirm-overwrite' is non-nil.  If `register-alist' and
-`register-preview-delay' are both non-nil, display a window
+Prompt with the string PROMPT.  Second optional argument CONFIRM
+says to ask for confirmation if the register is already in use
+and `register-confirm-overwrite' is non-nil.  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."
+seconds, or immediately in response to `help-char' (or a member
+of `help-event-list').  Third optional argument PRED is a
+predicate that registers must satisfy to appear in the preview,
+see `register-preview'."
   (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))))))
+                                     (register-preview buffer nil nil pred))))))
         (help-chars (cl-loop for c in (cons help-char help-event-list)
                              when (not (get-register c))
                              collect c)))
@@ -182,7 +198,7 @@ pressed, display such a window regardless."
          (while (memq (read-key (propertize prompt 'face 'minibuffer-prompt))
                       help-chars)
            (unless (get-buffer-window buffer)
-             (register-preview buffer 'show-empty)))
+             (register-preview buffer 'show-empty nil pred)))
           (cond
            ((or (eq ?\C-g last-input-event)
                 (eq 'escape last-input-event)
@@ -190,8 +206,8 @@ pressed, display such a window regardless."
             (keyboard-quit))
            ((and (get-register last-input-event)
                  confirm register-confirm-overwrite
-                 (not (progn
-                        (register-preview buffer nil last-input-event)
+                 (not (let ((last-input-event last-input-event))
+                        (register-preview buffer nil last-input-event pred)
                         (y-or-n-p (substitute-quotes
                                    (format "Overwrite register `%s'?"
                                            (single-key-description
@@ -260,6 +276,21 @@ Interactively, prompt for REGISTER using `register-read-with-preview'."
 
 (make-obsolete 'frame-configuration-to-register 'frameset-to-register "24.4")
 
+(declare-function frameset-register-p "frameset")
+
+(defun register-jump-p (contents)
+  "Return non-nil if \\[jump-to-register] can apply to register CONTENTS."
+  (or (and (registerv-p contents) (registerv-jump-func contents))
+      (markerp contents)
+      (and (consp contents)
+           (let ((cont (car contents)))
+             (or (frame-configuration-p cont)
+                 (window-configuration-p cont)
+                 (eq cont 'file)
+                 (eq cont 'buffer)
+                 (eq cont 'file-query))))
+      (and (featurep 'frameset) (frameset-register-p contents))))
+
 (defalias 'register-to-point 'jump-to-register)
 (defun jump-to-register (register &optional delete)
   "Go to location stored in REGISTER, or restore configuration stored there.
@@ -277,7 +308,8 @@ to delete any existing frames that the frameset doesn't mention.
 ignored if the register contains anything but a frameset.
 
 Interactively, prompt for REGISTER using `register-read-with-preview'."
-  (interactive (list (register-read-with-preview "Jump to register: ")
+  (interactive (list (register-read-with-preview "Jump to register: "
+                                                 nil #'register-jump-p)
                     current-prefix-arg))
   (let ((val (get-register register)))
     (register-val-jump-to val delete)))
@@ -352,6 +384,10 @@ Interactively, prompt for REGISTER using `register-read-with-preview'."
                        (string-to-number (match-string 0)))
                    0))))
 
+(defun register-increment-p (contents)
+  "Return non-nil if \\[increment-register] can apply to register CONTENTS."
+  (or (numberp contents) (stringp contents)))
+
 (defun increment-register (prefix register)
   "Augment contents of REGISTER using PREFIX.
 Interactively, PREFIX is the raw prefix argument.
@@ -364,7 +400,8 @@ If REGISTER is empty or if it contains text, call
 
 Interactively, prompt for REGISTER using `register-read-with-preview'."
   (interactive (list current-prefix-arg
-                    (register-read-with-preview "Increment register: ")))
+                    (register-read-with-preview "Increment register: "
+                                                 nil #'register-increment-p)))
   (let ((register-val (get-register register)))
     (cond
      ((numberp register-val)
@@ -500,6 +537,11 @@ Second argument VERBOSE means produce a more detailed description."
      (t
       (princ "the empty string")))))
 
+(defun register-insert-p (contents)
+  "Return non-nil if \\[insert-register] can apply to register CONTENTS."
+  (or (and (registerv-p contents) (registerv-insert-func contents))
+      (stringp (car (ensure-list contents)))))
+
 (defun insert-register (register &optional arg)
   "Insert contents of REGISTER at point.
 REGISTER is a character, the name of the register.
@@ -511,7 +553,8 @@ and t otherwise.
 Interactively, prompt for REGISTER using `register-read-with-preview'."
   (interactive (progn
                 (barf-if-buffer-read-only)
-                (list (register-read-with-preview "Insert register: ")
+                (list (register-read-with-preview "Insert register: "
+                                                   nil #'register-insert-p)
                       (not current-prefix-arg))))
   (push-mark)
   (let ((val (get-register register)))
@@ -576,7 +619,8 @@ START and END are buffer positions indicating what to append.
 
 Interactively, prompt for REGISTER using `register-read-with-preview',
 and use mark and point as START and END."
-  (interactive (list (register-read-with-preview "Append to register: ")
+  (interactive (list (register-read-with-preview "Append to register: "
+                                                 nil #'stringp)
                     (region-beginning)
                     (region-end)
                     current-prefix-arg))
@@ -602,7 +646,8 @@ START and END are buffer positions indicating what to prepend.
 
 Interactively, prompt for REGISTER using `register-read-with-preview',
 and use mark and point as START and END."
-  (interactive (list (register-read-with-preview "Prepend to register: ")
+  (interactive (list (register-read-with-preview "Prepend to register: "
+                                                 nil #'stringp)
                     (region-beginning)
                     (region-end)
                     current-prefix-arg))