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.

diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 5d05ef18d4f3426c793d3d1ef1a4669f66330ed2..9f5b846b92d70dce29af349c00fd147a2d72bda7 100644 (file)
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -4710,7 +4710,7 @@ a rectangle (a list), currently useless things happen.  This may be
 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 @@ and their contents.  The preview is shown in a temporary window, after
 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 a79eefd8fe9446f383f0adb5d5c44998552ff274..0dac6b46a889448c8056d5fb9606062eeadd3766 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1089,6 +1089,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 a2a91dc8fb8716f6170384da3ddd4fcace0e11d6..ed1a8e1c0469f0251b83e0d3b9aabeba7c3612de 100644 (file)
--- a/lisp/calc/calc-yank.el
+++ b/lisp/calc/calc-yank.el
@@ -281,7 +281,7 @@ 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: ")
+  (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 ca4334eaff55d22d2f9eea87d9825302a92cb082..2c1fc4fda3bf0f056572625cfb140ba262fa2bc2 100644 (file)
--- a/lisp/cedet/semantic/senator.el
+++ b/lisp/cedet/semantic/senator.el
@@ -736,7 +736,7 @@ 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: ")
+  (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 224746bbfe30e47627005971e40f527f18053257..63ff4668541e7a3c593d128bd6cb552913e963bd 100644 (file)
--- a/lisp/frameset.el
+++ b/lisp/frameset.el
@@ -1451,7 +1451,7 @@ 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: ")))
+  (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 588b2d14943a13a85f4658f9900d3b9ac5ac795b..a7aa2c88508d362831a2c5935ec43144320741f6 100644 (file)
--- a/lisp/kmacro.el
+++ b/lisp/kmacro.el
@@ -967,7 +967,7 @@ 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: "))))
+     (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 971d8ea70ca1d5c6399f019531d8c1c1b7fe64e7..e46770af2da2bb97ea57ba805bc88428e06063aa 100644 (file)
--- a/lisp/play/gametree.el
+++ b/lisp/play/gametree.el
@@ -523,7 +523,7 @@ 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: ")))
+  (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 ca6de45099326bdb0254174d775f131691dc48e3..4e400fbff2cd43281844680e13192246198dadeb 100644 (file)
--- a/lisp/register.el
+++ b/lisp/register.el
@@ -99,6 +99,12 @@ If nil, do not show register previews, unless `help-char' (or a member of
   :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 @@ 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)
+(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 @@ Format of each entry is controlled by the variable `register-preview-function'."
             (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 @@ display such a window regardless."
                       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 @@ Interactively, prompt for REGISTER using `register-read-with-preview'."
   (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 @@ 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: ")
+                     "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 @@ 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: ")
+                     "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 @@ 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: ")))
+                    (register-read-with-preview "Number to register: " t)))
   (set-register register
                (if number
                    (prefix-numeric-value number)
@@ -527,7 +553,7 @@ 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: ")
+  (interactive (list (register-read-with-preview "Copy to register: " t)
                     (region-beginning)
                     (region-end)
                     current-prefix-arg
@@ -605,7 +631,7 @@ 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: ")
+                     "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 f98c3963b6f063f5055e13770ac3ffd2b8cbc12f..efa59e0682f9c8f1c810354ace748d39e02d3ed5 100644 (file)
--- a/lisp/textmodes/picture.el
+++ b/lisp/textmodes/picture.el
@@ -503,7 +503,7 @@ prefix argument, the rectangle is actually killed, shifting remaining text.
 
 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)))