From: Eshel Yaron <me@eshelyaron.com>
Date: Thu, 28 Mar 2024 20:29:14 +0000 (+0100)
Subject: Add command 'register-toggle-volatility'
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=6b1dcb72239b18b936c8634e54157b9844a65cc8;p=emacs.git

Add command 'register-toggle-volatility'
---

diff --git a/lisp/bindings.el b/lisp/bindings.el
index 816ca49319b..d45c561bb65 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -1518,6 +1518,7 @@ if `inhibit-field-text-motion' is non-nil."
   "g"     #'insert-register
   "r"     #'copy-rectangle-to-register
   "n"     #'number-to-register
+  "v"     #'register-toggle-volatility
   "+"     #'increment-register
   "w"     #'window-configuration-to-register
   "f"     #'frameset-to-register)
diff --git a/lisp/register.el b/lisp/register.el
index bde3998338f..df028d8b8ca 100644
--- a/lisp/register.el
+++ b/lisp/register.el
@@ -138,13 +138,17 @@ See the documentation of the variable `register-alist' for possible VALUEs."
         (substring d (match-end 0))
       d)))
 
+(defface register-name
+  '((t :inherit help-key-binding))
+  "Face for register names.")
+
 (defun register-preview-default (r)
   "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))
+	  (propertize (single-key-description (car r)) 'face 'register-name)
 	  (register-describe-oneline (car r))))
 
 (defvar register-preview-function #'register-preview-default
@@ -188,6 +192,13 @@ format of each entry in the preview."
                     (insert desc))))
               register-alist)))))
 
+(defvar register-volatile-registers nil
+  "List of volatile registers.")
+
+(defun register-volatile-p (register)
+  "Return non-nil if REGISTER is a volatile register."
+  (member register register-volatile-registers))
+
 (defun register-read-with-preview (prompt &optional confirm pred)
   "Read and return a register name, possibly showing existing registers.
 
@@ -225,7 +236,9 @@ appear in the preview, see `register-preview'."
                   (eq key 'escape)
                   (eq key ?\C-\[))
               (keyboard-quit))
-             ((and confirm (get-register key)
+             ((and confirm
+                   (not (register-volatile-p key))
+                   (get-register key)
                    (progn
                      (register-preview buffer nil key pred)
                      (not (y-or-n-p (substitute-quotes
@@ -714,5 +727,22 @@ and use mark and point as START and END."
       (setq deactivate-mark t)
       (indicate-copied-region (length (car rectangle))))))
 
+(defun register-toggle-volatility (register)
+  "Toggle volatility of register REGISTER.
+
+Emacs lets you overwrite volatile registers without confirmation, even
+when option `register-confirm-overwrite' is non-nil.
+
+By default, all registers are non-volatile."
+  (interactive
+   (list (register-read-with-preview "Toggle volatility of register: ")))
+  (if (register-volatile-p register)
+      (setq register-volatile-registers
+            (delete register register-volatile-registers))
+    (push register register-volatile-registers))
+  (message "Register %s is now %svolatile"
+           (propertize (single-key-description register) 'face 'register-name)
+           (if (register-volatile-p register) "" "non-")))
+
 (provide 'register)
 ;;; register.el ends here