diff options
Diffstat (limited to 'lisp/repeat.el')
| -rw-r--r-- | lisp/repeat.el | 184 |
1 files changed, 183 insertions, 1 deletions
diff --git a/lisp/repeat.el b/lisp/repeat.el index 795577c93fc..cec3cb643a1 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -180,7 +180,7 @@ this function is always whether the value of `this-command' would've been (= repeat-num-input-keys-at-repeat num-input-keys)) ;; An example of the use of (repeat-is-really-this-command) may still be -;; available in <http://www.eskimo.com/~seldon/dotemacs.el>; search for +;; available in <https://www.eskimo.com/~seldon/dotemacs.el>; search for ;; "defun wm-switch-buffer". ;;;;; ******************* THE REPEAT COMMAND ITSELF ******************* ;;;;; @@ -329,6 +329,188 @@ recently executed command not bound to an input event\"." ;;;;; ************************* EMACS CONTROL ************************* ;;;;; + +;; And now for something completely different. + +;;; repeat-mode + +(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") + +(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") + +(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") + +(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") + +(defvar repeat-in-progress nil + "Non-nil when the repeating map is active.") + +;;;###autoload +(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 +(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)))))) + +(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)))) + +(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)) + "")))) + +(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))) + (when (string-prefix-p "Repeat with " (current-message)) + (message nil)))) + +(defvar repeat-echo-mode-line-string + (propertize "[Repeating...] " 'face 'mode-line-emphasis) + "String displayed in the mode line in repeating mode.") + +(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))) + +(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 'repeat) ;;; repeat.el ends here |