1 ;;; edmacro.el --- keyboard macro editor
3 ;; Copyright (C) 1990 Free Software Foundation, Inc.
5 ;; Author: Dave Gillespie <daveg@csvax.caltech.edu>
10 ;; This file is part of GNU Emacs.
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
14 ;; the Free Software Foundation; either version 2, or (at your option)
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.
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.
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.
36 ;;; The user-level commands for editing macros.
39 (defun edit-last-kbd-macro (&optional prefix buffer hook)
40 "Edit the most recently defined keyboard macro."
42 (edmacro-edit-macro last-kbd-macro
43 (function (lambda (x arg) (setq last-kbd-macro x)))
47 (defun edit-kbd-macro (cmd &optional prefix buffer hook in-hook out-hook)
48 "Edit a keyboard macro which has been given a name by `name-last-kbd-macro'.
49 \(See also `edit-last-kbd-macro'.)"
50 (interactive "CCommand name: \nP")
52 (edmacro-edit-macro (if in-hook
54 (symbol-function cmd))
56 (list 'lambda '(x arg)
60 prefix buffer hook cmd)))
63 (defun read-kbd-macro (start end)
64 "Read the region as a keyboard macro definition.
65 The region is interpreted as spelled-out keystrokes, e.g., \"M-x abc RET\".
66 The resulting macro is installed as the \"current\" keyboard macro.
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."
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))))
77 ;;; Formatting a keyboard macro as human-readable text.
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)
85 (use-local-map local-map)
86 (while (edmacro-peek-char)
88 (setq this-prefix prefix-arg)
89 (or (memq key-symbol '(digit-argument
94 (cond ((consp prefix-arg)
95 (insert (format "prefix-arg (%d)\n"
98 (insert "prefix-arg -\n"))
100 (insert (format "prefix-arg %d\n" prefix-arg))))
101 (setq prefix-arg nil)))
102 (cond ((null key-symbol)
104 (edmacro-insert-string 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)
116 char (edmacro-read-char)))
117 (edmacro-prefix-arg char c-u nil)))
118 ((eq key-symbol 'self-insert-command)
120 (if (and (>= key-last 32) (<= key-last 126))
122 (while (or (and (eq key-symbol
123 'self-insert-command)
127 (and (memq key-symbol
128 '(backward-delete-char
130 backward-delete-char-untabify))
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)))
137 (insert "\"" str "\"\n")
138 (edmacro-unread-chars key-str))
140 (edmacro-insert-string (char-to-string key-last))
142 ((and (eq key-symbol 'quoted-insert)
144 (insert "quoted-insert\n")
145 (let ((ch (edmacro-read-char))
147 (if (and (>= ch ?0) (<= ch ?7))
150 ch2 (edmacro-read-char))
152 (if (and (>= ch2 ?0) (<= ch2 ?7))
154 (setq ch (+ (* ch 8) (- ch2 ?0))
155 ch2 (edmacro-read-char))
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
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))
174 (let ((cust (get key-symbol 'edmacro-print)))
177 (insert (symbol-name key-symbol))
180 (edmacro-insert-string key-str)
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
189 ((memq (aref int 0) '(?b ?B ?D ?f ?F ?n
191 (edmacro-read-argument))
192 ((and (= (aref int 0) ?c)
195 (edmacro-insert-string
197 (edmacro-read-char)))
200 (edmacro-read-argument
207 (edmacro-insert-string key-str)
209 (edmacro-unread-chars key-str)))
212 (edmacro-read-argument)))
214 (edmacro-read-argument
215 obarray 'user-variable-p)))
216 (let ((nl (string-match "\n" int)))
218 (substring int (1+ nl))
220 (use-local-map save-map))))
222 (defun edmacro-prefix-arg (char c-u value)
224 (if (and (numberp value) (< value 0))
225 (setq sign -1 value (- 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)))
235 (cond (c-u (list c-u))
236 ((numberp value) (* value sign))
238 (edmacro-unread-chars char)))
240 (defun edmacro-insert-string (str)
242 (while (< i (length str))
243 (if (and (> (setq ch (aref str i)) 127)
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))))))
256 (if (or (= ch 34) (= ch 92))
257 (insert "\\" (char-to-string ch))
259 (while (and (< (setq i (1+ i)) (length str))
260 (>= (setq ch (aref str i)) 32)
261 (/= ch 34) (/= ch 92)
263 (insert (substring str j i))
265 (if (memq ch '(127 255))
266 (insert (format "\\%03o" ch))
267 (insert "\\M-" (char-to-string (- ch 128))))))
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))
274 (glob-str macro-str))
276 (setq loc-str (substring macro-str 0 loc)
277 loc (lookup-key map loc-str)))
283 (setq glob-str (substring macro-str 0 glob)
284 glob (lookup-key (current-global-map) glob-str)))
289 (if (> (length glob-str) (length loc-str))
290 (setq key-symbol glob
294 (setq key-last (and (> (length key-str) 0)
295 (logand (aref key-str (1- (length key-str))) 127)))
298 (defun edmacro-read-argument (&optional obarray pred) ;; currently ignored
301 (exec (eq key-symbol 'execute-extended-command))
304 (edmacro-lookup-key (current-global-map))
305 (or (and (eq key-symbol 'self-insert-command)
308 '(backward-delete-char
310 backward-delete-char-untabify))
312 (setq macro-str (substring macro-str (length key-str)))
313 (or (and (eq key-last 9)
315 (let ((comp (try-completion str obarray pred)))
317 (> (length comp) (length str))
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)))))
326 str (concat str key-str)
327 macro-str (substring macro-str (length key-str)))
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")
337 (edmacro-insert-string str)
339 (if (> (length str) 0)
342 (edmacro-insert-string str)
345 (defun edmacro-isearch-argument ()
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)
360 (not search-exit-option)
361 (and (/= ch 127) (>= ch 32))))
362 (if (and (eq ch search-quote-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
378 (setq str (concat str (char-to-string ch)))
379 (and (eq (edmacro-peek-char) ?\C-w)
381 (setq str (concat str "\C-w"))
382 (edmacro-read-char)))
383 (if (> (length str) 0)
386 (edmacro-insert-string str)
388 (edmacro-read-argument)
390 (edmacro-unread-chars ch))
391 (if (> (length str) 0)
394 (edmacro-insert-string str)
395 (insert "\\e\"\n")))))
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))
402 (setq macro-str (substring macro-str (length key-str)))))
404 (defun edmacro-peek-char ()
405 (and (> (length macro-str) 0)
408 (defun edmacro-read-char ()
409 (and (> (length macro-str) 0)
412 (setq macro-str (substring macro-str 1)))))
414 (defun edmacro-unread-chars (chars)
415 (and (integerp chars)
416 (setq chars (char-to-string chars)))
418 (setq macro-str (concat chars macro-str))))
420 (defun edmacro-dump (mac)
421 (set-mark-command nil)
423 (edmacro-print-macro mac (current-local-map)))
425 ;;; Parse a string of spelled-out keystrokes, as produced by key-description.
427 (defun edmacro-parse-keys (str)
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))
436 (if (and (> (length part) 2)
438 (= (aref part 0) ?M))
440 (setq part (substring part 2))
442 (if (and (> (length part) 4)
446 (= (aref part 3) ?-))
448 (setq part (concat "C-" (substring part 4)))
451 (or (cdr (assoc part '( ( "NUL" . "\0" )
460 ( "C-SPC" . "\0") )))
461 (and (equal part "REM")
462 (setq pos (or (string-match "\n" str pos)
465 (and (= (length part) 3)
468 (char-to-string (logand (aref part 2) 31)))
472 ;;; Parse a keyboard macro description in edmacro-print-macro's format.
474 (defun edmacro-read-macro (&optional map)
475 (or map (setq map (current-local-map)))
476 (let ((macro-str ""))
478 (skip-chars-forward " \t\n")
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))))
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 ")
496 (edmacro-append-chars (read (current-buffer)))
497 (if (< (current-column) 7)
499 ((looking-at "type ")
501 (edmacro-append-chars (read (current-buffer)))
502 (if (< (current-column) 5)
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)
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)))
516 (error "Not an Emacs command"))
518 (string-match "\\`#" arg)
519 (error "Unexpected argument to command"))
521 (or (where-is-internal func map t)
522 (where-is-internal func (current-global-map) t))))
524 (edmacro-append-chars keys)
525 (edmacro-append-chars (concat "\ex"
528 (t (error "Syntax error")))
532 (defun edmacro-append-chars (chars)
533 (setq macro-str (concat macro-str chars)))
535 (defun edmacro-match-string (n)
536 (if (match-beginning n)
537 (buffer-substring (match-beginning n) (match-end n))
540 (defun edmacro-get-interactive (func)
542 (let ((cust (get func 'edmacro-interactive)))
545 (edmacro-get-interactive (symbol-function func))))
546 (or (and (eq (car-safe func) 'lambda)
547 (let ((int (if (consp (nth 2 func))
550 (and (eq (car-safe int) 'interactive)
551 (stringp (nth 1 int))
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")
570 ;;; Think about kbd-macro-query
572 ;;; Edit a keyboard macro in another buffer.
573 ;;; (Prefix argument is currently ignored.)
575 (defun edmacro-edit-macro (mac repl &optional prefix buffer hook arg)
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*"))))
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)
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))
600 (set-buffer-modified-p nil)
601 (message "Formatting keyboard macro...done")
602 (run-hooks 'edmacro-format-hook)))
604 (defun edmacro-finish-edit ()
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))
611 (error "This command is valid only in buffers created by `edit-kbd-macro'."))
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)
622 (message "Compiling keyboard macro...")
623 (let ((mac (edmacro-read-macro
624 (and (buffer-name edmacro-original-buffer)
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")))
634 (funcall hook arg))))
636 (defun edmacro-mode ()
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.
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
642 \"type\" commands. When you press \\[edmacro-finish-edit], edmacro converts each command
643 back into a suitable keystroke sequence; \"type\" commands are converted
644 directly back into keystrokes."
646 (error "This mode can be enabled only by `edit-kbd-macro' or `edit-last-kbd-macro'."))
647 (put 'edmacro-mode 'mode-class 'special)
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))
653 ;;; edmacro.el ends here