about summary refs log tree commit diff stats
path: root/lisp
diff options
context:
space:
mode:
authorCase Duckworth2021-08-25 17:39:55 -0500
committerCase Duckworth2021-08-25 17:39:55 -0500
commitde8263f12f03c562349e1ef7250e2214bb752339 (patch)
tree2fa8ca73f1cae90b971bd9043583fb61ec529c06 /lisp
parentChange typo logic on ' (diff)
downloademacs-de8263f12f03c562349e1ef7250e2214bb752339.tar.gz
emacs-de8263f12f03c562349e1ef7250e2214bb752339.zip
Add repeat-mode to acdw-compat
Diffstat (limited to 'lisp')
-rw-r--r--lisp/acdw-compat.el381
1 files changed, 377 insertions, 4 deletions
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 @@
21 21
22;;; Code: 22;;; Code:
23 23
24;; Convenience macro 24;; Convenience macros
25(defmacro safe-defun (name arglist &optional docstring &rest body) 25(defmacro safe-defun (name arglist &rest body)
26 "Like `defun', but only if the function doesn't already exist. 26 "Like `defun', but only if the function doesn't already exist.
27 27
28Is it necessary? Who knows! 28Is it necessary? Who knows!
@@ -31,11 +31,45 @@ Is it necessary? Who knows!
31 (declare (doc-string 3) 31 (declare (doc-string 3)
32 (indent 2)) 32 (indent 2))
33 `(unless (fboundp (function ,name)) 33 `(unless (fboundp (function ,name))
34 (defun ,name ,@body))) 34 (defun ,name ,arglist ,@body)))
35
36(defmacro safe-defsubst (name arglist &rest body)
37 "Like `defsubst', but only if the inline function doesn't exist.
38\(fn NAME ARGLIST &optional DOCSTRING DECL &rest BODY"
39 (declare (debug defun) (doc-string 3))
40 `(unless (fboundp (function ,name))
41 (defsubst ,name ,arglist ,@body)))
42
43(defmacro safe-define-minor-mode (mode doc &rest body)
44 "Like `define-minor-mode', but only if the mode doesn't exist.
45\(fn MODE DOC &optional INIT-VALUE LIGHTER KEYMAP &rest BODY)"
46 (declare (doc-string 2)
47 (debug (&define name string-or-null-p
48 [&optional [&not keywordp] sexp
49 &optional [&not keywordp] sexp
50 &optional [&not keywordp] sexp]
51 [&rest [keywordp sexp]]
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)))
35 69
36 70
37;;; Functions for changing capitalization that Do What I Mean 71;;; Functions for changing capitalization that Do What I Mean
38;; Defined in /usr/share/emacs/28.0.50/lisp/simple.el 72;; Defined in EMACS/lisp/simple.el
39 73
40(safe-defun upcase-dwim (arg) 74(safe-defun upcase-dwim (arg)
41 "Upcase words in the region, if active; if not, upcase word at point. 75 "Upcase words in the region, if active; if not, upcase word at point.
@@ -67,5 +101,344 @@ to capitalize ARG words."
67 (capitalize-region (region-beginning) (region-end) (region-noncontiguous-p)) 101 (capitalize-region (region-beginning) (region-end) (region-noncontiguous-p))
68 (capitalize-word arg))) 102 (capitalize-word arg)))
69 103
104
105;;; Repeat.el
106;; Defined in EMACS/lisp/repeat.el
107
108(safe-defcustom repeat-too-dangerous '(kill-this-buffer)
109 "Commands too dangerous to repeat with \\[repeat]."
110 :group 'convenience
111 :type '(repeat function))
112
113(safe-defvar repeat-message-function nil
114 "If non-nil, function used by `repeat' command to say what it's doing.
115Message is something like \"Repeating command glorp\".
116A value of `ignore' will disable such messages. To customize
117display, assign a function that takes one string as an arg and
118displays it however you want.
119If this variable is nil, the normal `message' function will be
120used to display the messages.")
121
122(safe-defcustom repeat-on-final-keystroke t
123 "Allow `repeat' to re-execute for repeating lastchar of a key sequence.
124If this variable is t, `repeat' determines what key sequence
125it 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
127if `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
129only 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."
131 :group 'convenience
132 :type '(choice (const :tag "Repeat for all keys" t)
133 (const :tag "Don't repeat" nil)
134 (sexp :tag "Repeat for specific keys")))
135
136(safe-defvar repeat-num-input-keys-at-repeat -1
137 "# key sequences read in Emacs session when `repeat' last invoked.")
138
139(safe-defsubst repeat-is-really-this-command ()
140 "Return t if this command is happening because user invoked `repeat'.
141Usually, when a command is executing, the Emacs builtin variable
142`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
144that, and usually does do more good than harm. However, like all do-gooders,
145sometimes `repeat' gets surprising results from its altruism. The value of
146this function is always whether the value of `this-command' would've been
147'repeat if `repeat' hadn't modified it."
148 (= repeat-num-input-keys-at-repeat num-input-keys))
149
150(safe-defvar repeat-previous-repeated-command nil
151 "The previous repeated command.")
152
153;;;###autoload
154(safe-defun repeat (repeat-arg)
155 "Repeat most recently executed command.
156If REPEAT-ARG is non-nil (interactively, with a prefix argument),
157supply a prefix argument to that command. Otherwise, give the
158command the same prefix argument it was given before, if any.
159
160If this command is invoked by a multi-character key sequence, it
161can then be repeated by repeating the final character of that
162sequence. This behavior can be modified by the global variable
163`repeat-on-final-keystroke'.
164
165`repeat' ignores commands bound to input events. Hence the term
166\"most recently executed command\" shall be read as \"most
167recently executed command not bound to an input event\"."
168 ;; The most recently executed command could be anything, so surprises could
169 ;; result if it were re-executed in a context where new dynamically
170 ;; localized variables were shadowing global variables in a `let' clause in
171 ;; here. (Remember that GNU Emacs 19 is dynamically localized.)
172 ;; 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
174 ;; "repeat-" prefix, reserved by this package, for *local* variables that
175 ;; might be visible to re-executed commands, including this function's arg.
176 (interactive "P")
177 (when (eq last-repeatable-command 'repeat)
178 (setq last-repeatable-command repeat-previous-repeated-command))
179 (cond
180 ((null last-repeatable-command)
181 (error "There is nothing to repeat"))
182 ((eq last-repeatable-command 'mode-exit)
183 (error "last-repeatable-command is mode-exit & can't be repeated"))
184 ((memq last-repeatable-command repeat-too-dangerous)
185 (error "Command %S too dangerous to repeat automatically"
186 last-repeatable-command)))
187 (setq this-command last-repeatable-command
188 repeat-previous-repeated-command last-repeatable-command
189 repeat-num-input-keys-at-repeat num-input-keys)
190 (when (null repeat-arg)
191 (setq repeat-arg last-prefix-arg))
192 ;; Now determine whether to loop on repeated taps of the final character
193 ;; of the key sequence that invoked repeat. The Emacs global
194 ;; last-command-event contains the final character now, but may not still
195 ;; contain it after the previous command is repeated, so the character
196 ;; needs to be saved.
197 (let ((repeat-repeat-char
198 (if (eq repeat-on-final-keystroke t)
199 last-command-event
200 ;; Allow only specified final keystrokes.
201 (car (memq last-command-event
202 (listify-key-sequence
203 repeat-on-final-keystroke))))))
204 (if (eq last-repeatable-command (caar command-history))
205 (let ((repeat-command (car command-history)))
206 (repeat-message "Repeating %S" repeat-command)
207 (eval repeat-command))
208 (if (null repeat-arg)
209 (repeat-message "Repeating command %S" last-repeatable-command)
210 (setq current-prefix-arg repeat-arg)
211 (repeat-message
212 "Repeating command %S %S" repeat-arg last-repeatable-command))
213 (when (eq last-repeatable-command 'self-insert-command)
214 ;; 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:
216 ;; (if (<= (- num-input-keys
217 ;; repeat-num-input-keys-at-self-insert)
218 ;; 1)
219 ;; repeat-last-self-insert
220 ;; (let ((range (nth 1 buffer-undo-list)))
221 ;; (condition-case nil
222 ;; (setq repeat-last-self-insert
223 ;; (buffer-substring (car range)
224 ;; (cdr range)))
225 ;; (error (error "%s %s %s" ;Danger, Will Robinson!
226 ;; "repeat can't intuit what you"
227 ;; "inserted before auto-fill"
228 ;; "clobbered it, sorry")))))
229 (setq last-command-event (char-before)))
230 (let ((indirect (indirect-function last-repeatable-command)))
231 (if (or (stringp indirect)
232 (vectorp indirect))
233 ;; Bind last-repeatable-command so that executing the macro does
234 ;; not alter it.
235 (let ((last-repeatable-command last-repeatable-command))
236 (execute-kbd-macro last-repeatable-command))
237 (call-interactively last-repeatable-command))))
238 (when repeat-repeat-char
239 (set-transient-map
240 (let ((map (make-sparse-keymap)))
241 (define-key map (vector repeat-repeat-char)
242 (if (null repeat-message-function) 'repeat
243 ;; If repeat-message-function is let-bound, preserve it for the
244 ;; next "iterations of the loop".
245 (let ((fun repeat-message-function))
246 (lambda ()
247 (interactive)
248 (let ((repeat-message-function fun))
249 (setq this-command 'repeat)
250 ;; Beware: messing with `real-this-command' is *bad*, but we
251 ;; need it so `last-repeatable-command' can be recognized
252 ;; later (bug#12232).
253 (setq real-this-command 'repeat)
254 (call-interactively 'repeat))))))
255 map)))))
256
257(safe-defun repeat-message (format &rest args)
258 "Like `message' but displays with `repeat-message-function' if non-nil."
259 (let ((message (apply 'format format args)))
260 (if repeat-message-function
261 (funcall repeat-message-function message)
262 (message "%s" message))))
263
264(safe-defcustom repeat-exit-key nil
265 "Key that stops the modal repeating of keys in sequence.
266For example, you can set it to <return> like `isearch-exit'."
267 :type '(choice (const :tag "No special key to exit repeating sequence" nil)
268 (key-sequence :tag "Key that exits repeating sequence"))
269 :group 'convenience
270 :version "28.1")
271
272(safe-defcustom repeat-exit-timeout nil
273 "Break the repetition chain of keys after specified timeout.
274When a number, exit the repeat mode after idle time of the specified
275number of seconds."
276 :type '(choice (const :tag "No timeout to exit repeating sequence" nil)
277 (number :tag "Timeout in seconds to exit repeating"))
278 :group 'convenience
279 :version "28.1")
280
281(safe-defvar repeat-exit-timer nil
282 "Timer activated after the last key typed in the repeating key sequence.")
283
284(defcustom repeat-keep-prefix t
285 "Keep the prefix arg of the previous command."
286 :type 'boolean
287 :group 'convenience
288 :version "28.1")
289
290(safe-defcustom repeat-echo-function #'repeat-echo-message
291 "Function to display a hint about available keys.
292Function is called after every repeatable command with one argument:
293a repeating map, or nil after deactivating the repeat mode."
294 :type '(choice (const :tag "Show hints in the echo area"
295 repeat-echo-message)
296 (const :tag "Show indicator in the mode line"
297 repeat-echo-mode-line)
298 (const :tag "No visual feedback" ignore)
299 (function :tag "Function"))
300 :group 'convenience
301 :version "28.1")
302
303(safe-defvar repeat-in-progress nil
304 "Non-nil when the repeating map is active.")
305
306;;;###autoload
307(safe-defvar repeat-map nil
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
310the map can't be set on the command symbol property `repeat-map'.")
311
312;;;###autoload
313(safe-define-minor-mode repeat-mode
314 "Toggle Repeat mode.
315When Repeat mode is enabled, and the command symbol has the property named
316`repeat-map', this map is activated temporarily for the next command."
317 :global t :group 'convenience
318 (if (not repeat-mode)
319 (remove-hook 'post-command-hook 'repeat-post-hook)
320 (add-hook 'post-command-hook 'repeat-post-hook)
321 (let* ((keymaps nil)
322 (commands (all-completions
323 "" obarray (lambda (s)
324 (and (commandp s)
325 (get s 'repeat-map)
326 (push (get s 'repeat-map) keymaps))))))
327 (message "Repeat mode is enabled for %d commands and %d keymaps; see `describe-repeat-maps'."
328 (length commands)
329 (length (delete-dups keymaps))))))
330
331(safe-defun repeat-post-hook ()
332 "Function run after commands to set transient keymap for repeatable keys."
333 (let ((was-in-progress repeat-in-progress))
334 (setq repeat-in-progress nil)
335 (when repeat-mode
336 (let ((rep-map (or repeat-map
337 (and (symbolp real-this-command)
338 (get real-this-command 'repeat-map)))))
339 (when rep-map
340 (when (boundp rep-map)
341 (setq rep-map (symbol-value rep-map)))
342 (let ((map (copy-keymap rep-map)))
343
344 ;; 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.
346 (when (and (zerop (minibuffer-depth)) ; avoid remapping in prompts
347 (or (lookup-key map (this-command-keys-vector))
348 prefix-arg))
349
350 ;; Messaging
351 (unless prefix-arg
352 (funcall repeat-echo-function map))
353
354 ;; Adding an exit key
355 (when repeat-exit-key
356 (define-key map repeat-exit-key 'ignore))
357
358 (when (and repeat-keep-prefix (not prefix-arg))
359 (setq prefix-arg current-prefix-arg))
360
361 (setq repeat-in-progress t)
362 (let ((exitfun (set-transient-map map)))
363
364 (when repeat-exit-timer
365 (cancel-timer repeat-exit-timer)
366 (setq repeat-exit-timer nil))
367
368 (when repeat-exit-timeout
369 (setq repeat-exit-timer
370 (run-with-idle-timer
371 repeat-exit-timeout nil
372 (lambda ()
373 (setq repeat-in-progress nil)
374 (funcall exitfun)
375 (funcall repeat-echo-function nil)))))))))))
376
377 (setq repeat-map nil)
378 (when (and was-in-progress (not repeat-in-progress))
379 (when repeat-exit-timer
380 (cancel-timer repeat-exit-timer)
381 (setq repeat-exit-timer nil))
382 (funcall repeat-echo-function nil))))
383
384(safe-defun repeat-echo-message-string (keymap)
385 "Return a string with a list of repeating keys."
386 (let (keys)
387 (map-keymap (lambda (key _) (push key keys)) keymap)
388 (format-message "Repeat with %s%s"
389 (mapconcat (lambda (key)
390 (key-description (vector key)))
391 keys ", ")
392 (if repeat-exit-key
393 (format ", or exit with %s"
394 (key-description repeat-exit-key))
395 ""))))
396
397(safe-defun repeat-echo-message (keymap)
398 "Display available repeating keys in the echo area."
399 (if keymap
400 (let ((mess (repeat-echo-message-string keymap)))
401 (if (current-message)
402 (message "%s [%s]" (current-message) mess)
403 (message mess)))
404 (and (current-message)
405 (string-search "Repeat with " (current-message))
406 (message nil))))
407
408(safe-defvar repeat-echo-mode-line-string
409 (propertize "[Repeating...] " 'face 'mode-line-emphasis)
410 "String displayed in the mode line in repeating mode.")
411
412(safe-defun repeat-echo-mode-line (keymap)
413 "Display the repeat indicator in the mode line."
414 (if keymap
415 (unless (assq 'repeat-in-progress mode-line-modes)
416 (add-to-list 'mode-line-modes (list 'repeat-in-progress
417 repeat-echo-mode-line-string)))
418 (force-mode-line-update t)))
419
420(safe-defun describe-repeat-maps ()
421 "Describe mappings of commands repeatable by symbol property `repeat-map'."
422 (interactive)
423 (help-setup-xref (list #'describe-repeat-maps)
424 (called-interactively-p 'interactive))
425 (let ((keymaps nil))
426 (all-completions
427 "" obarray (lambda (s)
428 (and (commandp s)
429 (get s 'repeat-map)
430 (push s (alist-get (get s 'repeat-map) keymaps)))))
431 (with-help-window (help-buffer)
432 (with-current-buffer standard-output
433 (princ "A list of keymaps used by commands with the symbol property `repeat-map'.\n\n")
434
435 (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"
437 (car keymap)))
438 (dolist (command (sort (cdr keymap) 'string-lessp))
439 (princ (format-message " `%s'\n" command)))
440 (princ "\n"))))))
441
442
70(provide 'acdw-compat) 443(provide 'acdw-compat)
71;;; acdw-compat.el ends here 444;;; acdw-compat.el ends here