Commit | Line | Data |
---|---|---|
e5167999 ER |
1 | ;;; edmacro.el --- keyboard macro editor |
2 | ||
9750e079 ER |
3 | ;; Copyright (C) 1990 Free Software Foundation, Inc. |
4 | ||
e5167999 ER |
5 | ;; Author: Dave Gillespie <daveg@csvax.caltech.edu> |
6 | ;; Maintainer: FSF | |
7 | ;; Version: 1.02 | |
e9571d2a | 8 | ;; Keywords: abbrev |
66b3ecce DL |
9 | |
10 | ;; This file is part of GNU Emacs. | |
11 | ||
12 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
13 | ;; it under the terms of the GNU General Public License as published by | |
e5167999 | 14 | ;; the Free Software Foundation; either version 2, or (at your option) |
66b3ecce DL |
15 | ;; any later version. |
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 | |
23 | ;; along with GNU Emacs; see the file COPYING. If not, write to | |
24 | ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
25 | ||
e5167999 | 26 | ;;; Commentary: |
66b3ecce DL |
27 | |
28 | ;; To use, type `M-x edit-last-kbd-macro' to edit the most recently | |
29 | ;; defined keyboard macro. If you have used `M-x name-last-kbd-macro' | |
30 | ;; to give a keyboard macro a name, type `M-x edit-kbd-macro' to edit | |
31 | ;; the macro by name. When you are done editing, type `C-c C-c' to | |
32 | ;; record your changes back into the original keyboard macro. | |
e5167999 ER |
33 | |
34 | ;;; Code: | |
66b3ecce DL |
35 | \f |
36 | ;;; The user-level commands for editing macros. | |
37 | ||
f9f9507e | 38 | ;;;###autoload |
66b3ecce DL |
39 | (defun edit-last-kbd-macro (&optional prefix buffer hook) |
40 | "Edit the most recently defined keyboard macro." | |
41 | (interactive "P") | |
42 | (edmacro-edit-macro last-kbd-macro | |
43 | (function (lambda (x arg) (setq last-kbd-macro x))) | |
44 | prefix buffer hook)) | |
45 | ||
f9f9507e | 46 | ;;;###autoload |
66b3ecce | 47 | (defun edit-kbd-macro (cmd &optional prefix buffer hook in-hook out-hook) |
052bdd09 RS |
48 | "Edit a keyboard macro which has been given a name by `name-last-kbd-macro'. |
49 | \(See also `edit-last-kbd-macro'.)" | |
66b3ecce DL |
50 | (interactive "CCommand name: \nP") |
51 | (and cmd | |
52 | (edmacro-edit-macro (if in-hook | |
53 | (funcall in-hook cmd) | |
54 | (symbol-function cmd)) | |
55 | (or out-hook | |
56 | (list 'lambda '(x arg) | |
57 | (list 'fset | |
58 | (list 'quote cmd) | |
59 | 'x))) | |
60 | prefix buffer hook cmd))) | |
61 | ||
f9f9507e | 62 | ;;;###autoload |
66b3ecce DL |
63 | (defun read-kbd-macro (start end) |
64 | "Read the region as a keyboard macro definition. | |
052bdd09 | 65 | The region is interpreted as spelled-out keystrokes, e.g., \"M-x abc RET\". |
66b3ecce DL |
66 | The resulting macro is installed as the \"current\" keyboard macro. |
67 | ||
68 | Symbols: RET, SPC, TAB, DEL, LFD, NUL; C-key; M-key. (Must be uppercase.) | |
69 | REM marks the rest of a line as a comment. | |
70 | Whitespace is ignored; other characters are copied into the macro." | |
71 | (interactive "r") | |
72 | (setq last-kbd-macro (edmacro-parse-keys (buffer-substring start end))) | |
73 | (if (and (string-match "\\`\C-x(" last-kbd-macro) | |
74 | (string-match "\C-x)\\'" last-kbd-macro)) | |
75 | (setq last-kbd-macro (substring last-kbd-macro 2 -2)))) | |
76 | \f | |
77 | ;;; Formatting a keyboard macro as human-readable text. | |
78 | ||
79 | (defun edmacro-print-macro (macro-str local-map) | |
80 | (let ((save-map (current-local-map)) | |
81 | (print-escape-newlines t) | |
82 | key-symbol key-str key-last prefix-arg this-prefix) | |
83 | (unwind-protect | |
84 | (progn | |
85 | (use-local-map local-map) | |
86 | (while (edmacro-peek-char) | |
87 | (edmacro-read-key) | |
88 | (setq this-prefix prefix-arg) | |
89 | (or (memq key-symbol '(digit-argument | |
90 | negative-argument | |
91 | universal-argument)) | |
92 | (null prefix-arg) | |
93 | (progn | |
94 | (cond ((consp prefix-arg) | |
95 | (insert (format "prefix-arg (%d)\n" | |
96 | (car prefix-arg)))) | |
97 | ((eq prefix-arg '-) | |
98 | (insert "prefix-arg -\n")) | |
99 | ((numberp prefix-arg) | |
100 | (insert (format "prefix-arg %d\n" prefix-arg)))) | |
101 | (setq prefix-arg nil))) | |
102 | (cond ((null key-symbol) | |
103 | (insert "type \"") | |
104 | (edmacro-insert-string macro-str) | |
105 | (insert "\"\n") | |
106 | (setq macro-str "")) | |
107 | ((eq key-symbol 'digit-argument) | |
108 | (edmacro-prefix-arg key-last nil prefix-arg)) | |
109 | ((eq key-symbol 'negative-argument) | |
110 | (edmacro-prefix-arg ?- nil prefix-arg)) | |
111 | ((eq key-symbol 'universal-argument) | |
112 | (let* ((c-u 4) (argstartchar key-last) | |
113 | (char (edmacro-read-char))) | |
114 | (while (= char argstartchar) | |
115 | (setq c-u (* 4 c-u) | |
116 | char (edmacro-read-char))) | |
117 | (edmacro-prefix-arg char c-u nil))) | |
118 | ((eq key-symbol 'self-insert-command) | |
119 | (insert "insert ") | |
120 | (if (and (>= key-last 32) (<= key-last 126)) | |
121 | (let ((str "")) | |
122 | (while (or (and (eq key-symbol | |
123 | 'self-insert-command) | |
124 | (< (length str) 60) | |
125 | (>= key-last 32) | |
126 | (<= key-last 126)) | |
127 | (and (memq key-symbol | |
128 | '(backward-delete-char | |
129 | delete-backward-char | |
130 | backward-delete-char-untabify)) | |
131 | (> (length str) 0))) | |
132 | (if (eq key-symbol 'self-insert-command) | |
133 | (setq str (concat str | |
134 | (char-to-string key-last))) | |
135 | (setq str (substring str 0 -1))) | |
136 | (edmacro-read-key)) | |
137 | (insert "\"" str "\"\n") | |
138 | (edmacro-unread-chars key-str)) | |
139 | (insert "\"") | |
140 | (edmacro-insert-string (char-to-string key-last)) | |
141 | (insert "\"\n"))) | |
142 | ((and (eq key-symbol 'quoted-insert) | |
143 | (edmacro-peek-char)) | |
144 | (insert "quoted-insert\n") | |
145 | (let ((ch (edmacro-read-char)) | |
146 | ch2) | |
147 | (if (and (>= ch ?0) (<= ch ?7)) | |
148 | (progn | |
149 | (setq ch (- ch ?0) | |
150 | ch2 (edmacro-read-char)) | |
151 | (if ch2 | |
152 | (if (and (>= ch2 ?0) (<= ch2 ?7)) | |
153 | (progn | |
154 | (setq ch (+ (* ch 8) (- ch2 ?0)) | |
155 | ch2 (edmacro-read-char)) | |
156 | (if ch2 | |
157 | (if (and (>= ch2 ?0) (<= ch2 ?7)) | |
158 | (setq ch (+ (* ch 8) (- ch2 ?0))) | |
159 | (edmacro-unread-chars ch2)))) | |
160 | (edmacro-unread-chars ch2))))) | |
161 | (if (or (and (>= ch ?0) (<= ch ?7)) | |
162 | (< ch 32) (> ch 126)) | |
163 | (insert (format "type \"\\%03o\"\n" ch)) | |
164 | (insert "type \"" (char-to-string ch) "\"\n")))) | |
165 | ((memq key-symbol '(isearch-forward | |
166 | isearch-backward | |
167 | isearch-forward-regexp | |
168 | isearch-backward-regexp)) | |
169 | (insert (symbol-name key-symbol) "\n") | |
170 | (edmacro-isearch-argument)) | |
171 | ((eq key-symbol 'execute-extended-command) | |
172 | (edmacro-read-argument obarray 'commandp)) | |
173 | (t | |
174 | (let ((cust (get key-symbol 'edmacro-print))) | |
175 | (if cust | |
176 | (funcall cust) | |
177 | (insert (symbol-name key-symbol)) | |
178 | (indent-to 30) | |
179 | (insert " # ") | |
180 | (edmacro-insert-string key-str) | |
181 | (insert "\n") | |
182 | (let ((int (edmacro-get-interactive key-symbol))) | |
183 | (if (string-match "\\`\\*" int) | |
184 | (setq int (substring int 1))) | |
185 | (while (> (length int) 0) | |
186 | (cond ((= (aref int 0) ?a) | |
187 | (edmacro-read-argument | |
188 | obarray nil)) | |
189 | ((memq (aref int 0) '(?b ?B ?D ?f ?F ?n | |
190 | ?s ?S ?x ?X)) | |
191 | (edmacro-read-argument)) | |
192 | ((and (= (aref int 0) ?c) | |
193 | (edmacro-peek-char)) | |
194 | (insert "type \"") | |
195 | (edmacro-insert-string | |
196 | (char-to-string | |
197 | (edmacro-read-char))) | |
198 | (insert "\"\n")) | |
199 | ((= (aref int 0) ?C) | |
200 | (edmacro-read-argument | |
201 | obarray 'commandp)) | |
202 | ((= (aref int 0) ?k) | |
203 | (edmacro-read-key) | |
204 | (if key-symbol | |
205 | (progn | |
206 | (insert "type \"") | |
207 | (edmacro-insert-string key-str) | |
208 | (insert "\"\n")) | |
209 | (edmacro-unread-chars key-str))) | |
210 | ((= (aref int 0) ?N) | |
211 | (or this-prefix | |
212 | (edmacro-read-argument))) | |
213 | ((= (aref int 0) ?v) | |
214 | (edmacro-read-argument | |
215 | obarray 'user-variable-p))) | |
216 | (let ((nl (string-match "\n" int))) | |
217 | (setq int (if nl | |
218 | (substring int (1+ nl)) | |
219 | ""))))))))))) | |
220 | (use-local-map save-map)))) | |
221 | ||
222 | (defun edmacro-prefix-arg (char c-u value) | |
223 | (let ((sign 1)) | |
224 | (if (and (numberp value) (< value 0)) | |
225 | (setq sign -1 value (- value))) | |
226 | (if (eq value '-) | |
227 | (setq sign -1 value nil)) | |
228 | (while (and char (= ?- char)) | |
229 | (setq sign (- sign) c-u nil) | |
230 | (setq char (edmacro-read-char))) | |
231 | (while (and char (>= char ?0) (<= char ?9)) | |
232 | (setq value (+ (* (if (numberp value) value 0) 10) (- char ?0)) c-u nil) | |
233 | (setq char (edmacro-read-char))) | |
234 | (setq prefix-arg | |
235 | (cond (c-u (list c-u)) | |
236 | ((numberp value) (* value sign)) | |
237 | ((= sign -1) '-))) | |
238 | (edmacro-unread-chars char))) | |
239 | ||
240 | (defun edmacro-insert-string (str) | |
241 | (let ((i 0) j ch) | |
242 | (while (< i (length str)) | |
243 | (if (and (> (setq ch (aref str i)) 127) | |
244 | (< ch 160)) | |
245 | (progn | |
246 | (setq ch (- ch 128)) | |
247 | (insert "\\M-"))) | |
248 | (if (< ch 32) | |
249 | (cond ((= ch 8) (insret "\\b")) | |
250 | ((= ch 9) (insert "\\t")) | |
251 | ((= ch 10) (insert "\\n")) | |
252 | ((= ch 13) (insert "\\r")) | |
253 | ((= ch 27) (insert "\\e")) | |
254 | (t (insert "\\C-" (char-to-string (downcase (+ ch 64)))))) | |
255 | (if (< ch 127) | |
256 | (if (or (= ch 34) (= ch 92)) | |
257 | (insert "\\" (char-to-string ch)) | |
258 | (setq j i) | |
259 | (while (and (< (setq i (1+ i)) (length str)) | |
260 | (>= (setq ch (aref str i)) 32) | |
261 | (/= ch 34) (/= ch 92) | |
262 | (< ch 127))) | |
263 | (insert (substring str j i)) | |
264 | (setq i (1- i))) | |
265 | (if (memq ch '(127 255)) | |
266 | (insert (format "\\%03o" ch)) | |
267 | (insert "\\M-" (char-to-string (- ch 128)))))) | |
268 | (setq i (1+ i))))) | |
269 | ||
270 | (defun edmacro-lookup-key (map) | |
271 | (let ((loc (and map (lookup-key map macro-str))) | |
272 | (glob (lookup-key (current-global-map) macro-str)) | |
273 | (loc-str macro-str) | |
274 | (glob-str macro-str)) | |
275 | (and (integerp loc) | |
276 | (setq loc-str (substring macro-str 0 loc) | |
277 | loc (lookup-key map loc-str))) | |
278 | (and (consp loc) | |
279 | (setq loc nil)) | |
280 | (or loc | |
281 | (setq loc-str "")) | |
282 | (and (integerp glob) | |
283 | (setq glob-str (substring macro-str 0 glob) | |
284 | glob (lookup-key (current-global-map) glob-str))) | |
285 | (and (consp glob) | |
286 | (setq glob nil)) | |
287 | (or glob | |
288 | (setq glob-str "")) | |
289 | (if (> (length glob-str) (length loc-str)) | |
290 | (setq key-symbol glob | |
291 | key-str glob-str) | |
292 | (setq key-symbol loc | |
293 | key-str loc-str)) | |
294 | (setq key-last (and (> (length key-str) 0) | |
295 | (logand (aref key-str (1- (length key-str))) 127))) | |
296 | key-symbol)) | |
297 | ||
298 | (defun edmacro-read-argument (&optional obarray pred) ;; currently ignored | |
299 | (let ((str "") | |
300 | (min-bsp 0) | |
301 | (exec (eq key-symbol 'execute-extended-command)) | |
302 | str-base) | |
303 | (while (progn | |
304 | (edmacro-lookup-key (current-global-map)) | |
305 | (or (and (eq key-symbol 'self-insert-command) | |
306 | (< (length str) 60)) | |
307 | (memq key-symbol | |
308 | '(backward-delete-char | |
309 | delete-backward-char | |
310 | backward-delete-char-untabify)) | |
311 | (eq key-last 9))) | |
312 | (setq macro-str (substring macro-str (length key-str))) | |
313 | (or (and (eq key-last 9) | |
314 | obarray | |
315 | (let ((comp (try-completion str obarray pred))) | |
316 | (and (stringp comp) | |
317 | (> (length comp) (length str)) | |
318 | (setq str comp)))) | |
319 | (if (or (eq key-symbol 'self-insert-command) | |
320 | (and (or (eq key-last 9) | |
321 | (<= (length str) min-bsp)) | |
322 | (setq min-bsp (+ (length str) (length key-str))))) | |
323 | (setq str (concat str key-str)) | |
324 | (setq str (substring str 0 -1))))) | |
325 | (setq str-base str | |
326 | str (concat str key-str) | |
327 | macro-str (substring macro-str (length key-str))) | |
328 | (if exec | |
329 | (let ((comp (try-completion str-base obarray pred))) | |
330 | (if (if (stringp comp) | |
331 | (and (commandp (intern comp)) | |
332 | (setq str-base comp)) | |
333 | (commandp (intern str-base))) | |
334 | (insert str-base "\n") | |
335 | (insert "execute-extended-command\n") | |
336 | (insert "type \"") | |
337 | (edmacro-insert-string str) | |
338 | (insert "\"\n"))) | |
339 | (if (> (length str) 0) | |
340 | (progn | |
341 | (insert "type \"") | |
342 | (edmacro-insert-string str) | |
343 | (insert "\"\n")))))) | |
344 | ||
345 | (defun edmacro-isearch-argument () | |
346 | (let ((str "") | |
347 | (min-bsp 0) | |
348 | ch) | |
349 | (while (and (setq ch (edmacro-read-char)) | |
350 | (or (<= ch 127) (not search-exit-option)) | |
351 | (not (eq ch search-exit-char)) | |
352 | (or (eq ch search-repeat-char) | |
353 | (eq ch search-reverse-char) | |
354 | (eq ch search-delete-char) | |
355 | (eq ch search-yank-word-char) | |
356 | (eq ch search-yank-line-char) | |
357 | (eq ch search-quote-char) | |
358 | (eq ch ?\r) | |
359 | (eq ch ?\t) | |
360 | (not search-exit-option) | |
361 | (and (/= ch 127) (>= ch 32)))) | |
362 | (if (and (eq ch search-quote-char) | |
363 | (edmacro-peek-char)) | |
364 | (setq str (concat str (char-to-string ch) | |
365 | (char-to-string (edmacro-read-char))) | |
366 | min-bsp (length str)) | |
367 | (if (or (and (< ch 127) (>= ch 32)) | |
368 | (eq ch search-yank-word-char) | |
369 | (eq ch search-yank-line-char) | |
370 | (and (or (not (eq ch search-delete-char)) | |
371 | (<= (length str) min-bsp)) | |
372 | (setq min-bsp (1+ (length str))))) | |
373 | (setq str (concat str (char-to-string ch))) | |
374 | (setq str (substring str 0 -1))))) | |
375 | (if (eq ch search-exit-char) | |
376 | (if (= (length str) 0) ;; non-incremental search | |
377 | (progn | |
378 | (setq str (concat str (char-to-string ch))) | |
379 | (and (eq (edmacro-peek-char) ?\C-w) | |
380 | (progn | |
381 | (setq str (concat str "\C-w")) | |
382 | (edmacro-read-char))) | |
383 | (if (> (length str) 0) | |
384 | (progn | |
385 | (insert "type \"") | |
386 | (edmacro-insert-string str) | |
387 | (insert "\"\n"))) | |
388 | (edmacro-read-argument) | |
389 | (setq str ""))) | |
390 | (edmacro-unread-chars ch)) | |
391 | (if (> (length str) 0) | |
392 | (progn | |
393 | (insert "type \"") | |
394 | (edmacro-insert-string str) | |
395 | (insert "\\e\"\n"))))) | |
396 | ||
397 | ;;; Get the next keystroke-sequence from the input stream. | |
398 | ;;; Sets key-symbol, key-str, and key-last as a side effect. | |
399 | (defun edmacro-read-key () | |
400 | (edmacro-lookup-key (current-local-map)) | |
401 | (and key-symbol | |
402 | (setq macro-str (substring macro-str (length key-str))))) | |
403 | ||
404 | (defun edmacro-peek-char () | |
405 | (and (> (length macro-str) 0) | |
406 | (aref macro-str 0))) | |
407 | ||
408 | (defun edmacro-read-char () | |
409 | (and (> (length macro-str) 0) | |
410 | (prog1 | |
411 | (aref macro-str 0) | |
412 | (setq macro-str (substring macro-str 1))))) | |
413 | ||
414 | (defun edmacro-unread-chars (chars) | |
415 | (and (integerp chars) | |
416 | (setq chars (char-to-string chars))) | |
417 | (and chars | |
418 | (setq macro-str (concat chars macro-str)))) | |
419 | ||
420 | (defun edmacro-dump (mac) | |
421 | (set-mark-command nil) | |
422 | (insert "\n\n") | |
423 | (edmacro-print-macro mac (current-local-map))) | |
424 | \f | |
425 | ;;; Parse a string of spelled-out keystrokes, as produced by key-description. | |
426 | ||
427 | (defun edmacro-parse-keys (str) | |
428 | (let ((pos 0) | |
429 | (mac "") | |
430 | part) | |
431 | (while (and (< pos (length str)) | |
432 | (string-match "[^ \t\n]+" str pos)) | |
433 | (setq pos (match-end 0) | |
434 | part (substring str (match-beginning 0) (match-end 0)) | |
435 | mac (concat mac | |
436 | (if (and (> (length part) 2) | |
437 | (= (aref part 1) ?-) | |
438 | (= (aref part 0) ?M)) | |
439 | (progn | |
440 | (setq part (substring part 2)) | |
441 | "\e") | |
442 | (if (and (> (length part) 4) | |
443 | (= (aref part 0) ?C) | |
444 | (= (aref part 1) ?-) | |
445 | (= (aref part 2) ?M) | |
446 | (= (aref part 3) ?-)) | |
447 | (progn | |
448 | (setq part (concat "C-" (substring part 4))) | |
449 | "\e") | |
450 | "")) | |
451 | (or (cdr (assoc part '( ( "NUL" . "\0" ) | |
452 | ( "RET" . "\r" ) | |
453 | ( "LFD" . "\n" ) | |
454 | ( "TAB" . "\t" ) | |
455 | ( "ESC" . "\e" ) | |
456 | ( "SPC" . " " ) | |
457 | ( "DEL" . "\177" ) | |
458 | ( "C-?" . "\177" ) | |
459 | ( "C-2" . "\0" ) | |
460 | ( "C-SPC" . "\0") ))) | |
461 | (and (equal part "REM") | |
462 | (setq pos (or (string-match "\n" str pos) | |
463 | (length str))) | |
464 | "") | |
465 | (and (= (length part) 3) | |
466 | (= (aref part 0) ?C) | |
467 | (= (aref part 1) ?-) | |
468 | (char-to-string (logand (aref part 2) 31))) | |
469 | part)))) | |
470 | mac)) | |
471 | \f | |
472 | ;;; Parse a keyboard macro description in edmacro-print-macro's format. | |
473 | ||
474 | (defun edmacro-read-macro (&optional map) | |
475 | (or map (setq map (current-local-map))) | |
476 | (let ((macro-str "")) | |
477 | (while (not (progn | |
478 | (skip-chars-forward " \t\n") | |
479 | (eobp))) | |
480 | (cond ((looking-at "#")) ;; comment | |
481 | ((looking-at "prefix-arg[ \t]*-[ \t]*\n") | |
482 | (edmacro-append-chars "\C-u-")) | |
483 | ((looking-at "prefix-arg[ \t]*\\(-?[0-9]+\\)[ \t]*\n") | |
484 | (edmacro-append-chars (concat "\C-u" (edmacro-match-string 1)))) | |
485 | ((looking-at "prefix-arg[ \t]*(\\([0-9]+\\))[ \t]*\n") | |
486 | (let ((val (string-to-int (edmacro-match-string 1)))) | |
487 | (while (> val 1) | |
488 | (or (= (% val 4) 0) | |
489 | (error "Bad prefix argument value")) | |
490 | (edmacro-append-chars "\C-u") | |
491 | (setq val (/ val 4))))) | |
492 | ((looking-at "prefix-arg") | |
493 | (error "Bad prefix argument syntax")) | |
494 | ((looking-at "insert ") | |
495 | (forward-char 7) | |
496 | (edmacro-append-chars (read (current-buffer))) | |
497 | (if (< (current-column) 7) | |
498 | (forward-line -1))) | |
499 | ((looking-at "type ") | |
500 | (forward-char 5) | |
501 | (edmacro-append-chars (read (current-buffer))) | |
502 | (if (< (current-column) 5) | |
503 | (forward-line -1))) | |
504 | ((looking-at "keys \\(.*\\)\n") | |
505 | (goto-char (1- (match-end 0))) | |
506 | (edmacro-append-chars (edmacro-parse-keys | |
507 | (buffer-substring (match-beginning 1) | |
508 | (match-end 1))))) | |
509 | ((looking-at "\\([-a-zA-z0-9_]+\\)[ \t]*\\(.*\\)\n") | |
510 | (let* ((func (intern (edmacro-match-string 1))) | |
511 | (arg (edmacro-match-string 2)) | |
512 | (cust (get func 'edmacro-read))) | |
513 | (if cust | |
514 | (funcall cust arg) | |
515 | (or (commandp func) | |
516 | (error "Not an Emacs command")) | |
517 | (or (equal arg "") | |
518 | (string-match "\\`#" arg) | |
519 | (error "Unexpected argument to command")) | |
520 | (let ((keys | |
521 | (or (where-is-internal func map t) | |
522 | (where-is-internal func (current-global-map) t)))) | |
523 | (if keys | |
524 | (edmacro-append-chars keys) | |
525 | (edmacro-append-chars (concat "\ex" | |
526 | (symbol-name func) | |
527 | "\n"))))))) | |
528 | (t (error "Syntax error"))) | |
529 | (forward-line 1)) | |
530 | macro-str)) | |
531 | ||
532 | (defun edmacro-append-chars (chars) | |
533 | (setq macro-str (concat macro-str chars))) | |
534 | ||
535 | (defun edmacro-match-string (n) | |
536 | (if (match-beginning n) | |
537 | (buffer-substring (match-beginning n) (match-end n)) | |
538 | "")) | |
539 | ||
540 | (defun edmacro-get-interactive (func) | |
541 | (if (symbolp func) | |
542 | (let ((cust (get func 'edmacro-interactive))) | |
543 | (if cust | |
544 | cust | |
545 | (edmacro-get-interactive (symbol-function func)))) | |
546 | (or (and (eq (car-safe func) 'lambda) | |
547 | (let ((int (if (consp (nth 2 func)) | |
548 | (nth 2 func) | |
549 | (nth 3 func)))) | |
550 | (and (eq (car-safe int) 'interactive) | |
551 | (stringp (nth 1 int)) | |
552 | (nth 1 int)))) | |
553 | ""))) | |
554 | ||
555 | (put 'search-forward 'edmacro-interactive "s") | |
556 | (put 'search-backward 'edmacro-interactive "s") | |
557 | (put 'word-search-forward 'edmacro-interactive "s") | |
558 | (put 'word-search-backward 'edmacro-interactive "s") | |
559 | (put 're-search-forward 'edmacro-interactive "s") | |
560 | (put 're-search-backward 'edmacro-interactive "s") | |
561 | (put 'switch-to-buffer 'edmacro-interactive "B") | |
562 | (put 'kill-buffer 'edmacro-interactive "B") | |
563 | (put 'rename-buffer 'edmacro-interactive "B\nB") | |
564 | (put 'goto-char 'edmacro-interactive "N") | |
565 | (put 'global-set-key 'edmacro-interactive "k\nC") | |
566 | (put 'global-unset-key 'edmacro-interactive "k") | |
567 | (put 'local-set-key 'edmacro-interactive "k\nC") | |
568 | (put 'local-unset-key 'edmacro-interactive "k") | |
569 | ||
570 | ;;; Think about kbd-macro-query | |
571 | ||
572 | ;;; Edit a keyboard macro in another buffer. | |
573 | ;;; (Prefix argument is currently ignored.) | |
574 | ||
575 | (defun edmacro-edit-macro (mac repl &optional prefix buffer hook arg) | |
576 | (or (stringp mac) | |
577 | (error "Not a keyboard macro")) | |
578 | (let ((oldbuf (current-buffer)) | |
579 | (local (current-local-map)) | |
580 | (buf (get-buffer-create (or buffer "*Edit Macro*")))) | |
581 | (set-buffer buf) | |
582 | (kill-all-local-variables) | |
583 | (use-local-map edmacro-mode-map) | |
584 | (setq buffer-read-only nil | |
585 | major-mode 'edmacro-mode | |
586 | mode-name "Edit Macro") | |
587 | (set (make-local-variable 'edmacro-original-buffer) oldbuf) | |
588 | (set (make-local-variable 'edmacro-replace-function) repl) | |
589 | (set (make-local-variable 'edmacro-replace-argument) arg) | |
590 | (set (make-local-variable 'edmacro-finish-hook) hook) | |
591 | (erase-buffer) | |
592 | (insert "# Keyboard Macro Editor. Press C-c C-c to finish; press C-x k RET to cancel.\n") | |
593 | (insert "# Original keys: " (key-description mac) "\n\n") | |
594 | (message "Formatting keyboard macro...") | |
595 | (edmacro-print-macro mac local) | |
596 | (switch-to-buffer buf) | |
597 | (goto-char (point-min)) | |
598 | (forward-line 3) | |
599 | (recenter '(4)) | |
600 | (set-buffer-modified-p nil) | |
601 | (message "Formatting keyboard macro...done") | |
602 | (run-hooks 'edmacro-format-hook))) | |
603 | ||
604 | (defun edmacro-finish-edit () | |
605 | (interactive) | |
606 | (or (and (boundp 'edmacro-original-buffer) | |
607 | (boundp 'edmacro-replace-function) | |
608 | (boundp 'edmacro-replace-argument) | |
609 | (boundp 'edmacro-finish-hook) | |
610 | (eq major-mode 'edmacro-mode)) | |
052bdd09 | 611 | (error "This command is valid only in buffers created by `edit-kbd-macro'.")) |
66b3ecce DL |
612 | (let ((buf (current-buffer)) |
613 | (str (buffer-string)) | |
614 | (func edmacro-replace-function) | |
615 | (arg edmacro-replace-argument) | |
616 | (hook edmacro-finish-hook)) | |
617 | (goto-char (point-min)) | |
618 | (run-hooks 'edmacro-compile-hook) | |
619 | (and (buffer-modified-p) | |
620 | func | |
621 | (progn | |
622 | (message "Compiling keyboard macro...") | |
623 | (let ((mac (edmacro-read-macro | |
624 | (and (buffer-name edmacro-original-buffer) | |
625 | (save-excursion | |
626 | (set-buffer edmacro-original-buffer) | |
627 | (current-local-map)))))) | |
628 | (and (buffer-name edmacro-original-buffer) | |
629 | (switch-to-buffer edmacro-original-buffer)) | |
630 | (funcall func mac arg)) | |
631 | (message "Compiling keyboard macro...done"))) | |
632 | (kill-buffer buf) | |
633 | (if hook | |
634 | (funcall hook arg)))) | |
635 | ||
636 | (defun edmacro-mode () | |
052bdd09 RS |
637 | "\\<edmacro-mode-map>Keyboard Macro Editing mode. Press \\[edmacro-finish-edit] to save and exit. |
638 | To abort the edit, just kill this buffer with \\[kill-buffer] RET. | |
66b3ecce DL |
639 | |
640 | The keyboard macro is represented as a series of M-x style command names. | |
641 | Keystrokes which do not correspond to simple M-x commands are written as | |
052bdd09 | 642 | \"type\" commands. When you press \\[edmacro-finish-edit], edmacro converts each command |
66b3ecce DL |
643 | back into a suitable keystroke sequence; \"type\" commands are converted |
644 | directly back into keystrokes." | |
645 | (interactive) | |
052bdd09 | 646 | (error "This mode can be enabled only by `edit-kbd-macro' or `edit-last-kbd-macro'.")) |
66b3ecce DL |
647 | (put 'edmacro-mode 'mode-class 'special) |
648 | ||
649 | (if (boundp 'edmacro-mode-map) () | |
650 | (setq edmacro-mode-map (make-sparse-keymap)) | |
651 | (define-key edmacro-mode-map "\C-c\C-c" 'edmacro-finish-edit)) | |
c0274f38 ER |
652 | |
653 | ;;; edmacro.el ends here |