Commit | Line | Data |
---|---|---|
e5167999 ER |
1 | ;;; edmacro.el --- keyboard macro editor |
2 | ||
acaf905b | 3 | ;; Copyright (C) 1993-1994, 2001-2012 Free Software Foundation, Inc. |
9750e079 | 4 | |
629d4dcd RS |
5 | ;; Author: Dave Gillespie <daveg@synaptics.com> |
6 | ;; Maintainer: Dave Gillespie <daveg@synaptics.com> | |
7 | ;; Version: 2.01 | |
e9571d2a | 8 | ;; Keywords: abbrev |
66b3ecce DL |
9 | |
10 | ;; This file is part of GNU Emacs. | |
11 | ||
eb3fa2cf | 12 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
66b3ecce | 13 | ;; it under the terms of the GNU General Public License as published by |
eb3fa2cf GM |
14 | ;; the Free Software Foundation, either version 3 of the License, or |
15 | ;; (at your option) any later version. | |
66b3ecce DL |
16 | |
17 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;; GNU General Public License for more details. | |
21 | ||
22 | ;; You should have received a copy of the GNU General Public License | |
eb3fa2cf | 23 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
66b3ecce | 24 | |
e5167999 | 25 | ;;; Commentary: |
66b3ecce | 26 | |
629d4dcd RS |
27 | ;;; Usage: |
28 | ;; | |
b680abcb | 29 | ;; The `C-x C-k e' (`edit-kbd-macro') command edits a keyboard macro |
629d4dcd RS |
30 | ;; in a special buffer. It prompts you to type a key sequence, |
31 | ;; which should be one of: | |
32 | ;; | |
71296446 | 33 | ;; * RET or `C-x e' (call-last-kbd-macro), to edit the most |
629d4dcd RS |
34 | ;; recently defined keyboard macro. |
35 | ;; | |
36 | ;; * `M-x' followed by a command name, to edit a named command | |
37 | ;; whose definition is a keyboard macro. | |
38 | ;; | |
6b8d1c72 | 39 | ;; * `C-h l' (view-lossage), to edit the 300 most recent keystrokes |
629d4dcd RS |
40 | ;; and install them as the "current" macro. |
41 | ;; | |
42 | ;; * any key sequence whose definition is a keyboard macro. | |
43 | ;; | |
44 | ;; This file includes a version of `insert-kbd-macro' that uses the | |
45 | ;; more readable format defined by these routines. | |
46 | ;; | |
47 | ;; Also, the `read-kbd-macro' command parses the region as | |
48 | ;; a keyboard macro, and installs it as the "current" macro. | |
49 | ;; This and `format-kbd-macro' can also be called directly as | |
50 | ;; Lisp functions. | |
51 | ||
52 | ;; Type `C-h m', or see the documentation for `edmacro-mode' below, | |
53 | ;; for information about the format of written keyboard macros. | |
54 | ||
55 | ;; `edit-kbd-macro' formats the macro with one command per line, | |
56 | ;; including the command names as comments on the right. If the | |
57 | ;; formatter gets confused about which keymap was used for the | |
58 | ;; characters, the command-name comments will be wrong but that | |
59 | ;; won't hurt anything. | |
60 | ||
61 | ;; With a prefix argument, `edit-kbd-macro' will format the | |
62 | ;; macro in a more concise way that omits the comments. | |
63 | ||
e5167999 | 64 | ;;; Code: |
66b3ecce | 65 | \f |
c31afdbd RS |
66 | (eval-when-compile |
67 | (require 'cl)) | |
629d4dcd | 68 | |
70e2ea11 KS |
69 | (require 'kmacro) |
70 | ||
66b3ecce DL |
71 | ;;; The user-level commands for editing macros. |
72 | ||
e17816e5 GM |
73 | (defcustom edmacro-eight-bits nil |
74 | "Non-nil if `edit-kbd-macro' should leave 8-bit characters intact. | |
75 | Default nil means to write characters above \\177 in octal notation." | |
76 | :type 'boolean | |
77 | :group 'kmacro) | |
629d4dcd | 78 | |
a0310a6c DN |
79 | (defvar edmacro-mode-map |
80 | (let ((map (make-sparse-keymap))) | |
81 | (define-key map "\C-c\C-c" 'edmacro-finish-edit) | |
82 | (define-key map "\C-c\C-q" 'edmacro-insert-key) | |
83 | map)) | |
629d4dcd | 84 | |
88c4981a RS |
85 | (defvar edmacro-store-hook) |
86 | (defvar edmacro-finish-hook) | |
87 | (defvar edmacro-original-buffer) | |
88 | ||
f9f9507e | 89 | ;;;###autoload |
629d4dcd RS |
90 | (defun edit-kbd-macro (keys &optional prefix finish-hook store-hook) |
91 | "Edit a keyboard macro. | |
92 | At the prompt, type any key sequence which is bound to a keyboard macro. | |
93 | Or, type `C-x e' or RET to edit the last keyboard macro, `C-h l' to edit | |
6b8d1c72 | 94 | the last 300 keystrokes as a keyboard macro, or `M-x' to edit a macro by |
629d4dcd RS |
95 | its command name. |
96 | With a prefix argument, format the macro in a more concise way." | |
97 | (interactive "kKeyboard macro to edit (C-x e, M-x, C-h l, or keys): \nP") | |
98 | (when keys | |
99 | (let ((cmd (if (arrayp keys) (key-binding keys) keys)) | |
70e2ea11 KS |
100 | (mac nil) (mac-counter nil) (mac-format nil) |
101 | kmacro) | |
629d4dcd RS |
102 | (cond (store-hook |
103 | (setq mac keys) | |
104 | (setq cmd nil)) | |
71296446 | 105 | ((or (memq cmd '(call-last-kbd-macro kmacro-call-macro |
059aa0a7 | 106 | kmacro-end-or-call-macro kmacro-end-and-call-macro)) |
629d4dcd RS |
107 | (member keys '("\r" [return]))) |
108 | (or last-kbd-macro | |
109 | (y-or-n-p "No keyboard macro defined. Create one? ") | |
110 | (keyboard-quit)) | |
111 | (setq mac (or last-kbd-macro "")) | |
70e2ea11 | 112 | (setq keys nil) |
629d4dcd RS |
113 | (setq cmd 'last-kbd-macro)) |
114 | ((eq cmd 'execute-extended-command) | |
115 | (setq cmd (read-command "Name of keyboard macro to edit: ")) | |
ef8e50b1 RS |
116 | (if (string-equal cmd "") |
117 | (error "No command name given")) | |
70e2ea11 | 118 | (setq keys nil) |
629d4dcd | 119 | (setq mac (symbol-function cmd))) |
fcd66424 | 120 | ((memq cmd '(view-lossage electric-view-lossage)) |
629d4dcd | 121 | (setq mac (recent-keys)) |
70e2ea11 | 122 | (setq keys nil) |
629d4dcd | 123 | (setq cmd 'last-kbd-macro)) |
a8e1fefa KH |
124 | ((null cmd) |
125 | (error "Key sequence %s is not defined" (key-description keys))) | |
629d4dcd RS |
126 | ((symbolp cmd) |
127 | (setq mac (symbol-function cmd))) | |
128 | (t | |
129 | (setq mac cmd) | |
130 | (setq cmd nil))) | |
70e2ea11 KS |
131 | (when (setq kmacro (kmacro-extract-lambda mac)) |
132 | (setq mac (car kmacro) | |
133 | mac-counter (nth 1 kmacro) | |
134 | mac-format (nth 2 kmacro))) | |
629d4dcd | 135 | (unless (arrayp mac) |
a8e1fefa KH |
136 | (error "Key sequence %s is not a keyboard macro" |
137 | (key-description keys))) | |
629d4dcd RS |
138 | (message "Formatting keyboard macro...") |
139 | (let* ((oldbuf (current-buffer)) | |
140 | (mmac (edmacro-fix-menu-commands mac)) | |
141 | (fmt (edmacro-format-keys mmac 1)) | |
142 | (fmtv (edmacro-format-keys mmac (not prefix))) | |
143 | (buf (get-buffer-create "*Edit Macro*"))) | |
144 | (message "Formatting keyboard macro...done") | |
145 | (switch-to-buffer buf) | |
146 | (kill-all-local-variables) | |
147 | (use-local-map edmacro-mode-map) | |
148 | (setq buffer-read-only nil) | |
149 | (setq major-mode 'edmacro-mode) | |
150 | (setq mode-name "Edit Macro") | |
151 | (set (make-local-variable 'edmacro-original-buffer) oldbuf) | |
152 | (set (make-local-variable 'edmacro-finish-hook) finish-hook) | |
153 | (set (make-local-variable 'edmacro-store-hook) store-hook) | |
154 | (erase-buffer) | |
155 | (insert ";; Keyboard Macro Editor. Press C-c C-c to finish; " | |
156 | "press C-x k RET to cancel.\n") | |
157 | (insert ";; Original keys: " fmt "\n") | |
158 | (unless store-hook | |
159 | (insert "\nCommand: " (if cmd (symbol-name cmd) "none") "\n") | |
70e2ea11 KS |
160 | (let ((gkeys (where-is-internal (or cmd mac) '(keymap)))) |
161 | (if (and keys (not (member keys gkeys))) | |
162 | (setq gkeys (cons keys gkeys))) | |
163 | (if gkeys | |
164 | (while gkeys | |
165 | (insert "Key: " (edmacro-format-keys (pop gkeys) 1) "\n")) | |
166 | (insert "Key: none\n"))) | |
167 | (when (and mac-counter mac-format) | |
168 | (insert (format "Counter: %d\nFormat: \"%s\"\n" mac-counter mac-format)))) | |
629d4dcd RS |
169 | (insert "\nMacro:\n\n") |
170 | (save-excursion | |
171 | (insert fmtv "\n")) | |
172 | (recenter '(4)) | |
173 | (when (eq mac mmac) | |
174 | (set-buffer-modified-p nil)) | |
175 | (run-hooks 'edmacro-format-hook))))) | |
176 | ||
177 | ;;; The next two commands are provided for convenience and backward | |
178 | ;;; compatibility. | |
179 | ||
180 | ;;;###autoload | |
181 | (defun edit-last-kbd-macro (&optional prefix) | |
66b3ecce DL |
182 | "Edit the most recently defined keyboard macro." |
183 | (interactive "P") | |
629d4dcd | 184 | (edit-kbd-macro 'call-last-kbd-macro prefix)) |
66b3ecce | 185 | |
f9f9507e | 186 | ;;;###autoload |
629d4dcd RS |
187 | (defun edit-named-kbd-macro (&optional prefix) |
188 | "Edit a keyboard macro which has been given a name by `name-last-kbd-macro'." | |
189 | (interactive "P") | |
190 | (edit-kbd-macro 'execute-extended-command prefix)) | |
66b3ecce | 191 | |
f9f9507e | 192 | ;;;###autoload |
629d4dcd | 193 | (defun read-kbd-macro (start &optional end) |
66b3ecce | 194 | "Read the region as a keyboard macro definition. |
052bdd09 | 195 | The region is interpreted as spelled-out keystrokes, e.g., \"M-x abc RET\". |
629d4dcd RS |
196 | See documentation for `edmacro-mode' for details. |
197 | Leading/trailing \"C-x (\" and \"C-x )\" in the text are allowed and ignored. | |
66b3ecce DL |
198 | The resulting macro is installed as the \"current\" keyboard macro. |
199 | ||
629d4dcd RS |
200 | In Lisp, may also be called with a single STRING argument in which case |
201 | the result is returned rather than being installed as the current macro. | |
202 | The result will be a string if possible, otherwise an event vector. | |
203 | Second argument NEED-VECTOR means to return an event vector always." | |
66b3ecce | 204 | (interactive "r") |
629d4dcd RS |
205 | (if (stringp start) |
206 | (edmacro-parse-keys start end) | |
207 | (setq last-kbd-macro (edmacro-parse-keys (buffer-substring start end))))) | |
66b3ecce | 208 | |
629d4dcd RS |
209 | ;;;###autoload |
210 | (defun format-kbd-macro (&optional macro verbose) | |
211 | "Return the keyboard macro MACRO as a human-readable string. | |
212 | This string is suitable for passing to `read-kbd-macro'. | |
213 | Second argument VERBOSE means to put one command per line with comments. | |
214 | If VERBOSE is `1', put everything on one line. If VERBOSE is omitted | |
215 | or nil, use a compact 80-column format." | |
216 | (and macro (symbolp macro) (setq macro (symbol-function macro))) | |
217 | (edmacro-format-keys (or macro last-kbd-macro) verbose)) | |
66b3ecce | 218 | \f |
629d4dcd | 219 | ;;; Commands for *Edit Macro* buffer. |
66b3ecce DL |
220 | |
221 | (defun edmacro-finish-edit () | |
222 | (interactive) | |
629d4dcd RS |
223 | (unless (eq major-mode 'edmacro-mode) |
224 | (error | |
225 | "This command is valid only in buffers created by `edit-kbd-macro'")) | |
226 | (run-hooks 'edmacro-finish-hook) | |
227 | (let ((cmd nil) (keys nil) (no-keys nil) | |
06b60517 | 228 | (mac-counter nil) (mac-format nil) |
629d4dcd RS |
229 | (top (point-min))) |
230 | (goto-char top) | |
231 | (let ((case-fold-search nil)) | |
232 | (while (cond ((looking-at "[ \t]*\\($\\|;;\\|REM[ \t\n]\\)") | |
233 | t) | |
234 | ((looking-at "Command:[ \t]*\\([^ \t\n]*\\)[ \t]*$") | |
235 | (when edmacro-store-hook | |
236 | (error "\"Command\" line not allowed in this context")) | |
237 | (let ((str (buffer-substring (match-beginning 1) | |
238 | (match-end 1)))) | |
239 | (unless (equal str "") | |
c31afdbd | 240 | (setq cmd (and (not (equal str "none")) |
629d4dcd RS |
241 | (intern str))) |
242 | (and (fboundp cmd) (not (arrayp (symbol-function cmd))) | |
06b60517 | 243 | (not (get cmd 'kmacro)) |
629d4dcd RS |
244 | (not (y-or-n-p |
245 | (format "Command %s is already defined; %s" | |
246 | cmd "proceed? "))) | |
247 | (keyboard-quit)))) | |
248 | t) | |
249 | ((looking-at "Key:\\(.*\\)$") | |
250 | (when edmacro-store-hook | |
251 | (error "\"Key\" line not allowed in this context")) | |
252 | (let ((key (edmacro-parse-keys | |
253 | (buffer-substring (match-beginning 1) | |
254 | (match-end 1))))) | |
255 | (unless (equal key "") | |
c31afdbd | 256 | (if (equal key "none") |
629d4dcd RS |
257 | (setq no-keys t) |
258 | (push key keys) | |
259 | (let ((b (key-binding key))) | |
260 | (and b (commandp b) (not (arrayp b)) | |
70e2ea11 | 261 | (not (kmacro-extract-lambda b)) |
629d4dcd | 262 | (or (not (fboundp b)) |
b680abcb LT |
263 | (not (or (arrayp (symbol-function b)) |
264 | (get b 'kmacro)))) | |
629d4dcd RS |
265 | (not (y-or-n-p |
266 | (format "Key %s is already defined; %s" | |
267 | (edmacro-format-keys key 1) | |
268 | "proceed? "))) | |
269 | (keyboard-quit)))))) | |
270 | t) | |
70e2ea11 KS |
271 | ((looking-at "Counter:[ \t]*\\([^ \t\n]*\\)[ \t]*$") |
272 | (when edmacro-store-hook | |
273 | (error "\"Counter\" line not allowed in this context")) | |
274 | (let ((str (buffer-substring (match-beginning 1) | |
275 | (match-end 1)))) | |
276 | (unless (equal str "") | |
027a4b6b | 277 | (setq mac-counter (string-to-number str)))) |
70e2ea11 KS |
278 | t) |
279 | ((looking-at "Format:[ \t]*\"\\([^\n]*\\)\"[ \t]*$") | |
280 | (when edmacro-store-hook | |
281 | (error "\"Format\" line not allowed in this context")) | |
282 | (let ((str (buffer-substring (match-beginning 1) | |
283 | (match-end 1)))) | |
284 | (unless (equal str "") | |
285 | (setq mac-format str))) | |
286 | t) | |
629d4dcd RS |
287 | ((looking-at "Macro:[ \t\n]*") |
288 | (goto-char (match-end 0)) | |
289 | nil) | |
290 | ((eobp) nil) | |
291 | (t (error "Expected a `Macro:' line"))) | |
292 | (forward-line 1)) | |
293 | (setq top (point))) | |
294 | (let* ((buf (current-buffer)) | |
295 | (str (buffer-substring top (point-max))) | |
296 | (modp (buffer-modified-p)) | |
297 | (obuf edmacro-original-buffer) | |
298 | (store-hook edmacro-store-hook) | |
299 | (finish-hook edmacro-finish-hook)) | |
300 | (unless (or cmd keys store-hook (equal str "")) | |
301 | (error "No command name or keys specified")) | |
302 | (when modp | |
303 | (when (buffer-name obuf) | |
304 | (set-buffer obuf)) | |
305 | (message "Compiling keyboard macro...") | |
306 | (let ((mac (edmacro-parse-keys str))) | |
307 | (message "Compiling keyboard macro...done") | |
308 | (if store-hook | |
309 | (funcall store-hook mac) | |
310 | (when (eq cmd 'last-kbd-macro) | |
311 | (setq last-kbd-macro (and (> (length mac) 0) mac)) | |
312 | (setq cmd nil)) | |
313 | (when cmd | |
314 | (if (= (length mac) 0) | |
315 | (fmakunbound cmd) | |
70e2ea11 KS |
316 | (fset cmd |
317 | (if (and mac-counter mac-format) | |
318 | (kmacro-lambda-form mac mac-counter mac-format) | |
319 | mac)))) | |
629d4dcd RS |
320 | (if no-keys |
321 | (when cmd | |
3f5e6d79 | 322 | (loop for key in (where-is-internal cmd '(keymap)) do |
629d4dcd RS |
323 | (global-unset-key key))) |
324 | (when keys | |
325 | (if (= (length mac) 0) | |
326 | (loop for key in keys do (global-unset-key key)) | |
327 | (loop for key in keys do | |
70e2ea11 KS |
328 | (global-set-key key |
329 | (or cmd | |
330 | (if (and mac-counter mac-format) | |
331 | (kmacro-lambda-form mac mac-counter mac-format) | |
332 | mac)))))))))) | |
629d4dcd RS |
333 | (kill-buffer buf) |
334 | (when (buffer-name obuf) | |
335 | (switch-to-buffer obuf)) | |
336 | (when finish-hook | |
337 | (funcall finish-hook))))) | |
338 | ||
339 | (defun edmacro-insert-key (key) | |
340 | "Insert the written name of a key in the buffer." | |
341 | (interactive "kKey to insert: ") | |
342 | (if (bolp) | |
343 | (insert (edmacro-format-keys key t) "\n") | |
344 | (insert (edmacro-format-keys key) " "))) | |
66b3ecce DL |
345 | |
346 | (defun edmacro-mode () | |
802393f6 | 347 | "\\<edmacro-mode-map>Keyboard Macro Editing mode. Press \ |
629d4dcd | 348 | \\[edmacro-finish-edit] to save and exit. |
052bdd09 | 349 | To abort the edit, just kill this buffer with \\[kill-buffer] RET. |
66b3ecce | 350 | |
629d4dcd RS |
351 | Press \\[edmacro-insert-key] to insert the name of any key by typing the key. |
352 | ||
353 | The editing buffer contains a \"Command:\" line and any number of | |
354 | \"Key:\" lines at the top. These are followed by a \"Macro:\" line | |
355 | and the macro itself as spelled-out keystrokes: `C-x C-f foo RET'. | |
356 | ||
357 | The \"Command:\" line specifies the command name to which the macro | |
358 | is bound, or \"none\" for no command name. Write \"last-kbd-macro\" | |
359 | to refer to the current keyboard macro (as used by \\[call-last-kbd-macro]). | |
360 | ||
361 | The \"Key:\" lines specify key sequences to which the macro is bound, | |
362 | or \"none\" for no key bindings. | |
363 | ||
364 | You can edit these lines to change the places where the new macro | |
365 | is stored. | |
366 | ||
367 | ||
368 | Format of keyboard macros during editing: | |
369 | ||
370 | Text is divided into \"words\" separated by whitespace. Except for | |
371 | the words described below, the characters of each word go directly | |
372 | as characters of the macro. The whitespace that separates words | |
373 | is ignored. Whitespace in the macro must be written explicitly, | |
374 | as in \"foo SPC bar RET\". | |
375 | ||
376 | * The special words RET, SPC, TAB, DEL, LFD, ESC, and NUL represent | |
377 | special control characters. The words must be written in uppercase. | |
378 | ||
379 | * A word in angle brackets, e.g., <return>, <down>, or <f1>, represents | |
380 | a function key. (Note that in the standard configuration, the | |
381 | function key <return> and the control key RET are synonymous.) | |
382 | You can use angle brackets on the words RET, SPC, etc., but they | |
383 | are not required there. | |
384 | ||
385 | * Keys can be written by their ASCII code, using a backslash followed | |
386 | by up to six octal digits. This is the only way to represent keys | |
387 | with codes above \\377. | |
388 | ||
389 | * One or more prefixes M- (meta), C- (control), S- (shift), A- (alt), | |
390 | H- (hyper), and s- (super) may precede a character or key notation. | |
391 | For function keys, the prefixes may go inside or outside of the | |
392 | brackets: C-<down> = <C-down>. The prefixes may be written in | |
393 | any order: M-C-x = C-M-x. | |
394 | ||
395 | Prefixes are not allowed on multi-key words, e.g., C-abc, except | |
396 | that the Meta prefix is allowed on a sequence of digits and optional | |
397 | minus sign: M--123 = M-- M-1 M-2 M-3. | |
398 | ||
399 | * The `^' notation for control characters also works: ^M = C-m. | |
400 | ||
401 | * Double angle brackets enclose command names: <<next-line>> is | |
402 | shorthand for M-x next-line RET. | |
403 | ||
404 | * Finally, REM or ;; causes the rest of the line to be ignored as a | |
405 | comment. | |
406 | ||
407 | Any word may be prefixed by a multiplier in the form of a decimal | |
408 | number and `*': 3*<right> = <right> <right> <right>, and | |
409 | 10*foo = foofoofoofoofoofoofoofoofoofoo. | |
410 | ||
411 | Multiple text keys can normally be strung together to form a word, | |
412 | but you may need to add whitespace if the word would look like one | |
413 | of the above notations: `; ; ;' is a keyboard macro with three | |
414 | semicolons, but `;;;' is a comment. Likewise, `\\ 1 2 3' is four | |
415 | keys but `\\123' is a single key written in octal, and `< right >' | |
416 | is seven keys but `<right>' is a single function key. When in | |
417 | doubt, use whitespace." | |
66b3ecce | 418 | (interactive) |
629d4dcd | 419 | (error "This mode can be enabled only by `edit-kbd-macro'")) |
66b3ecce | 420 | (put 'edmacro-mode 'mode-class 'special) |
629d4dcd RS |
421 | \f |
422 | ;;; Formatting a keyboard macro as human-readable text. | |
66b3ecce | 423 | |
629d4dcd RS |
424 | (defun edmacro-format-keys (macro &optional verbose) |
425 | (setq macro (edmacro-fix-menu-commands macro)) | |
6db93fd9 | 426 | (let* ((maps (current-active-maps)) |
629d4dcd RS |
427 | (pkeys '(end-macro ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?- ?\C-u |
428 | ?\M-- ?\M-0 ?\M-1 ?\M-2 ?\M-3 ?\M-4 ?\M-5 ?\M-6 | |
429 | ?\M-7 ?\M-8 ?\M-9)) | |
430 | (mdigs (nthcdr 13 pkeys)) | |
431 | (maxkey (if edmacro-eight-bits 255 127)) | |
432 | (case-fold-search nil) | |
433 | (res-words '("NUL" "TAB" "LFD" "RET" "ESC" "SPC" "DEL" "REM")) | |
434 | (rest-mac (vconcat macro [end-macro])) | |
435 | (res "") | |
436 | (len 0) | |
437 | (one-line (eq verbose 1))) | |
438 | (if one-line (setq verbose nil)) | |
439 | (when (stringp macro) | |
440 | (loop for i below (length macro) do | |
441 | (when (>= (aref rest-mac i) 128) | |
a9b8cb16 | 442 | (incf (aref rest-mac i) (- ?\M-\^@ 128))))) |
629d4dcd RS |
443 | (while (not (eq (aref rest-mac 0) 'end-macro)) |
444 | (let* ((prefix | |
445 | (or (and (integerp (aref rest-mac 0)) | |
446 | (memq (aref rest-mac 0) mdigs) | |
c31afdbd | 447 | (memq (key-binding (edmacro-subseq rest-mac 0 1)) |
629d4dcd RS |
448 | '(digit-argument negative-argument)) |
449 | (let ((i 1)) | |
450 | (while (memq (aref rest-mac i) (cdr mdigs)) | |
451 | (incf i)) | |
452 | (and (not (memq (aref rest-mac i) pkeys)) | |
6b61353c | 453 | (prog1 (vconcat "M-" (edmacro-subseq rest-mac 0 i) " ") |
c31afdbd | 454 | (callf edmacro-subseq rest-mac i))))) |
629d4dcd RS |
455 | (and (eq (aref rest-mac 0) ?\C-u) |
456 | (eq (key-binding [?\C-u]) 'universal-argument) | |
457 | (let ((i 1)) | |
458 | (while (eq (aref rest-mac i) ?\C-u) | |
459 | (incf i)) | |
460 | (and (not (memq (aref rest-mac i) pkeys)) | |
461 | (prog1 (loop repeat i concat "C-u ") | |
c31afdbd | 462 | (callf edmacro-subseq rest-mac i))))) |
629d4dcd RS |
463 | (and (eq (aref rest-mac 0) ?\C-u) |
464 | (eq (key-binding [?\C-u]) 'universal-argument) | |
465 | (let ((i 1)) | |
466 | (when (eq (aref rest-mac i) ?-) | |
467 | (incf i)) | |
468 | (while (memq (aref rest-mac i) | |
469 | '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) | |
470 | (incf i)) | |
471 | (and (not (memq (aref rest-mac i) pkeys)) | |
6b61353c | 472 | (prog1 (vconcat "C-u " (edmacro-subseq rest-mac 1 i) " ") |
c31afdbd | 473 | (callf edmacro-subseq rest-mac i))))))) |
629d4dcd RS |
474 | (bind-len (apply 'max 1 |
475 | (loop for map in maps | |
476 | for b = (lookup-key map rest-mac) | |
477 | when b collect b))) | |
c31afdbd | 478 | (key (edmacro-subseq rest-mac 0 bind-len)) |
629d4dcd RS |
479 | (fkey nil) tlen tkey |
480 | (bind (or (loop for map in maps for b = (lookup-key map key) | |
481 | thereis (and (not (integerp b)) b)) | |
c40bb1ba | 482 | (and (setq fkey (lookup-key local-function-key-map rest-mac)) |
c31afdbd | 483 | (setq tlen fkey tkey (edmacro-subseq rest-mac 0 tlen) |
c40bb1ba | 484 | fkey (lookup-key local-function-key-map tkey)) |
629d4dcd RS |
485 | (loop for map in maps |
486 | for b = (lookup-key map fkey) | |
487 | when (and (not (integerp b)) b) | |
488 | do (setq bind-len tlen key tkey) | |
489 | and return b | |
490 | finally do (setq fkey nil))))) | |
491 | (first (aref key 0)) | |
492 | (text (loop for i from bind-len below (length rest-mac) | |
493 | for ch = (aref rest-mac i) | |
494 | while (and (integerp ch) | |
495 | (> ch 32) (< ch maxkey) (/= ch 92) | |
496 | (eq (key-binding (char-to-string ch)) | |
497 | 'self-insert-command) | |
498 | (or (> i (- (length rest-mac) 2)) | |
499 | (not (eq ch (aref rest-mac (+ i 1)))) | |
500 | (not (eq ch (aref rest-mac (+ i 2)))))) | |
501 | finally return i)) | |
502 | desc) | |
503 | (if (stringp bind) (setq bind nil)) | |
504 | (cond ((and (eq bind 'self-insert-command) (not prefix) | |
505 | (> text 1) (integerp first) | |
506 | (> first 32) (<= first maxkey) (/= first 92) | |
507 | (progn | |
508 | (if (> text 30) (setq text 30)) | |
c31afdbd | 509 | (setq desc (concat (edmacro-subseq rest-mac 0 text))) |
629d4dcd RS |
510 | (when (string-match "^[ACHMsS]-." desc) |
511 | (setq text 2) | |
512 | (callf substring desc 0 2)) | |
513 | (not (string-match | |
514 | "^;;\\|^<.*>$\\|^\\\\[0-9]+$\\|^[0-9]+\\*." | |
515 | desc)))) | |
516 | (when (or (string-match "^\\^.$" desc) | |
517 | (member desc res-words)) | |
518 | (setq desc (mapconcat 'char-to-string desc " "))) | |
519 | (when verbose | |
520 | (setq bind (format "%s * %d" bind text))) | |
521 | (setq bind-len text)) | |
522 | ((and (eq bind 'execute-extended-command) | |
523 | (> text bind-len) | |
524 | (memq (aref rest-mac text) '(return 13)) | |
525 | (progn | |
c31afdbd | 526 | (setq desc (concat (edmacro-subseq rest-mac bind-len text))) |
629d4dcd RS |
527 | (commandp (intern-soft desc)))) |
528 | (if (commandp (intern-soft desc)) (setq bind desc)) | |
529 | (setq desc (format "<<%s>>" desc)) | |
530 | (setq bind-len (1+ text))) | |
531 | (t | |
532 | (setq desc (mapconcat | |
533 | (function | |
534 | (lambda (ch) | |
535 | (cond | |
536 | ((integerp ch) | |
537 | (concat | |
538 | (loop for pf across "ACHMsS" | |
a9b8cb16 KH |
539 | for bit in '(?\A-\^@ ?\C-\^@ ?\H-\^@ |
540 | ?\M-\^@ ?\s-\^@ ?\S-\^@) | |
541 | when (/= (logand ch bit) 0) | |
629d4dcd RS |
542 | concat (format "%c-" pf)) |
543 | (let ((ch2 (logand ch (1- (lsh 1 18))))) | |
544 | (cond ((<= ch2 32) | |
545 | (case ch2 | |
546 | (0 "NUL") (9 "TAB") (10 "LFD") | |
547 | (13 "RET") (27 "ESC") (32 "SPC") | |
548 | (t | |
549 | (format "C-%c" | |
550 | (+ (if (<= ch2 26) 96 64) | |
551 | ch2))))) | |
552 | ((= ch2 127) "DEL") | |
553 | ((<= ch2 maxkey) (char-to-string ch2)) | |
554 | (t (format "\\%o" ch2)))))) | |
555 | ((symbolp ch) | |
556 | (format "<%s>" ch)) | |
557 | (t | |
558 | (error "Unrecognized item in macro: %s" ch))))) | |
559 | (or fkey key) " ")))) | |
6b61353c KH |
560 | (if prefix |
561 | (setq desc (concat (edmacro-sanitize-for-string prefix) desc))) | |
629d4dcd RS |
562 | (unless (string-match " " desc) |
563 | (let ((times 1) (pos bind-len)) | |
c31afdbd RS |
564 | (while (not (edmacro-mismatch rest-mac rest-mac |
565 | 0 bind-len pos (+ bind-len pos))) | |
629d4dcd RS |
566 | (incf times) |
567 | (incf pos bind-len)) | |
568 | (when (> times 1) | |
569 | (setq desc (format "%d*%s" times desc)) | |
570 | (setq bind-len (* bind-len times))))) | |
c31afdbd | 571 | (setq rest-mac (edmacro-subseq rest-mac bind-len)) |
629d4dcd RS |
572 | (if verbose |
573 | (progn | |
574 | (unless (equal res "") (callf concat res "\n")) | |
575 | (callf concat res desc) | |
576 | (when (and bind (or (stringp bind) (symbolp bind))) | |
577 | (callf concat res | |
578 | (make-string (max (- 3 (/ (length desc) 8)) 1) 9) | |
579 | ";; " (if (stringp bind) bind (symbol-name bind)))) | |
580 | (setq len 0)) | |
581 | (if (and (> (+ len (length desc) 2) 72) (not one-line)) | |
582 | (progn | |
583 | (callf concat res "\n ") | |
584 | (setq len 1)) | |
585 | (unless (equal res "") | |
586 | (callf concat res " ") | |
587 | (incf len))) | |
588 | (callf concat res desc) | |
589 | (incf len (length desc))))) | |
590 | res)) | |
591 | ||
c31afdbd RS |
592 | (defun edmacro-mismatch (cl-seq1 cl-seq2 cl-start1 cl-end1 cl-start2 cl-end2) |
593 | "Compare SEQ1 with SEQ2, return index of first mismatching element. | |
594 | Return nil if the sequences match. If one sequence is a prefix of the | |
802393f6 JB |
595 | other, the return value indicates the end of the shorted sequence. |
596 | \n(fn SEQ1 SEQ2 START1 END1 START2 END2)" | |
c31afdbd RS |
597 | (let (cl-test cl-test-not cl-key cl-from-end) |
598 | (or cl-end1 (setq cl-end1 (length cl-seq1))) | |
599 | (or cl-end2 (setq cl-end2 (length cl-seq2))) | |
600 | (if cl-from-end | |
601 | (progn | |
602 | (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2) | |
603 | (cl-check-match (elt cl-seq1 (1- cl-end1)) | |
604 | (elt cl-seq2 (1- cl-end2)))) | |
605 | (setq cl-end1 (1- cl-end1) cl-end2 (1- cl-end2))) | |
606 | (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2)) | |
607 | (1- cl-end1))) | |
608 | (let ((cl-p1 (and (listp cl-seq1) (nthcdr cl-start1 cl-seq1))) | |
609 | (cl-p2 (and (listp cl-seq2) (nthcdr cl-start2 cl-seq2)))) | |
610 | (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2) | |
611 | (cl-check-match (if cl-p1 (car cl-p1) | |
612 | (aref cl-seq1 cl-start1)) | |
613 | (if cl-p2 (car cl-p2) | |
614 | (aref cl-seq2 cl-start2)))) | |
615 | (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2) | |
616 | cl-start1 (1+ cl-start1) cl-start2 (1+ cl-start2))) | |
617 | (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2)) | |
618 | cl-start1))))) | |
619 | ||
620 | (defun edmacro-subseq (seq start &optional end) | |
621 | "Return the subsequence of SEQ from START to END. | |
622 | If END is omitted, it defaults to the length of the sequence. | |
623 | If START or END is negative, it counts from the end." | |
624 | (if (stringp seq) (substring seq start end) | |
625 | (let (len) | |
626 | (and end (< end 0) (setq end (+ end (setq len (length seq))))) | |
627 | (if (< start 0) (setq start (+ start (or len (setq len (length seq)))))) | |
628 | (cond ((listp seq) | |
629 | (if (> start 0) (setq seq (nthcdr start seq))) | |
630 | (if end | |
631 | (let ((res nil)) | |
632 | (while (>= (setq end (1- end)) start) | |
39223437 | 633 | (push (pop seq) res)) |
c31afdbd RS |
634 | (nreverse res)) |
635 | (copy-sequence seq))) | |
636 | (t | |
637 | (or end (setq end (or len (length seq)))) | |
638 | (let ((res (make-vector (max (- end start) 0) nil)) | |
639 | (i 0)) | |
640 | (while (< start end) | |
641 | (aset res i (aref seq start)) | |
642 | (setq i (1+ i) start (1+ start))) | |
643 | res)))))) | |
644 | ||
6b61353c | 645 | (defun edmacro-sanitize-for-string (seq) |
802393f6 | 646 | "Convert a key sequence vector SEQ into a string. |
6b61353c KH |
647 | The string represents the same events; Meta is indicated by bit 7. |
648 | This function assumes that the events can be stored in a string." | |
649 | (setq seq (copy-sequence seq)) | |
650 | (loop for i below (length seq) do | |
b680abcb | 651 | (when (logand (aref seq i) 128) |
6b61353c KH |
652 | (setf (aref seq i) (logand (aref seq i) 127)))) |
653 | seq) | |
654 | ||
5cfe1cec RS |
655 | (defun edmacro-fix-menu-commands (macro &optional noerror) |
656 | (if (vectorp macro) | |
657 | (let (result) | |
658 | ;; Make a list of the elements. | |
659 | (setq macro (append macro nil)) | |
660 | (dolist (ev macro) | |
661 | (cond ((atom ev) | |
662 | (push ev result)) | |
663 | ((eq (car ev) 'help-echo)) | |
d2f00838 | 664 | ((eq (car ev) 'switch-frame)) |
5cfe1cec RS |
665 | ((equal ev '(menu-bar)) |
666 | (push 'menu-bar result)) | |
667 | ((equal (cadadr ev) '(menu-bar)) | |
668 | (push (vector 'menu-bar (car ev)) result)) | |
629d4dcd RS |
669 | ;; It would be nice to do pop-up menus, too, but not enough |
670 | ;; info is recorded in macros to make this possible. | |
5cfe1cec RS |
671 | (noerror |
672 | ;; Just ignore mouse events. | |
673 | nil) | |
629d4dcd RS |
674 | (t |
675 | (error "Macros with mouse clicks are not %s" | |
676 | "supported by this command")))) | |
5cfe1cec RS |
677 | ;; Reverse them again and make them back into a vector. |
678 | (vconcat (nreverse result))) | |
679 | macro)) | |
629d4dcd RS |
680 | \f |
681 | ;;; Parsing a human-readable keyboard macro. | |
682 | ||
683 | (defun edmacro-parse-keys (string &optional need-vector) | |
684 | (let ((case-fold-search nil) | |
bf2e3fa7 | 685 | (len (length string)) ; We won't alter string in the loop below. |
629d4dcd RS |
686 | (pos 0) |
687 | (res [])) | |
bf2e3fa7 | 688 | (while (and (< pos len) |
629d4dcd | 689 | (string-match "[^ \t\n\f]+" string pos)) |
bf2e3fa7 CY |
690 | (let* ((word-beg (match-beginning 0)) |
691 | (word-end (match-end 0)) | |
692 | (word (substring string word-beg len)) | |
693 | (times 1) | |
694 | key) | |
695 | ;; Try to catch events of the form "<as df>". | |
c46768fc | 696 | (if (string-match "\\`<[^ <>\t\n\f][^>\t\n\f]*>" word) |
bf2e3fa7 CY |
697 | (setq word (match-string 0 word) |
698 | pos (+ word-beg (match-end 0))) | |
699 | (setq word (substring string word-beg word-end) | |
700 | pos word-end)) | |
629d4dcd | 701 | (when (string-match "\\([0-9]+\\)\\*." word) |
027a4b6b | 702 | (setq times (string-to-number (substring word 0 (match-end 1)))) |
629d4dcd RS |
703 | (setq word (substring word (1+ (match-end 1))))) |
704 | (cond ((string-match "^<<.+>>$" word) | |
705 | (setq key (vconcat (if (eq (key-binding [?\M-x]) | |
706 | 'execute-extended-command) | |
707 | [?\M-x] | |
708 | (or (car (where-is-internal | |
709 | 'execute-extended-command)) | |
710 | [?\M-x])) | |
711 | (substring word 2 -2) "\r"))) | |
712 | ((and (string-match "^\\(\\([ACHMsS]-\\)*\\)<\\(.+\\)>$" word) | |
713 | (progn | |
714 | (setq word (concat (substring word (match-beginning 1) | |
715 | (match-end 1)) | |
716 | (substring word (match-beginning 3) | |
717 | (match-end 3)))) | |
718 | (not (string-match | |
719 | "\\<\\(NUL\\|RET\\|LFD\\|ESC\\|SPC\\|DEL\\)$" | |
720 | word)))) | |
721 | (setq key (list (intern word)))) | |
722 | ((or (equal word "REM") (string-match "^;;" word)) | |
723 | (setq pos (string-match "$" string pos))) | |
724 | (t | |
725 | (let ((orig-word word) (prefix 0) (bits 0)) | |
726 | (while (string-match "^[ACHMsS]-." word) | |
a9b8cb16 KH |
727 | (incf bits (cdr (assq (aref word 0) |
728 | '((?A . ?\A-\^@) (?C . ?\C-\^@) | |
729 | (?H . ?\H-\^@) (?M . ?\M-\^@) | |
730 | (?s . ?\s-\^@) (?S . ?\S-\^@))))) | |
629d4dcd RS |
731 | (incf prefix 2) |
732 | (callf substring word 2)) | |
733 | (when (string-match "^\\^.$" word) | |
a9b8cb16 | 734 | (incf bits ?\C-\^@) |
629d4dcd RS |
735 | (incf prefix) |
736 | (callf substring word 1)) | |
737 | (let ((found (assoc word '(("NUL" . "\0") ("RET" . "\r") | |
738 | ("LFD" . "\n") ("TAB" . "\t") | |
739 | ("ESC" . "\e") ("SPC" . " ") | |
740 | ("DEL" . "\177"))))) | |
741 | (when found (setq word (cdr found)))) | |
742 | (when (string-match "^\\\\[0-7]+$" word) | |
743 | (loop for ch across word | |
744 | for n = 0 then (+ (* n 8) ch -48) | |
745 | finally do (setq word (vector n)))) | |
746 | (cond ((= bits 0) | |
747 | (setq key word)) | |
a9b8cb16 | 748 | ((and (= bits ?\M-\^@) (stringp word) |
629d4dcd RS |
749 | (string-match "^-?[0-9]+$" word)) |
750 | (setq key (loop for x across word collect (+ x bits)))) | |
751 | ((/= (length word) 1) | |
752 | (error "%s must prefix a single character, not %s" | |
753 | (substring orig-word 0 prefix) word)) | |
a9b8cb16 | 754 | ((and (/= (logand bits ?\C-\^@) 0) (stringp word) |
1e3b420b RS |
755 | ;; We used to accept . and ? here, |
756 | ;; but . is simply wrong, | |
757 | ;; and C-? is not used (we use DEL instead). | |
758 | (string-match "[@-_a-z]" word)) | |
a9b8cb16 | 759 | (setq key (list (+ bits (- ?\C-\^@) |
094e8ee4 | 760 | (logand (aref word 0) 31))))) |
629d4dcd RS |
761 | (t |
762 | (setq key (list (+ bits (aref word 0))))))))) | |
763 | (when key | |
764 | (loop repeat times do (callf vconcat res key))))) | |
765 | (when (and (>= (length res) 4) | |
766 | (eq (aref res 0) ?\C-x) | |
767 | (eq (aref res 1) ?\() | |
768 | (eq (aref res (- (length res) 2)) ?\C-x) | |
769 | (eq (aref res (- (length res) 1)) ?\))) | |
c31afdbd | 770 | (setq res (edmacro-subseq res 2 -2))) |
629d4dcd RS |
771 | (if (and (not need-vector) |
772 | (loop for ch across res | |
97443772 | 773 | always (and (characterp ch) |
a9b8cb16 | 774 | (let ((ch2 (logand ch (lognot ?\M-\^@)))) |
629d4dcd RS |
775 | (and (>= ch2 0) (<= ch2 127)))))) |
776 | (concat (loop for ch across res | |
a9b8cb16 | 777 | collect (if (= (logand ch ?\M-\^@) 0) |
629d4dcd RS |
778 | ch (+ ch 128)))) |
779 | res))) | |
629d4dcd RS |
780 | |
781 | (provide 'edmacro) | |
c0274f38 ER |
782 | |
783 | ;;; edmacro.el ends here |