From de8263f12f03c562349e1ef7250e2214bb752339 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Wed, 25 Aug 2021 17:39:55 -0500 Subject: Add repeat-mode to acdw-compat --- lisp/acdw-compat.el | 381 +++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 377 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/acdw-compat.el b/lisp/acdw-compat.el index b77527c..2ce8898 100644 --- a/lisp/acdw-compat.el +++ b/lisp/acdw-compat.el @@ -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 [¬ keywordp] sexp + &optional [¬ keywordp] sexp + &optional [¬ 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 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 -- cgit 1.4.1-21-gabe81