From d1538aadc4f3d0da6a8c550248f8d348edb96116 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Sun, 3 Dec 2023 20:44:16 +0100 Subject: [PATCH 2/2] Optionally ask for confirmation before overwriting registers Commands can now call 'register-read-with-preview' with optional argument CONFIRM to ask the user for confirmation if they choose a register that is already in use, subject to new user option 'register-confirm-overwrite'. Commands that write to registers are adapted to make use of this new argument. When asking for confirmation, Emacs also highlights the selected register in the *Register Preview* buffer. * lisp/register.el (register-confirm-overwrite): New user option. (register-preview): New optional argument HIGHLIGHT. (register-read-with-preview): Use them. New optional arg CONFIRM. (point-to-register,window-configuration-to-register) (frame-configuration-to-register,number-to-register) (copy-to-register,copy-rectangle-to-register) * lisp/textmodes/picture.el (picture-clear-rectangle-to-register) * lisp/calc/calc-yank.el (calc-copy-to-register) * lisp/cedet/semantic/senator.el (senator-copy-tag-to-register) * lisp/frameset.el (frameset-to-register) * lisp/kmacro.el (kmacro-to-register) * lisp/play/gametree.el (gametree-layout-to-register): Use new arg. * doc/lispref/text.texi (Registers): Update. * etc/NEWS: Announce. --- doc/lispref/text.texi | 8 +++-- etc/NEWS | 6 ++++ lisp/calc/calc-yank.el | 2 +- lisp/cedet/semantic/senator.el | 2 +- lisp/frameset.el | 2 +- lisp/kmacro.el | 2 +- lisp/play/gametree.el | 2 +- lisp/register.el | 62 ++++++++++++++++++++++++---------- lisp/textmodes/picture.el | 2 +- 9 files changed, 61 insertions(+), 27 deletions(-) diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 5d05ef18d4f..9f5b846b92d 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -4710,7 +4710,7 @@ Registers changed in the future. @end deffn -@defun register-read-with-preview prompt +@defun register-read-with-preview prompt &optional confirm @cindex register preview This function reads and returns a register name, prompting with @var{prompt} and possibly showing a preview of the existing registers @@ -4718,8 +4718,10 @@ Registers the delay specified by the user option @code{register-preview-delay}, 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). We recommend that all interactive commands which -read register names use this function. +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. @end defun @node Transposition diff --git a/etc/NEWS b/etc/NEWS index af8e1049483..0617c8dc218 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1085,6 +1085,12 @@ 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/calc/calc-yank.el b/lisp/calc/calc-yank.el index a2a91dc8fb8..ed1a8e1c046 100644 --- a/lisp/calc/calc-yank.el +++ b/lisp/calc/calc-yank.el @@ -281,7 +281,7 @@ calc-copy-to-register With prefix arg, delete as well. Interactively, reads the register using `register-read-with-preview'." - (interactive (list (register-read-with-preview "Copy to register: ") + (interactive (list (register-read-with-preview "Copy to register: " t) (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 ca4334eaff5..2c1fc4fda3b 100644 --- a/lisp/cedet/semantic/senator.el +++ b/lisp/cedet/semantic/senator.el @@ -736,7 +736,7 @@ senator-copy-tag-to-register kill ring. Interactively, reads the register using `register-read-with-preview'." - (interactive (list (register-read-with-preview "Tag to register: ") + (interactive (list (register-read-with-preview "Tag to register: " t) current-prefix-arg)) (semantic-fetch-tags) (let ((ft (semantic-obtain-foreign-tag))) diff --git a/lisp/frameset.el b/lisp/frameset.el index 224746bbfe3..63ff4668541 100644 --- a/lisp/frameset.el +++ b/lisp/frameset.el @@ -1451,7 +1451,7 @@ frameset-to-register 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: "))) + (interactive (list (register-read-with-preview "Frameset to register: " t))) (set-register register (frameset-make-register (frameset-save nil diff --git a/lisp/kmacro.el b/lisp/kmacro.el index 588b2d14943..a7aa2c88508 100644 --- a/lisp/kmacro.el +++ b/lisp/kmacro.el @@ -967,7 +967,7 @@ kmacro-to-register (interactive (progn (or last-kbd-macro (error "No keyboard macro defined")) - (list (register-read-with-preview "Save to register: ")))) + (list (register-read-with-preview "Save to register: " t)))) (set-register r (kmacro-ring-head))) diff --git a/lisp/play/gametree.el b/lisp/play/gametree.el index 971d8ea70ca..e46770af2da 100644 --- a/lisp/play/gametree.el +++ b/lisp/play/gametree.el @@ -523,7 +523,7 @@ gametree-layout-to-register 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: "))) + (interactive (list (register-read-with-preview "Layout to register: " t))) (save-excursion (goto-char (point-min)) (set-register register diff --git a/lisp/register.el b/lisp/register.el index ca6de450993..4e400fbff2c 100644 --- a/lisp/register.el +++ b/lisp/register.el @@ -99,6 +99,12 @@ register-preview-delay :type '(choice number (const :tag "No preview unless requested" nil)) :group 'register) +(defcustom register-confirm-overwrite t + "Whether to ask for confirmation before overwriting register contents." + :version "30.1" + :type 'boolean + :group 'register) + (defun get-register (register) "Return contents of Emacs register named REGISTER, or nil if none." (alist-get register register-alist)) @@ -128,10 +134,12 @@ register-preview-function 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) +(defun register-preview (buffer &optional show-empty highlight) "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'." +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'." (when (or show-empty (consp register-alist)) (with-current-buffer-window buffer @@ -140,19 +148,26 @@ register-preview (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 (get-register (car elem)) - (insert (funcall register-preview-function 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) +(defun register-read-with-preview (prompt &optional confirm) "Read and return a register name, possibly showing existing registers. -Prompt with the string PROMPT. If `register-alist' and +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 -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." +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 @@ -168,10 +183,20 @@ register-read-with-preview 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)) + (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 (progn + (register-preview buffer nil last-input-event) + (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"))) (and (timerp timer) (cancel-timer timer)) @@ -189,7 +214,8 @@ point-to-register (interactive (list (register-read-with-preview (if current-prefix-arg "Frame configuration to register: " - "Point to register: ")) + "Point to register: ") + t) 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) @@ -204,7 +230,7 @@ window-configuration-to-register Interactively, prompt for REGISTER using `register-read-with-preview'." (interactive (list (register-read-with-preview - "Window configuration to register: ") + "Window configuration to register: " t) current-prefix-arg)) ;; current-window-configuration does not include the value ;; of point in the current buffer, so record that separately. @@ -222,7 +248,7 @@ frame-configuration-to-register Interactively, prompt for REGISTER using `register-read-with-preview'." (interactive (list (register-read-with-preview - "Frame configuration to register: ") + "Frame configuration to register: " t) current-prefix-arg)) ;; current-frame-configuration does not include the value ;; of point in the current buffer, so record that separately. @@ -316,7 +342,7 @@ number-to-register Interactively, prompt for REGISTER using `register-read-with-preview'." (interactive (list current-prefix-arg - (register-read-with-preview "Number to register: "))) + (register-read-with-preview "Number to register: " t))) (set-register register (if number (prefix-numeric-value number) @@ -527,7 +553,7 @@ copy-to-register 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: ") + (interactive (list (register-read-with-preview "Copy to register: " t) (region-beginning) (region-end) current-prefix-arg @@ -605,7 +631,7 @@ copy-rectangle-to-register 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: ") + "Copy rectangle to register: " t) (region-beginning) (region-end) current-prefix-arg)) diff --git a/lisp/textmodes/picture.el b/lisp/textmodes/picture.el index f98c3963b6f..efa59e0682f 100644 --- a/lisp/textmodes/picture.el +++ b/lisp/textmodes/picture.el @@ -503,7 +503,7 @@ picture-clear-rectangle-to-register Interactively, reads the register using `register-read-with-preview'." (interactive (list (region-beginning) (region-end) - (register-read-with-preview "Rectangle to register: ") + (register-read-with-preview "Rectangle to register: " t) current-prefix-arg)) (set-register register (picture-snarf-rectangle start end killp))) -- 2.42.0