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