: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))
(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
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)))
(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)
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.
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.
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)
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
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))
projects / emacs.git / commitdiff