about summary refs log tree commit diff stats
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/acdw-compat.el888
1 files changed, 432 insertions, 456 deletions
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 @@
21 21
22;;; Code: 22;;; Code:
23 23
24;; Convenience macros 24;; Convenience macro
25(defmacro safe-defun (name arglist &rest body) 25(defmacro safe-define (&rest defines)
26 "Like `defun', but only if the function doesn't already exist. 26 "Wrap DEFINES in tests to make sure they're not already defined.
27 27Is it necessary? Who knows!!"
28Is it necessary? Who knows! 28 (let (output)
29 29 (dolist (form defines)
30\(fn NAME ARGLIST &optional DOCSTRING DECL &rest BODY)" 30 (let ((test (cond ((memq (car form)
31 (declare (doc-string 3) 31 '(define-global-minor-mode
32 (indent 2)) 32 define-globalized-minor-mode
33 `(unless (fboundp (function ,name)) 33 define-minor-mode
34 (defun ,name ,arglist ,@body))) 34 defmacro
35 35 defsubst
36(defmacro safe-defsubst (name arglist &rest body) 36 defun))
37 "Like `defsubst', but only if the inline function doesn't exist. 37 #'fboundp)
38\(fn NAME ARGLIST &optional DOCSTRING DECL &rest BODY" 38 ((memq (car form)
39 (declare (debug defun) (doc-string 3)) 39 '(defcustom
40 `(unless (fboundp (function ,name)) 40 defvar
41 (defsubst ,name ,arglist ,@body))) 41 defvar
42 42 defvar-local
43(defmacro safe-define-minor-mode (mode doc &rest body) 43 defvar-mode-local
44 "Like `define-minor-mode', but only if the mode doesn't exist. 44 defvaralias))
45\(fn MODE DOC &optional INIT-VALUE LIGHTER KEYMAP &rest BODY)" 45 #'boundp)
46 (declare (doc-string 2) 46 (t (error "Don't know how to deal with %S"
47 (debug (&define name string-or-null-p 47 (car form))))))
48 [&optional [&not keywordp] sexp 48 (push `(unless (,test ',(cadr form))
49 &optional [&not keywordp] sexp 49 ,form)
50 &optional [&not keywordp] sexp] 50 output)))
51 [&rest [keywordp sexp]] 51 `(progn ,@(nreverse output))))
52 def-body)))
53 `(unless (fboundp (function ,mode))
54 (define-minor-mode ,mode ,doc ,@body)))
55
56(defmacro safe-defvar (symbol &optional initvalue docstring)
57 "Like `defvar', but only if the variable doesn't already exist."
58 (declare (doc-string 3)
59 (indent 2))
60 `(unless (boundp (quote ,symbol))
61 (defvar ,symbol ,initvalue ,docstring)))
62
63(defmacro safe-defcustom (symbol standard doc &rest args)
64 "Like `defcustom', but only if the variable doesn't already exist."
65 (declare (doc-string 3)
66 (debug (name body)))
67 `(unless (boundp (quote ,symbol))
68 (defcustom ,symbol ,standard ,doc ,@args)))
69 52
70 53
71;;; Functions for changing capitalization that Do What I Mean 54;;; Functions for changing capitalization that Do What I Mean
72;; Defined in EMACS/lisp/simple.el 55;; Defined in EMACS/lisp/simple.el
73 56(safe-define
74(safe-defun upcase-dwim (arg) 57 (defun upcase-dwim (arg)
75 "Upcase words in the region, if active; if not, upcase word at point. 58 "Upcase words in the region, if active; if not, upcase word at point.
76If the region is active, this function calls `upcase-region'. 59If the region is active, this function calls `upcase-region'.
77Otherwise, it calls `upcase-word', with prefix argument passed to it 60Otherwise, it calls `upcase-word', with prefix argument passed to it
78to upcase ARG words." 61to upcase ARG words."
79 (interactive "*p") 62 (interactive "*p")
80 (if (use-region-p) 63 (if (use-region-p)
81 (upcase-region (region-beginning) (region-end) (region-noncontiguous-p)) 64 (upcase-region (region-beginning) (region-end) (region-noncontiguous-p))
82 (upcase-word arg))) 65 (upcase-word arg)))
83 66
84(safe-defun downcase-dwim (arg) 67 (defun downcase-dwim (arg)
85 "Downcase words in the region, if active; if not, downcase word at point. 68 "Downcase words in the region, if active; if not, downcase word at point.
86If the region is active, this function calls `downcase-region'. 69If the region is active, this function calls `downcase-region'.
87Otherwise, it calls `downcase-word', with prefix argument passed to it 70Otherwise, it calls `downcase-word', with prefix argument passed to it
88to downcase ARG words." 71to downcase ARG words."
89 (interactive "*p") 72 (interactive "*p")
90 (if (use-region-p) 73 (if (use-region-p)
91 (downcase-region (region-beginning) (region-end) (region-noncontiguous-p)) 74 (downcase-region (region-beginning) (region-end) (region-noncontiguous-p))
92 (downcase-word arg))) 75 (downcase-word arg)))
93 76
94(safe-defun capitalize-dwim (arg) 77 (defun capitalize-dwim (arg)
95 "Capitalize words in the region, if active; if not, capitalize word at point. 78 "Capitalize words in the region, if active; if not, capitalize word at point.
96If the region is active, this function calls `capitalize-region'. 79If the region is active, this function calls `capitalize-region'.
97Otherwise, it calls `capitalize-word', with prefix argument passed to it 80Otherwise, it calls `capitalize-word', with prefix argument passed to it
98to capitalize ARG words." 81to capitalize ARG words."
99 (interactive "*p") 82 (interactive "*p")
100 (if (use-region-p) 83 (if (use-region-p)
101 (capitalize-region (region-beginning) (region-end) (region-noncontiguous-p)) 84 (capitalize-region (region-beginning) (region-end) (region-noncontiguous-p))
102 (capitalize-word arg))) 85 (capitalize-word arg))))
103 86
104 87
105;;; Repeat.el 88;;; Repeat.el
106;; Defined in EMACS/lisp/repeat.el 89;; Defined in EMACS/lisp/repeat.el
107 90
108(safe-defcustom repeat-too-dangerous '(kill-this-buffer) 91(safe-define
109 "Commands too dangerous to repeat with \\[repeat]." 92 (defcustom repeat-too-dangerous '(kill-this-buffer)
110 :group 'convenience 93 "Commands too dangerous to repeat with \\[repeat]."
111 :type '(repeat function)) 94 :group 'convenience
95 :type '(repeat function))
112 96
113(safe-defvar repeat-message-function nil 97 (defvar repeat-message-function nil
114 "If non-nil, function used by `repeat' command to say what it's doing. 98 "If non-nil, function used by `repeat' command to say what it's doing.
115Message is something like \"Repeating command glorp\". 99Message is something like \"Repeating command glorp\".
116A value of `ignore' will disable such messages. To customize 100A value of `ignore' will disable such messages. To customize
117display, assign a function that takes one string as an arg and 101display, assign a function that takes one string as an arg and
@@ -119,8 +103,8 @@ displays it however you want.
119If this variable is nil, the normal `message' function will be 103If this variable is nil, the normal `message' function will be
120used to display the messages.") 104used to display the messages.")
121 105
122(safe-defcustom repeat-on-final-keystroke t 106 (defcustom repeat-on-final-keystroke t
123 "Allow `repeat' to re-execute for repeating lastchar of a key sequence. 107 "Allow `repeat' to re-execute for repeating lastchar of a key sequence.
124If this variable is t, `repeat' determines what key sequence 108If this variable is t, `repeat' determines what key sequence
125it was invoked by, extracts the final character of that sequence, and 109it was invoked by, extracts the final character of that sequence, and
126re-executes as many times as that final character is hit; so for example 110re-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
1283 times. If this variable is a sequence of characters, then re-execution 1123 times. If this variable is a sequence of characters, then re-execution
129only occurs if the final character by which `repeat' was invoked is a 113only occurs if the final character by which `repeat' was invoked is a
130member of that sequence. If this variable is nil, no re-execution occurs." 114member of that sequence. If this variable is nil, no re-execution occurs."
131 :group 'convenience 115 :group 'convenience
132 :type '(choice (const :tag "Repeat for all keys" t) 116 :type '(choice (const :tag "Repeat for all keys" t)
133 (const :tag "Don't repeat" nil) 117 (const :tag "Don't repeat" nil)
134 (sexp :tag "Repeat for specific keys"))) 118 (sexp :tag "Repeat for specific keys")))
135 119
136(safe-defvar repeat-num-input-keys-at-repeat -1 120 (defvar repeat-num-input-keys-at-repeat -1
137 "# key sequences read in Emacs session when `repeat' last invoked.") 121 "# key sequences read in Emacs session when `repeat' last invoked.")
138 122
139(safe-defsubst repeat-is-really-this-command () 123 (defsubst repeat-is-really-this-command ()
140 "Return t if this command is happening because user invoked `repeat'. 124 "Return t if this command is happening because user invoked `repeat'.
141Usually, when a command is executing, the Emacs builtin variable 125Usually, when a command is executing, the Emacs builtin variable
142`this-command' identifies the command the user invoked. Some commands modify 126`this-command' identifies the command the user invoked. Some commands modify
143that variable on the theory they're doing more good than harm; `repeat' does 127that 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,
145sometimes `repeat' gets surprising results from its altruism. The value of 129sometimes `repeat' gets surprising results from its altruism. The value of
146this function is always whether the value of `this-command' would've been 130this function is always whether the value of `this-command' would've been
147'repeat if `repeat' hadn't modified it." 131'repeat if `repeat' hadn't modified it."
148 (= repeat-num-input-keys-at-repeat num-input-keys)) 132 (= repeat-num-input-keys-at-repeat num-input-keys))
149 133
150(safe-defvar repeat-previous-repeated-command nil 134 (defvar repeat-previous-repeated-command nil
151 "The previous repeated command.") 135 "The previous repeated command.")
152 136
153;;;###autoload 137 (defun repeat (repeat-arg)
154(safe-defun repeat (repeat-arg) 138 "Repeat most recently executed command.
155 "Repeat most recently executed command.
156If REPEAT-ARG is non-nil (interactively, with a prefix argument), 139If REPEAT-ARG is non-nil (interactively, with a prefix argument),
157supply a prefix argument to that command. Otherwise, give the 140supply a prefix argument to that command. Otherwise, give the
158command the same prefix argument it was given before, if any. 141command the same prefix argument it was given before, if any.
@@ -165,377 +148,368 @@ sequence. This behavior can be modified by the global variable
165`repeat' ignores commands bound to input events. Hence the term 148`repeat' ignores commands bound to input events. Hence the term
166\"most recently executed command\" shall be read as \"most 149\"most recently executed command\" shall be read as \"most
167recently executed command not bound to an input event\"." 150recently executed command not bound to an input event\"."
168 ;; The most recently executed command could be anything, so surprises could 151 ;; The most recently executed command could be anything, so surprises could
169 ;; result if it were re-executed in a context where new dynamically 152 ;; result if it were re-executed in a context where new dynamically
170 ;; localized variables were shadowing global variables in a `let' clause in 153 ;; localized variables were shadowing global variables in a `let' clause in
171 ;; here. (Remember that GNU Emacs 19 is dynamically localized.) 154 ;; here. (Remember that GNU Emacs 19 is dynamically localized.)
172 ;; To avoid that, I tried the `lexical-let' of the Common Lisp extensions, 155 ;; To avoid that, I tried the `lexical-let' of the Common Lisp extensions,
173 ;; but that entails a very noticeable performance hit, so instead I use the 156 ;; but that entails a very noticeable performance hit, so instead I use the
174 ;; "repeat-" prefix, reserved by this package, for *local* variables that 157 ;; "repeat-" prefix, reserved by this package, for *local* variables that
175 ;; might be visible to re-executed commands, including this function's arg. 158 ;; might be visible to re-executed commands, including this function's arg.
176 (interactive "P") 159 (interactive "P")
177 (when (eq last-repeatable-command 'repeat) 160 (when (eq last-repeatable-command 'repeat)
178 (setq last-repeatable-command repeat-previous-repeated-command)) 161 (setq last-repeatable-command repeat-previous-repeated-command))
179 (cond 162 (cond
180 ((null last-repeatable-command) 163 ((null last-repeatable-command)
181 (error "There is nothing to repeat")) 164 (error "There is nothing to repeat"))
182 ((eq last-repeatable-command 'mode-exit) 165 ((eq last-repeatable-command 'mode-exit)
183 (error "last-repeatable-command is mode-exit & can't be repeated")) 166 (error "last-repeatable-command is mode-exit & can't be repeated"))
184 ((memq last-repeatable-command repeat-too-dangerous) 167 ((memq last-repeatable-command repeat-too-dangerous)
185 (error "Command %S too dangerous to repeat automatically" 168 (error "Command %S too dangerous to repeat automatically"
186 last-repeatable-command))) 169 last-repeatable-command)))
187 (setq this-command last-repeatable-command 170 (setq this-command last-repeatable-command
188 repeat-previous-repeated-command last-repeatable-command 171 repeat-previous-repeated-command last-repeatable-command
189 repeat-num-input-keys-at-repeat num-input-keys) 172 repeat-num-input-keys-at-repeat num-input-keys)
190 (when (null repeat-arg) 173 (when (null repeat-arg)
191 (setq repeat-arg last-prefix-arg)) 174 (setq repeat-arg last-prefix-arg))
192 ;; Now determine whether to loop on repeated taps of the final character 175 ;; Now determine whether to loop on repeated taps of the final character
193 ;; of the key sequence that invoked repeat. The Emacs global 176 ;; of the key sequence that invoked repeat. The Emacs global
194 ;; last-command-event contains the final character now, but may not still 177 ;; last-command-event contains the final character now, but may not still
195 ;; contain it after the previous command is repeated, so the character 178 ;; contain it after the previous command is repeated, so the character
196 ;; needs to be saved. 179 ;; needs to be saved.
197 (let ((repeat-repeat-char 180 (let ((repeat-repeat-char
198 (if (eq repeat-on-final-keystroke t) 181 (if (eq repeat-on-final-keystroke t)
199 last-command-event 182 last-command-event
200 ;; Allow only specified final keystrokes. 183 ;; Allow only specified final keystrokes.
201 (car (memq last-command-event 184 (car (memq last-command-event
202 (listify-key-sequence 185 (listify-key-sequence
203 repeat-on-final-keystroke)))))) 186 repeat-on-final-keystroke))))))
204 (if (eq last-repeatable-command (caar command-history)) 187 (if (eq last-repeatable-command (caar command-history))
205 (let ((repeat-command (car command-history))) 188 (let ((repeat-command (car command-history)))
206 (repeat-message "Repeating %S" repeat-command) 189 (repeat-message "Repeating %S" repeat-command)
207 (eval repeat-command)) 190 (eval repeat-command))
208 (if (null repeat-arg) 191 (if (null repeat-arg)
209 (repeat-message "Repeating command %S" last-repeatable-command) 192 (repeat-message "Repeating command %S" last-repeatable-command)
210 (setq current-prefix-arg repeat-arg) 193 (setq current-prefix-arg repeat-arg)
211 (repeat-message 194 (repeat-message
212 "Repeating command %S %S" repeat-arg last-repeatable-command)) 195 "Repeating command %S %S" repeat-arg last-repeatable-command))
213 (when (eq last-repeatable-command 'self-insert-command) 196 (when (eq last-repeatable-command 'self-insert-command)
214 ;; We used to use a much more complex code to try and figure out 197 ;; We used to use a much more complex code to try and figure out
215 ;; what key was used to run that self-insert-command: 198 ;; what key was used to run that self-insert-command:
216 ;; (if (<= (- num-input-keys 199 ;; (if (<= (- num-input-keys
217 ;; repeat-num-input-keys-at-self-insert) 200 ;; repeat-num-input-keys-at-self-insert)
218 ;; 1) 201 ;; 1)
219 ;; repeat-last-self-insert 202 ;; repeat-last-self-insert
220 ;; (let ((range (nth 1 buffer-undo-list))) 203 ;; (let ((range (nth 1 buffer-undo-list)))
221 ;; (condition-case nil 204 ;; (condition-case nil
222 ;; (setq repeat-last-self-insert 205 ;; (setq repeat-last-self-insert
223 ;; (buffer-substring (car range) 206 ;; (buffer-substring (car range)
224 ;; (cdr range))) 207 ;; (cdr range)))
225 ;; (error (error "%s %s %s" ;Danger, Will Robinson! 208 ;; (error (error "%s %s %s" ;Danger, Will Robinson!
226 ;; "repeat can't intuit what you" 209 ;; "repeat can't intuit what you"
227 ;; "inserted before auto-fill" 210 ;; "inserted before auto-fill"
228 ;; "clobbered it, sorry"))))) 211 ;; "clobbered it, sorry")))))
229 (setq last-command-event (char-before))) 212 (setq last-command-event (char-before)))
230 (let ((indirect (indirect-function last-repeatable-command))) 213 (let ((indirect (indirect-function last-repeatable-command)))
231 (if (or (stringp indirect) 214 (if (or (stringp indirect)
232 (vectorp indirect)) 215 (vectorp indirect))
233 ;; Bind last-repeatable-command so that executing the macro does 216 ;; Bind last-repeatable-command so that executing the macro does
234 ;; not alter it. 217 ;; not alter it.
235 (let ((last-repeatable-command last-repeatable-command)) 218 (let ((last-repeatable-command last-repeatable-command))
236 (execute-kbd-macro last-repeatable-command)) 219 (execute-kbd-macro last-repeatable-command))
237 (call-interactively last-repeatable-command)))) 220 (call-interactively last-repeatable-command))))
238 (when repeat-repeat-char 221 (when repeat-repeat-char
239 (set-transient-map 222 (set-transient-map
240 (let ((map (make-sparse-keymap))) 223 (let ((map (make-sparse-keymap)))
241 (define-key map (vector repeat-repeat-char) 224 (define-key map (vector repeat-repeat-char)
242 (if (null repeat-message-function) 'repeat 225 (if (null repeat-message-function) 'repeat
243 ;; If repeat-message-function is let-bound, preserve it for the 226 ;; If repeat-message-function is let-bound, preserve it for the
244 ;; next "iterations of the loop". 227 ;; next "iterations of the loop".
245 (let ((fun repeat-message-function)) 228 (let ((fun repeat-message-function))
246 (lambda () 229 (lambda ()
247 (interactive) 230 (interactive)
248 (let ((repeat-message-function fun)) 231 (let ((repeat-message-function fun))
249 (setq this-command 'repeat) 232 (setq this-command 'repeat)
250 ;; Beware: messing with `real-this-command' is *bad*, but we 233 ;; Beware: messing with `real-this-command' is *bad*, but we
251 ;; need it so `last-repeatable-command' can be recognized 234 ;; need it so `last-repeatable-command' can be recognized
252 ;; later (bug#12232). 235 ;; later (bug#12232).
253 (setq real-this-command 'repeat) 236 (setq real-this-command 'repeat)
254 (call-interactively 'repeat)))))) 237 (call-interactively 'repeat))))))
255 map))))) 238 map)))))
256 239
257(safe-defun repeat-message (format &rest args) 240 (defun repeat-message (format &rest args)
258 "Like `message' but displays with `repeat-message-function' if non-nil." 241 "Like `message' but displays with `repeat-message-function' if non-nil."
259 (let ((message (apply 'format format args))) 242 (let ((message (apply 'format format args)))
260 (if repeat-message-function 243 (if repeat-message-function
261 (funcall repeat-message-function message) 244 (funcall repeat-message-function message)
262 (message "%s" message)))) 245 (message "%s" message))))
263 246
264(safe-defcustom repeat-exit-key nil 247 (defcustom repeat-exit-key nil
265 "Key that stops the modal repeating of keys in sequence. 248 "Key that stops the modal repeating of keys in sequence.
266For example, you can set it to <return> like `isearch-exit'." 249For example, you can set it to <return> like `isearch-exit'."
267 :type '(choice (const :tag "No special key to exit repeating sequence" nil) 250 :type '(choice (const :tag "No special key to exit repeating sequence" nil)
268 (key-sequence :tag "Key that exits repeating sequence")) 251 (key-sequence :tag "Key that exits repeating sequence"))
269 :group 'convenience 252 :group 'convenience
270 :version "28.1") 253 :version "28.1")
271 254
272(safe-defcustom repeat-exit-timeout nil 255 (defcustom repeat-exit-timeout nil
273 "Break the repetition chain of keys after specified timeout. 256 "Break the repetition chain of keys after specified timeout.
274When a number, exit the repeat mode after idle time of the specified 257When a number, exit the repeat mode after idle time of the specified
275number of seconds." 258number of seconds."
276 :type '(choice (const :tag "No timeout to exit repeating sequence" nil) 259 :type '(choice (const :tag "No timeout to exit repeating sequence" nil)
277 (number :tag "Timeout in seconds to exit repeating")) 260 (number :tag "Timeout in seconds to exit repeating"))
278 :group 'convenience 261 :group 'convenience
279 :version "28.1") 262 :version "28.1")
280 263
281(safe-defvar repeat-exit-timer nil 264 (defvar repeat-exit-timer nil
282 "Timer activated after the last key typed in the repeating key sequence.") 265 "Timer activated after the last key typed in the repeating key sequence.")
283 266
284(defcustom repeat-keep-prefix t 267 (defcustom repeat-keep-prefix t
285 "Keep the prefix arg of the previous command." 268 "Keep the prefix arg of the previous command."
286 :type 'boolean 269 :type 'boolean
287 :group 'convenience 270 :group 'convenience
288 :version "28.1") 271 :version "28.1")
289 272
290(safe-defcustom repeat-echo-function #'repeat-echo-message 273 (defcustom repeat-echo-function #'repeat-echo-message
291 "Function to display a hint about available keys. 274 "Function to display a hint about available keys.
292Function is called after every repeatable command with one argument: 275Function is called after every repeatable command with one argument:
293a repeating map, or nil after deactivating the repeat mode." 276a repeating map, or nil after deactivating the repeat mode."
294 :type '(choice (const :tag "Show hints in the echo area" 277 :type '(choice (const :tag "Show hints in the echo area"
295 repeat-echo-message) 278 repeat-echo-message)
296 (const :tag "Show indicator in the mode line" 279 (const :tag "Show indicator in the mode line"
297 repeat-echo-mode-line) 280 repeat-echo-mode-line)
298 (const :tag "No visual feedback" ignore) 281 (const :tag "No visual feedback" ignore)
299 (function :tag "Function")) 282 (function :tag "Function"))
300 :group 'convenience 283 :group 'convenience
301 :version "28.1") 284 :version "28.1")
302 285
303(safe-defvar repeat-in-progress nil 286 (defvar repeat-in-progress nil
304 "Non-nil when the repeating map is active.") 287 "Non-nil when the repeating map is active.")
305 288
306;;;###autoload 289 (defvar repeat-map nil
307(safe-defvar repeat-map nil 290 "The value of the repeating map for the next command.
308 "The value of the repeating map for the next command.
309A command called from the map can set it again to the same map when 291A command called from the map can set it again to the same map when
310the map can't be set on the command symbol property `repeat-map'.") 292the map can't be set on the command symbol property `repeat-map'.")
311 293
312;;;###autoload 294 (define-minor-mode repeat-mode
313(safe-define-minor-mode repeat-mode 295 "Toggle Repeat mode.
314 "Toggle Repeat mode.
315When Repeat mode is enabled, and the command symbol has the property named 296When Repeat mode is enabled, and the command symbol has the property named
316`repeat-map', this map is activated temporarily for the next command." 297`repeat-map', this map is activated temporarily for the next command."
317 :global t :group 'convenience 298 :global t :group 'convenience
318 (if (not repeat-mode) 299 (if (not repeat-mode)
319 (remove-hook 'post-command-hook 'repeat-post-hook) 300 (remove-hook 'post-command-hook 'repeat-post-hook)
320 (add-hook 'post-command-hook 'repeat-post-hook) 301 (add-hook 'post-command-hook 'repeat-post-hook)
321 (let* ((keymaps nil) 302 (let* ((keymaps nil)
322 (commands (all-completions 303 (commands (all-completions
323 "" obarray (lambda (s) 304 "" obarray (lambda (s)
324 (and (commandp s) 305 (and (commandp s)
325 (get s 'repeat-map) 306 (get s 'repeat-map)
326 (push (get s 'repeat-map) keymaps)))))) 307 (push (get s 'repeat-map) keymaps))))))
327 (message "Repeat mode is enabled for %d commands and %d keymaps; see `describe-repeat-maps'." 308 (message "Repeat mode is enabled for %d commands and %d keymaps; see `describe-repeat-maps'."
328 (length commands) 309 (length commands)
329 (length (delete-dups keymaps)))))) 310 (length (delete-dups keymaps))))))
330 311
331(safe-defun repeat-post-hook () 312 (defun repeat-post-hook ()
332 "Function run after commands to set transient keymap for repeatable keys." 313 "Function run after commands to set transient keymap for repeatable keys."
333 (let ((was-in-progress repeat-in-progress)) 314 (let ((was-in-progress repeat-in-progress))
334 (setq repeat-in-progress nil) 315 (setq repeat-in-progress nil)
335 (when repeat-mode 316 (when repeat-mode
336 (let ((rep-map (or repeat-map 317 (let ((rep-map (or repeat-map
337 (and (symbolp real-this-command) 318 (and (symbolp real-this-command)
338 (get real-this-command 'repeat-map))))) 319 (get real-this-command 'repeat-map)))))
339 (when rep-map 320 (when rep-map
340 (when (boundp rep-map) 321 (when (boundp rep-map)
341 (setq rep-map (symbol-value rep-map))) 322 (setq rep-map (symbol-value rep-map)))
342 (let ((map (copy-keymap rep-map))) 323 (let ((map (copy-keymap rep-map)))
343 324
344 ;; Exit when the last char is not among repeatable keys, 325 ;; Exit when the last char is not among repeatable keys,
345 ;; so e.g. `C-x u u' repeats undo, whereas `C-/ u' doesn't. 326 ;; so e.g. `C-x u u' repeats undo, whereas `C-/ u' doesn't.
346 (when (and (zerop (minibuffer-depth)) ; avoid remapping in prompts 327 (when (and (zerop (minibuffer-depth)) ; avoid remapping in prompts
347 (or (lookup-key map (this-command-keys-vector)) 328 (or (lookup-key map (this-command-keys-vector))
348 prefix-arg)) 329 prefix-arg))
349 330
350 ;; Messaging 331 ;; Messaging
351 (unless prefix-arg 332 (unless prefix-arg
352 (funcall repeat-echo-function map)) 333 (funcall repeat-echo-function map))
353 334
354 ;; Adding an exit key 335 ;; Adding an exit key
355 (when repeat-exit-key 336 (when repeat-exit-key
356 (define-key map repeat-exit-key 'ignore)) 337 (define-key map repeat-exit-key 'ignore))
357 338
358 (when (and repeat-keep-prefix (not prefix-arg)) 339 (when (and repeat-keep-prefix (not prefix-arg))
359 (setq prefix-arg current-prefix-arg)) 340 (setq prefix-arg current-prefix-arg))
360 341
361 (setq repeat-in-progress t) 342 (setq repeat-in-progress t)
362 (let ((exitfun (set-transient-map map))) 343 (let ((exitfun (set-transient-map map)))
363 344
364 (when repeat-exit-timer 345 (when repeat-exit-timer
365 (cancel-timer repeat-exit-timer) 346 (cancel-timer repeat-exit-timer)
366 (setq repeat-exit-timer nil)) 347 (setq repeat-exit-timer nil))
367 348
368 (when repeat-exit-timeout 349 (when repeat-exit-timeout
369 (setq repeat-exit-timer 350 (setq repeat-exit-timer
370 (run-with-idle-timer 351 (run-with-idle-timer
371 repeat-exit-timeout nil 352 repeat-exit-timeout nil
372 (lambda () 353 (lambda ()
373 (setq repeat-in-progress nil) 354 (setq repeat-in-progress nil)
374 (funcall exitfun) 355 (funcall exitfun)
375 (funcall repeat-echo-function nil))))))))))) 356 (funcall repeat-echo-function nil)))))))))))
376 357
377 (setq repeat-map nil) 358 (setq repeat-map nil)
378 (when (and was-in-progress (not repeat-in-progress)) 359 (when (and was-in-progress (not repeat-in-progress))
379 (when repeat-exit-timer 360 (when repeat-exit-timer
380 (cancel-timer repeat-exit-timer) 361 (cancel-timer repeat-exit-timer)
381 (setq repeat-exit-timer nil)) 362 (setq repeat-exit-timer nil))
382 (funcall repeat-echo-function nil)))) 363 (funcall repeat-echo-function nil))))
383 364
384(safe-defun repeat-echo-message-string (keymap) 365 (defun repeat-echo-message-string (keymap)
385 "Return a string with a list of repeating keys." 366 "Return a string with a list of repeating keys."
386 (let (keys) 367 (let (keys)
387 (map-keymap (lambda (key _) (push key keys)) keymap) 368 (map-keymap (lambda (key _) (push key keys)) keymap)
388 (format-message "Repeat with %s%s" 369 (format-message "Repeat with %s%s"
389 (mapconcat (lambda (key) 370 (mapconcat (lambda (key)
390 (key-description (vector key))) 371 (key-description (vector key)))
391 keys ", ") 372 keys ", ")
392 (if repeat-exit-key 373 (if repeat-exit-key
393 (format ", or exit with %s" 374 (format ", or exit with %s"
394 (key-description repeat-exit-key)) 375 (key-description repeat-exit-key))
395 "")))) 376 ""))))
396 377
397(safe-defun repeat-echo-message (keymap) 378 (defun repeat-echo-message (keymap)
398 "Display available repeating keys in the echo area." 379 "Display available repeating keys in the echo area."
399 (if keymap 380 (if keymap
400 (let ((mess (repeat-echo-message-string keymap))) 381 (let ((mess (repeat-echo-message-string keymap)))
401 (if (current-message) 382 (if (current-message)
402 (message "%s [%s]" (current-message) mess) 383 (message "%s [%s]" (current-message) mess)
403 (message mess))) 384 (message mess)))
404 (and (current-message) 385 (and (current-message)
405 (string-search "Repeat with " (current-message)) 386 (string-search "Repeat with " (current-message))
406 (message nil)))) 387 (message nil))))
407 388
408(safe-defvar repeat-echo-mode-line-string 389 (defvar repeat-echo-mode-line-string
409 (propertize "[Repeating...] " 'face 'mode-line-emphasis) 390 (propertize "[Repeating...] " 'face 'mode-line-emphasis)
410 "String displayed in the mode line in repeating mode.") 391 "String displayed in the mode line in repeating mode.")
411 392
412(safe-defun repeat-echo-mode-line (keymap) 393 (defun repeat-echo-mode-line (keymap)
413 "Display the repeat indicator in the mode line." 394 "Display the repeat indicator in the mode line."
414 (if keymap 395 (if keymap
415 (unless (assq 'repeat-in-progress mode-line-modes) 396 (unless (assq 'repeat-in-progress mode-line-modes)
416 (add-to-list 'mode-line-modes (list 'repeat-in-progress 397 (add-to-list 'mode-line-modes (list 'repeat-in-progress
417 repeat-echo-mode-line-string))) 398 repeat-echo-mode-line-string)))
418 (force-mode-line-update t))) 399 (force-mode-line-update t)))
419 400
420(safe-defun describe-repeat-maps () 401 (defun describe-repeat-maps ()
421 "Describe mappings of commands repeatable by symbol property `repeat-map'." 402 "Describe mappings of commands repeatable by symbol property `repeat-map'."
422 (interactive) 403 (interactive)
423 (help-setup-xref (list #'describe-repeat-maps) 404 (help-setup-xref (list #'describe-repeat-maps)
424 (called-interactively-p 'interactive)) 405 (called-interactively-p 'interactive))
425 (let ((keymaps nil)) 406 (let ((keymaps nil))
426 (all-completions 407 (all-completions
427 "" obarray (lambda (s) 408 "" obarray (lambda (s)
428 (and (commandp s) 409 (and (commandp s)
429 (get s 'repeat-map) 410 (get s 'repeat-map)
430 (push s (alist-get (get s 'repeat-map) keymaps))))) 411 (push s (alist-get (get s 'repeat-map) keymaps)))))
431 (with-help-window (help-buffer) 412 (with-help-window (help-buffer)
432 (with-current-buffer standard-output 413 (with-current-buffer standard-output
433 (princ "A list of keymaps used by commands with the symbol property `repeat-map'.\n\n") 414 (princ "A list of keymaps used by commands with the symbol property `repeat-map'.\n\n")
434 415
435 (dolist (keymap (sort keymaps (lambda (a b) (string-lessp (car a) (car b))))) 416 (dolist (keymap (sort keymaps (lambda (a b) (string-lessp (car a) (car b)))))
436 (princ (format-message "`%s' keymap is repeatable by these commands:\n" 417 (princ (format-message "`%s' keymap is repeatable by these commands:\n"
437 (car keymap))) 418 (car keymap)))
438 (dolist (command (sort (cdr keymap) 'string-lessp)) 419 (dolist (command (sort (cdr keymap) 'string-lessp))
439 (princ (format-message " `%s'\n" command))) 420 (princ (format-message " `%s'\n" command)))
440 (princ "\n")))))) 421 (princ "\n"))))))
441 422
442;;; Bindings! 423;;; Bindings!
443(safe-defvar undo-repeat-map 424 (defvar undo-repeat-map
444 (let ((map (make-sparse-keymap))) 425 (let ((map (make-sparse-keymap)))
445 (define-key map "u" 'undo) 426 (define-key map "u" 'undo)
446 map) 427 map)
447 "Keymap to repeat undo key sequences `C-x u u'. Used in `repeat-mode'.") 428 "Keymap to repeat undo key sequences `C-x u u'. Used in `repeat-mode'.")
448(put 'undo 'repeat-map 'undo-repeat-map) 429
449 430 (defvar next-error-repeat-map
450 431 (let ((map (make-sparse-keymap)))
451(safe-defvar next-error-repeat-map 432 (define-key map "n" 'next-error)
452 (let ((map (make-sparse-keymap))) 433 (define-key map "\M-n" 'next-error)
453 (define-key map "n" 'next-error) 434 (define-key map "p" 'previous-error)
454 (define-key map "\M-n" 'next-error) 435 (define-key map "\M-p" 'previous-error)
455 (define-key map "p" 'previous-error) 436 map)
456 (define-key map "\M-p" 'previous-error) 437 "Keymap to repeat next-error key sequences. Used in `repeat-mode'.")
457 map) 438
458 "Keymap to repeat next-error key sequences. Used in `repeat-mode'.") 439 (defvar page-navigation-repeat-map
459(put 'next-error 'repeat-map 'next-error-repeat-map) 440 (let ((map (make-sparse-keymap)))
460(put 'previous-error 'repeat-map 'next-error-repeat-map) 441 (define-key map "]" #'forward-page)
461 442 (define-key map "[" #'backward-page)
462 443 map)
463(safe-defvar page-navigation-repeat-map 444 "Keymap to repeat page navigation key sequences. Used in `repeat-mode'.")
464 (let ((map (make-sparse-keymap))) 445
465 (define-key map "]" #'forward-page) 446 (defvar tab-bar-switch-repeat-map
466 (define-key map "[" #'backward-page) 447 (let ((map (make-sparse-keymap)))
467 map) 448 (define-key map "o" 'tab-next)
468 "Keymap to repeat page navigation key sequences. Used in `repeat-mode'.") 449 (define-key map "O" 'tab-previous)
469 450 map)
470(put 'forward-page 'repeat-map 'page-navigation-repeat-map) 451 "Keymap to repeat tab switch key sequences `C-x t o o O'.
471(put 'backward-page 'repeat-map 'page-navigation-repeat-map)
472
473
474(safe-defvar tab-bar-switch-repeat-map
475 (let ((map (make-sparse-keymap)))
476 (define-key map "o" 'tab-next)
477 (define-key map "O" 'tab-previous)
478 map)
479 "Keymap to repeat tab switch key sequences `C-x t o o O'.
480Used in `repeat-mode'.") 452Used in `repeat-mode'.")
481(put 'tab-next 'repeat-map 'tab-bar-switch-repeat-map)
482(put 'tab-previous 'repeat-map 'tab-bar-switch-repeat-map)
483 453
484(safe-defvar tab-bar-move-repeat-map 454 (defvar tab-bar-move-repeat-map
485 (let ((map (make-sparse-keymap))) 455 (let ((map (make-sparse-keymap)))
486 (define-key map "m" 'tab-move) 456 (define-key map "m" 'tab-move)
487 (define-key map "M" (lambda () 457 (define-key map "M" (lambda ()
488 (interactive) 458 (interactive)
489 (setq repeat-map 'tab-bar-move-repeat-map) 459 (setq repeat-map 'tab-bar-move-repeat-map)
490 (tab-move -1))) 460 (tab-move -1)))
491 map) 461 map)
492 "Keymap to repeat tab move key sequences `C-x t m m M'. 462 "Keymap to repeat tab move key sequences `C-x t m m M'.
493Used in `repeat-mode'.") 463Used in `repeat-mode'.")
494(put 'tab-move 'repeat-map 'tab-bar-move-repeat-map)
495
496
497(safe-defvar other-window-repeat-map
498 (let ((map (make-sparse-keymap)))
499 (define-key map "o" 'other-window)
500 (define-key map "O" (lambda ()
501 (interactive)
502 (setq repeat-map 'other-window-repeat-map)
503 (other-window -1)))
504 map)
505 "Keymap to repeat other-window key sequences. Used in `repeat-mode'.")
506(put 'other-window 'repeat-map 'other-window-repeat-map)
507
508(safe-defvar resize-window-repeat-map
509 (let ((map (make-sparse-keymap)))
510 ;; Standard keys:
511 (define-key map "^" 'enlarge-window)
512 (define-key map "}" 'enlarge-window-horizontally)
513 (define-key map "{" 'shrink-window-horizontally)
514 ;; Additional keys:
515 (define-key map "v" 'shrink-window)
516 map)
517 "Keymap to repeat window resizing commands. Used in `repeat-mode'.")
518(put 'enlarge-window 'repeat-map 'resize-window-repeat-map)
519(put 'enlarge-window-horizontally 'repeat-map 'resize-window-repeat-map)
520(put 'shrink-window-horizontally 'repeat-map 'resize-window-repeat-map)
521(put 'shrink-window 'repeat-map 'resize-window-repeat-map)
522 464
465 (defvar other-window-repeat-map
466 (let ((map (make-sparse-keymap)))
467 (define-key map "o" 'other-window)
468 (define-key map "O" (lambda ()
469 (interactive)
470 (setq repeat-map 'other-window-repeat-map)
471 (other-window -1)))
472 map)
473 "Keymap to repeat other-window key sequences. Used in `repeat-mode'.")
474
475 (defvar resize-window-repeat-map
476 (let ((map (make-sparse-keymap)))
477 ;; Standard keys:
478 (define-key map "^" 'enlarge-window)
479 (define-key map "}" 'enlarge-window-horizontally)
480 (define-key map "{" 'shrink-window-horizontally)
481 ;; Additional keys:
482 (define-key map "v" 'shrink-window)
483 map)
484 "Keymap to repeat window resizing commands. Used in `repeat-mode'.")
485
486 (defvar outline-navigation-repeat-map
487 (let ((map (make-sparse-keymap)))
488 (define-key map (kbd "C-b") #'outline-backward-same-level)
489 (define-key map (kbd "b") #'outline-backward-same-level)
490 (define-key map (kbd "C-f") #'outline-forward-same-level)
491 (define-key map (kbd "f") #'outline-forward-same-level)
492 (define-key map (kbd "C-n") #'outline-next-visible-heading)
493 (define-key map (kbd "n") #'outline-next-visible-heading)
494 (define-key map (kbd "C-p") #'outline-previous-visible-heading)
495 (define-key map (kbd "p") #'outline-previous-visible-heading)
496 (define-key map (kbd "C-u") #'outline-up-heading)
497 (define-key map (kbd "u") #'outline-up-heading)
498 map))
499
500 (defvar outline-editing-repeat-map
501 (let ((map (make-sparse-keymap)))
502 (define-key map (kbd "C-v") #'outline-move-subtree-down)
503 (define-key map (kbd "v") #'outline-move-subtree-down)
504 (define-key map (kbd "C-^") #'outline-move-subtree-up)
505 (define-key map (kbd "^") #'outline-move-subtree-up)
506 (define-key map (kbd "C->") #'outline-demote)
507 (define-key map (kbd ">") #'outline-demote)
508 (define-key map (kbd "C-<") #'outline-promote)
509 (define-key map (kbd "<") #'outline-promote)
510 map)))
523 511
524(with-eval-after-load 'outline 512(with-eval-after-load 'outline
525 (safe-defvar outline-navigation-repeat-map
526 (let ((map (make-sparse-keymap)))
527 (define-key map (kbd "C-b") #'outline-backward-same-level)
528 (define-key map (kbd "b") #'outline-backward-same-level)
529 (define-key map (kbd "C-f") #'outline-forward-same-level)
530 (define-key map (kbd "f") #'outline-forward-same-level)
531 (define-key map (kbd "C-n") #'outline-next-visible-heading)
532 (define-key map (kbd "n") #'outline-next-visible-heading)
533 (define-key map (kbd "C-p") #'outline-previous-visible-heading)
534 (define-key map (kbd "p") #'outline-previous-visible-heading)
535 (define-key map (kbd "C-u") #'outline-up-heading)
536 (define-key map (kbd "u") #'outline-up-heading)
537 map))
538
539 (dolist (command '(outline-backward-same-level 513 (dolist (command '(outline-backward-same-level
540 outline-forward-same-level 514 outline-forward-same-level
541 outline-next-visible-heading 515 outline-next-visible-heading
@@ -543,30 +517,32 @@ Used in `repeat-mode'.")
543 outline-up-heading)) 517 outline-up-heading))
544 (put command 'repeat-map 'outline-navigation-repeat-map)) 518 (put command 'repeat-map 'outline-navigation-repeat-map))
545 519
546 (safe-defvar outline-editing-repeat-map
547 (let ((map (make-sparse-keymap)))
548 (define-key map (kbd "C-v") #'outline-move-subtree-down)
549 (define-key map (kbd "v") #'outline-move-subtree-down)
550 (define-key map (kbd "C-^") #'outline-move-subtree-up)
551 (define-key map (kbd "^") #'outline-move-subtree-up)
552 (define-key map (kbd "C->") #'outline-demote)
553 (define-key map (kbd ">") #'outline-demote)
554 (define-key map (kbd "C-<") #'outline-promote)
555 (define-key map (kbd "<") #'outline-promote)
556 map))
557
558 (dolist (command '(outline-move-subtree-down 520 (dolist (command '(outline-move-subtree-down
559 outline-move-subtree-up 521 outline-move-subtree-up
560 outline-demote 522 outline-demote
561 outline-promote)) 523 outline-promote))
562 (put command 'repeat-map 'outline-editing-repeat-map)) 524 (put command 'repeat-map 'outline-editing-repeat-map)))
563 ) 525
526(put 'undo 'repeat-map 'undo-repeat-map)
527(put 'next-error 'repeat-map 'next-error-repeat-map)
528(put 'previous-error 'repeat-map 'next-error-repeat-map)
529(put 'forward-page 'repeat-map 'page-navigation-repeat-map)
530(put 'backward-page 'repeat-map 'page-navigation-repeat-map)
531(put 'tab-next 'repeat-map 'tab-bar-switch-repeat-map)
532(put 'tab-previous 'repeat-map 'tab-bar-switch-repeat-map)
533(put 'tab-move 'repeat-map 'tab-bar-move-repeat-map)
534(put 'other-window 'repeat-map 'other-window-repeat-map)
535(put 'enlarge-window 'repeat-map 'resize-window-repeat-map)
536(put 'enlarge-window-horizontally 'repeat-map 'resize-window-repeat-map)
537(put 'shrink-window-horizontally 'repeat-map 'resize-window-repeat-map)
538(put 'shrink-window 'repeat-map 'resize-window-repeat-map)
539
564 540
565;;; goto-address-mode 541;;; goto-address-mode
566(unless (fboundp 'global-goto-address-mode) 542(safe-define
567 (define-globalized-minor-mode global-goto-address-mode 543 (define-globalized-minor-mode global-goto-address-mode
568 goto-address-mode goto-addr-mode--turn-on 544 goto-address-mode goto-addr-mode--turn-on
569 :version "28.1")) 545 :version "28.1"))
570 546
571(provide 'acdw-compat) 547(provide 'acdw-compat)
572;;; acdw-compat.el ends here 548;;; acdw-compat.el ends here
© 2022 C. Duckworth. generated by cgit. comments, issues, and patches welcome at < git at acdw dot net >.