1 ;;; edmacro.el --- keyboard macro editor for GNU Emacs. Version 1.02.
3 ;; Copyright (C) 1990 Free Software Foundation, Inc.
5 ;; This file is part of GNU Emacs.
7 ;; GNU Emacs is free software; you can redistribute it and/or modify
8 ;; it under the terms of the GNU General Public License as published by
9 ;; the Free Software Foundation; either version 1, or (at your option)
12 ;; GNU Emacs is distributed in the hope that it will be useful,
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;; GNU General Public License for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with GNU Emacs; see the file COPYING. If not, write to
19 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
21 ;; Original from: Dave Gillespie, daveg@csvax.caltech.edu.
23 ;; To use, type `M-x edit-last-kbd-macro' to edit the most recently
24 ;; defined keyboard macro. If you have used `M-x name-last-kbd-macro'
25 ;; to give a keyboard macro a name, type `M-x edit-kbd-macro' to edit
26 ;; the macro by name. When you are done editing, type `C-c C-c' to
27 ;; record your changes back into the original keyboard macro.
29 ;;; The user-level commands for editing macros.
32 (defun edit-last-kbd-macro (&optional prefix buffer hook
)
33 "Edit the most recently defined keyboard macro."
35 (edmacro-edit-macro last-kbd-macro
36 (function (lambda (x arg
) (setq last-kbd-macro x
)))
40 (defun edit-kbd-macro (cmd &optional prefix buffer hook in-hook out-hook
)
41 "Edit a keyboard macro which has been given a name by `name-last-kbd-macro'.
42 \(See also `edit-last-kbd-macro'.)"
43 (interactive "CCommand name: \nP")
45 (edmacro-edit-macro (if in-hook
47 (symbol-function cmd
))
49 (list 'lambda
'(x arg
)
53 prefix buffer hook cmd
)))
56 (defun read-kbd-macro (start end
)
57 "Read the region as a keyboard macro definition.
58 The region is interpreted as spelled-out keystrokes, e.g., \"M-x abc RET\".
59 The resulting macro is installed as the \"current\" keyboard macro.
61 Symbols: RET, SPC, TAB, DEL, LFD, NUL; C-key; M-key. (Must be uppercase.)
62 REM marks the rest of a line as a comment.
63 Whitespace is ignored; other characters are copied into the macro."
65 (setq last-kbd-macro
(edmacro-parse-keys (buffer-substring start end
)))
66 (if (and (string-match "\\`\C-x(" last-kbd-macro
)
67 (string-match "\C-x)\\'" last-kbd-macro
))
68 (setq last-kbd-macro
(substring last-kbd-macro
2 -
2))))
70 ;;; Formatting a keyboard macro as human-readable text.
72 (defun edmacro-print-macro (macro-str local-map
)
73 (let ((save-map (current-local-map))
74 (print-escape-newlines t
)
75 key-symbol key-str key-last prefix-arg this-prefix
)
78 (use-local-map local-map
)
79 (while (edmacro-peek-char)
81 (setq this-prefix prefix-arg
)
82 (or (memq key-symbol
'(digit-argument
87 (cond ((consp prefix-arg
)
88 (insert (format "prefix-arg (%d)\n"
91 (insert "prefix-arg -\n"))
93 (insert (format "prefix-arg %d\n" prefix-arg
))))
94 (setq prefix-arg nil
)))
95 (cond ((null key-symbol
)
97 (edmacro-insert-string macro-str
)
100 ((eq key-symbol
'digit-argument
)
101 (edmacro-prefix-arg key-last nil prefix-arg
))
102 ((eq key-symbol
'negative-argument
)
103 (edmacro-prefix-arg ?- nil prefix-arg
))
104 ((eq key-symbol
'universal-argument
)
105 (let* ((c-u 4) (argstartchar key-last
)
106 (char (edmacro-read-char)))
107 (while (= char argstartchar
)
109 char
(edmacro-read-char)))
110 (edmacro-prefix-arg char c-u nil
)))
111 ((eq key-symbol
'self-insert-command
)
113 (if (and (>= key-last
32) (<= key-last
126))
115 (while (or (and (eq key-symbol
116 'self-insert-command
)
120 (and (memq key-symbol
121 '(backward-delete-char
123 backward-delete-char-untabify
))
125 (if (eq key-symbol
'self-insert-command
)
126 (setq str
(concat str
127 (char-to-string key-last
)))
128 (setq str
(substring str
0 -
1)))
130 (insert "\"" str
"\"\n")
131 (edmacro-unread-chars key-str
))
133 (edmacro-insert-string (char-to-string key-last
))
135 ((and (eq key-symbol
'quoted-insert
)
137 (insert "quoted-insert\n")
138 (let ((ch (edmacro-read-char))
140 (if (and (>= ch ?
0) (<= ch ?
7))
143 ch2
(edmacro-read-char))
145 (if (and (>= ch2 ?
0) (<= ch2 ?
7))
147 (setq ch
(+ (* ch
8) (- ch2 ?
0))
148 ch2
(edmacro-read-char))
150 (if (and (>= ch2 ?
0) (<= ch2 ?
7))
151 (setq ch
(+ (* ch
8) (- ch2 ?
0)))
152 (edmacro-unread-chars ch2
))))
153 (edmacro-unread-chars ch2
)))))
154 (if (or (and (>= ch ?
0) (<= ch ?
7))
155 (< ch
32) (> ch
126))
156 (insert (format "type \"\\%03o\"\n" ch
))
157 (insert "type \"" (char-to-string ch
) "\"\n"))))
158 ((memq key-symbol
'(isearch-forward
160 isearch-forward-regexp
161 isearch-backward-regexp
))
162 (insert (symbol-name key-symbol
) "\n")
163 (edmacro-isearch-argument))
164 ((eq key-symbol
'execute-extended-command
)
165 (edmacro-read-argument obarray
'commandp
))
167 (let ((cust (get key-symbol
'edmacro-print
)))
170 (insert (symbol-name key-symbol
))
173 (edmacro-insert-string key-str
)
175 (let ((int (edmacro-get-interactive key-symbol
)))
176 (if (string-match "\\`\\*" int
)
177 (setq int
(substring int
1)))
178 (while (> (length int
) 0)
179 (cond ((= (aref int
0) ?a
)
180 (edmacro-read-argument
182 ((memq (aref int
0) '(?b ?B ?D ?f ?F ?n
184 (edmacro-read-argument))
185 ((and (= (aref int
0) ?c
)
188 (edmacro-insert-string
190 (edmacro-read-char)))
193 (edmacro-read-argument
200 (edmacro-insert-string key-str
)
202 (edmacro-unread-chars key-str
)))
205 (edmacro-read-argument)))
207 (edmacro-read-argument
208 obarray
'user-variable-p
)))
209 (let ((nl (string-match "\n" int
)))
211 (substring int
(1+ nl
))
213 (use-local-map save-map
))))
215 (defun edmacro-prefix-arg (char c-u value
)
217 (if (and (numberp value
) (< value
0))
218 (setq sign -
1 value
(- value
)))
220 (setq sign -
1 value nil
))
221 (while (and char
(= ?- char
))
222 (setq sign
(- sign
) c-u nil
)
223 (setq char
(edmacro-read-char)))
224 (while (and char
(>= char ?
0) (<= char ?
9))
225 (setq value
(+ (* (if (numberp value
) value
0) 10) (- char ?
0)) c-u nil
)
226 (setq char
(edmacro-read-char)))
228 (cond (c-u (list c-u
))
229 ((numberp value
) (* value sign
))
231 (edmacro-unread-chars char
)))
233 (defun edmacro-insert-string (str)
235 (while (< i
(length str
))
236 (if (and (> (setq ch
(aref str i
)) 127)
242 (cond ((= ch
8) (insret "\\b"))
243 ((= ch
9) (insert "\\t"))
244 ((= ch
10) (insert "\\n"))
245 ((= ch
13) (insert "\\r"))
246 ((= ch
27) (insert "\\e"))
247 (t (insert "\\C-" (char-to-string (downcase (+ ch
64))))))
249 (if (or (= ch
34) (= ch
92))
250 (insert "\\" (char-to-string ch
))
252 (while (and (< (setq i
(1+ i
)) (length str
))
253 (>= (setq ch
(aref str i
)) 32)
254 (/= ch
34) (/= ch
92)
256 (insert (substring str j i
))
258 (if (memq ch
'(127 255))
259 (insert (format "\\%03o" ch
))
260 (insert "\\M-" (char-to-string (- ch
128))))))
263 (defun edmacro-lookup-key (map)
264 (let ((loc (and map
(lookup-key map macro-str
)))
265 (glob (lookup-key (current-global-map) macro-str
))
267 (glob-str macro-str
))
269 (setq loc-str
(substring macro-str
0 loc
)
270 loc
(lookup-key map loc-str
)))
276 (setq glob-str
(substring macro-str
0 glob
)
277 glob
(lookup-key (current-global-map) glob-str
)))
282 (if (> (length glob-str
) (length loc-str
))
283 (setq key-symbol glob
287 (setq key-last
(and (> (length key-str
) 0)
288 (logand (aref key-str
(1- (length key-str
))) 127)))
291 (defun edmacro-read-argument (&optional obarray pred
) ;; currently ignored
294 (exec (eq key-symbol
'execute-extended-command
))
297 (edmacro-lookup-key (current-global-map))
298 (or (and (eq key-symbol
'self-insert-command
)
301 '(backward-delete-char
303 backward-delete-char-untabify
))
305 (setq macro-str
(substring macro-str
(length key-str
)))
306 (or (and (eq key-last
9)
308 (let ((comp (try-completion str obarray pred
)))
310 (> (length comp
) (length str
))
312 (if (or (eq key-symbol
'self-insert-command
)
313 (and (or (eq key-last
9)
314 (<= (length str
) min-bsp
))
315 (setq min-bsp
(+ (length str
) (length key-str
)))))
316 (setq str
(concat str key-str
))
317 (setq str
(substring str
0 -
1)))))
319 str
(concat str key-str
)
320 macro-str
(substring macro-str
(length key-str
)))
322 (let ((comp (try-completion str-base obarray pred
)))
323 (if (if (stringp comp
)
324 (and (commandp (intern comp
))
325 (setq str-base comp
))
326 (commandp (intern str-base
)))
327 (insert str-base
"\n")
328 (insert "execute-extended-command\n")
330 (edmacro-insert-string str
)
332 (if (> (length str
) 0)
335 (edmacro-insert-string str
)
338 (defun edmacro-isearch-argument ()
342 (while (and (setq ch
(edmacro-read-char))
343 (or (<= ch
127) (not search-exit-option
))
344 (not (eq ch search-exit-char
))
345 (or (eq ch search-repeat-char
)
346 (eq ch search-reverse-char
)
347 (eq ch search-delete-char
)
348 (eq ch search-yank-word-char
)
349 (eq ch search-yank-line-char
)
350 (eq ch search-quote-char
)
353 (not search-exit-option
)
354 (and (/= ch
127) (>= ch
32))))
355 (if (and (eq ch search-quote-char
)
357 (setq str
(concat str
(char-to-string ch
)
358 (char-to-string (edmacro-read-char)))
359 min-bsp
(length str
))
360 (if (or (and (< ch
127) (>= ch
32))
361 (eq ch search-yank-word-char
)
362 (eq ch search-yank-line-char
)
363 (and (or (not (eq ch search-delete-char
))
364 (<= (length str
) min-bsp
))
365 (setq min-bsp
(1+ (length str
)))))
366 (setq str
(concat str
(char-to-string ch
)))
367 (setq str
(substring str
0 -
1)))))
368 (if (eq ch search-exit-char
)
369 (if (= (length str
) 0) ;; non-incremental search
371 (setq str
(concat str
(char-to-string ch
)))
372 (and (eq (edmacro-peek-char) ?\C-w
)
374 (setq str
(concat str
"\C-w"))
375 (edmacro-read-char)))
376 (if (> (length str
) 0)
379 (edmacro-insert-string str
)
381 (edmacro-read-argument)
383 (edmacro-unread-chars ch
))
384 (if (> (length str
) 0)
387 (edmacro-insert-string str
)
388 (insert "\\e\"\n")))))
390 ;;; Get the next keystroke-sequence from the input stream.
391 ;;; Sets key-symbol, key-str, and key-last as a side effect.
392 (defun edmacro-read-key ()
393 (edmacro-lookup-key (current-local-map))
395 (setq macro-str
(substring macro-str
(length key-str
)))))
397 (defun edmacro-peek-char ()
398 (and (> (length macro-str
) 0)
401 (defun edmacro-read-char ()
402 (and (> (length macro-str
) 0)
405 (setq macro-str
(substring macro-str
1)))))
407 (defun edmacro-unread-chars (chars)
408 (and (integerp chars
)
409 (setq chars
(char-to-string chars
)))
411 (setq macro-str
(concat chars macro-str
))))
413 (defun edmacro-dump (mac)
414 (set-mark-command nil
)
416 (edmacro-print-macro mac
(current-local-map)))
418 ;;; Parse a string of spelled-out keystrokes, as produced by key-description.
420 (defun edmacro-parse-keys (str)
424 (while (and (< pos
(length str
))
425 (string-match "[^ \t\n]+" str pos
))
426 (setq pos
(match-end 0)
427 part
(substring str
(match-beginning 0) (match-end 0))
429 (if (and (> (length part
) 2)
431 (= (aref part
0) ?M
))
433 (setq part
(substring part
2))
435 (if (and (> (length part
) 4)
439 (= (aref part
3) ?-
))
441 (setq part
(concat "C-" (substring part
4)))
444 (or (cdr (assoc part
'( ( "NUL" .
"\0" )
453 ( "C-SPC" .
"\0") )))
454 (and (equal part
"REM")
455 (setq pos
(or (string-match "\n" str pos
)
458 (and (= (length part
) 3)
461 (char-to-string (logand (aref part
2) 31)))
465 ;;; Parse a keyboard macro description in edmacro-print-macro's format.
467 (defun edmacro-read-macro (&optional map
)
468 (or map
(setq map
(current-local-map)))
469 (let ((macro-str ""))
471 (skip-chars-forward " \t\n")
473 (cond ((looking-at "#")) ;; comment
474 ((looking-at "prefix-arg[ \t]*-[ \t]*\n")
475 (edmacro-append-chars "\C-u-"))
476 ((looking-at "prefix-arg[ \t]*\\(-?[0-9]+\\)[ \t]*\n")
477 (edmacro-append-chars (concat "\C-u" (edmacro-match-string 1))))
478 ((looking-at "prefix-arg[ \t]*(\\([0-9]+\\))[ \t]*\n")
479 (let ((val (string-to-int (edmacro-match-string 1))))
482 (error "Bad prefix argument value"))
483 (edmacro-append-chars "\C-u")
484 (setq val
(/ val
4)))))
485 ((looking-at "prefix-arg")
486 (error "Bad prefix argument syntax"))
487 ((looking-at "insert ")
489 (edmacro-append-chars (read (current-buffer)))
490 (if (< (current-column) 7)
492 ((looking-at "type ")
494 (edmacro-append-chars (read (current-buffer)))
495 (if (< (current-column) 5)
497 ((looking-at "keys \\(.*\\)\n")
498 (goto-char (1- (match-end 0)))
499 (edmacro-append-chars (edmacro-parse-keys
500 (buffer-substring (match-beginning 1)
502 ((looking-at "\\([-a-zA-z0-9_]+\\)[ \t]*\\(.*\\)\n")
503 (let* ((func (intern (edmacro-match-string 1)))
504 (arg (edmacro-match-string 2))
505 (cust (get func
'edmacro-read
)))
509 (error "Not an Emacs command"))
511 (string-match "\\`#" arg
)
512 (error "Unexpected argument to command"))
514 (or (where-is-internal func map t
)
515 (where-is-internal func
(current-global-map) t
))))
517 (edmacro-append-chars keys
)
518 (edmacro-append-chars (concat "\ex"
521 (t (error "Syntax error")))
525 (defun edmacro-append-chars (chars)
526 (setq macro-str
(concat macro-str chars
)))
528 (defun edmacro-match-string (n)
529 (if (match-beginning n
)
530 (buffer-substring (match-beginning n
) (match-end n
))
533 (defun edmacro-get-interactive (func)
535 (let ((cust (get func
'edmacro-interactive
)))
538 (edmacro-get-interactive (symbol-function func
))))
539 (or (and (eq (car-safe func
) 'lambda
)
540 (let ((int (if (consp (nth 2 func
))
543 (and (eq (car-safe int
) 'interactive
)
544 (stringp (nth 1 int
))
548 (put 'search-forward
'edmacro-interactive
"s")
549 (put 'search-backward
'edmacro-interactive
"s")
550 (put 'word-search-forward
'edmacro-interactive
"s")
551 (put 'word-search-backward
'edmacro-interactive
"s")
552 (put 're-search-forward
'edmacro-interactive
"s")
553 (put 're-search-backward
'edmacro-interactive
"s")
554 (put 'switch-to-buffer
'edmacro-interactive
"B")
555 (put 'kill-buffer
'edmacro-interactive
"B")
556 (put 'rename-buffer
'edmacro-interactive
"B\nB")
557 (put 'goto-char
'edmacro-interactive
"N")
558 (put 'global-set-key
'edmacro-interactive
"k\nC")
559 (put 'global-unset-key
'edmacro-interactive
"k")
560 (put 'local-set-key
'edmacro-interactive
"k\nC")
561 (put 'local-unset-key
'edmacro-interactive
"k")
563 ;;; Think about kbd-macro-query
565 ;;; Edit a keyboard macro in another buffer.
566 ;;; (Prefix argument is currently ignored.)
568 (defun edmacro-edit-macro (mac repl
&optional prefix buffer hook arg
)
570 (error "Not a keyboard macro"))
571 (let ((oldbuf (current-buffer))
572 (local (current-local-map))
573 (buf (get-buffer-create (or buffer
"*Edit Macro*"))))
575 (kill-all-local-variables)
576 (use-local-map edmacro-mode-map
)
577 (setq buffer-read-only nil
578 major-mode
'edmacro-mode
579 mode-name
"Edit Macro")
580 (set (make-local-variable 'edmacro-original-buffer
) oldbuf
)
581 (set (make-local-variable 'edmacro-replace-function
) repl
)
582 (set (make-local-variable 'edmacro-replace-argument
) arg
)
583 (set (make-local-variable 'edmacro-finish-hook
) hook
)
585 (insert "# Keyboard Macro Editor. Press C-c C-c to finish; press C-x k RET to cancel.\n")
586 (insert "# Original keys: " (key-description mac
) "\n\n")
587 (message "Formatting keyboard macro...")
588 (edmacro-print-macro mac local
)
589 (switch-to-buffer buf
)
590 (goto-char (point-min))
593 (set-buffer-modified-p nil
)
594 (message "Formatting keyboard macro...done")
595 (run-hooks 'edmacro-format-hook
)))
597 (defun edmacro-finish-edit ()
599 (or (and (boundp 'edmacro-original-buffer
)
600 (boundp 'edmacro-replace-function
)
601 (boundp 'edmacro-replace-argument
)
602 (boundp 'edmacro-finish-hook
)
603 (eq major-mode
'edmacro-mode
))
604 (error "This command is valid only in buffers created by `edit-kbd-macro'."))
605 (let ((buf (current-buffer))
606 (str (buffer-string))
607 (func edmacro-replace-function
)
608 (arg edmacro-replace-argument
)
609 (hook edmacro-finish-hook
))
610 (goto-char (point-min))
611 (run-hooks 'edmacro-compile-hook
)
612 (and (buffer-modified-p)
615 (message "Compiling keyboard macro...")
616 (let ((mac (edmacro-read-macro
617 (and (buffer-name edmacro-original-buffer
)
619 (set-buffer edmacro-original-buffer
)
620 (current-local-map))))))
621 (and (buffer-name edmacro-original-buffer
)
622 (switch-to-buffer edmacro-original-buffer
))
623 (funcall func mac arg
))
624 (message "Compiling keyboard macro...done")))
627 (funcall hook arg
))))
629 (defun edmacro-mode ()
630 "\\<edmacro-mode-map>Keyboard Macro Editing mode. Press \\[edmacro-finish-edit] to save and exit.
631 To abort the edit, just kill this buffer with \\[kill-buffer] RET.
633 The keyboard macro is represented as a series of M-x style command names.
634 Keystrokes which do not correspond to simple M-x commands are written as
635 \"type\" commands. When you press \\[edmacro-finish-edit], edmacro converts each command
636 back into a suitable keystroke sequence; \"type\" commands are converted
637 directly back into keystrokes."
639 (error "This mode can be enabled only by `edit-kbd-macro' or `edit-last-kbd-macro'."))
640 (put 'edmacro-mode
'mode-class
'special
)
642 (if (boundp 'edmacro-mode-map
) ()
643 (setq edmacro-mode-map
(make-sparse-keymap))
644 (define-key edmacro-mode-map
"\C-c\C-c" 'edmacro-finish-edit
))
646 ;;; edmacro.el ends here