Add repeat-mode to acdw-compat

1 files changed, 377 insertions, 4 deletions

@@ -21,8 +21,8 @@
 
 ;;; Code:
 
-;; Convenience macro
-(defmacro safe-defun (name arglist &optional docstring &rest body)
+;; Convenience macros
+(defmacro safe-defun (name arglist &rest body)
   "Like `defun', but only if the function doesn't already exist.
 
 Is it necessary?  Who knows!
@@ -31,11 +31,45 @@ Is it necessary?  Who knows!
   (declare (doc-string 3)
            (indent 2))
   `(unless (fboundp (function ,name))
-     (defun ,name ,@body)))
+     (defun ,name ,arglist ,@body)))
+
+(defmacro safe-defsubst (name arglist &rest body)
+  "Like `defsubst', but only if the inline function doesn't exist.
+\(fn NAME ARGLIST &optional DOCSTRING DECL &rest BODY"
+  (declare (debug defun) (doc-string 3))
+  `(unless (fboundp (function ,name))
+     (defsubst ,name ,arglist ,@body)))
+
+(defmacro safe-define-minor-mode (mode doc &rest body)
+  "Like `define-minor-mode', but only if the mode doesn't exist.
+\(fn MODE DOC &optional INIT-VALUE LIGHTER KEYMAP &rest BODY)"
+  (declare (doc-string 2)
+           (debug (&define name string-or-null-p
+                           [&optional [&not keywordp] sexp
+                                      &optional [&not keywordp] sexp
+                                      &optional [&not keywordp] sexp]
+                           [&rest [keywordp sexp]]
+                           def-body)))
+  `(unless (fboundp (function ,mode))
+     (define-minor-mode ,mode ,doc ,@body)))
+
+(defmacro safe-defvar (symbol &optional initvalue docstring)
+  "Like `defvar', but only if the variable doesn't already exist."
+  (declare (doc-string 3)
+           (indent 2))
+  `(unless (boundp (quote ,symbol))
+     (defvar ,symbol ,initvalue ,docstring)))
+
+(defmacro safe-defcustom (symbol standard doc &rest args)
+  "Like `defcustom', but only if the variable doesn't already exist."
+  (declare (doc-string 3)
+           (debug (name body)))
+  `(unless (boundp (quote ,symbol))
+     (defcustom ,symbol ,standard ,doc ,@args)))
 
 
 ;;; Functions for changing capitalization that Do What I Mean
-;; Defined in /usr/share/emacs/28.0.50/lisp/simple.el
+;; Defined in EMACS/lisp/simple.el
 
 (safe-defun upcase-dwim (arg)
   "Upcase words in the region, if active; if not, upcase word at point.
@@ -67,5 +101,344 @@ to capitalize ARG words."
       (capitalize-region (region-beginning) (region-end) (region-noncontiguous-p))
     (capitalize-word arg)))
 
+
+;;; Repeat.el
+;; Defined in EMACS/lisp/repeat.el
+
+(safe-defcustom repeat-too-dangerous '(kill-this-buffer)
+                "Commands too dangerous to repeat with \\[repeat]."
+                :group 'convenience
+                :type '(repeat function))
+
+(safe-defvar repeat-message-function nil
+  "If non-nil, function used by `repeat' command to say what it's doing.
+Message is something like \"Repeating command glorp\".
+A value of `ignore' will disable such messages.  To customize
+display, assign a function that takes one string as an arg and
+displays it however you want.
+If this variable is nil, the normal `message' function will be
+used to display the messages.")
+
+(safe-defcustom repeat-on-final-keystroke t
+                "Allow `repeat' to re-execute for repeating lastchar of a key sequence.
+If this variable is t, `repeat' determines what key sequence
+it was invoked by, extracts the final character of that sequence, and
+re-executes as many times as that final character is hit; so for example
+if `repeat' is bound to C-x z, typing C-x z z z repeats the previous command
+3 times.  If this variable is a sequence of characters, then re-execution
+only occurs if the final character by which `repeat' was invoked is a
+member of that sequence.  If this variable is nil, no re-execution occurs."
+                :group 'convenience
+                :type '(choice (const :tag "Repeat for all keys" t)
+                               (const :tag "Don't repeat" nil)
+                               (sexp :tag "Repeat for specific keys")))
+
+(safe-defvar repeat-num-input-keys-at-repeat -1
+  "# key sequences read in Emacs session when `repeat' last invoked.")
+
+(safe-defsubst repeat-is-really-this-command ()
+               "Return t if this command is happening because user invoked `repeat'.
+Usually, when a command is executing, the Emacs builtin variable
+`this-command' identifies the command the user invoked.  Some commands modify
+that variable on the theory they're doing more good than harm; `repeat' does
+that, and usually does do more good than harm.  However, like all do-gooders,
+sometimes `repeat' gets surprising results from its altruism.  The value of
+this function is always whether the value of `this-command' would've been
+'repeat if `repeat' hadn't modified it."
+               (= repeat-num-input-keys-at-repeat num-input-keys))
+
+(safe-defvar repeat-previous-repeated-command nil
+  "The previous repeated command.")
+
+;;;###autoload
+(safe-defun repeat (repeat-arg)
+  "Repeat most recently executed command.
+If REPEAT-ARG is non-nil (interactively, with a prefix argument),
+supply a prefix argument to that command.  Otherwise, give the
+command the same prefix argument it was given before, if any.
+
+If this command is invoked by a multi-character key sequence, it
+can then be repeated by repeating the final character of that
+sequence.  This behavior can be modified by the global variable
+`repeat-on-final-keystroke'.
+
+`repeat' ignores commands bound to input events.  Hence the term
+\"most recently executed command\" shall be read as \"most
+recently executed command not bound to an input event\"."
+  ;; The most recently executed command could be anything, so surprises could
+  ;; result if it were re-executed in a context where new dynamically
+  ;; localized variables were shadowing global variables in a `let' clause in
+  ;; here.  (Remember that GNU Emacs 19 is dynamically localized.)
+  ;; To avoid that, I tried the `lexical-let' of the Common Lisp extensions,
+  ;; but that entails a very noticeable performance hit, so instead I use the
+  ;; "repeat-" prefix, reserved by this package, for *local* variables that
+  ;; might be visible to re-executed commands, including this function's arg.
+  (interactive "P")
+  (when (eq last-repeatable-command 'repeat)
+    (setq last-repeatable-command repeat-previous-repeated-command))
+  (cond
+   ((null last-repeatable-command)
+    (error "There is nothing to repeat"))
+   ((eq last-repeatable-command 'mode-exit)
+    (error "last-repeatable-command is mode-exit & can't be repeated"))
+   ((memq last-repeatable-command repeat-too-dangerous)
+    (error "Command %S too dangerous to repeat automatically"
+           last-repeatable-command)))
+  (setq this-command last-repeatable-command
+        repeat-previous-repeated-command last-repeatable-command
+        repeat-num-input-keys-at-repeat num-input-keys)
+  (when (null repeat-arg)
+    (setq repeat-arg last-prefix-arg))
+  ;; Now determine whether to loop on repeated taps of the final character
+  ;; of the key sequence that invoked repeat.  The Emacs global
+  ;; last-command-event contains the final character now, but may not still
+  ;; contain it after the previous command is repeated, so the character
+  ;; needs to be saved.
+  (let ((repeat-repeat-char
+         (if (eq repeat-on-final-keystroke t)
+             last-command-event
+           ;; Allow only specified final keystrokes.
+           (car (memq last-command-event
+                      (listify-key-sequence
+                       repeat-on-final-keystroke))))))
+    (if (eq last-repeatable-command (caar command-history))
+        (let ((repeat-command (car command-history)))
+          (repeat-message "Repeating %S" repeat-command)
+          (eval repeat-command))
+      (if (null repeat-arg)
+          (repeat-message "Repeating command %S" last-repeatable-command)
+        (setq current-prefix-arg repeat-arg)
+        (repeat-message
+         "Repeating command %S %S" repeat-arg last-repeatable-command))
+      (when (eq last-repeatable-command 'self-insert-command)
+        ;; We used to use a much more complex code to try and figure out
+        ;; what key was used to run that self-insert-command:
+        ;; (if (<= (- num-input-keys
+        ;;            repeat-num-input-keys-at-self-insert)
+        ;;         1)
+        ;;     repeat-last-self-insert
+        ;;   (let ((range (nth 1 buffer-undo-list)))
+        ;;     (condition-case nil
+        ;;         (setq repeat-last-self-insert
+        ;;               (buffer-substring (car range)
+        ;;                                 (cdr range)))
+        ;;       (error (error "%s %s %s"  ;Danger, Will Robinson!
+        ;;                     "repeat can't intuit what you"
+        ;;                     "inserted before auto-fill"
+        ;;                     "clobbered it, sorry")))))
+        (setq last-command-event (char-before)))
+      (let ((indirect (indirect-function last-repeatable-command)))
+        (if (or (stringp indirect)
+                (vectorp indirect))
+            ;; Bind last-repeatable-command so that executing the macro does
+            ;; not alter it.
+            (let ((last-repeatable-command last-repeatable-command))
+              (execute-kbd-macro last-repeatable-command))
+          (call-interactively last-repeatable-command))))
+    (when repeat-repeat-char
+      (set-transient-map
+       (let ((map (make-sparse-keymap)))
+         (define-key map (vector repeat-repeat-char)
+           (if (null repeat-message-function) 'repeat
+             ;; If repeat-message-function is let-bound, preserve it for the
+             ;; next "iterations of the loop".
+             (let ((fun repeat-message-function))
+               (lambda ()
+                 (interactive)
+                 (let ((repeat-message-function fun))
+                   (setq this-command 'repeat)
+                   ;; Beware: messing with `real-this-command' is *bad*, but we
+                   ;; need it so `last-repeatable-command' can be recognized
+                   ;; later (bug#12232).
+                   (setq real-this-command 'repeat)
+                   (call-interactively 'repeat))))))
+         map)))))
+
+(safe-defun repeat-message (format &rest args)
+  "Like `message' but displays with `repeat-message-function' if non-nil."
+  (let ((message (apply 'format format args)))
+    (if repeat-message-function
+        (funcall repeat-message-function message)
+      (message "%s" message))))
+
+(safe-defcustom repeat-exit-key nil
+                "Key that stops the modal repeating of keys in sequence.
+For example, you can set it to <return> like `isearch-exit'."
+                :type '(choice (const :tag "No special key to exit repeating sequence" nil)
+                               (key-sequence :tag "Key that exits repeating sequence"))
+                :group 'convenience
+                :version "28.1")
+
+(safe-defcustom repeat-exit-timeout nil
+                "Break the repetition chain of keys after specified timeout.
+When a number, exit the repeat mode after idle time of the specified
+number of seconds."
+                :type '(choice (const :tag "No timeout to exit repeating sequence" nil)
+                               (number :tag "Timeout in seconds to exit repeating"))
+                :group 'convenience
+                :version "28.1")
+
+(safe-defvar repeat-exit-timer nil
+  "Timer activated after the last key typed in the repeating key sequence.")
+
+(defcustom repeat-keep-prefix t
+  "Keep the prefix arg of the previous command."
+  :type 'boolean
+  :group 'convenience
+  :version "28.1")
+
+(safe-defcustom repeat-echo-function #'repeat-echo-message
+                "Function to display a hint about available keys.
+Function is called after every repeatable command with one argument:
+a repeating map, or nil after deactivating the repeat mode."
+                :type '(choice (const :tag "Show hints in the echo area"
+                                      repeat-echo-message)
+                               (const :tag "Show indicator in the mode line"
+                                      repeat-echo-mode-line)
+                               (const :tag "No visual feedback" ignore)
+                               (function :tag "Function"))
+                :group 'convenience
+                :version "28.1")
+
+(safe-defvar repeat-in-progress nil
+  "Non-nil when the repeating map is active.")
+
+;;;###autoload
+(safe-defvar repeat-map nil
+  "The value of the repeating map for the next command.
+A command called from the map can set it again to the same map when
+the map can't be set on the command symbol property `repeat-map'.")
+
+;;;###autoload
+(safe-define-minor-mode repeat-mode
+                        "Toggle Repeat mode.
+When Repeat mode is enabled, and the command symbol has the property named
+`repeat-map', this map is activated temporarily for the next command."
+                        :global t :group 'convenience
+                        (if (not repeat-mode)
+                            (remove-hook 'post-command-hook 'repeat-post-hook)
+                          (add-hook 'post-command-hook 'repeat-post-hook)
+                          (let* ((keymaps nil)
+                                 (commands (all-completions
+                                            "" obarray (lambda (s)
+                                                         (and (commandp s)
+                                                              (get s 'repeat-map)
+                                                              (push (get s 'repeat-map) keymaps))))))
+                            (message "Repeat mode is enabled for %d commands and %d keymaps; see `describe-repeat-maps'."
+                                     (length commands)
+                                     (length (delete-dups keymaps))))))
+
+(safe-defun repeat-post-hook ()
+  "Function run after commands to set transient keymap for repeatable keys."
+  (let ((was-in-progress repeat-in-progress))
+    (setq repeat-in-progress nil)
+    (when repeat-mode
+      (let ((rep-map (or repeat-map
+                         (and (symbolp real-this-command)
+                              (get real-this-command 'repeat-map)))))
+        (when rep-map
+          (when (boundp rep-map)
+            (setq rep-map (symbol-value rep-map)))
+          (let ((map (copy-keymap rep-map)))
+
+            ;; Exit when the last char is not among repeatable keys,
+            ;; so e.g. `C-x u u' repeats undo, whereas `C-/ u' doesn't.
+            (when (and (zerop (minibuffer-depth)) ; avoid remapping in prompts
+                       (or (lookup-key map (this-command-keys-vector))
+                           prefix-arg))
+
+              ;; Messaging
+              (unless prefix-arg
+                (funcall repeat-echo-function map))
+
+              ;; Adding an exit key
+              (when repeat-exit-key
+                (define-key map repeat-exit-key 'ignore))
+
+              (when (and repeat-keep-prefix (not prefix-arg))
+                (setq prefix-arg current-prefix-arg))
+
+              (setq repeat-in-progress t)
+              (let ((exitfun (set-transient-map map)))
+
+                (when repeat-exit-timer
+                  (cancel-timer repeat-exit-timer)
+                  (setq repeat-exit-timer nil))
+
+                (when repeat-exit-timeout
+                  (setq repeat-exit-timer
+                        (run-with-idle-timer
+                         repeat-exit-timeout nil
+                         (lambda ()
+                           (setq repeat-in-progress nil)
+                           (funcall exitfun)
+                           (funcall repeat-echo-function nil)))))))))))
+
+    (setq repeat-map nil)
+    (when (and was-in-progress (not repeat-in-progress))
+      (when repeat-exit-timer
+        (cancel-timer repeat-exit-timer)
+        (setq repeat-exit-timer nil))
+      (funcall repeat-echo-function nil))))
+
+(safe-defun repeat-echo-message-string (keymap)
+  "Return a string with a list of repeating keys."
+  (let (keys)
+    (map-keymap (lambda (key _) (push key keys)) keymap)
+    (format-message "Repeat with %s%s"
+                    (mapconcat (lambda (key)
+                                 (key-description (vector key)))
+                               keys ", ")
+                    (if repeat-exit-key
+                        (format ", or exit with %s"
+                                (key-description repeat-exit-key))
+                      ""))))
+
+(safe-defun repeat-echo-message (keymap)
+  "Display available repeating keys in the echo area."
+  (if keymap
+      (let ((mess (repeat-echo-message-string keymap)))
+        (if (current-message)
+            (message "%s [%s]" (current-message) mess)
+          (message mess)))
+    (and (current-message)
+         (string-search "Repeat with " (current-message))
+         (message nil))))
+
+(safe-defvar repeat-echo-mode-line-string
+    (propertize "[Repeating...] " 'face 'mode-line-emphasis)
+  "String displayed in the mode line in repeating mode.")
+
+(safe-defun repeat-echo-mode-line (keymap)
+  "Display the repeat indicator in the mode line."
+  (if keymap
+      (unless (assq 'repeat-in-progress mode-line-modes)
+        (add-to-list 'mode-line-modes (list 'repeat-in-progress
+                                            repeat-echo-mode-line-string)))
+    (force-mode-line-update t)))
+
+(safe-defun describe-repeat-maps ()
+  "Describe mappings of commands repeatable by symbol property `repeat-map'."
+  (interactive)
+  (help-setup-xref (list #'describe-repeat-maps)
+                   (called-interactively-p 'interactive))
+  (let ((keymaps nil))
+    (all-completions
+     "" obarray (lambda (s)
+                  (and (commandp s)
+                       (get s 'repeat-map)
+                       (push s (alist-get (get s 'repeat-map) keymaps)))))
+    (with-help-window (help-buffer)
+      (with-current-buffer standard-output
+        (princ "A list of keymaps used by commands with the symbol property `repeat-map'.\n\n")
+
+        (dolist (keymap (sort keymaps (lambda (a b) (string-lessp (car a) (car b)))))
+          (princ (format-message "`%s' keymap is repeatable by these commands:\n"
+                                 (car keymap)))
+          (dolist (command (sort (cdr keymap) 'string-lessp))
+            (princ (format-message " `%s'\n" command)))
+          (princ "\n"))))))
+
+
 (provide 'acdw-compat)
 ;;; acdw-compat.el ends here