1 ;;; edmacro.el --- keyboard macro editor
3 ;; Copyright (C) 1993-1994, 2001-2011 Free Software Foundation, Inc.
5 ;; Author: Dave Gillespie <daveg@synaptics.com>
6 ;; Maintainer: Dave Gillespie <daveg@synaptics.com>
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 3 of the License, or
15 ;; (at your option) any later version.
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. If not, see <http://www.gnu.org/licenses/>.
29 ;; The `C-x C-k e' (`edit-kbd-macro') command edits a keyboard macro
30 ;; in a special buffer. It prompts you to type a key sequence,
31 ;; which should be one of:
33 ;; * RET or `C-x e' (call-last-kbd-macro), to edit the most
34 ;; recently defined keyboard macro.
36 ;; * `M-x' followed by a command name, to edit a named command
37 ;; whose definition is a keyboard macro.
39 ;; * `C-h l' (view-lossage), to edit the 300 most recent keystrokes
40 ;; and install them as the "current" macro.
42 ;; * any key sequence whose definition is a keyboard macro.
44 ;; This file includes a version of `insert-kbd-macro' that uses the
45 ;; more readable format defined by these routines.
47 ;; Also, the `read-kbd-macro' command parses the region as
48 ;; a keyboard macro, and installs it as the "current" macro.
49 ;; This and `format-kbd-macro' can also be called directly as
52 ;; Type `C-h m', or see the documentation for `edmacro-mode' below,
53 ;; for information about the format of written keyboard macros.
55 ;; `edit-kbd-macro' formats the macro with one command per line,
56 ;; including the command names as comments on the right. If the
57 ;; formatter gets confused about which keymap was used for the
58 ;; characters, the command-name comments will be wrong but that
59 ;; won't hurt anything.
61 ;; With a prefix argument, `edit-kbd-macro' will format the
62 ;; macro in a more concise way that omits the comments.
64 ;; This package requires GNU Emacs 19 or later, and daveg's CL
65 ;; package 2.02 or later. (CL 2.02 comes standard starting with
66 ;; Emacs 19.18.) This package does not work with Emacs 18 or
76 ;;; The user-level commands for editing macros.
79 (defvar edmacro-eight-bits nil
80 "*Non-nil if `edit-kbd-macro' should leave 8-bit characters intact.
81 Default nil means to write characters above \\177 in octal notation.")
83 (defvar edmacro-mode-map
84 (let ((map (make-sparse-keymap)))
85 (define-key map
"\C-c\C-c" 'edmacro-finish-edit
)
86 (define-key map
"\C-c\C-q" 'edmacro-insert-key
)
89 (defvar edmacro-store-hook
)
90 (defvar edmacro-finish-hook
)
91 (defvar edmacro-original-buffer
)
94 (defun edit-kbd-macro (keys &optional prefix finish-hook store-hook
)
95 "Edit a keyboard macro.
96 At the prompt, type any key sequence which is bound to a keyboard macro.
97 Or, type `C-x e' or RET to edit the last keyboard macro, `C-h l' to edit
98 the last 300 keystrokes as a keyboard macro, or `M-x' to edit a macro by
100 With a prefix argument, format the macro in a more concise way."
101 (interactive "kKeyboard macro to edit (C-x e, M-x, C-h l, or keys): \nP")
103 (let ((cmd (if (arrayp keys
) (key-binding keys
) keys
))
104 (mac nil
) (mac-counter nil
) (mac-format nil
)
109 ((or (memq cmd
'(call-last-kbd-macro kmacro-call-macro
110 kmacro-end-or-call-macro kmacro-end-and-call-macro
))
111 (member keys
'("\r" [return])))
113 (y-or-n-p "No keyboard macro defined. Create one? ")
115 (setq mac (or last-kbd-macro ""))
117 (setq cmd 'last-kbd-macro))
118 ((eq cmd 'execute-extended-command)
119 (setq cmd (read-command "Name of keyboard macro to edit: "))
120 (if (string-equal cmd "")
121 (error "No command name given"))
123 (setq mac (symbol-function cmd)))
124 ((memq cmd '(view-lossage electric-view-lossage))
125 (setq mac (recent-keys))
127 (setq cmd 'last-kbd-macro))
129 (error "Key sequence %s is not defined" (key-description keys)))
131 (setq mac (symbol-function cmd)))
135 (when (setq kmacro (kmacro-extract-lambda mac))
136 (setq mac (car kmacro)
137 mac-counter (nth 1 kmacro)
138 mac-format (nth 2 kmacro)))
140 (error "Key sequence %s is not a keyboard macro"
141 (key-description keys)))
142 (message "Formatting keyboard macro...")
143 (let* ((oldbuf (current-buffer))
144 (mmac (edmacro-fix-menu-commands mac))
145 (fmt (edmacro-format-keys mmac 1))
146 (fmtv (edmacro-format-keys mmac (not prefix)))
147 (buf (get-buffer-create "*Edit Macro*")))
148 (message "Formatting keyboard macro...done")
149 (switch-to-buffer buf)
150 (kill-all-local-variables)
151 (use-local-map edmacro-mode-map)
152 (setq buffer-read-only nil)
153 (setq major-mode 'edmacro-mode)
154 (setq mode-name "Edit Macro")
155 (set (make-local-variable 'edmacro-original-buffer) oldbuf)
156 (set (make-local-variable 'edmacro-finish-hook) finish-hook)
157 (set (make-local-variable 'edmacro-store-hook) store-hook)
159 (insert ";; Keyboard Macro Editor. Press C-c C-c to finish; "
160 "press C-x k RET to cancel.\n")
161 (insert ";; Original keys: " fmt "\n")
163 (insert "\nCommand: " (if cmd (symbol-name cmd) "none") "\n")
164 (let ((gkeys (where-is-internal (or cmd mac) '(keymap))))
165 (if (and keys (not (member keys gkeys)))
166 (setq gkeys (cons keys gkeys)))
169 (insert "Key: " (edmacro-format-keys (pop gkeys) 1) "\n"))
170 (insert "Key: none\n")))
171 (when (and mac-counter mac-format)
172 (insert (format "Counter: %d\nFormat: \"%s\"\n" mac-counter mac-format))))
173 (insert "\nMacro:\n\n")
178 (set-buffer-modified-p nil))
179 (run-hooks 'edmacro-format-hook)))))
181 ;;; The next two commands are provided for convenience and backward
185 (defun edit-last-kbd-macro (&optional prefix)
186 "Edit the most recently defined keyboard macro."
188 (edit-kbd-macro 'call-last-kbd-macro prefix))
191 (defun edit-named-kbd-macro (&optional prefix)
192 "Edit a keyboard macro which has been given a name by `name-last-kbd-macro'."
194 (edit-kbd-macro 'execute-extended-command prefix))
197 (defun read-kbd-macro (start &optional end)
198 "Read the region as a keyboard macro definition.
199 The region is interpreted as spelled-out keystrokes, e.g., \"M-x abc RET\".
200 See documentation for `edmacro-mode' for details.
201 Leading/trailing \"C-x (\" and \"C-x )\" in the text are allowed and ignored.
202 The resulting macro is installed as the \"current\" keyboard macro.
204 In Lisp, may also be called with a single STRING argument in which case
205 the result is returned rather than being installed as the current macro.
206 The result will be a string if possible, otherwise an event vector.
207 Second argument NEED-VECTOR means to return an event vector always."
210 (edmacro-parse-keys start end)
211 (setq last-kbd-macro (edmacro-parse-keys (buffer-substring start end)))))
214 (defun format-kbd-macro (&optional macro verbose)
215 "Return the keyboard macro MACRO as a human-readable string.
216 This string is suitable for passing to `read-kbd-macro'.
217 Second argument VERBOSE means to put one command per line with comments.
218 If VERBOSE is `1', put everything on one line. If VERBOSE is omitted
219 or nil, use a compact 80-column format."
220 (and macro (symbolp macro) (setq macro (symbol-function macro)))
221 (edmacro-format-keys (or macro last-kbd-macro) verbose))
223 ;;; Commands for *Edit Macro* buffer.
225 (defun edmacro-finish-edit ()
227 (unless (eq major-mode 'edmacro-mode)
229 "This command is valid only in buffers created by `edit-kbd-macro'"))
230 (run-hooks 'edmacro-finish-hook)
231 (let ((cmd nil) (keys nil) (no-keys nil)
232 (mac-counter nil) (mac-format nil) (kmacro nil)
235 (let ((case-fold-search nil))
236 (while (cond ((looking-at "[ \t]*\\($\\|;;\\|REM[ \t\n]\\)")
238 ((looking-at "Command:[ \t]*\\([^ \t\n]*\\)[ \t]*$")
239 (when edmacro-store-hook
240 (error "\"Command\" line not allowed in this context"))
241 (let ((str (buffer-substring (match-beginning 1)
243 (unless (equal str "")
244 (setq cmd (and (not (equal str "none"))
246 (and (fboundp cmd) (not (arrayp (symbol-function cmd)))
247 (not (setq kmacro (get cmd 'kmacro)))
249 (format "Command %s is already defined; %s"
253 ((looking-at "Key:\\(.*\\)$")
254 (when edmacro-store-hook
255 (error "\"Key\" line not allowed in this context"))
256 (let ((key (edmacro-parse-keys
257 (buffer-substring (match-beginning 1)
259 (unless (equal key "")
260 (if (equal key "none")
263 (let ((b (key-binding key)))
264 (and b (commandp b) (not (arrayp b))
265 (not (kmacro-extract-lambda b))
266 (or (not (fboundp b))
267 (not (or (arrayp (symbol-function b))
270 (format "Key %s is already defined; %s"
271 (edmacro-format-keys key 1)
275 ((looking-at "Counter:[ \t]*\\([^ \t\n]*\\)[ \t]*$")
276 (when edmacro-store-hook
277 (error "\"Counter\" line not allowed in this context"))
278 (let ((str (buffer-substring (match-beginning 1)
280 (unless (equal str "")
281 (setq mac-counter (string-to-number str))))
283 ((looking-at "Format:[ \t]*\"\\([^\n]*\\)\"[ \t]*$")
284 (when edmacro-store-hook
285 (error "\"Format\" line not allowed in this context"))
286 (let ((str (buffer-substring (match-beginning 1)
288 (unless (equal str "")
289 (setq mac-format str)))
291 ((looking-at "Macro:[ \t\n]*")
292 (goto-char (match-end 0))
295 (t (error "Expected a `Macro:' line")))
298 (let* ((buf (current-buffer))
299 (str (buffer-substring top (point-max)))
300 (modp (buffer-modified-p))
301 (obuf edmacro-original-buffer)
302 (store-hook edmacro-store-hook)
303 (finish-hook edmacro-finish-hook))
304 (unless (or cmd keys store-hook (equal str ""))
305 (error "No command name or keys specified"))
307 (when (buffer-name obuf)
309 (message "Compiling keyboard macro...")
310 (let ((mac (edmacro-parse-keys str)))
311 (message "Compiling keyboard macro...done")
313 (funcall store-hook mac)
314 (when (eq cmd 'last-kbd-macro)
315 (setq last-kbd-macro (and (> (length mac) 0) mac))
318 (if (= (length mac) 0)
321 (if (and mac-counter mac-format)
322 (kmacro-lambda-form mac mac-counter mac-format)
326 (loop for key in (where-is-internal cmd '(keymap)) do
327 (global-unset-key key)))
329 (if (= (length mac) 0)
330 (loop for key in keys do (global-unset-key key))
331 (loop for key in keys do
334 (if (and mac-counter mac-format)
335 (kmacro-lambda-form mac mac-counter mac-format)
338 (when (buffer-name obuf)
339 (switch-to-buffer obuf))
341 (funcall finish-hook)))))
343 (defun edmacro-insert-key (key)
344 "Insert the written name of a key in the buffer."
345 (interactive "kKey to insert: ")
347 (insert (edmacro-format-keys key t) "\n")
348 (insert (edmacro-format-keys key) " ")))
350 (defun edmacro-mode ()
351 "\\<edmacro-mode-map>Keyboard Macro Editing mode. Press \
352 \\[edmacro-finish-edit] to save and exit.
353 To abort the edit, just kill this buffer with \\[kill-buffer] RET.
355 Press \\[edmacro-insert-key] to insert the name of any key by typing the key.
357 The editing buffer contains a \"Command:\" line and any number of
358 \"Key:\" lines at the top. These are followed by a \"Macro:\" line
359 and the macro itself as spelled-out keystrokes: `C-x C-f foo RET'.
361 The \"Command:\" line specifies the command name to which the macro
362 is bound, or \"none\" for no command name. Write \"last-kbd-macro\"
363 to refer to the current keyboard macro (as used by \\[call-last-kbd-macro]).
365 The \"Key:\" lines specify key sequences to which the macro is bound,
366 or \"none\" for no key bindings.
368 You can edit these lines to change the places where the new macro
372 Format of keyboard macros during editing:
374 Text is divided into \"words\" separated by whitespace. Except for
375 the words described below, the characters of each word go directly
376 as characters of the macro. The whitespace that separates words
377 is ignored. Whitespace in the macro must be written explicitly,
378 as in \"foo SPC bar RET\".
380 * The special words RET, SPC, TAB, DEL, LFD, ESC, and NUL represent
381 special control characters. The words must be written in uppercase.
383 * A word in angle brackets, e.g., <return>, <down>, or <f1>, represents
384 a function key. (Note that in the standard configuration, the
385 function key <return> and the control key RET are synonymous.)
386 You can use angle brackets on the words RET, SPC, etc., but they
387 are not required there.
389 * Keys can be written by their ASCII code, using a backslash followed
390 by up to six octal digits. This is the only way to represent keys
391 with codes above \\377.
393 * One or more prefixes M- (meta), C- (control), S- (shift), A- (alt),
394 H- (hyper), and s- (super) may precede a character or key notation.
395 For function keys, the prefixes may go inside or outside of the
396 brackets: C-<down> = <C-down>. The prefixes may be written in
397 any order: M-C-x = C-M-x.
399 Prefixes are not allowed on multi-key words, e.g., C-abc, except
400 that the Meta prefix is allowed on a sequence of digits and optional
401 minus sign: M--123 = M-- M-1 M-2 M-3.
403 * The `^' notation for control characters also works: ^M = C-m.
405 * Double angle brackets enclose command names: <<next-line>> is
406 shorthand for M-x next-line RET.
408 * Finally, REM or ;; causes the rest of the line to be ignored as a
411 Any word may be prefixed by a multiplier in the form of a decimal
412 number and `*': 3*<right> = <right> <right> <right>, and
413 10*foo = foofoofoofoofoofoofoofoofoofoo.
415 Multiple text keys can normally be strung together to form a word,
416 but you may need to add whitespace if the word would look like one
417 of the above notations: `; ; ;' is a keyboard macro with three
418 semicolons, but `;;;' is a comment. Likewise, `\\ 1 2 3' is four
419 keys but `\\123' is a single key written in octal, and `< right >'
420 is seven keys but `<right>' is a single function key. When in
421 doubt, use whitespace."
423 (error "This mode can be enabled only by `edit-kbd-macro'"))
424 (put 'edmacro-mode 'mode-class 'special)
426 ;;; Formatting a keyboard macro as human-readable text.
428 (defun edmacro-format-keys (macro &optional verbose)
429 (setq macro (edmacro-fix-menu-commands macro))
430 (let* ((maps (current-active-maps))
431 (pkeys '(end-macro ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?- ?\C-u
432 ?\M-- ?\M-0 ?\M-1 ?\M-2 ?\M-3 ?\M-4 ?\M-5 ?\M-6
434 (mdigs (nthcdr 13 pkeys))
435 (maxkey (if edmacro-eight-bits 255 127))
436 (case-fold-search nil)
437 (res-words '("NUL" "TAB" "LFD" "RET" "ESC" "SPC" "DEL" "REM"))
438 (rest-mac (vconcat macro [end-macro]))
441 (one-line (eq verbose 1)))
442 (if one-line (setq verbose nil))
443 (when (stringp macro)
444 (loop for i below (length macro) do
445 (when (>= (aref rest-mac i) 128)
446 (incf (aref rest-mac i) (- ?\M-\^@ 128)))))
447 (while (not (eq (aref rest-mac 0) 'end-macro))
449 (or (and (integerp (aref rest-mac 0))
450 (memq (aref rest-mac 0) mdigs)
451 (memq (key-binding (edmacro-subseq rest-mac 0 1))
452 '(digit-argument negative-argument))
454 (while (memq (aref rest-mac i) (cdr mdigs))
456 (and (not (memq (aref rest-mac i) pkeys))
457 (prog1 (vconcat "M-" (edmacro-subseq rest-mac 0 i) " ")
458 (callf edmacro-subseq rest-mac i)))))
459 (and (eq (aref rest-mac 0) ?\C-u)
460 (eq (key-binding [?\C-u]) 'universal-argument)
462 (while (eq (aref rest-mac i) ?\C-u)
464 (and (not (memq (aref rest-mac i) pkeys))
465 (prog1 (loop repeat i concat "C-u ")
466 (callf edmacro-subseq rest-mac i)))))
467 (and (eq (aref rest-mac 0) ?\C-u)
468 (eq (key-binding [?\C-u]) 'universal-argument)
470 (when (eq (aref rest-mac i) ?-)
472 (while (memq (aref rest-mac i)
473 '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
475 (and (not (memq (aref rest-mac i) pkeys))
476 (prog1 (vconcat "C-u " (edmacro-subseq rest-mac 1 i) " ")
477 (callf edmacro-subseq rest-mac i)))))))
478 (bind-len (apply 'max 1
479 (loop for map in maps
480 for b = (lookup-key map rest-mac)
482 (key (edmacro-subseq rest-mac 0 bind-len))
484 (bind (or (loop for map in maps for b = (lookup-key map key)
485 thereis (and (not (integerp b)) b))
486 (and (setq fkey (lookup-key local-function-key-map rest-mac))
487 (setq tlen fkey tkey (edmacro-subseq rest-mac 0 tlen)
488 fkey (lookup-key local-function-key-map tkey))
489 (loop for map in maps
490 for b = (lookup-key map fkey)
491 when (and (not (integerp b)) b)
492 do (setq bind-len tlen key tkey)
494 finally do (setq fkey nil)))))
496 (text (loop for i from bind-len below (length rest-mac)
497 for ch = (aref rest-mac i)
498 while (and (integerp ch)
499 (> ch 32) (< ch maxkey) (/= ch 92)
500 (eq (key-binding (char-to-string ch))
501 'self-insert-command)
502 (or (> i (- (length rest-mac) 2))
503 (not (eq ch (aref rest-mac (+ i 1))))
504 (not (eq ch (aref rest-mac (+ i 2))))))
507 (if (stringp bind) (setq bind nil))
508 (cond ((and (eq bind 'self-insert-command) (not prefix)
509 (> text 1) (integerp first)
510 (> first 32) (<= first maxkey) (/= first 92)
512 (if (> text 30) (setq text 30))
513 (setq desc (concat (edmacro-subseq rest-mac 0 text)))
514 (when (string-match "^[ACHMsS]-." desc)
516 (callf substring desc 0 2))
518 "^;;\\|^<.*>$\\|^\\\\[0-9]+$\\|^[0-9]+\\*."
520 (when (or (string-match "^\\^.$" desc)
521 (member desc res-words))
522 (setq desc (mapconcat 'char-to-string desc " ")))
524 (setq bind (format "%s * %d" bind text)))
525 (setq bind-len text))
526 ((and (eq bind 'execute-extended-command)
528 (memq (aref rest-mac text) '(return 13))
530 (setq desc (concat (edmacro-subseq rest-mac bind-len text)))
531 (commandp (intern-soft desc))))
532 (if (commandp (intern-soft desc)) (setq bind desc))
533 (setq desc (format "<<%s>>" desc))
534 (setq bind-len (1+ text)))
536 (setq desc (mapconcat
542 (loop for pf across "ACHMsS"
543 for bit in '(?\A-\^@ ?\C-\^@ ?\H-\^@
544 ?\M-\^@ ?\s-\^@ ?\S-\^@)
545 when (/= (logand ch bit) 0)
546 concat (format "%c-" pf))
547 (let ((ch2 (logand ch (1- (lsh 1 18)))))
550 (0 "NUL") (9 "TAB") (10 "LFD")
551 (13 "RET") (27 "ESC") (32 "SPC")
554 (+ (if (<= ch2 26) 96 64)
557 ((<= ch2 maxkey) (char-to-string ch2))
558 (t (format "\\%o" ch2))))))
562 (error "Unrecognized item in macro: %s" ch)))))
563 (or fkey key) " "))))
565 (setq desc (concat (edmacro-sanitize-for-string prefix) desc)))
566 (unless (string-match " " desc)
567 (let ((times 1) (pos bind-len))
568 (while (not (edmacro-mismatch rest-mac rest-mac
569 0 bind-len pos (+ bind-len pos)))
573 (setq desc (format "%d*%s" times desc))
574 (setq bind-len (* bind-len times)))))
575 (setq rest-mac (edmacro-subseq rest-mac bind-len))
578 (unless (equal res "") (callf concat res "\n"))
579 (callf concat res desc)
580 (when (and bind (or (stringp bind) (symbolp bind)))
582 (make-string (max (- 3 (/ (length desc) 8)) 1) 9)
583 ";; " (if (stringp bind) bind (symbol-name bind))))
585 (if (and (> (+ len (length desc) 2) 72) (not one-line))
587 (callf concat res "\n ")
589 (unless (equal res "")
590 (callf concat res " ")
592 (callf concat res desc)
593 (incf len (length desc)))))
596 (defun edmacro-mismatch (cl-seq1 cl-seq2 cl-start1 cl-end1 cl-start2 cl-end2)
597 "Compare SEQ1 with SEQ2, return index of first mismatching element.
598 Return nil if the sequences match. If one sequence is a prefix of the
599 other, the return value indicates the end of the shorted sequence.
600 \n(fn SEQ1 SEQ2 START1 END1 START2 END2)"
601 (let (cl-test cl-test-not cl-key cl-from-end)
602 (or cl-end1 (setq cl-end1 (length cl-seq1)))
603 (or cl-end2 (setq cl-end2 (length cl-seq2)))
606 (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
607 (cl-check-match (elt cl-seq1 (1- cl-end1))
608 (elt cl-seq2 (1- cl-end2))))
609 (setq cl-end1 (1- cl-end1) cl-end2 (1- cl-end2)))
610 (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
612 (let ((cl-p1 (and (listp cl-seq1) (nthcdr cl-start1 cl-seq1)))
613 (cl-p2 (and (listp cl-seq2) (nthcdr cl-start2 cl-seq2))))
614 (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
615 (cl-check-match (if cl-p1 (car cl-p1)
616 (aref cl-seq1 cl-start1))
617 (if cl-p2 (car cl-p2)
618 (aref cl-seq2 cl-start2))))
619 (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)
620 cl-start1 (1+ cl-start1) cl-start2 (1+ cl-start2)))
621 (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
624 (defun edmacro-subseq (seq start &optional end)
625 "Return the subsequence of SEQ from START to END.
626 If END is omitted, it defaults to the length of the sequence.
627 If START or END is negative, it counts from the end."
628 (if (stringp seq) (substring seq start end)
630 (and end (< end 0) (setq end (+ end (setq len (length seq)))))
631 (if (< start 0) (setq start (+ start (or len (setq len (length seq))))))
633 (if (> start 0) (setq seq (nthcdr start seq)))
636 (while (>= (setq end (1- end)) start)
637 (push (pop seq) res))
639 (copy-sequence seq)))
641 (or end (setq end (or len (length seq))))
642 (let ((res (make-vector (max (- end start) 0) nil))
645 (aset res i (aref seq start))
646 (setq i (1+ i) start (1+ start)))
649 (defun edmacro-sanitize-for-string (seq)
650 "Convert a key sequence vector SEQ into a string.
651 The string represents the same events; Meta is indicated by bit 7.
652 This function assumes that the events can be stored in a string."
653 (setq seq (copy-sequence seq))
654 (loop for i below (length seq) do
655 (when (logand (aref seq i) 128)
656 (setf (aref seq i) (logand (aref seq i) 127))))
659 (defun edmacro-fix-menu-commands (macro &optional noerror)
662 ;; Make a list of the elements.
663 (setq macro (append macro nil))
667 ((eq (car ev) 'help-echo))
668 ((eq (car ev) 'switch-frame))
669 ((equal ev '(menu-bar))
670 (push 'menu-bar result))
671 ((equal (cadadr ev) '(menu-bar))
672 (push (vector 'menu-bar (car ev)) result))
673 ;; It would be nice to do pop-up menus, too, but not enough
674 ;; info is recorded in macros to make this possible.
676 ;; Just ignore mouse events.
679 (error "Macros with mouse clicks are not %s"
680 "supported by this command"))))
681 ;; Reverse them again and make them back into a vector.
682 (vconcat (nreverse result)))
685 ;;; Parsing a human-readable keyboard macro.
687 (defun edmacro-parse-keys (string &optional need-vector)
688 (let ((case-fold-search nil)
689 (len (length string)) ; We won't alter string in the loop below.
692 (while (and (< pos len)
693 (string-match "[^ \t\n\f]+" string pos))
694 (let* ((word-beg (match-beginning 0))
695 (word-end (match-end 0))
696 (word (substring string word-beg len))
699 ;; Try to catch events of the form "<as df>".
700 (if (string-match "\\`<[^ <>\t\n\f][^>\t\n\f]*>" word)
701 (setq word (match-string 0 word)
702 pos (+ word-beg (match-end 0)))
703 (setq word (substring string word-beg word-end)
705 (when (string-match "\\([0-9]+\\)\\*." word)
706 (setq times (string-to-number (substring word 0 (match-end 1))))
707 (setq word (substring word (1+ (match-end 1)))))
708 (cond ((string-match "^<<.+>>$" word)
709 (setq key (vconcat (if (eq (key-binding [?\M-x])
710 'execute-extended-command)
712 (or (car (where-is-internal
713 'execute-extended-command))
715 (substring word 2 -2) "\r")))
716 ((and (string-match "^\\(\\([ACHMsS]-\\)*\\)<\\(.+\\)>$" word)
718 (setq word (concat (substring word (match-beginning 1)
720 (substring word (match-beginning 3)
723 "\\<\\(NUL\\|RET\\|LFD\\|ESC\\|SPC\\|DEL\\)$"
725 (setq key (list (intern word))))
726 ((or (equal word "REM") (string-match "^;;" word))
727 (setq pos (string-match "$" string pos)))
729 (let ((orig-word word) (prefix 0) (bits 0))
730 (while (string-match "^[ACHMsS]-." word)
731 (incf bits (cdr (assq (aref word 0)
732 '((?A . ?\A-\^@) (?C . ?\C-\^@)
733 (?H . ?\H-\^@) (?M . ?\M-\^@)
734 (?s . ?\s-\^@) (?S . ?\S-\^@)))))
736 (callf substring word 2))
737 (when (string-match "^\\^.$" word)
740 (callf substring word 1))
741 (let ((found (assoc word '(("NUL" . "\0") ("RET" . "\r")
742 ("LFD" . "\n") ("TAB" . "\t")
743 ("ESC" . "\e") ("SPC" . " ")
745 (when found (setq word (cdr found))))
746 (when (string-match "^\\\\[0-7]+$" word)
747 (loop for ch across word
748 for n = 0 then (+ (* n 8) ch -48)
749 finally do (setq word (vector n))))
752 ((and (= bits ?\M-\^@) (stringp word)
753 (string-match "^-?[0-9]+$" word))
754 (setq key (loop for x across word collect (+ x bits))))
755 ((/= (length word) 1)
756 (error "%s must prefix a single character, not %s"
757 (substring orig-word 0 prefix) word))
758 ((and (/= (logand bits ?\C-\^@) 0) (stringp word)
759 ;; We used to accept . and ? here,
760 ;; but . is simply wrong,
761 ;; and C-? is not used (we use DEL instead).
762 (string-match "[@-_a-z]" word))
763 (setq key (list (+ bits (- ?\C-\^@)
764 (logand (aref word 0) 31)))))
766 (setq key (list (+ bits (aref word 0)))))))))
768 (loop repeat times do (callf vconcat res key)))))
769 (when (and (>= (length res) 4)
770 (eq (aref res 0) ?\C-x)
771 (eq (aref res 1) ?\()
772 (eq (aref res (- (length res) 2)) ?\C-x)
773 (eq (aref res (- (length res) 1)) ?\)))
774 (setq res (edmacro-subseq res 2 -2)))
775 (if (and (not need-vector)
776 (loop for ch across res
777 always (and (characterp ch)
778 (let ((ch2 (logand ch (lognot ?\M-\^@))))
779 (and (>= ch2 0) (<= ch2 127))))))
780 (concat (loop for ch across res
781 collect (if (= (logand ch ?\M-\^@) 0)
787 ;;; edmacro.el ends here