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