From 773509b596391025dedd155d0265bbd0f3371f44 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Fri, 15 Dec 2023 17:39:07 +0100 Subject: [PATCH] Reconcile register overwrite confirmation and kbd macros Give full control over overwrite confirmation to callers of this function. Provide a helper function that such callers can use to adhere to standard behavior, and in particular skip confirmation while defining/executing keyboard macros. * lisp/register.el (register-read-with-preview): Simplify. (register-confirm-overwrite): New function. (point-to-register, window-configuration-to-register) (frame-configuration-to-register, number-to-register) (copy-to-register, copy-rectangle-to-register) * lisp/play/gametree.el (gametree-layout-to-register) * lisp/kmacro.el (kmacro-to-register) * lisp/frameset.el (frameset-to-register) * lisp/cedet/semantic/senator.el (senator-copy-tag-to-register) * lisp/calc/calc-yank.el (calc-copy-to-register): Use it. * doc/emacs/regs.texi (Registers): Update. * test/lisp/register-tests.el (register-test-bug27634): Adapt. --- doc/emacs/regs.texi | 9 ++++ lisp/calc/calc-yank.el | 3 +- lisp/cedet/semantic/senator.el | 3 +- lisp/frameset.el | 3 +- lisp/kmacro.el | 3 +- lisp/play/gametree.el | 3 +- lisp/register.el | 97 +++++++++++++++++++++------------- test/lisp/register-tests.el | 18 +++---- 8 files changed, 89 insertions(+), 50 deletions(-) diff --git a/doc/emacs/regs.texi b/doc/emacs/regs.texi index e52f68dd18e..20b39b8408f 100644 --- a/doc/emacs/regs.texi +++ b/doc/emacs/regs.texi @@ -42,6 +42,15 @@ customize @code{register-preview-delay}. To prevent this display, set that option to @code{nil}. You can explicitly request a preview window by pressing @kbd{C-h} or @key{F1}. +@vindex register-confirm-overwrite + Commands that potentially overwrite register contents, such as +@code{copy-to-register} (@pxref{Text Registers}), ask for confirmation +when you select a register that is already in use. Setting the user +option @code{register-confirm-overwrite} to @code{nil} disables such +confirmation. Regardless of the value of this option, Emacs +overwrites register contents without confirmation when you are +defining or executing a keyboard macro. @xref{Keyboard Macros}. + @dfn{Bookmarks} record files and positions in them, so you can return to those positions when you look at the file again. Bookmarks are similar in spirit to registers, so they are also documented in diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el index ed1a8e1c046..050e5171e47 100644 --- a/lisp/calc/calc-yank.el +++ b/lisp/calc/calc-yank.el @@ -281,7 +281,8 @@ text or a number) or nil." With prefix arg, delete as well. Interactively, reads the register using `register-read-with-preview'." - (interactive (list (register-read-with-preview "Copy to register: " t) + (interactive (list (register-read-with-preview "Copy to register: " + (register-confirm-overwrite)) (region-beginning) (region-end) current-prefix-arg)) (if (eq major-mode 'calc-mode) diff --git a/lisp/cedet/semantic/senator.el b/lisp/cedet/semantic/senator.el index 2c1fc4fda3b..b42f65c08f0 100644 --- a/lisp/cedet/semantic/senator.el +++ b/lisp/cedet/semantic/senator.el @@ -736,7 +736,8 @@ Optional argument KILL-FLAG will delete the text of the tag to the kill ring. Interactively, reads the register using `register-read-with-preview'." - (interactive (list (register-read-with-preview "Tag to register: " t) + (interactive (list (register-read-with-preview "Tag to register: " + (register-confirm-overwrite)) current-prefix-arg)) (semantic-fetch-tags) (let ((ft (semantic-obtain-foreign-tag))) diff --git a/lisp/frameset.el b/lisp/frameset.el index 63ff4668541..7bc3a81a33d 100644 --- a/lisp/frameset.el +++ b/lisp/frameset.el @@ -1451,7 +1451,8 @@ Use \\[jump-to-register] to restore the frameset. Argument is a character, naming the register. Interactively, reads the register using `register-read-with-preview'." - (interactive (list (register-read-with-preview "Frameset to register: " t))) + (interactive (list (register-read-with-preview "Frameset to register: " + (register-confirm-overwrite)))) (set-register register (frameset-make-register (frameset-save nil diff --git a/lisp/kmacro.el b/lisp/kmacro.el index a7aa2c88508..da3d69e7f12 100644 --- a/lisp/kmacro.el +++ b/lisp/kmacro.el @@ -967,7 +967,8 @@ Interactively, reads the register using `register-read-with-preview'." (interactive (progn (or last-kbd-macro (error "No keyboard macro defined")) - (list (register-read-with-preview "Save to register: " t)))) + (list (register-read-with-preview "Save to register: " + (register-confirm-overwrite))))) (set-register r (kmacro-ring-head))) diff --git a/lisp/play/gametree.el b/lisp/play/gametree.el index e46770af2da..29755ca983f 100644 --- a/lisp/play/gametree.el +++ b/lisp/play/gametree.el @@ -523,7 +523,8 @@ Use \\[gametree-apply-register-layout] to restore that configuration. Argument is a character, naming the register. Interactively, reads the register using `register-read-with-preview'." - (interactive (list (register-read-with-preview "Layout to register: " t))) + (interactive (list (register-read-with-preview "Layout to register: " + (register-confirm-overwrite)))) (save-excursion (goto-char (point-min)) (set-register register diff --git a/lisp/register.el b/lisp/register.el index 3df5a5d5abc..2ca82ec7e1e 100644 --- a/lisp/register.el +++ b/lisp/register.el @@ -100,11 +100,26 @@ If nil, do not show register previews, unless `help-char' (or a member of :group 'register) (defcustom register-confirm-overwrite t - "Whether to ask for confirmation before overwriting register contents." + "Whether to ask for confirmation before overwriting register contents. + +If this option is non-nil, Emacs asks for confirmation before +overwriting a register that is already in use. When you are +defining or executing a keyboard macro, Emacs overwrites the +previous contents of the register without confirmation, +regardless of the value of this option." :version "30.1" :type 'boolean :group 'register) +(defun register-confirm-overwrite () + "Return non-nil if Emacs should confirm overwriting register contents. + +Commands that overwrite register contents pass the return value +of this function to `register-read-with-preview' as the CONFIRM +argument of that function." + (and register-confirm-overwrite + (not (or defining-kbd-macro executing-kbd-macro)))) + (defun get-register (register) "Return contents of Emacs register named REGISTER, or nil if none." (alist-get register register-alist)) @@ -175,15 +190,19 @@ format of each entry in the preview." (defun register-read-with-preview (prompt &optional confirm pred) "Read and return a register name, possibly showing existing registers. + 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, 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'." +says to ask for confirmation if the register is already in use. +Callers of this function that overwrite the register contents can +use the function `register-confirm-overwrite' to obtain a value +for this argument that is suitable in the current context. + +If `register-alist' and `register-preview-delay' are both +non-nil, display a window listing existing registers after +`register-preview-delay' 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 @@ -194,27 +213,28 @@ see `register-preview'." 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 nil pred))) - (cond - ((or (eq ?\C-g last-input-event) - (eq 'escape last-input-event) - (eq ?\C-\[ last-input-event)) - (keyboard-quit)) - ((and (get-register last-input-event) - confirm register-confirm-overwrite - (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 - last-input-event)))))) - (user-error "Register already in use")))) - (if (characterp last-input-event) last-input-event - (error "Non-character input-event"))) + (named-let ask () + (let ((key (read-key (propertize prompt 'face + 'minibuffer-prompt)))) + (cond + ((memq key help-chars) + (unless (get-buffer-window buffer) + (register-preview buffer 'show-empty nil pred)) + (ask)) + ((or (eq key ?\C-g) + (eq key 'escape) + (eq key ?\C-\[)) + (keyboard-quit)) + ((and confirm (get-register key) + (progn + (register-preview buffer nil key pred) + (not (y-or-n-p (substitute-quotes + (format "Overwrite register `%s'?" + (single-key-description key))))))) + (register-preview buffer 'show-empty nil pred) + (ask)) + ((characterp key) key) + (t (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))) @@ -231,7 +251,7 @@ Interactively, prompt for REGISTER using `register-read-with-preview'." (if current-prefix-arg "Frame configuration to register: " "Point to register: ") - t) + (register-confirm-overwrite)) current-prefix-arg)) ;; Turn the marker into a file-ref if the buffer is killed. (add-hook 'kill-buffer-hook 'register-swap-out nil t) @@ -246,7 +266,8 @@ Argument is a character, the name of the register. Interactively, prompt for REGISTER using `register-read-with-preview'." (interactive (list (register-read-with-preview - "Window configuration to register: " t) + "Window configuration to register: " + (register-confirm-overwrite)) current-prefix-arg)) ;; current-window-configuration does not include the value ;; of point in the current buffer, so record that separately. @@ -264,7 +285,8 @@ Argument is a character, the name of the register. Interactively, prompt for REGISTER using `register-read-with-preview'." (interactive (list (register-read-with-preview - "Frame configuration to register: " t) + "Frame configuration to register: " + (register-confirm-overwrite)) current-prefix-arg)) ;; current-frame-configuration does not include the value ;; of point in the current buffer, so record that separately. @@ -374,7 +396,8 @@ Interactively, NUMBER is the prefix arg (none means nil). Interactively, prompt for REGISTER using `register-read-with-preview'." (interactive (list current-prefix-arg - (register-read-with-preview "Number to register: " t))) + (register-read-with-preview "Number to register: " + (register-confirm-overwrite)))) (set-register register (if number (prefix-numeric-value number) @@ -596,7 +619,8 @@ region. Interactively, prompt for REGISTER using `register-read-with-preview' and use mark and point as START and END; REGION is always non-nil in this case." - (interactive (list (register-read-with-preview "Copy to register: " t) + (interactive (list (register-read-with-preview "Copy to register: " + (register-confirm-overwrite)) (region-beginning) (region-end) current-prefix-arg @@ -676,7 +700,8 @@ START and END are buffer positions giving two corners of rectangle. Interactively, prompt for REGISTER using `register-read-with-preview', and use mark and point as START and END." (interactive (list (register-read-with-preview - "Copy rectangle to register: " t) + "Copy rectangle to register: " + (register-confirm-overwrite)) (region-beginning) (region-end) current-prefix-arg)) diff --git a/test/lisp/register-tests.el b/test/lisp/register-tests.el index 6283d1c31e0..26752765cb3 100644 --- a/test/lisp/register-tests.el +++ b/test/lisp/register-tests.el @@ -29,15 +29,15 @@ (ert-deftest register-test-bug27634 () "Test for https://debbugs.gnu.org/27634 ." - (dolist (event (list ?\C-g 'escape ?\C-\[)) - (cl-letf (((symbol-function 'read-key) #'ignore) - (last-input-event event) - (register-alist nil)) - (should (equal 'quit - (condition-case err - (call-interactively 'point-to-register) - (quit (car err))))) - (should-not register-alist)))) + (cl-letf (((symbol-function 'read-key) + (lambda (&rest _) + (keyboard-quit))) + (register-alist nil)) + (should (equal 'quit + (condition-case err + (call-interactively 'point-to-register) + (quit (car err))))) + (should-not register-alist))) (provide 'register-tests) ;;; register-tests.el ends here -- 2.39.5