Mercurial > emacs
annotate lisp/edmacro.el @ 2800:a7b260d27c2c
(face-initialize): Don't create the `modeline' face.
Set region-face.
(invert-face): Really do use the default colors.
(x-initialize-frame-faces): Always try "gray" color for
primary-selection; always invert if that fails.
Similar changes for highlight, secondary-selection.
(make-face): Add interactive spec.
(set-default-font): Deleted.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Sat, 15 May 1993 19:53:44 +0000 |
parents | 2c7997f249eb |
children | 463663a999ee |
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 |
2247
2c7997f249eb
Add or correct keywords
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
845
diff
changeset
|
8 ;; Keywords: abbrev |
109 | 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 | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
662
diff
changeset
|
14 ;; the Free Software Foundation; either version 2, or (at your option) |
109 | 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 | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
662
diff
changeset
|
26 ;;; Commentary: |
109 | 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. | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
662
diff
changeset
|
33 |
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
662
diff
changeset
|
34 ;;; Code: |
109 | 35 |
36 ;;; The user-level commands for editing macros. | |
37 | |
258 | 38 ;;;###autoload |
109 | 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 | |
258 | 46 ;;;###autoload |
109 | 47 (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
|
48 "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
|
49 \(See also `edit-last-kbd-macro'.)" |
109 | 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 | |
258 | 62 ;;;###autoload |
109 | 63 (defun read-kbd-macro (start end) |
64 "Read the region as a keyboard macro definition. | |
199
b3710ab30435
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
109
diff
changeset
|
65 The region is interpreted as spelled-out keystrokes, e.g., \"M-x abc RET\". |
109 | 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 | |
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 | |
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 | |
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)) | |
199
b3710ab30435
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
109
diff
changeset
|
611 (error "This command is valid only in buffers created by `edit-kbd-macro'.")) |
109 | 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 () | |
199
b3710ab30435
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
109
diff
changeset
|
637 "\\<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
|
638 To abort the edit, just kill this buffer with \\[kill-buffer] RET. |
109 | 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 | |
199
b3710ab30435
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
109
diff
changeset
|
642 \"type\" commands. When you press \\[edmacro-finish-edit], edmacro converts each command |
109 | 643 back into a suitable keystroke sequence; \"type\" commands are converted |
644 directly back into keystrokes." | |
645 (interactive) | |
199
b3710ab30435
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
109
diff
changeset
|
646 (error "This mode can be enabled only by `edit-kbd-macro' or `edit-last-kbd-macro'.")) |
109 | 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)) | |
662
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
258
diff
changeset
|
652 |
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
258
diff
changeset
|
653 ;;; edmacro.el ends here |