Mercurial > emacs
changeset 4754:463663a999ee
Total rewrite by Gillespie.
| author | Richard M. Stallman <rms@gnu.org> |
|---|---|
| date | Tue, 21 Sep 1993 03:44:04 +0000 |
| parents | 3963121bd25f |
| children | 4f348ddd841e |
| files | lisp/edmacro.el |
| diffstat | 1 files changed, 647 insertions(+), 606 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/edmacro.el Mon Sep 20 20:03:30 1993 +0000 +++ b/lisp/edmacro.el Tue Sep 21 03:44:04 1993 +0000 @@ -1,10 +1,10 @@ ;;; edmacro.el --- keyboard macro editor -;; Copyright (C) 1990 Free Software Foundation, Inc. +;; Copyright (C) 1993 Free Software Foundation, Inc. -;; Author: Dave Gillespie <daveg@csvax.caltech.edu> -;; Maintainer: FSF -;; Version: 1.02 +;; Author: Dave Gillespie <daveg@synaptics.com> +;; Maintainer: Dave Gillespie <daveg@synaptics.com> +;; Version: 2.01 ;; Keywords: abbrev ;; This file is part of GNU Emacs. @@ -25,629 +25,670 @@ ;;; Commentary: -;; To use, type `M-x edit-last-kbd-macro' to edit the most recently -;; defined keyboard macro. If you have used `M-x name-last-kbd-macro' -;; to give a keyboard macro a name, type `M-x edit-kbd-macro' to edit -;; the macro by name. When you are done editing, type `C-c C-c' to -;; record your changes back into the original keyboard macro. +;;; Usage: +;; +;; The `C-x C-k' (`edit-kbd-macro') command edits a keyboard macro +;; in a special buffer. It prompts you to type a key sequence, +;; which should be one of: +;; +;; * RET or `C-x e' (call-last-kbd-macro), to edit the most +;; recently defined keyboard macro. +;; +;; * `M-x' followed by a command name, to edit a named command +;; whose definition is a keyboard macro. +;; +;; * `C-h l' (view-lossage), to edit the 100 most recent keystrokes +;; and install them as the "current" macro. +;; +;; * any key sequence whose definition is a keyboard macro. +;; +;; This file includes a version of `insert-kbd-macro' that uses the +;; more readable format defined by these routines. +;; +;; Also, the `read-kbd-macro' command parses the region as +;; a keyboard macro, and installs it as the "current" macro. +;; This and `format-kbd-macro' can also be called directly as +;; Lisp functions. + +;; Type `C-h m', or see the documentation for `edmacro-mode' below, +;; for information about the format of written keyboard macros. + +;; `edit-kbd-macro' formats the macro with one command per line, +;; including the command names as comments on the right. If the +;; formatter gets confused about which keymap was used for the +;; characters, the command-name comments will be wrong but that +;; won't hurt anything. + +;; With a prefix argument, `edit-kbd-macro' will format the +;; macro in a more concise way that omits the comments. + +;; This package requires GNU Emacs 19 or later, and daveg's CL +;; package 2.02 or later. (CL 2.02 comes standard starting with +;; Emacs 19.18.) This package does not work with Emacs 18 or +;; Lucid Emacs. ;;; Code: +(require 'cl) + ;;; The user-level commands for editing macros. +;;;###autoload (define-key ctl-x-map "\C-k" 'edit-kbd-macro) +(define-key ctl-x-map "\C-k" 'edit-kbd-macro) + +;;;###autoload +(defvar edmacro-eight-bits nil + "*Non-nil if edit-kbd-macro should leave 8-bit characters intact. +Default nil means to write characters above \\177 in octal notation.") + +(defvar edmacro-mode-map nil) +(unless edmacro-mode-map + (setq edmacro-mode-map (make-sparse-keymap)) + (define-key edmacro-mode-map "\C-c\C-c" 'edmacro-finish-edit) + (define-key edmacro-mode-map "\C-c\C-q" 'edmacro-insert-key)) + ;;;###autoload -(defun edit-last-kbd-macro (&optional prefix buffer hook) +(defun edit-kbd-macro (keys &optional prefix finish-hook store-hook) + "Edit a keyboard macro. +At the prompt, type any key sequence which is bound to a keyboard macro. +Or, type `C-x e' or RET to edit the last keyboard macro, `C-h l' to edit +the last 100 keystrokes as a keyboard macro, or `M-x' to edit a macro by +its command name. +With a prefix argument, format the macro in a more concise way." + (interactive "kKeyboard macro to edit (C-x e, M-x, C-h l, or keys): \nP") + (when keys + (let ((cmd (if (arrayp keys) (key-binding keys) keys)) + (mac nil)) + (cond (store-hook + (setq mac keys) + (setq cmd nil)) + ((or (eq cmd 'call-last-kbd-macro) + (member keys '("\r" [return]))) + (or last-kbd-macro + (y-or-n-p "No keyboard macro defined. Create one? ") + (keyboard-quit)) + (setq mac (or last-kbd-macro "")) + (setq cmd 'last-kbd-macro)) + ((eq cmd 'execute-extended-command) + (setq cmd (read-command "Name of keyboard macro to edit: ")) + (setq mac (symbol-function cmd))) + ((eq cmd 'view-lossage) + (setq mac (recent-keys)) + (setq cmd 'last-kbd-macro)) + ((symbolp cmd) + (setq mac (symbol-function cmd))) + (t + (setq mac cmd) + (setq cmd nil))) + (unless (arrayp mac) + (error "Not a keyboard macro: %s" cmd)) + (message "Formatting keyboard macro...") + (let* ((oldbuf (current-buffer)) + (mmac (edmacro-fix-menu-commands mac)) + (fmt (edmacro-format-keys mmac 1)) + (fmtv (edmacro-format-keys mmac (not prefix))) + (buf (get-buffer-create "*Edit Macro*"))) + (message "Formatting keyboard macro...done") + (switch-to-buffer buf) + (kill-all-local-variables) + (use-local-map edmacro-mode-map) + (setq buffer-read-only nil) + (setq major-mode 'edmacro-mode) + (setq mode-name "Edit Macro") + (set (make-local-variable 'edmacro-original-buffer) oldbuf) + (set (make-local-variable 'edmacro-finish-hook) finish-hook) + (set (make-local-variable 'edmacro-store-hook) store-hook) + (erase-buffer) + (insert ";; Keyboard Macro Editor. Press C-c C-c to finish; " + "press C-x k RET to cancel.\n") + (insert ";; Original keys: " fmt "\n") + (unless store-hook + (insert "\nCommand: " (if cmd (symbol-name cmd) "none") "\n") + (let ((keys (where-is-internal (or cmd mac) nil))) + (if keys + (while keys + (insert "Key: " (edmacro-format-keys (pop keys) 1) "\n")) + (insert "Key: none\n")))) + (insert "\nMacro:\n\n") + (save-excursion + (insert fmtv "\n")) + (recenter '(4)) + (when (eq mac mmac) + (set-buffer-modified-p nil)) + (run-hooks 'edmacro-format-hook))))) + +;;; The next two commands are provided for convenience and backward +;;; compatibility. + +;;;###autoload +(defun edit-last-kbd-macro (&optional prefix) "Edit the most recently defined keyboard macro." (interactive "P") - (edmacro-edit-macro last-kbd-macro - (function (lambda (x arg) (setq last-kbd-macro x))) - prefix buffer hook)) + (edit-kbd-macro 'call-last-kbd-macro prefix)) + +;;;###autoload +(defun edit-named-kbd-macro (&optional prefix) + "Edit a keyboard macro which has been given a name by `name-last-kbd-macro'." + (interactive "P") + (edit-kbd-macro 'execute-extended-command prefix)) + +;;;###autoload +(defun read-kbd-macro (start &optional end) + "Read the region as a keyboard macro definition. +The region is interpreted as spelled-out keystrokes, e.g., \"M-x abc RET\". +See documentation for `edmacro-mode' for details. +Leading/trailing \"C-x (\" and \"C-x )\" in the text are allowed and ignored. +The resulting macro is installed as the \"current\" keyboard macro. + +In Lisp, may also be called with a single STRING argument in which case +the result is returned rather than being installed as the current macro. +The result will be a string if possible, otherwise an event vector. +Second argument NEED-VECTOR means to return an event vector always." + (interactive "r") + (if (stringp start) + (edmacro-parse-keys start end) + (setq last-kbd-macro (edmacro-parse-keys (buffer-substring start end))))) ;;;###autoload -(defun edit-kbd-macro (cmd &optional prefix buffer hook in-hook out-hook) - "Edit a keyboard macro which has been given a name by `name-last-kbd-macro'. -\(See also `edit-last-kbd-macro'.)" - (interactive "CCommand name: \nP") - (and cmd - (edmacro-edit-macro (if in-hook - (funcall in-hook cmd) - (symbol-function cmd)) - (or out-hook - (list 'lambda '(x arg) - (list 'fset - (list 'quote cmd) - 'x))) - prefix buffer hook cmd))) +(defun format-kbd-macro (&optional macro verbose) + "Return the keyboard macro MACRO as a human-readable string. +This string is suitable for passing to `read-kbd-macro'. +Second argument VERBOSE means to put one command per line with comments. +If VERBOSE is `1', put everything on one line. If VERBOSE is omitted +or nil, use a compact 80-column format." + (and macro (symbolp macro) (setq macro (symbol-function macro))) + (edmacro-format-keys (or macro last-kbd-macro) verbose)) + +;;; Commands for *Edit Macro* buffer. -;;;###autoload -(defun read-kbd-macro (start end) - "Read the region as a keyboard macro definition. -The region is interpreted as spelled-out keystrokes, e.g., \"M-x abc RET\". -The resulting macro is installed as the \"current\" keyboard macro. +(defun edmacro-finish-edit () + (interactive) + (unless (eq major-mode 'edmacro-mode) + (error + "This command is valid only in buffers created by `edit-kbd-macro'")) + (run-hooks 'edmacro-finish-hook) + (let ((cmd nil) (keys nil) (no-keys nil) + (top (point-min))) + (goto-char top) + (let ((case-fold-search nil)) + (while (cond ((looking-at "[ \t]*\\($\\|;;\\|REM[ \t\n]\\)") + t) + ((looking-at "Command:[ \t]*\\([^ \t\n]*\\)[ \t]*$") + (when edmacro-store-hook + (error "\"Command\" line not allowed in this context")) + (let ((str (buffer-substring (match-beginning 1) + (match-end 1)))) + (unless (equal str "") + (setq cmd (and (not (equalp str "none")) + (intern str))) + (and (fboundp cmd) (not (arrayp (symbol-function cmd))) + (not (y-or-n-p + (format "Command %s is already defined; %s" + cmd "proceed? "))) + (keyboard-quit)))) + t) + ((looking-at "Key:\\(.*\\)$") + (when edmacro-store-hook + (error "\"Key\" line not allowed in this context")) + (let ((key (edmacro-parse-keys + (buffer-substring (match-beginning 1) + (match-end 1))))) + (unless (equal key "") + (if (equalp key "none") + (setq no-keys t) + (push key keys) + (let ((b (key-binding key))) + (and b (commandp b) (not (arrayp b)) + (or (not (fboundp b)) + (not (arrayp (symbol-function b)))) + (not (y-or-n-p + (format "Key %s is already defined; %s" + (edmacro-format-keys key 1) + "proceed? "))) + (keyboard-quit)))))) + t) + ((looking-at "Macro:[ \t\n]*") + (goto-char (match-end 0)) + nil) + ((eobp) nil) + (t (error "Expected a `Macro:' line"))) + (forward-line 1)) + (setq top (point))) + (let* ((buf (current-buffer)) + (str (buffer-substring top (point-max))) + (modp (buffer-modified-p)) + (obuf edmacro-original-buffer) + (store-hook edmacro-store-hook) + (finish-hook edmacro-finish-hook)) + (unless (or cmd keys store-hook (equal str "")) + (error "No command name or keys specified")) + (when modp + (when (buffer-name obuf) + (set-buffer obuf)) + (message "Compiling keyboard macro...") + (let ((mac (edmacro-parse-keys str))) + (message "Compiling keyboard macro...done") + (if store-hook + (funcall store-hook mac) + (when (eq cmd 'last-kbd-macro) + (setq last-kbd-macro (and (> (length mac) 0) mac)) + (setq cmd nil)) + (when cmd + (if (= (length mac) 0) + (fmakunbound cmd) + (fset cmd mac))) + (if no-keys + (when cmd + (loop for key in (where-is-internal cmd nil) do + (global-unset-key key))) + (when keys + (if (= (length mac) 0) + (loop for key in keys do (global-unset-key key)) + (loop for key in keys do + (global-set-key key (or cmd mac))))))))) + (kill-buffer buf) + (when (buffer-name obuf) + (switch-to-buffer obuf)) + (when finish-hook + (funcall finish-hook))))) -Symbols: RET, SPC, TAB, DEL, LFD, NUL; C-key; M-key. (Must be uppercase.) - REM marks the rest of a line as a comment. - Whitespace is ignored; other characters are copied into the macro." - (interactive "r") - (setq last-kbd-macro (edmacro-parse-keys (buffer-substring start end))) - (if (and (string-match "\\`\C-x(" last-kbd-macro) - (string-match "\C-x)\\'" last-kbd-macro)) - (setq last-kbd-macro (substring last-kbd-macro 2 -2)))) +(defun edmacro-insert-key (key) + "Insert the written name of a key in the buffer." + (interactive "kKey to insert: ") + (if (bolp) + (insert (edmacro-format-keys key t) "\n") + (insert (edmacro-format-keys key) " "))) + +(defun edmacro-mode () + "\\<edmacro-mode-map>Keyboard Macro Editing mode. Press +\\[edmacro-finish-edit] to save and exit. +To abort the edit, just kill this buffer with \\[kill-buffer] RET. + +Press \\[edmacro-insert-key] to insert the name of any key by typing the key. + +The editing buffer contains a \"Command:\" line and any number of +\"Key:\" lines at the top. These are followed by a \"Macro:\" line +and the macro itself as spelled-out keystrokes: `C-x C-f foo RET'. + +The \"Command:\" line specifies the command name to which the macro +is bound, or \"none\" for no command name. Write \"last-kbd-macro\" +to refer to the current keyboard macro (as used by \\[call-last-kbd-macro]). + +The \"Key:\" lines specify key sequences to which the macro is bound, +or \"none\" for no key bindings. + +You can edit these lines to change the places where the new macro +is stored. + + +Format of keyboard macros during editing: + +Text is divided into \"words\" separated by whitespace. Except for +the words described below, the characters of each word go directly +as characters of the macro. The whitespace that separates words +is ignored. Whitespace in the macro must be written explicitly, +as in \"foo SPC bar RET\". + + * The special words RET, SPC, TAB, DEL, LFD, ESC, and NUL represent + special control characters. The words must be written in uppercase. + + * A word in angle brackets, e.g., <return>, <down>, or <f1>, represents + a function key. (Note that in the standard configuration, the + function key <return> and the control key RET are synonymous.) + You can use angle brackets on the words RET, SPC, etc., but they + are not required there. + + * Keys can be written by their ASCII code, using a backslash followed + by up to six octal digits. This is the only way to represent keys + with codes above \\377. + + * One or more prefixes M- (meta), C- (control), S- (shift), A- (alt), + H- (hyper), and s- (super) may precede a character or key notation. + For function keys, the prefixes may go inside or outside of the + brackets: C-<down> = <C-down>. The prefixes may be written in + any order: M-C-x = C-M-x. + + Prefixes are not allowed on multi-key words, e.g., C-abc, except + that the Meta prefix is allowed on a sequence of digits and optional + minus sign: M--123 = M-- M-1 M-2 M-3. + + * The `^' notation for control characters also works: ^M = C-m. + + * Double angle brackets enclose command names: <<next-line>> is + shorthand for M-x next-line RET. + + * Finally, REM or ;; causes the rest of the line to be ignored as a + comment. + +Any word may be prefixed by a multiplier in the form of a decimal +number and `*': 3*<right> = <right> <right> <right>, and +10*foo = foofoofoofoofoofoofoofoofoofoo. + +Multiple text keys can normally be strung together to form a word, +but you may need to add whitespace if the word would look like one +of the above notations: `; ; ;' is a keyboard macro with three +semicolons, but `;;;' is a comment. Likewise, `\\ 1 2 3' is four +keys but `\\123' is a single key written in octal, and `< right >' +is seven keys but `<right>' is a single function key. When in +doubt, use whitespace." + (interactive) + (error "This mode can be enabled only by `edit-kbd-macro'")) +(put 'edmacro-mode 'mode-class 'special) ;;; Formatting a keyboard macro as human-readable text. -(defun edmacro-print-macro (macro-str local-map) - (let ((save-map (current-local-map)) - (print-escape-newlines t) - key-symbol key-str key-last prefix-arg this-prefix) - (unwind-protect - (progn - (use-local-map local-map) - (while (edmacro-peek-char) - (edmacro-read-key) - (setq this-prefix prefix-arg) - (or (memq key-symbol '(digit-argument - negative-argument - universal-argument)) - (null prefix-arg) - (progn - (cond ((consp prefix-arg) - (insert (format "prefix-arg (%d)\n" - (car prefix-arg)))) - ((eq prefix-arg '-) - (insert "prefix-arg -\n")) - ((numberp prefix-arg) - (insert (format "prefix-arg %d\n" prefix-arg)))) - (setq prefix-arg nil))) - (cond ((null key-symbol) - (insert "type \"") - (edmacro-insert-string macro-str) - (insert "\"\n") - (setq macro-str "")) - ((eq key-symbol 'digit-argument) - (edmacro-prefix-arg key-last nil prefix-arg)) - ((eq key-symbol 'negative-argument) - (edmacro-prefix-arg ?- nil prefix-arg)) - ((eq key-symbol 'universal-argument) - (let* ((c-u 4) (argstartchar key-last) - (char (edmacro-read-char))) - (while (= char argstartchar) - (setq c-u (* 4 c-u) - char (edmacro-read-char))) - (edmacro-prefix-arg char c-u nil))) - ((eq key-symbol 'self-insert-command) - (insert "insert ") - (if (and (>= key-last 32) (<= key-last 126)) - (let ((str "")) - (while (or (and (eq key-symbol - 'self-insert-command) - (< (length str) 60) - (>= key-last 32) - (<= key-last 126)) - (and (memq key-symbol - '(backward-delete-char - delete-backward-char - backward-delete-char-untabify)) - (> (length str) 0))) - (if (eq key-symbol 'self-insert-command) - (setq str (concat str - (char-to-string key-last))) - (setq str (substring str 0 -1))) - (edmacro-read-key)) - (insert "\"" str "\"\n") - (edmacro-unread-chars key-str)) - (insert "\"") - (edmacro-insert-string (char-to-string key-last)) - (insert "\"\n"))) - ((and (eq key-symbol 'quoted-insert) - (edmacro-peek-char)) - (insert "quoted-insert\n") - (let ((ch (edmacro-read-char)) - ch2) - (if (and (>= ch ?0) (<= ch ?7)) - (progn - (setq ch (- ch ?0) - ch2 (edmacro-read-char)) - (if ch2 - (if (and (>= ch2 ?0) (<= ch2 ?7)) - (progn - (setq ch (+ (* ch 8) (- ch2 ?0)) - ch2 (edmacro-read-char)) - (if ch2 - (if (and (>= ch2 ?0) (<= ch2 ?7)) - (setq ch (+ (* ch 8) (- ch2 ?0))) - (edmacro-unread-chars ch2)))) - (edmacro-unread-chars ch2))))) - (if (or (and (>= ch ?0) (<= ch ?7)) - (< ch 32) (> ch 126)) - (insert (format "type \"\\%03o\"\n" ch)) - (insert "type \"" (char-to-string ch) "\"\n")))) - ((memq key-symbol '(isearch-forward - isearch-backward - isearch-forward-regexp - isearch-backward-regexp)) - (insert (symbol-name key-symbol) "\n") - (edmacro-isearch-argument)) - ((eq key-symbol 'execute-extended-command) - (edmacro-read-argument obarray 'commandp)) - (t - (let ((cust (get key-symbol 'edmacro-print))) - (if cust - (funcall cust) - (insert (symbol-name key-symbol)) - (indent-to 30) - (insert " # ") - (edmacro-insert-string key-str) - (insert "\n") - (let ((int (edmacro-get-interactive key-symbol))) - (if (string-match "\\`\\*" int) - (setq int (substring int 1))) - (while (> (length int) 0) - (cond ((= (aref int 0) ?a) - (edmacro-read-argument - obarray nil)) - ((memq (aref int 0) '(?b ?B ?D ?f ?F ?n - ?s ?S ?x ?X)) - (edmacro-read-argument)) - ((and (= (aref int 0) ?c) - (edmacro-peek-char)) - (insert "type \"") - (edmacro-insert-string - (char-to-string - (edmacro-read-char))) - (insert "\"\n")) - ((= (aref int 0) ?C) - (edmacro-read-argument - obarray 'commandp)) - ((= (aref int 0) ?k) - (edmacro-read-key) - (if key-symbol - (progn - (insert "type \"") - (edmacro-insert-string key-str) - (insert "\"\n")) - (edmacro-unread-chars key-str))) - ((= (aref int 0) ?N) - (or this-prefix - (edmacro-read-argument))) - ((= (aref int 0) ?v) - (edmacro-read-argument - obarray 'user-variable-p))) - (let ((nl (string-match "\n" int))) - (setq int (if nl - (substring int (1+ nl)) - ""))))))))))) - (use-local-map save-map)))) - -(defun edmacro-prefix-arg (char c-u value) - (let ((sign 1)) - (if (and (numberp value) (< value 0)) - (setq sign -1 value (- value))) - (if (eq value '-) - (setq sign -1 value nil)) - (while (and char (= ?- char)) - (setq sign (- sign) c-u nil) - (setq char (edmacro-read-char))) - (while (and char (>= char ?0) (<= char ?9)) - (setq value (+ (* (if (numberp value) value 0) 10) (- char ?0)) c-u nil) - (setq char (edmacro-read-char))) - (setq prefix-arg - (cond (c-u (list c-u)) - ((numberp value) (* value sign)) - ((= sign -1) '-))) - (edmacro-unread-chars char))) - -(defun edmacro-insert-string (str) - (let ((i 0) j ch) - (while (< i (length str)) - (if (and (> (setq ch (aref str i)) 127) - (< ch 160)) - (progn - (setq ch (- ch 128)) - (insert "\\M-"))) - (if (< ch 32) - (cond ((= ch 8) (insret "\\b")) - ((= ch 9) (insert "\\t")) - ((= ch 10) (insert "\\n")) - ((= ch 13) (insert "\\r")) - ((= ch 27) (insert "\\e")) - (t (insert "\\C-" (char-to-string (downcase (+ ch 64)))))) - (if (< ch 127) - (if (or (= ch 34) (= ch 92)) - (insert "\\" (char-to-string ch)) - (setq j i) - (while (and (< (setq i (1+ i)) (length str)) - (>= (setq ch (aref str i)) 32) - (/= ch 34) (/= ch 92) - (< ch 127))) - (insert (substring str j i)) - (setq i (1- i))) - (if (memq ch '(127 255)) - (insert (format "\\%03o" ch)) - (insert "\\M-" (char-to-string (- ch 128)))))) - (setq i (1+ i))))) - -(defun edmacro-lookup-key (map) - (let ((loc (and map (lookup-key map macro-str))) - (glob (lookup-key (current-global-map) macro-str)) - (loc-str macro-str) - (glob-str macro-str)) - (and (integerp loc) - (setq loc-str (substring macro-str 0 loc) - loc (lookup-key map loc-str))) - (and (consp loc) - (setq loc nil)) - (or loc - (setq loc-str "")) - (and (integerp glob) - (setq glob-str (substring macro-str 0 glob) - glob (lookup-key (current-global-map) glob-str))) - (and (consp glob) - (setq glob nil)) - (or glob - (setq glob-str "")) - (if (> (length glob-str) (length loc-str)) - (setq key-symbol glob - key-str glob-str) - (setq key-symbol loc - key-str loc-str)) - (setq key-last (and (> (length key-str) 0) - (logand (aref key-str (1- (length key-str))) 127))) - key-symbol)) - -(defun edmacro-read-argument (&optional obarray pred) ;; currently ignored - (let ((str "") - (min-bsp 0) - (exec (eq key-symbol 'execute-extended-command)) - str-base) - (while (progn - (edmacro-lookup-key (current-global-map)) - (or (and (eq key-symbol 'self-insert-command) - (< (length str) 60)) - (memq key-symbol - '(backward-delete-char - delete-backward-char - backward-delete-char-untabify)) - (eq key-last 9))) - (setq macro-str (substring macro-str (length key-str))) - (or (and (eq key-last 9) - obarray - (let ((comp (try-completion str obarray pred))) - (and (stringp comp) - (> (length comp) (length str)) - (setq str comp)))) - (if (or (eq key-symbol 'self-insert-command) - (and (or (eq key-last 9) - (<= (length str) min-bsp)) - (setq min-bsp (+ (length str) (length key-str))))) - (setq str (concat str key-str)) - (setq str (substring str 0 -1))))) - (setq str-base str - str (concat str key-str) - macro-str (substring macro-str (length key-str))) - (if exec - (let ((comp (try-completion str-base obarray pred))) - (if (if (stringp comp) - (and (commandp (intern comp)) - (setq str-base comp)) - (commandp (intern str-base))) - (insert str-base "\n") - (insert "execute-extended-command\n") - (insert "type \"") - (edmacro-insert-string str) - (insert "\"\n"))) - (if (> (length str) 0) - (progn - (insert "type \"") - (edmacro-insert-string str) - (insert "\"\n")))))) +(defun edmacro-format-keys (macro &optional verbose) + (setq macro (edmacro-fix-menu-commands macro)) + (let* ((maps (append (current-minor-mode-maps) + (list (current-local-map) (current-global-map)))) + (pkeys '(end-macro ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?- ?\C-u + ?\M-- ?\M-0 ?\M-1 ?\M-2 ?\M-3 ?\M-4 ?\M-5 ?\M-6 + ?\M-7 ?\M-8 ?\M-9)) + (mdigs (nthcdr 13 pkeys)) + (maxkey (if edmacro-eight-bits 255 127)) + (case-fold-search nil) + (res-words '("NUL" "TAB" "LFD" "RET" "ESC" "SPC" "DEL" "REM")) + (rest-mac (vconcat macro [end-macro])) + (res "") + (len 0) + (one-line (eq verbose 1))) + (if one-line (setq verbose nil)) + (when (stringp macro) + (loop for i below (length macro) do + (when (>= (aref rest-mac i) 128) + (incf (aref rest-mac i) (- (lsh 1 23) 128))))) + (while (not (eq (aref rest-mac 0) 'end-macro)) + (let* ((prefix + (or (and (integerp (aref rest-mac 0)) + (memq (aref rest-mac 0) mdigs) + (memq (key-binding (subseq rest-mac 0 1)) + '(digit-argument negative-argument)) + (let ((i 1)) + (while (memq (aref rest-mac i) (cdr mdigs)) + (incf i)) + (and (not (memq (aref rest-mac i) pkeys)) + (prog1 (concat "M-" (subseq rest-mac 0 i) " ") + (callf subseq rest-mac i))))) + (and (eq (aref rest-mac 0) ?\C-u) + (eq (key-binding [?\C-u]) 'universal-argument) + (let ((i 1)) + (while (eq (aref rest-mac i) ?\C-u) + (incf i)) + (and (not (memq (aref rest-mac i) pkeys)) + (prog1 (loop repeat i concat "C-u ") + (callf subseq rest-mac i))))) + (and (eq (aref rest-mac 0) ?\C-u) + (eq (key-binding [?\C-u]) 'universal-argument) + (let ((i 1)) + (when (eq (aref rest-mac i) ?-) + (incf i)) + (while (memq (aref rest-mac i) + '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) + (incf i)) + (and (not (memq (aref rest-mac i) pkeys)) + (prog1 (concat "C-u " (subseq rest-mac 1 i) " ") + (callf subseq rest-mac i))))))) + (bind-len (apply 'max 1 + (loop for map in maps + for b = (lookup-key map rest-mac) + when b collect b))) + (key (subseq rest-mac 0 bind-len)) + (fkey nil) tlen tkey + (bind (or (loop for map in maps for b = (lookup-key map key) + thereis (and (not (integerp b)) b)) + (and (setq fkey (lookup-key function-key-map rest-mac)) + (setq tlen fkey tkey (subseq rest-mac 0 tlen) + fkey (lookup-key function-key-map tkey)) + (loop for map in maps + for b = (lookup-key map fkey) + when (and (not (integerp b)) b) + do (setq bind-len tlen key tkey) + and return b + finally do (setq fkey nil))))) + (first (aref key 0)) + (text (loop for i from bind-len below (length rest-mac) + for ch = (aref rest-mac i) + while (and (integerp ch) + (> ch 32) (< ch maxkey) (/= ch 92) + (eq (key-binding (char-to-string ch)) + 'self-insert-command) + (or (> i (- (length rest-mac) 2)) + (not (eq ch (aref rest-mac (+ i 1)))) + (not (eq ch (aref rest-mac (+ i 2)))))) + finally return i)) + desc) + (if (stringp bind) (setq bind nil)) + (cond ((and (eq bind 'self-insert-command) (not prefix) + (> text 1) (integerp first) + (> first 32) (<= first maxkey) (/= first 92) + (progn + (if (> text 30) (setq text 30)) + (setq desc (concat (subseq rest-mac 0 text))) + (when (string-match "^[ACHMsS]-." desc) + (setq text 2) + (callf substring desc 0 2)) + (not (string-match + "^;;\\|^<.*>$\\|^\\\\[0-9]+$\\|^[0-9]+\\*." + desc)))) + (when (or (string-match "^\\^.$" desc) + (member desc res-words)) + (setq desc (mapconcat 'char-to-string desc " "))) + (when verbose + (setq bind (format "%s * %d" bind text))) + (setq bind-len text)) + ((and (eq bind 'execute-extended-command) + (> text bind-len) + (memq (aref rest-mac text) '(return 13)) + (progn + (setq desc (concat (subseq rest-mac bind-len text))) + (commandp (intern-soft desc)))) + (if (commandp (intern-soft desc)) (setq bind desc)) + (setq desc (format "<<%s>>" desc)) + (setq bind-len (1+ text))) + (t + (setq desc (mapconcat + (function + (lambda (ch) + (cond + ((integerp ch) + (concat + (loop for pf across "ACHMsS" + for bit in '(18 22 20 23 19 21) + when (/= (logand ch (lsh 1 bit)) 0) + concat (format "%c-" pf)) + (let ((ch2 (logand ch (1- (lsh 1 18))))) + (cond ((<= ch2 32) + (case ch2 + (0 "NUL") (9 "TAB") (10 "LFD") + (13 "RET") (27 "ESC") (32 "SPC") + (t + (format "C-%c" + (+ (if (<= ch2 26) 96 64) + ch2))))) + ((= ch2 127) "DEL") + ((<= ch2 maxkey) (char-to-string ch2)) + (t (format "\\%o" ch2)))))) + ((symbolp ch) + (format "<%s>" ch)) + (t + (error "Unrecognized item in macro: %s" ch))))) + (or fkey key) " ")))) + (if prefix (setq desc (concat prefix desc))) + (unless (string-match " " desc) + (let ((times 1) (pos bind-len)) + (while (not (mismatch rest-mac rest-mac + :end1 bind-len :start2 pos + :end2 (+ bind-len pos))) + (incf times) + (incf pos bind-len)) + (when (> times 1) + (setq desc (format "%d*%s" times desc)) + (setq bind-len (* bind-len times))))) + (setq rest-mac (subseq rest-mac bind-len)) + (if verbose + (progn + (unless (equal res "") (callf concat res "\n")) + (callf concat res desc) + (when (and bind (or (stringp bind) (symbolp bind))) + (callf concat res + (make-string (max (- 3 (/ (length desc) 8)) 1) 9) + ";; " (if (stringp bind) bind (symbol-name bind)))) + (setq len 0)) + (if (and (> (+ len (length desc) 2) 72) (not one-line)) + (progn + (callf concat res "\n ") + (setq len 1)) + (unless (equal res "") + (callf concat res " ") + (incf len))) + (callf concat res desc) + (incf len (length desc))))) + res)) -(defun edmacro-isearch-argument () - (let ((str "") - (min-bsp 0) - ch) - (while (and (setq ch (edmacro-read-char)) - (or (<= ch 127) (not search-exit-option)) - (not (eq ch search-exit-char)) - (or (eq ch search-repeat-char) - (eq ch search-reverse-char) - (eq ch search-delete-char) - (eq ch search-yank-word-char) - (eq ch search-yank-line-char) - (eq ch search-quote-char) - (eq ch ?\r) - (eq ch ?\t) - (not search-exit-option) - (and (/= ch 127) (>= ch 32)))) - (if (and (eq ch search-quote-char) - (edmacro-peek-char)) - (setq str (concat str (char-to-string ch) - (char-to-string (edmacro-read-char))) - min-bsp (length str)) - (if (or (and (< ch 127) (>= ch 32)) - (eq ch search-yank-word-char) - (eq ch search-yank-line-char) - (and (or (not (eq ch search-delete-char)) - (<= (length str) min-bsp)) - (setq min-bsp (1+ (length str))))) - (setq str (concat str (char-to-string ch))) - (setq str (substring str 0 -1))))) - (if (eq ch search-exit-char) - (if (= (length str) 0) ;; non-incremental search - (progn - (setq str (concat str (char-to-string ch))) - (and (eq (edmacro-peek-char) ?\C-w) - (progn - (setq str (concat str "\C-w")) - (edmacro-read-char))) - (if (> (length str) 0) - (progn - (insert "type \"") - (edmacro-insert-string str) - (insert "\"\n"))) - (edmacro-read-argument) - (setq str ""))) - (edmacro-unread-chars ch)) - (if (> (length str) 0) - (progn - (insert "type \"") - (edmacro-insert-string str) - (insert "\\e\"\n"))))) - -;;; Get the next keystroke-sequence from the input stream. -;;; Sets key-symbol, key-str, and key-last as a side effect. -(defun edmacro-read-key () - (edmacro-lookup-key (current-local-map)) - (and key-symbol - (setq macro-str (substring macro-str (length key-str))))) - -(defun edmacro-peek-char () - (and (> (length macro-str) 0) - (aref macro-str 0))) - -(defun edmacro-read-char () - (and (> (length macro-str) 0) - (prog1 - (aref macro-str 0) - (setq macro-str (substring macro-str 1))))) - -(defun edmacro-unread-chars (chars) - (and (integerp chars) - (setq chars (char-to-string chars))) - (and chars - (setq macro-str (concat chars macro-str)))) - -(defun edmacro-dump (mac) - (set-mark-command nil) - (insert "\n\n") - (edmacro-print-macro mac (current-local-map))) +(defun edmacro-fix-menu-commands (macro) + (when (vectorp macro) + (let ((i 0) ev) + (while (< i (length macro)) + (when (consp (setq ev (aref macro i))) + (cond ((equal (cadadr ev) '(menu-bar)) + (setq macro (vconcat (subseq macro 0 i) + (vector 'menu-bar (car ev)) + (subseq macro (1+ i)))) + (incf i)) + ;; It would be nice to do pop-up menus, too, but not enough + ;; info is recorded in macros to make this possible. + (t + (error "Macros with mouse clicks are not %s" + "supported by this command")))) + (incf i)))) + macro) -;;; Parse a string of spelled-out keystrokes, as produced by key-description. - -(defun edmacro-parse-keys (str) - (let ((pos 0) - (mac "") - part) - (while (and (< pos (length str)) - (string-match "[^ \t\n]+" str pos)) - (setq pos (match-end 0) - part (substring str (match-beginning 0) (match-end 0)) - mac (concat mac - (if (and (> (length part) 2) - (= (aref part 1) ?-) - (= (aref part 0) ?M)) - (progn - (setq part (substring part 2)) - "\e") - (if (and (> (length part) 4) - (= (aref part 0) ?C) - (= (aref part 1) ?-) - (= (aref part 2) ?M) - (= (aref part 3) ?-)) - (progn - (setq part (concat "C-" (substring part 4))) - "\e") - "")) - (or (cdr (assoc part '( ( "NUL" . "\0" ) - ( "RET" . "\r" ) - ( "LFD" . "\n" ) - ( "TAB" . "\t" ) - ( "ESC" . "\e" ) - ( "SPC" . " " ) - ( "DEL" . "\177" ) - ( "C-?" . "\177" ) - ( "C-2" . "\0" ) - ( "C-SPC" . "\0") ))) - (and (equal part "REM") - (setq pos (or (string-match "\n" str pos) - (length str))) - "") - (and (= (length part) 3) - (= (aref part 0) ?C) - (= (aref part 1) ?-) - (char-to-string (logand (aref part 2) 31))) - part)))) - mac)) - -;;; Parse a keyboard macro description in edmacro-print-macro's format. +;;; Parsing a human-readable keyboard macro. -(defun edmacro-read-macro (&optional map) - (or map (setq map (current-local-map))) - (let ((macro-str "")) - (while (not (progn - (skip-chars-forward " \t\n") - (eobp))) - (cond ((looking-at "#")) ;; comment - ((looking-at "prefix-arg[ \t]*-[ \t]*\n") - (edmacro-append-chars "\C-u-")) - ((looking-at "prefix-arg[ \t]*\\(-?[0-9]+\\)[ \t]*\n") - (edmacro-append-chars (concat "\C-u" (edmacro-match-string 1)))) - ((looking-at "prefix-arg[ \t]*(\\([0-9]+\\))[ \t]*\n") - (let ((val (string-to-int (edmacro-match-string 1)))) - (while (> val 1) - (or (= (% val 4) 0) - (error "Bad prefix argument value")) - (edmacro-append-chars "\C-u") - (setq val (/ val 4))))) - ((looking-at "prefix-arg") - (error "Bad prefix argument syntax")) - ((looking-at "insert ") - (forward-char 7) - (edmacro-append-chars (read (current-buffer))) - (if (< (current-column) 7) - (forward-line -1))) - ((looking-at "type ") - (forward-char 5) - (edmacro-append-chars (read (current-buffer))) - (if (< (current-column) 5) - (forward-line -1))) - ((looking-at "keys \\(.*\\)\n") - (goto-char (1- (match-end 0))) - (edmacro-append-chars (edmacro-parse-keys - (buffer-substring (match-beginning 1) - (match-end 1))))) - ((looking-at "\\([-a-zA-z0-9_]+\\)[ \t]*\\(.*\\)\n") - (let* ((func (intern (edmacro-match-string 1))) - (arg (edmacro-match-string 2)) - (cust (get func 'edmacro-read))) - (if cust - (funcall cust arg) - (or (commandp func) - (error "Not an Emacs command")) - (or (equal arg "") - (string-match "\\`#" arg) - (error "Unexpected argument to command")) - (let ((keys - (or (where-is-internal func map t) - (where-is-internal func (current-global-map) t)))) - (if keys - (edmacro-append-chars keys) - (edmacro-append-chars (concat "\ex" - (symbol-name func) - "\n"))))))) - (t (error "Syntax error"))) - (forward-line 1)) - macro-str)) - -(defun edmacro-append-chars (chars) - (setq macro-str (concat macro-str chars))) - -(defun edmacro-match-string (n) - (if (match-beginning n) - (buffer-substring (match-beginning n) (match-end n)) - "")) - -(defun edmacro-get-interactive (func) - (if (symbolp func) - (let ((cust (get func 'edmacro-interactive))) - (if cust - cust - (edmacro-get-interactive (symbol-function func)))) - (or (and (eq (car-safe func) 'lambda) - (let ((int (if (consp (nth 2 func)) - (nth 2 func) - (nth 3 func)))) - (and (eq (car-safe int) 'interactive) - (stringp (nth 1 int)) - (nth 1 int)))) - ""))) +(defun edmacro-parse-keys (string &optional need-vector) + (let ((case-fold-search nil) + (pos 0) + (res [])) + (while (and (< pos (length string)) + (string-match "[^ \t\n\f]+" string pos)) + (let ((word (substring string (match-beginning 0) (match-end 0))) + (key nil) + (times 1)) + (setq pos (match-end 0)) + (when (string-match "\\([0-9]+\\)\\*." word) + (setq times (string-to-int (substring word 0 (match-end 1)))) + (setq word (substring word (1+ (match-end 1))))) + (cond ((string-match "^<<.+>>$" word) + (setq key (vconcat (if (eq (key-binding [?\M-x]) + 'execute-extended-command) + [?\M-x] + (or (car (where-is-internal + 'execute-extended-command)) + [?\M-x])) + (substring word 2 -2) "\r"))) + ((and (string-match "^\\(\\([ACHMsS]-\\)*\\)<\\(.+\\)>$" word) + (progn + (setq word (concat (substring word (match-beginning 1) + (match-end 1)) + (substring word (match-beginning 3) + (match-end 3)))) + (not (string-match + "\\<\\(NUL\\|RET\\|LFD\\|ESC\\|SPC\\|DEL\\)$" + word)))) + (setq key (list (intern word)))) + ((or (equal word "REM") (string-match "^;;" word)) + (setq pos (string-match "$" string pos))) + (t + (let ((orig-word word) (prefix 0) (bits 0)) + (while (string-match "^[ACHMsS]-." word) + (incf bits (lsh 1 (cdr (assq (aref word 0) + '((?A . 18) (?C . 22) + (?H . 20) (?M . 23) + (?s . 19) (?S . 21)))))) + (incf prefix 2) + (callf substring word 2)) + (when (string-match "^\\^.$" word) + (incf bits (lsh 1 22)) + (incf prefix) + (callf substring word 1)) + (let ((found (assoc word '(("NUL" . "\0") ("RET" . "\r") + ("LFD" . "\n") ("TAB" . "\t") + ("ESC" . "\e") ("SPC" . " ") + ("DEL" . "\177"))))) + (when found (setq word (cdr found)))) + (when (string-match "^\\\\[0-7]+$" word) + (loop for ch across word + for n = 0 then (+ (* n 8) ch -48) + finally do (setq word (vector n)))) + (cond ((= bits 0) + (setq key word)) + ((and (= bits (lsh 1 23)) (stringp word) + (string-match "^-?[0-9]+$" word)) + (setq key (loop for x across word collect (+ x bits)))) + ((/= (length word) 1) + (error "%s must prefix a single character, not %s" + (substring orig-word 0 prefix) word)) + ((and (/= (logand bits (lsh 1 22)) 0) (stringp word) + (string-match "[@-_.a-z?]" word)) + (setq key (list (+ bits (- (lsh 1 22)) + (if (equal word "?") 127 + (logand (aref word 0) 31)))))) + (t + (setq key (list (+ bits (aref word 0))))))))) + (when key + (loop repeat times do (callf vconcat res key))))) + (when (and (>= (length res) 4) + (eq (aref res 0) ?\C-x) + (eq (aref res 1) ?\() + (eq (aref res (- (length res) 2)) ?\C-x) + (eq (aref res (- (length res) 1)) ?\))) + (setq res (subseq res 2 -2))) + (if (and (not need-vector) + (loop for ch across res + always (and (integerp ch) + (let ((ch2 (logand ch (lognot (lsh 1 23))))) + (and (>= ch2 0) (<= ch2 127)))))) + (concat (loop for ch across res + collect (if (= (logand ch (lsh 1 23)) 0) + ch (+ ch 128)))) + res))) + +;;; The following probably ought to go in macros.el: -(put 'search-forward 'edmacro-interactive "s") -(put 'search-backward 'edmacro-interactive "s") -(put 'word-search-forward 'edmacro-interactive "s") -(put 'word-search-backward 'edmacro-interactive "s") -(put 're-search-forward 'edmacro-interactive "s") -(put 're-search-backward 'edmacro-interactive "s") -(put 'switch-to-buffer 'edmacro-interactive "B") -(put 'kill-buffer 'edmacro-interactive "B") -(put 'rename-buffer 'edmacro-interactive "B\nB") -(put 'goto-char 'edmacro-interactive "N") -(put 'global-set-key 'edmacro-interactive "k\nC") -(put 'global-unset-key 'edmacro-interactive "k") -(put 'local-set-key 'edmacro-interactive "k\nC") -(put 'local-unset-key 'edmacro-interactive "k") - -;;; Think about kbd-macro-query - -;;; Edit a keyboard macro in another buffer. -;;; (Prefix argument is currently ignored.) +;;;###autoload +(defun insert-kbd-macro (macroname &optional keys) + "Insert in buffer the definition of kbd macro NAME, as Lisp code. +Optional second arg KEYS means also record the keys it is on +\(this is the prefix argument, when calling interactively). -(defun edmacro-edit-macro (mac repl &optional prefix buffer hook arg) - (or (stringp mac) - (error "Not a keyboard macro")) - (let ((oldbuf (current-buffer)) - (local (current-local-map)) - (buf (get-buffer-create (or buffer "*Edit Macro*")))) - (set-buffer buf) - (kill-all-local-variables) - (use-local-map edmacro-mode-map) - (setq buffer-read-only nil - major-mode 'edmacro-mode - mode-name "Edit Macro") - (set (make-local-variable 'edmacro-original-buffer) oldbuf) - (set (make-local-variable 'edmacro-replace-function) repl) - (set (make-local-variable 'edmacro-replace-argument) arg) - (set (make-local-variable 'edmacro-finish-hook) hook) - (erase-buffer) - (insert "# Keyboard Macro Editor. Press C-c C-c to finish; press C-x k RET to cancel.\n") - (insert "# Original keys: " (key-description mac) "\n\n") - (message "Formatting keyboard macro...") - (edmacro-print-macro mac local) - (switch-to-buffer buf) - (goto-char (point-min)) - (forward-line 3) - (recenter '(4)) - (set-buffer-modified-p nil) - (message "Formatting keyboard macro...done") - (run-hooks 'edmacro-format-hook))) +This Lisp code will, when executed, define the kbd macro with the same +definition it has now. If you say to record the keys, the Lisp code +will also rebind those keys to the macro. Only global key bindings +are recorded since executing this Lisp code always makes global +bindings. -(defun edmacro-finish-edit () - (interactive) - (or (and (boundp 'edmacro-original-buffer) - (boundp 'edmacro-replace-function) - (boundp 'edmacro-replace-argument) - (boundp 'edmacro-finish-hook) - (eq major-mode 'edmacro-mode)) - (error "This command is valid only in buffers created by `edit-kbd-macro'.")) - (let ((buf (current-buffer)) - (str (buffer-string)) - (func edmacro-replace-function) - (arg edmacro-replace-argument) - (hook edmacro-finish-hook)) - (goto-char (point-min)) - (run-hooks 'edmacro-compile-hook) - (and (buffer-modified-p) - func - (progn - (message "Compiling keyboard macro...") - (let ((mac (edmacro-read-macro - (and (buffer-name edmacro-original-buffer) - (save-excursion - (set-buffer edmacro-original-buffer) - (current-local-map)))))) - (and (buffer-name edmacro-original-buffer) - (switch-to-buffer edmacro-original-buffer)) - (funcall func mac arg)) - (message "Compiling keyboard macro...done"))) - (kill-buffer buf) - (if hook - (funcall hook arg)))) +To save a kbd macro, visit a file of Lisp code such as your `~/.emacs', +use this command, and then save the file." + (interactive "CInsert kbd macro (name): \nP") + (let (definition) + (if (string= (symbol-name macroname) "") + (progn + (setq definition (format-kbd-macro)) + (insert "(setq last-kbd-macro")) + (setq definition (format-kbd-macro macroname)) + (insert (format "(defalias '%s" macroname))) + (if (> (length definition) 50) + (insert " (read-kbd-macro\n") + (insert "\n (read-kbd-macro ")) + (prin1 definition (current-buffer)) + (insert "))\n") + (if keys + (let ((keys (where-is-internal macroname nil))) + (while keys + (insert (format "(global-set-key %S '%s)\n" (car keys) macroname)) + (setq keys (cdr keys))))))) -(defun edmacro-mode () - "\\<edmacro-mode-map>Keyboard Macro Editing mode. Press \\[edmacro-finish-edit] to save and exit. -To abort the edit, just kill this buffer with \\[kill-buffer] RET. - -The keyboard macro is represented as a series of M-x style command names. -Keystrokes which do not correspond to simple M-x commands are written as -\"type\" commands. When you press \\[edmacro-finish-edit], edmacro converts each command -back into a suitable keystroke sequence; \"type\" commands are converted -directly back into keystrokes." - (interactive) - (error "This mode can be enabled only by `edit-kbd-macro' or `edit-last-kbd-macro'.")) -(put 'edmacro-mode 'mode-class 'special) - -(if (boundp 'edmacro-mode-map) () - (setq edmacro-mode-map (make-sparse-keymap)) - (define-key edmacro-mode-map "\C-c\C-c" 'edmacro-finish-edit)) +(provide 'edmacro) ;;; edmacro.el ends here +