From ddefa3dadd809b5c88e160981aedfdfbfffdcd22 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Mon, 30 Aug 2021 22:39:56 -0500 Subject: Rewrite acdw-compat to more easily copy-paste stuff --- lisp/acdw-compat.el | 888 +++++++++++++++++++++++++--------------------------- 1 file changed, 432 insertions(+), 456 deletions(-) (limited to 'lisp/acdw-compat.el') diff --git a/lisp/acdw-compat.el b/lisp/acdw-compat.el index f9ba9af..27dd8ef 100644 --- a/lisp/acdw-compat.el +++ b/lisp/acdw-compat.el @@ -21,97 +21,81 @@ ;;; Code: -;; 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! - -\(fn NAME ARGLIST &optional DOCSTRING DECL &rest BODY)" - (declare (doc-string 3) - (indent 2)) - `(unless (fboundp (function ,name)) - (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))) +;; Convenience macro +(defmacro safe-define (&rest defines) + "Wrap DEFINES in tests to make sure they're not already defined. +Is it necessary? Who knows!!" + (let (output) + (dolist (form defines) + (let ((test (cond ((memq (car form) + '(define-global-minor-mode + define-globalized-minor-mode + define-minor-mode + defmacro + defsubst + defun)) + #'fboundp) + ((memq (car form) + '(defcustom + defvar + defvar + defvar-local + defvar-mode-local + defvaralias)) + #'boundp) + (t (error "Don't know how to deal with %S" + (car form)))))) + (push `(unless (,test ',(cadr form)) + ,form) + output))) + `(progn ,@(nreverse output)))) ;;; Functions for changing capitalization that Do What I Mean ;; Defined in EMACS/lisp/simple.el - -(safe-defun upcase-dwim (arg) - "Upcase words in the region, if active; if not, upcase word at point. +(safe-define + (defun upcase-dwim (arg) + "Upcase words in the region, if active; if not, upcase word at point. If the region is active, this function calls `upcase-region'. Otherwise, it calls `upcase-word', with prefix argument passed to it to upcase ARG words." - (interactive "*p") - (if (use-region-p) - (upcase-region (region-beginning) (region-end) (region-noncontiguous-p)) - (upcase-word arg))) + (interactive "*p") + (if (use-region-p) + (upcase-region (region-beginning) (region-end) (region-noncontiguous-p)) + (upcase-word arg))) -(safe-defun downcase-dwim (arg) - "Downcase words in the region, if active; if not, downcase word at point. + (defun downcase-dwim (arg) + "Downcase words in the region, if active; if not, downcase word at point. If the region is active, this function calls `downcase-region'. Otherwise, it calls `downcase-word', with prefix argument passed to it to downcase ARG words." - (interactive "*p") - (if (use-region-p) - (downcase-region (region-beginning) (region-end) (region-noncontiguous-p)) - (downcase-word arg))) + (interactive "*p") + (if (use-region-p) + (downcase-region (region-beginning) (region-end) (region-noncontiguous-p)) + (downcase-word arg))) -(safe-defun capitalize-dwim (arg) - "Capitalize words in the region, if active; if not, capitalize word at point. + (defun capitalize-dwim (arg) + "Capitalize words in the region, if active; if not, capitalize word at point. If the region is active, this function calls `capitalize-region'. Otherwise, it calls `capitalize-word', with prefix argument passed to it to capitalize ARG words." - (interactive "*p") - (if (use-region-p) - (capitalize-region (region-beginning) (region-end) (region-noncontiguous-p)) - (capitalize-word arg))) + (interactive "*p") + (if (use-region-p) + (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-define + (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. + (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 @@ -119,8 +103,8 @@ 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. + (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 @@ -128,16 +112,16 @@ 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"))) + :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.") + (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'. + (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 @@ -145,14 +129,13 @@ 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)) + (= repeat-num-input-keys-at-repeat num-input-keys)) -(safe-defvar repeat-previous-repeated-command nil - "The previous repeated command.") + (defvar repeat-previous-repeated-command nil + "The previous repeated command.") -;;;###autoload -(safe-defun repeat (repeat-arg) - "Repeat most recently executed command. + (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. @@ -165,377 +148,368 @@ sequence. This behavior can be modified by the global variable `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. + ;; 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))))) + + (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)))) + + (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") + :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. + (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. + :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") - -(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. + :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.") + + (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. + (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")))))) + :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))) + (and (current-message) + (string-search "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")))))) ;;; Bindings! -(safe-defvar undo-repeat-map - (let ((map (make-sparse-keymap))) - (define-key map "u" 'undo) - map) - "Keymap to repeat undo key sequences `C-x u u'. Used in `repeat-mode'.") -(put 'undo 'repeat-map 'undo-repeat-map) - - -(safe-defvar next-error-repeat-map - (let ((map (make-sparse-keymap))) - (define-key map "n" 'next-error) - (define-key map "\M-n" 'next-error) - (define-key map "p" 'previous-error) - (define-key map "\M-p" 'previous-error) - map) - "Keymap to repeat next-error key sequences. Used in `repeat-mode'.") -(put 'next-error 'repeat-map 'next-error-repeat-map) -(put 'previous-error 'repeat-map 'next-error-repeat-map) - - -(safe-defvar page-navigation-repeat-map - (let ((map (make-sparse-keymap))) - (define-key map "]" #'forward-page) - (define-key map "[" #'backward-page) - map) - "Keymap to repeat page navigation key sequences. Used in `repeat-mode'.") - -(put 'forward-page 'repeat-map 'page-navigation-repeat-map) -(put 'backward-page 'repeat-map 'page-navigation-repeat-map) - - -(safe-defvar tab-bar-switch-repeat-map - (let ((map (make-sparse-keymap))) - (define-key map "o" 'tab-next) - (define-key map "O" 'tab-previous) - map) - "Keymap to repeat tab switch key sequences `C-x t o o O'. + (defvar undo-repeat-map + (let ((map (make-sparse-keymap))) + (define-key map "u" 'undo) + map) + "Keymap to repeat undo key sequences `C-x u u'. Used in `repeat-mode'.") + + (defvar next-error-repeat-map + (let ((map (make-sparse-keymap))) + (define-key map "n" 'next-error) + (define-key map "\M-n" 'next-error) + (define-key map "p" 'previous-error) + (define-key map "\M-p" 'previous-error) + map) + "Keymap to repeat next-error key sequences. Used in `repeat-mode'.") + + (defvar page-navigation-repeat-map + (let ((map (make-sparse-keymap))) + (define-key map "]" #'forward-page) + (define-key map "[" #'backward-page) + map) + "Keymap to repeat page navigation key sequences. Used in `repeat-mode'.") + + (defvar tab-bar-switch-repeat-map + (let ((map (make-sparse-keymap))) + (define-key map "o" 'tab-next) + (define-key map "O" 'tab-previous) + map) + "Keymap to repeat tab switch key sequences `C-x t o o O'. Used in `repeat-mode'.") -(put 'tab-next 'repeat-map 'tab-bar-switch-repeat-map) -(put 'tab-previous 'repeat-map 'tab-bar-switch-repeat-map) -(safe-defvar tab-bar-move-repeat-map - (let ((map (make-sparse-keymap))) - (define-key map "m" 'tab-move) - (define-key map "M" (lambda () - (interactive) - (setq repeat-map 'tab-bar-move-repeat-map) - (tab-move -1))) - map) - "Keymap to repeat tab move key sequences `C-x t m m M'. + (defvar tab-bar-move-repeat-map + (let ((map (make-sparse-keymap))) + (define-key map "m" 'tab-move) + (define-key map "M" (lambda () + (interactive) + (setq repeat-map 'tab-bar-move-repeat-map) + (tab-move -1))) + map) + "Keymap to repeat tab move key sequences `C-x t m m M'. Used in `repeat-mode'.") -(put 'tab-move 'repeat-map 'tab-bar-move-repeat-map) - - -(safe-defvar other-window-repeat-map - (let ((map (make-sparse-keymap))) - (define-key map "o" 'other-window) - (define-key map "O" (lambda () - (interactive) - (setq repeat-map 'other-window-repeat-map) - (other-window -1))) - map) - "Keymap to repeat other-window key sequences. Used in `repeat-mode'.") -(put 'other-window 'repeat-map 'other-window-repeat-map) - -(safe-defvar resize-window-repeat-map - (let ((map (make-sparse-keymap))) - ;; Standard keys: - (define-key map "^" 'enlarge-window) - (define-key map "}" 'enlarge-window-horizontally) - (define-key map "{" 'shrink-window-horizontally) - ;; Additional keys: - (define-key map "v" 'shrink-window) - map) - "Keymap to repeat window resizing commands. Used in `repeat-mode'.") -(put 'enlarge-window 'repeat-map 'resize-window-repeat-map) -(put 'enlarge-window-horizontally 'repeat-map 'resize-window-repeat-map) -(put 'shrink-window-horizontally 'repeat-map 'resize-window-repeat-map) -(put 'shrink-window 'repeat-map 'resize-window-repeat-map) + (defvar other-window-repeat-map + (let ((map (make-sparse-keymap))) + (define-key map "o" 'other-window) + (define-key map "O" (lambda () + (interactive) + (setq repeat-map 'other-window-repeat-map) + (other-window -1))) + map) + "Keymap to repeat other-window key sequences. Used in `repeat-mode'.") + + (defvar resize-window-repeat-map + (let ((map (make-sparse-keymap))) + ;; Standard keys: + (define-key map "^" 'enlarge-window) + (define-key map "}" 'enlarge-window-horizontally) + (define-key map "{" 'shrink-window-horizontally) + ;; Additional keys: + (define-key map "v" 'shrink-window) + map) + "Keymap to repeat window resizing commands. Used in `repeat-mode'.") + + (defvar outline-navigation-repeat-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-b") #'outline-backward-same-level) + (define-key map (kbd "b") #'outline-backward-same-level) + (define-key map (kbd "C-f") #'outline-forward-same-level) + (define-key map (kbd "f") #'outline-forward-same-level) + (define-key map (kbd "C-n") #'outline-next-visible-heading) + (define-key map (kbd "n") #'outline-next-visible-heading) + (define-key map (kbd "C-p") #'outline-previous-visible-heading) + (define-key map (kbd "p") #'outline-previous-visible-heading) + (define-key map (kbd "C-u") #'outline-up-heading) + (define-key map (kbd "u") #'outline-up-heading) + map)) + + (defvar outline-editing-repeat-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-v") #'outline-move-subtree-down) + (define-key map (kbd "v") #'outline-move-subtree-down) + (define-key map (kbd "C-^") #'outline-move-subtree-up) + (define-key map (kbd "^") #'outline-move-subtree-up) + (define-key map (kbd "C->") #'outline-demote) + (define-key map (kbd ">") #'outline-demote) + (define-key map (kbd "C-<") #'outline-promote) + (define-key map (kbd "<") #'outline-promote) + map))) (with-eval-after-load 'outline - (safe-defvar outline-navigation-repeat-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-b") #'outline-backward-same-level) - (define-key map (kbd "b") #'outline-backward-same-level) - (define-key map (kbd "C-f") #'outline-forward-same-level) - (define-key map (kbd "f") #'outline-forward-same-level) - (define-key map (kbd "C-n") #'outline-next-visible-heading) - (define-key map (kbd "n") #'outline-next-visible-heading) - (define-key map (kbd "C-p") #'outline-previous-visible-heading) - (define-key map (kbd "p") #'outline-previous-visible-heading) - (define-key map (kbd "C-u") #'outline-up-heading) - (define-key map (kbd "u") #'outline-up-heading) - map)) - (dolist (command '(outline-backward-same-level outline-forward-same-level outline-next-visible-heading @@ -543,30 +517,32 @@ Used in `repeat-mode'.") outline-up-heading)) (put command 'repeat-map 'outline-navigation-repeat-map)) - (safe-defvar outline-editing-repeat-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-v") #'outline-move-subtree-down) - (define-key map (kbd "v") #'outline-move-subtree-down) - (define-key map (kbd "C-^") #'outline-move-subtree-up) - (define-key map (kbd "^") #'outline-move-subtree-up) - (define-key map (kbd "C->") #'outline-demote) - (define-key map (kbd ">") #'outline-demote) - (define-key map (kbd "C-<") #'outline-promote) - (define-key map (kbd "<") #'outline-promote) - map)) - (dolist (command '(outline-move-subtree-down outline-move-subtree-up outline-demote outline-promote)) - (put command 'repeat-map 'outline-editing-repeat-map)) - ) + (put command 'repeat-map 'outline-editing-repeat-map))) + +(put 'undo 'repeat-map 'undo-repeat-map) +(put 'next-error 'repeat-map 'next-error-repeat-map) +(put 'previous-error 'repeat-map 'next-error-repeat-map) +(put 'forward-page 'repeat-map 'page-navigation-repeat-map) +(put 'backward-page 'repeat-map 'page-navigation-repeat-map) +(put 'tab-next 'repeat-map 'tab-bar-switch-repeat-map) +(put 'tab-previous 'repeat-map 'tab-bar-switch-repeat-map) +(put 'tab-move 'repeat-map 'tab-bar-move-repeat-map) +(put 'other-window 'repeat-map 'other-window-repeat-map) +(put 'enlarge-window 'repeat-map 'resize-window-repeat-map) +(put 'enlarge-window-horizontally 'repeat-map 'resize-window-repeat-map) +(put 'shrink-window-horizontally 'repeat-map 'resize-window-repeat-map) +(put 'shrink-window 'repeat-map 'resize-window-repeat-map) + ;;; goto-address-mode -(unless (fboundp 'global-goto-address-mode) - (define-globalized-minor-mode global-goto-address-mode - goto-address-mode goto-addr-mode--turn-on - :version "28.1")) +(safe-define + (define-globalized-minor-mode global-goto-address-mode + goto-address-mode goto-addr-mode--turn-on + :version "28.1")) (provide 'acdw-compat) ;;; acdw-compat.el ends here -- cgit 1.4.1-21-gabe81