aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman1993-09-21 03:44:04 +0000
committerRichard M. Stallman1993-09-21 03:44:04 +0000
commit629d4dcd2a184da6a0b246d31f152a84327db51a (patch)
tree0b9251f097f1aef8a138814719c4531015bc65bb
parent6366e5dff00f1d540506c1d65201d3d006c7b8b6 (diff)
downloademacs-629d4dcd2a184da6a0b246d31f152a84327db51a.tar.gz
emacs-629d4dcd2a184da6a0b246d31f152a84327db51a.zip
Total rewrite by Gillespie.
Diffstat
-rw-r--r--lisp/edmacro.el1239
1 files changed, 640 insertions, 599 deletions
diff --git a/lisp/edmacro.el b/lisp/edmacro.el
index cb9f7739f6d..78e7406b645 100644
--- a/lisp/edmacro.el
+++ b/lisp/edmacro.el
@@ -1,10 +1,10 @@
1;;; edmacro.el --- keyboard macro editor 1;;; edmacro.el --- keyboard macro editor
2 2
3;; Copyright (C) 1990 Free Software Foundation, Inc. 3;; Copyright (C) 1993 Free Software Foundation, Inc.
4 4
5;; Author: Dave Gillespie <daveg@csvax.caltech.edu> 5;; Author: Dave Gillespie <daveg@synaptics.com>
6;; Maintainer: FSF 6;; Maintainer: Dave Gillespie <daveg@synaptics.com>
7;; Version: 1.02 7;; Version: 2.01
8;; Keywords: abbrev 8;; Keywords: abbrev
9 9
10;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
@@ -25,629 +25,670 @@
25 25
26;;; Commentary: 26;;; Commentary:
27 27
28;; To use, type `M-x edit-last-kbd-macro' to edit the most recently 28;;; Usage:
29;; defined keyboard macro. If you have used `M-x name-last-kbd-macro' 29;;
30;; to give a keyboard macro a name, type `M-x edit-kbd-macro' to edit 30;; The `C-x C-k' (`edit-kbd-macro') command edits a keyboard macro
31;; the macro by name. When you are done editing, type `C-c C-c' to 31;; in a special buffer. It prompts you to type a key sequence,
32;; record your changes back into the original keyboard macro. 32;; which should be one of:
33;;
34;; * RET or `C-x e' (call-last-kbd-macro), to edit the most
35;; recently defined keyboard macro.
36;;
37;; * `M-x' followed by a command name, to edit a named command
38;; whose definition is a keyboard macro.
39;;
40;; * `C-h l' (view-lossage), to edit the 100 most recent keystrokes
41;; and install them as the "current" macro.
42;;
43;; * any key sequence whose definition is a keyboard macro.
44;;
45;; This file includes a version of `insert-kbd-macro' that uses the
46;; more readable format defined by these routines.
47;;
48;; Also, the `read-kbd-macro' command parses the region as
49;; a keyboard macro, and installs it as the "current" macro.
50;; This and `format-kbd-macro' can also be called directly as
51;; Lisp functions.
52
53;; Type `C-h m', or see the documentation for `edmacro-mode' below,
54;; for information about the format of written keyboard macros.
55
56;; `edit-kbd-macro' formats the macro with one command per line,
57;; including the command names as comments on the right. If the
58;; formatter gets confused about which keymap was used for the
59;; characters, the command-name comments will be wrong but that
60;; won't hurt anything.
61
62;; With a prefix argument, `edit-kbd-macro' will format the
63;; macro in a more concise way that omits the comments.
64
65;; This package requires GNU Emacs 19 or later, and daveg's CL
66;; package 2.02 or later. (CL 2.02 comes standard starting with
67;; Emacs 19.18.) This package does not work with Emacs 18 or
68;; Lucid Emacs.
33 69
34;;; Code: 70;;; Code:
35 71
72(require 'cl)
73
36;;; The user-level commands for editing macros. 74;;; The user-level commands for editing macros.
37 75
76;;;###autoload (define-key ctl-x-map "\C-k" 'edit-kbd-macro)
77(define-key ctl-x-map "\C-k" 'edit-kbd-macro)
78
79;;;###autoload
80(defvar edmacro-eight-bits nil
81 "*Non-nil if edit-kbd-macro should leave 8-bit characters intact.
82Default nil means to write characters above \\177 in octal notation.")
83
84(defvar edmacro-mode-map nil)
85(unless edmacro-mode-map
86 (setq edmacro-mode-map (make-sparse-keymap))
87 (define-key edmacro-mode-map "\C-c\C-c" 'edmacro-finish-edit)
88 (define-key edmacro-mode-map "\C-c\C-q" 'edmacro-insert-key))
89
38;;;###autoload 90;;;###autoload
39(defun edit-last-kbd-macro (&optional prefix buffer hook) 91(defun edit-kbd-macro (keys &optional prefix finish-hook store-hook)
92 "Edit a keyboard macro.
93At the prompt, type any key sequence which is bound to a keyboard macro.
94Or, type `C-x e' or RET to edit the last keyboard macro, `C-h l' to edit
95the last 100 keystrokes as a keyboard macro, or `M-x' to edit a macro by
96its command name.
97With a prefix argument, format the macro in a more concise way."
98 (interactive "kKeyboard macro to edit (C-x e, M-x, C-h l, or keys): \nP")
99 (when keys
100 (let ((cmd (if (arrayp keys) (key-binding keys) keys))
101 (mac nil))
102 (cond (store-hook
103 (setq mac keys)
104 (setq cmd nil))
105 ((or (eq cmd 'call-last-kbd-macro)
106 (member keys '("\r" [return])))
107 (or last-kbd-macro
108 (y-or-n-p "No keyboard macro defined. Create one? ")
109 (keyboard-quit))
110 (setq mac (or last-kbd-macro ""))
111 (setq cmd 'last-kbd-macro))
112 ((eq cmd 'execute-extended-command)
113 (setq cmd (read-command "Name of keyboard macro to edit: "))
114 (setq mac (symbol-function cmd)))
115 ((eq cmd 'view-lossage)
116 (setq mac (recent-keys))
117 (setq cmd 'last-kbd-macro))
118 ((symbolp cmd)
119 (setq mac (symbol-function cmd)))
120 (t
121 (setq mac cmd)
122 (setq cmd nil)))
123 (unless (arrayp mac)
124 (error "Not a keyboard macro: %s" cmd))
125 (message "Formatting keyboard macro...")
126 (let* ((oldbuf (current-buffer))
127 (mmac (edmacro-fix-menu-commands mac))
128 (fmt (edmacro-format-keys mmac 1))
129 (fmtv (edmacro-format-keys mmac (not prefix)))
130 (buf (get-buffer-create "*Edit Macro*")))
131 (message "Formatting keyboard macro...done")
132 (switch-to-buffer buf)
133 (kill-all-local-variables)
134 (use-local-map edmacro-mode-map)
135 (setq buffer-read-only nil)
136 (setq major-mode 'edmacro-mode)
137 (setq mode-name "Edit Macro")
138 (set (make-local-variable 'edmacro-original-buffer) oldbuf)
139 (set (make-local-variable 'edmacro-finish-hook) finish-hook)
140 (set (make-local-variable 'edmacro-store-hook) store-hook)
141 (erase-buffer)
142 (insert ";; Keyboard Macro Editor. Press C-c C-c to finish; "
143 "press C-x k RET to cancel.\n")
144 (insert ";; Original keys: " fmt "\n")
145 (unless store-hook
146 (insert "\nCommand: " (if cmd (symbol-name cmd) "none") "\n")
147 (let ((keys (where-is-internal (or cmd mac) nil)))
148 (if keys
149 (while keys
150 (insert "Key: " (edmacro-format-keys (pop keys) 1) "\n"))
151 (insert "Key: none\n"))))
152 (insert "\nMacro:\n\n")
153 (save-excursion
154 (insert fmtv "\n"))
155 (recenter '(4))
156 (when (eq mac mmac)
157 (set-buffer-modified-p nil))
158 (run-hooks 'edmacro-format-hook)))))
159
160;;; The next two commands are provided for convenience and backward
161;;; compatibility.
162
163;;;###autoload
164(defun edit-last-kbd-macro (&optional prefix)
40 "Edit the most recently defined keyboard macro." 165 "Edit the most recently defined keyboard macro."
41 (interactive "P") 166 (interactive "P")
42 (edmacro-edit-macro last-kbd-macro 167 (edit-kbd-macro 'call-last-kbd-macro prefix))
43 (function (lambda (x arg) (setq last-kbd-macro x)))
44 prefix buffer hook))
45 168
46;;;###autoload 169;;;###autoload
47(defun edit-kbd-macro (cmd &optional prefix buffer hook in-hook out-hook) 170(defun edit-named-kbd-macro (&optional prefix)
48 "Edit a keyboard macro which has been given a name by `name-last-kbd-macro'. 171 "Edit a keyboard macro which has been given a name by `name-last-kbd-macro'."
49\(See also `edit-last-kbd-macro'.)" 172 (interactive "P")
50 (interactive "CCommand name: \nP") 173 (edit-kbd-macro 'execute-extended-command prefix))
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 174
62;;;###autoload 175;;;###autoload
63(defun read-kbd-macro (start end) 176(defun read-kbd-macro (start &optional end)
64 "Read the region as a keyboard macro definition. 177 "Read the region as a keyboard macro definition.
65The region is interpreted as spelled-out keystrokes, e.g., \"M-x abc RET\". 178The region is interpreted as spelled-out keystrokes, e.g., \"M-x abc RET\".
179See documentation for `edmacro-mode' for details.
180Leading/trailing \"C-x (\" and \"C-x )\" in the text are allowed and ignored.
66The resulting macro is installed as the \"current\" keyboard macro. 181The resulting macro is installed as the \"current\" keyboard macro.
67 182
68Symbols: RET, SPC, TAB, DEL, LFD, NUL; C-key; M-key. (Must be uppercase.) 183In Lisp, may also be called with a single STRING argument in which case
69 REM marks the rest of a line as a comment. 184the result is returned rather than being installed as the current macro.
70 Whitespace is ignored; other characters are copied into the macro." 185The result will be a string if possible, otherwise an event vector.
186Second argument NEED-VECTOR means to return an event vector always."
71 (interactive "r") 187 (interactive "r")
72 (setq last-kbd-macro (edmacro-parse-keys (buffer-substring start end))) 188 (if (stringp start)
73 (if (and (string-match "\\`\C-x(" last-kbd-macro) 189 (edmacro-parse-keys start end)
74 (string-match "\C-x)\\'" last-kbd-macro)) 190 (setq last-kbd-macro (edmacro-parse-keys (buffer-substring start end)))))
75 (setq last-kbd-macro (substring last-kbd-macro 2 -2))))
76
77;;; Formatting a keyboard macro as human-readable text.
78 191
79(defun edmacro-print-macro (macro-str local-map) 192;;;###autoload
80 (let ((save-map (current-local-map)) 193(defun format-kbd-macro (&optional macro verbose)
81 (print-escape-newlines t) 194 "Return the keyboard macro MACRO as a human-readable string.
82 key-symbol key-str key-last prefix-arg this-prefix) 195This string is suitable for passing to `read-kbd-macro'.
83 (unwind-protect 196Second argument VERBOSE means to put one command per line with comments.
84 (progn 197If VERBOSE is `1', put everything on one line. If VERBOSE is omitted
85 (use-local-map local-map) 198or nil, use a compact 80-column format."
86 (while (edmacro-peek-char) 199 (and macro (symbolp macro) (setq macro (symbol-function macro)))
87 (edmacro-read-key) 200 (edmacro-format-keys (or macro last-kbd-macro) verbose))
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 201
472;;; Parse a keyboard macro description in edmacro-print-macro's format. 202;;; Commands for *Edit Macro* buffer.
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 203
604(defun edmacro-finish-edit () 204(defun edmacro-finish-edit ()
605 (interactive) 205 (interactive)
606 (or (and (boundp 'edmacro-original-buffer) 206 (unless (eq major-mode 'edmacro-mode)
607 (boundp 'edmacro-replace-function) 207 (error
608 (boundp 'edmacro-replace-argument) 208 "This command is valid only in buffers created by `edit-kbd-macro'"))
609 (boundp 'edmacro-finish-hook) 209 (run-hooks 'edmacro-finish-hook)
610 (eq major-mode 'edmacro-mode)) 210 (let ((cmd nil) (keys nil) (no-keys nil)
611 (error "This command is valid only in buffers created by `edit-kbd-macro'.")) 211 (top (point-min)))
612 (let ((buf (current-buffer)) 212 (goto-char top)
613 (str (buffer-string)) 213 (let ((case-fold-search nil))
614 (func edmacro-replace-function) 214 (while (cond ((looking-at "[ \t]*\\($\\|;;\\|REM[ \t\n]\\)")
615 (arg edmacro-replace-argument) 215 t)
616 (hook edmacro-finish-hook)) 216 ((looking-at "Command:[ \t]*\\([^ \t\n]*\\)[ \t]*$")
617 (goto-char (point-min)) 217 (when edmacro-store-hook
618 (run-hooks 'edmacro-compile-hook) 218 (error "\"Command\" line not allowed in this context"))
619 (and (buffer-modified-p) 219 (let ((str (buffer-substring (match-beginning 1)
620 func 220 (match-end 1))))
621 (progn 221 (unless (equal str "")
622 (message "Compiling keyboard macro...") 222 (setq cmd (and (not (equalp str "none"))
623 (let ((mac (edmacro-read-macro 223 (intern str)))
624 (and (buffer-name edmacro-original-buffer) 224 (and (fboundp cmd) (not (arrayp (symbol-function cmd)))
625 (save-excursion 225 (not (y-or-n-p
626 (set-buffer edmacro-original-buffer) 226 (format "Command %s is already defined; %s"
627 (current-local-map)))))) 227 cmd "proceed? ")))
628 (and (buffer-name edmacro-original-buffer) 228 (keyboard-quit))))
629 (switch-to-buffer edmacro-original-buffer)) 229 t)
630 (funcall func mac arg)) 230 ((looking-at "Key:\\(.*\\)$")
631 (message "Compiling keyboard macro...done"))) 231 (when edmacro-store-hook
632 (kill-buffer buf) 232 (error "\"Key\" line not allowed in this context"))
633 (if hook 233 (let ((key (edmacro-parse-keys
634 (funcall hook arg)))) 234 (buffer-substring (match-beginning 1)
235 (match-end 1)))))
236 (unless (equal key "")
237 (if (equalp key "none")
238 (setq no-keys t)
239 (push key keys)
240 (let ((b (key-binding key)))
241 (and b (commandp b) (not (arrayp b))
242 (or (not (fboundp b))
243 (not (arrayp (symbol-function b))))
244 (not (y-or-n-p
245 (format "Key %s is already defined; %s"
246 (edmacro-format-keys key 1)
247 "proceed? ")))
248 (keyboard-quit))))))
249 t)
250 ((looking-at "Macro:[ \t\n]*")
251 (goto-char (match-end 0))
252 nil)
253 ((eobp) nil)
254 (t (error "Expected a `Macro:' line")))
255 (forward-line 1))
256 (setq top (point)))
257 (let* ((buf (current-buffer))
258 (str (buffer-substring top (point-max)))
259 (modp (buffer-modified-p))
260 (obuf edmacro-original-buffer)
261 (store-hook edmacro-store-hook)
262 (finish-hook edmacro-finish-hook))
263 (unless (or cmd keys store-hook (equal str ""))
264 (error "No command name or keys specified"))
265 (when modp
266 (when (buffer-name obuf)
267 (set-buffer obuf))
268 (message "Compiling keyboard macro...")
269 (let ((mac (edmacro-parse-keys str)))
270 (message "Compiling keyboard macro...done")
271 (if store-hook
272 (funcall store-hook mac)
273 (when (eq cmd 'last-kbd-macro)
274 (setq last-kbd-macro (and (> (length mac) 0) mac))
275 (setq cmd nil))
276 (when cmd
277 (if (= (length mac) 0)
278 (fmakunbound cmd)
279 (fset cmd mac)))
280 (if no-keys
281 (when cmd
282 (loop for key in (where-is-internal cmd nil) do
283 (global-unset-key key)))
284 (when keys
285 (if (= (length mac) 0)
286 (loop for key in keys do (global-unset-key key))
287 (loop for key in keys do
288 (global-set-key key (or cmd mac)))))))))
289 (kill-buffer buf)
290 (when (buffer-name obuf)
291 (switch-to-buffer obuf))
292 (when finish-hook
293 (funcall finish-hook)))))
294
295(defun edmacro-insert-key (key)
296 "Insert the written name of a key in the buffer."
297 (interactive "kKey to insert: ")
298 (if (bolp)
299 (insert (edmacro-format-keys key t) "\n")
300 (insert (edmacro-format-keys key) " ")))
635 301
636(defun edmacro-mode () 302(defun edmacro-mode ()
637 "\\<edmacro-mode-map>Keyboard Macro Editing mode. Press \\[edmacro-finish-edit] to save and exit. 303 "\\<edmacro-mode-map>Keyboard Macro Editing mode. Press
304\\[edmacro-finish-edit] to save and exit.
638To abort the edit, just kill this buffer with \\[kill-buffer] RET. 305To abort the edit, just kill this buffer with \\[kill-buffer] RET.
639 306
640The keyboard macro is represented as a series of M-x style command names. 307Press \\[edmacro-insert-key] to insert the name of any key by typing the key.
641Keystrokes which do not correspond to simple M-x commands are written as 308
642\"type\" commands. When you press \\[edmacro-finish-edit], edmacro converts each command 309The editing buffer contains a \"Command:\" line and any number of
643back into a suitable keystroke sequence; \"type\" commands are converted 310\"Key:\" lines at the top. These are followed by a \"Macro:\" line
644directly back into keystrokes." 311and the macro itself as spelled-out keystrokes: `C-x C-f foo RET'.
312
313The \"Command:\" line specifies the command name to which the macro
314is bound, or \"none\" for no command name. Write \"last-kbd-macro\"
315to refer to the current keyboard macro (as used by \\[call-last-kbd-macro]).
316
317The \"Key:\" lines specify key sequences to which the macro is bound,
318or \"none\" for no key bindings.
319
320You can edit these lines to change the places where the new macro
321is stored.
322
323
324Format of keyboard macros during editing:
325
326Text is divided into \"words\" separated by whitespace. Except for
327the words described below, the characters of each word go directly
328as characters of the macro. The whitespace that separates words
329is ignored. Whitespace in the macro must be written explicitly,
330as in \"foo SPC bar RET\".
331
332 * The special words RET, SPC, TAB, DEL, LFD, ESC, and NUL represent
333 special control characters. The words must be written in uppercase.
334
335 * A word in angle brackets, e.g., <return>, <down>, or <f1>, represents
336 a function key. (Note that in the standard configuration, the
337 function key <return> and the control key RET are synonymous.)
338 You can use angle brackets on the words RET, SPC, etc., but they
339 are not required there.
340
341 * Keys can be written by their ASCII code, using a backslash followed
342 by up to six octal digits. This is the only way to represent keys
343 with codes above \\377.
344
345 * One or more prefixes M- (meta), C- (control), S- (shift), A- (alt),
346 H- (hyper), and s- (super) may precede a character or key notation.
347 For function keys, the prefixes may go inside or outside of the
348 brackets: C-<down> = <C-down>. The prefixes may be written in
349 any order: M-C-x = C-M-x.
350
351 Prefixes are not allowed on multi-key words, e.g., C-abc, except
352 that the Meta prefix is allowed on a sequence of digits and optional
353 minus sign: M--123 = M-- M-1 M-2 M-3.
354
355 * The `^' notation for control characters also works: ^M = C-m.
356
357 * Double angle brackets enclose command names: <<next-line>> is
358 shorthand for M-x next-line RET.
359
360 * Finally, REM or ;; causes the rest of the line to be ignored as a
361 comment.
362
363Any word may be prefixed by a multiplier in the form of a decimal
364number and `*': 3*<right> = <right> <right> <right>, and
36510*foo = foofoofoofoofoofoofoofoofoofoo.
366
367Multiple text keys can normally be strung together to form a word,
368but you may need to add whitespace if the word would look like one
369of the above notations: `; ; ;' is a keyboard macro with three
370semicolons, but `;;;' is a comment. Likewise, `\\ 1 2 3' is four
371keys but `\\123' is a single key written in octal, and `< right >'
372is seven keys but `<right>' is a single function key. When in
373doubt, use whitespace."
645 (interactive) 374 (interactive)
646 (error "This mode can be enabled only by `edit-kbd-macro' or `edit-last-kbd-macro'.")) 375 (error "This mode can be enabled only by `edit-kbd-macro'"))
647(put 'edmacro-mode 'mode-class 'special) 376(put 'edmacro-mode 'mode-class 'special)
377
378;;; Formatting a keyboard macro as human-readable text.
648 379
649(if (boundp 'edmacro-mode-map) () 380(defun edmacro-format-keys (macro &optional verbose)
650 (setq edmacro-mode-map (make-sparse-keymap)) 381 (setq macro (edmacro-fix-menu-commands macro))
651 (define-key edmacro-mode-map "\C-c\C-c" 'edmacro-finish-edit)) 382 (let* ((maps (append (current-minor-mode-maps)
383 (list (current-local-map) (current-global-map))))
384 (pkeys '(end-macro ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?- ?\C-u
385 ?\M-- ?\M-0 ?\M-1 ?\M-2 ?\M-3 ?\M-4 ?\M-5 ?\M-6
386 ?\M-7 ?\M-8 ?\M-9))
387 (mdigs (nthcdr 13 pkeys))
388 (maxkey (if edmacro-eight-bits 255 127))
389 (case-fold-search nil)
390 (res-words '("NUL" "TAB" "LFD" "RET" "ESC" "SPC" "DEL" "REM"))
391 (rest-mac (vconcat macro [end-macro]))
392 (res "")
393 (len 0)
394 (one-line (eq verbose 1)))
395 (if one-line (setq verbose nil))
396 (when (stringp macro)
397 (loop for i below (length macro) do
398 (when (>= (aref rest-mac i) 128)
399 (incf (aref rest-mac i) (- (lsh 1 23) 128)))))
400 (while (not (eq (aref rest-mac 0) 'end-macro))
401 (let* ((prefix
402 (or (and (integerp (aref rest-mac 0))
403 (memq (aref rest-mac 0) mdigs)
404 (memq (key-binding (subseq rest-mac 0 1))
405 '(digit-argument negative-argument))
406 (let ((i 1))
407 (while (memq (aref rest-mac i) (cdr mdigs))
408 (incf i))
409 (and (not (memq (aref rest-mac i) pkeys))
410 (prog1 (concat "M-" (subseq rest-mac 0 i) " ")
411 (callf subseq rest-mac i)))))
412 (and (eq (aref rest-mac 0) ?\C-u)
413 (eq (key-binding [?\C-u]) 'universal-argument)
414 (let ((i 1))
415 (while (eq (aref rest-mac i) ?\C-u)
416 (incf i))
417 (and (not (memq (aref rest-mac i) pkeys))
418 (prog1 (loop repeat i concat "C-u ")
419 (callf subseq rest-mac i)))))
420 (and (eq (aref rest-mac 0) ?\C-u)
421 (eq (key-binding [?\C-u]) 'universal-argument)
422 (let ((i 1))
423 (when (eq (aref rest-mac i) ?-)
424 (incf i))
425 (while (memq (aref rest-mac i)
426 '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
427 (incf i))
428 (and (not (memq (aref rest-mac i) pkeys))
429 (prog1 (concat "C-u " (subseq rest-mac 1 i) " ")
430 (callf subseq rest-mac i)))))))
431 (bind-len (apply 'max 1
432 (loop for map in maps
433 for b = (lookup-key map rest-mac)
434 when b collect b)))
435 (key (subseq rest-mac 0 bind-len))
436 (fkey nil) tlen tkey
437 (bind (or (loop for map in maps for b = (lookup-key map key)
438 thereis (and (not (integerp b)) b))
439 (and (setq fkey (lookup-key function-key-map rest-mac))
440 (setq tlen fkey tkey (subseq rest-mac 0 tlen)
441 fkey (lookup-key function-key-map tkey))
442 (loop for map in maps
443 for b = (lookup-key map fkey)
444 when (and (not (integerp b)) b)
445 do (setq bind-len tlen key tkey)
446 and return b
447 finally do (setq fkey nil)))))
448 (first (aref key 0))
449 (text (loop for i from bind-len below (length rest-mac)
450 for ch = (aref rest-mac i)
451 while (and (integerp ch)
452 (> ch 32) (< ch maxkey) (/= ch 92)
453 (eq (key-binding (char-to-string ch))
454 'self-insert-command)
455 (or (> i (- (length rest-mac) 2))
456 (not (eq ch (aref rest-mac (+ i 1))))
457 (not (eq ch (aref rest-mac (+ i 2))))))
458 finally return i))
459 desc)
460 (if (stringp bind) (setq bind nil))
461 (cond ((and (eq bind 'self-insert-command) (not prefix)
462 (> text 1) (integerp first)
463 (> first 32) (<= first maxkey) (/= first 92)
464 (progn
465 (if (> text 30) (setq text 30))
466 (setq desc (concat (subseq rest-mac 0 text)))
467 (when (string-match "^[ACHMsS]-." desc)
468 (setq text 2)
469 (callf substring desc 0 2))
470 (not (string-match
471 "^;;\\|^<.*>$\\|^\\\\[0-9]+$\\|^[0-9]+\\*."
472 desc))))
473 (when (or (string-match "^\\^.$" desc)
474 (member desc res-words))
475 (setq desc (mapconcat 'char-to-string desc " ")))
476 (when verbose
477 (setq bind (format "%s * %d" bind text)))
478 (setq bind-len text))
479 ((and (eq bind 'execute-extended-command)
480 (> text bind-len)
481 (memq (aref rest-mac text) '(return 13))
482 (progn
483 (setq desc (concat (subseq rest-mac bind-len text)))
484 (commandp (intern-soft desc))))
485 (if (commandp (intern-soft desc)) (setq bind desc))
486 (setq desc (format "<<%s>>" desc))
487 (setq bind-len (1+ text)))
488 (t
489 (setq desc (mapconcat
490 (function
491 (lambda (ch)
492 (cond
493 ((integerp ch)
494 (concat
495 (loop for pf across "ACHMsS"
496 for bit in '(18 22 20 23 19 21)
497 when (/= (logand ch (lsh 1 bit)) 0)
498 concat (format "%c-" pf))
499 (let ((ch2 (logand ch (1- (lsh 1 18)))))
500 (cond ((<= ch2 32)
501 (case ch2
502 (0 "NUL") (9 "TAB") (10 "LFD")
503 (13 "RET") (27 "ESC") (32 "SPC")
504 (t
505 (format "C-%c"
506 (+ (if (<= ch2 26) 96 64)
507 ch2)))))
508 ((= ch2 127) "DEL")
509 ((<= ch2 maxkey) (char-to-string ch2))
510 (t (format "\\%o" ch2))))))
511 ((symbolp ch)
512 (format "<%s>" ch))
513 (t
514 (error "Unrecognized item in macro: %s" ch)))))
515 (or fkey key) " "))))
516 (if prefix (setq desc (concat prefix desc)))
517 (unless (string-match " " desc)
518 (let ((times 1) (pos bind-len))
519 (while (not (mismatch rest-mac rest-mac
520 :end1 bind-len :start2 pos
521 :end2 (+ bind-len pos)))
522 (incf times)
523 (incf pos bind-len))
524 (when (> times 1)
525 (setq desc (format "%d*%s" times desc))
526 (setq bind-len (* bind-len times)))))
527 (setq rest-mac (subseq rest-mac bind-len))
528 (if verbose
529 (progn
530 (unless (equal res "") (callf concat res "\n"))
531 (callf concat res desc)
532 (when (and bind (or (stringp bind) (symbolp bind)))
533 (callf concat res
534 (make-string (max (- 3 (/ (length desc) 8)) 1) 9)
535 ";; " (if (stringp bind) bind (symbol-name bind))))
536 (setq len 0))
537 (if (and (> (+ len (length desc) 2) 72) (not one-line))
538 (progn
539 (callf concat res "\n ")
540 (setq len 1))
541 (unless (equal res "")
542 (callf concat res " ")
543 (incf len)))
544 (callf concat res desc)
545 (incf len (length desc)))))
546 res))
547
548(defun edmacro-fix-menu-commands (macro)
549 (when (vectorp macro)
550 (let ((i 0) ev)
551 (while (< i (length macro))
552 (when (consp (setq ev (aref macro i)))
553 (cond ((equal (cadadr ev) '(menu-bar))
554 (setq macro (vconcat (subseq macro 0 i)
555 (vector 'menu-bar (car ev))
556 (subseq macro (1+ i))))
557 (incf i))
558 ;; It would be nice to do pop-up menus, too, but not enough
559 ;; info is recorded in macros to make this possible.
560 (t
561 (error "Macros with mouse clicks are not %s"
562 "supported by this command"))))
563 (incf i))))
564 macro)
565
566;;; Parsing a human-readable keyboard macro.
567
568(defun edmacro-parse-keys (string &optional need-vector)
569 (let ((case-fold-search nil)
570 (pos 0)
571 (res []))
572 (while (and (< pos (length string))
573 (string-match "[^ \t\n\f]+" string pos))
574 (let ((word (substring string (match-beginning 0) (match-end 0)))
575 (key nil)
576 (times 1))
577 (setq pos (match-end 0))
578 (when (string-match "\\([0-9]+\\)\\*." word)
579 (setq times (string-to-int (substring word 0 (match-end 1))))
580 (setq word (substring word (1+ (match-end 1)))))
581 (cond ((string-match "^<<.+>>$" word)
582 (setq key (vconcat (if (eq (key-binding [?\M-x])
583 'execute-extended-command)
584 [?\M-x]
585 (or (car (where-is-internal
586 'execute-extended-command))
587 [?\M-x]))
588 (substring word 2 -2) "\r")))
589 ((and (string-match "^\\(\\([ACHMsS]-\\)*\\)<\\(.+\\)>$" word)
590 (progn
591 (setq word (concat (substring word (match-beginning 1)
592 (match-end 1))
593 (substring word (match-beginning 3)
594 (match-end 3))))
595 (not (string-match
596 "\\<\\(NUL\\|RET\\|LFD\\|ESC\\|SPC\\|DEL\\)$"
597 word))))
598 (setq key (list (intern word))))
599 ((or (equal word "REM") (string-match "^;;" word))
600 (setq pos (string-match "$" string pos)))
601 (t
602 (let ((orig-word word) (prefix 0) (bits 0))
603 (while (string-match "^[ACHMsS]-." word)
604 (incf bits (lsh 1 (cdr (assq (aref word 0)
605 '((?A . 18) (?C . 22)
606 (?H . 20) (?M . 23)
607 (?s . 19) (?S . 21))))))
608 (incf prefix 2)
609 (callf substring word 2))
610 (when (string-match "^\\^.$" word)
611 (incf bits (lsh 1 22))
612 (incf prefix)
613 (callf substring word 1))
614 (let ((found (assoc word '(("NUL" . "\0") ("RET" . "\r")
615 ("LFD" . "\n") ("TAB" . "\t")
616 ("ESC" . "\e") ("SPC" . " ")
617 ("DEL" . "\177")))))
618 (when found (setq word (cdr found))))
619 (when (string-match "^\\\\[0-7]+$" word)
620 (loop for ch across word
621 for n = 0 then (+ (* n 8) ch -48)
622 finally do (setq word (vector n))))
623 (cond ((= bits 0)
624 (setq key word))
625 ((and (= bits (lsh 1 23)) (stringp word)
626 (string-match "^-?[0-9]+$" word))
627 (setq key (loop for x across word collect (+ x bits))))
628 ((/= (length word) 1)
629 (error "%s must prefix a single character, not %s"
630 (substring orig-word 0 prefix) word))
631 ((and (/= (logand bits (lsh 1 22)) 0) (stringp word)
632 (string-match "[@-_.a-z?]" word))
633 (setq key (list (+ bits (- (lsh 1 22))
634 (if (equal word "?") 127
635 (logand (aref word 0) 31))))))
636 (t
637 (setq key (list (+ bits (aref word 0)))))))))
638 (when key
639 (loop repeat times do (callf vconcat res key)))))
640 (when (and (>= (length res) 4)
641 (eq (aref res 0) ?\C-x)
642 (eq (aref res 1) ?\()
643 (eq (aref res (- (length res) 2)) ?\C-x)
644 (eq (aref res (- (length res) 1)) ?\)))
645 (setq res (subseq res 2 -2)))
646 (if (and (not need-vector)
647 (loop for ch across res
648 always (and (integerp ch)
649 (let ((ch2 (logand ch (lognot (lsh 1 23)))))
650 (and (>= ch2 0) (<= ch2 127))))))
651 (concat (loop for ch across res
652 collect (if (= (logand ch (lsh 1 23)) 0)
653 ch (+ ch 128))))
654 res)))
655
656;;; The following probably ought to go in macros.el:
657
658;;;###autoload
659(defun insert-kbd-macro (macroname &optional keys)
660 "Insert in buffer the definition of kbd macro NAME, as Lisp code.
661Optional second arg KEYS means also record the keys it is on
662\(this is the prefix argument, when calling interactively).
663
664This Lisp code will, when executed, define the kbd macro with the same
665definition it has now. If you say to record the keys, the Lisp code
666will also rebind those keys to the macro. Only global key bindings
667are recorded since executing this Lisp code always makes global
668bindings.
669
670To save a kbd macro, visit a file of Lisp code such as your `~/.emacs',
671use this command, and then save the file."
672 (interactive "CInsert kbd macro (name): \nP")
673 (let (definition)
674 (if (string= (symbol-name macroname) "")
675 (progn
676 (setq definition (format-kbd-macro))
677 (insert "(setq last-kbd-macro"))
678 (setq definition (format-kbd-macro macroname))
679 (insert (format "(defalias '%s" macroname)))
680 (if (> (length definition) 50)
681 (insert " (read-kbd-macro\n")
682 (insert "\n (read-kbd-macro "))
683 (prin1 definition (current-buffer))
684 (insert "))\n")
685 (if keys
686 (let ((keys (where-is-internal macroname nil)))
687 (while keys
688 (insert (format "(global-set-key %S '%s)\n" (car keys) macroname))
689 (setq keys (cdr keys)))))))
690
691(provide 'edmacro)
652 692
653;;; edmacro.el ends here 693;;; edmacro.el ends here
694
generated by cgit v1.2.1 (git 2.18.0) at 2026-01-29 23:44:05 +0000