Mercurial > hg > xemacs-beta

comparison lisp/utils/edmacro.el @ 98:0d2f883870bc r20-1b1

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