;;; edmacro.el --- keyboard macro editor
-;; Copyright (C) 1990 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 2002, 2003, 2004,
+;; 2005, 2006 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.
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; 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 e' (`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:
\f
+(eval-when-compile
+ (require 'cl))
+
+(require 'kmacro)
+
;;; The user-level commands for editing macros.
;;;###autoload
-(defun edit-last-kbd-macro (&optional prefix buffer hook)
+(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))
+
+(defvar edmacro-store-hook)
+(defvar edmacro-finish-hook)
+(defvar edmacro-original-buffer)
+
+;;;###autoload
+(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) (mac-counter nil) (mac-format nil)
+ kmacro)
+ (cond (store-hook
+ (setq mac keys)
+ (setq cmd nil))
+ ((or (memq cmd '(call-last-kbd-macro kmacro-call-macro
+ kmacro-end-or-call-macro kmacro-end-and-call-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 keys nil)
+ (setq cmd 'last-kbd-macro))
+ ((eq cmd 'execute-extended-command)
+ (setq cmd (read-command "Name of keyboard macro to edit: "))
+ (if (string-equal cmd "")
+ (error "No command name given"))
+ (setq keys nil)
+ (setq mac (symbol-function cmd)))
+ ((memq cmd '(view-lossage electric-view-lossage))
+ (setq mac (recent-keys))
+ (setq keys nil)
+ (setq cmd 'last-kbd-macro))
+ ((null cmd)
+ (error "Key sequence %s is not defined" (key-description keys)))
+ ((symbolp cmd)
+ (setq mac (symbol-function cmd)))
+ (t
+ (setq mac cmd)
+ (setq cmd nil)))
+ (when (setq kmacro (kmacro-extract-lambda mac))
+ (setq mac (car kmacro)
+ mac-counter (nth 1 kmacro)
+ mac-format (nth 2 kmacro)))
+ (unless (arrayp mac)
+ (error "Key sequence %s is not a keyboard macro"
+ (key-description keys)))
+ (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 ((gkeys (where-is-internal (or cmd mac) '(keymap))))
+ (if (and keys (not (member keys gkeys)))
+ (setq gkeys (cons keys gkeys)))
+ (if gkeys
+ (while gkeys
+ (insert "Key: " (edmacro-format-keys (pop gkeys) 1) "\n"))
+ (insert "Key: none\n")))
+ (when (and mac-counter mac-format)
+ (insert (format "Counter: %d\nFormat: \"%s\"\n" mac-counter mac-format))))
+ (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-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 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 end)
+(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.
-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."
+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")
- (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))))
-\f
-;;; Formatting a keyboard macro as human-readable text.
+ (if (stringp start)
+ (edmacro-parse-keys start end)
+ (setq last-kbd-macro (edmacro-parse-keys (buffer-substring start end)))))
-(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-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)))
-\f
-;;; 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))
+;;;###autoload
+(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))
\f
-;;; Parse a keyboard macro description in edmacro-print-macro's format.
-
-(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))))
- "")))
-
-(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.)
-
-(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)))
+;;; Commands for *Edit Macro* buffer.
(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))))
+ (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)
+ (mac-counter nil) (mac-format nil) (kmacro 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 (equal str "none"))
+ (intern str)))
+ (and (fboundp cmd) (not (arrayp (symbol-function cmd)))
+ (not (setq kmacro (get cmd 'kmacro)))
+ (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 (equal key "none")
+ (setq no-keys t)
+ (push key keys)
+ (let ((b (key-binding key)))
+ (and b (commandp b) (not (arrayp b))
+ (not (kmacro-extract-lambda b))
+ (or (not (fboundp b))
+ (not (or (arrayp (symbol-function b))
+ (get b 'kmacro))))
+ (not (y-or-n-p
+ (format "Key %s is already defined; %s"
+ (edmacro-format-keys key 1)
+ "proceed? ")))
+ (keyboard-quit))))))
+ t)
+ ((looking-at "Counter:[ \t]*\\([^ \t\n]*\\)[ \t]*$")
+ (when edmacro-store-hook
+ (error "\"Counter\" line not allowed in this context"))
+ (let ((str (buffer-substring (match-beginning 1)
+ (match-end 1))))
+ (unless (equal str "")
+ (setq mac-counter (string-to-number str))))
+ t)
+ ((looking-at "Format:[ \t]*\"\\([^\n]*\\)\"[ \t]*$")
+ (when edmacro-store-hook
+ (error "\"Format\" line not allowed in this context"))
+ (let ((str (buffer-substring (match-beginning 1)
+ (match-end 1))))
+ (unless (equal str "")
+ (setq mac-format str)))
+ 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
+ (if (and mac-counter mac-format)
+ (kmacro-lambda-form mac mac-counter mac-format)
+ mac))))
+ (if no-keys
+ (when cmd
+ (loop for key in (where-is-internal cmd '(keymap)) 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
+ (if (and mac-counter mac-format)
+ (kmacro-lambda-form mac mac-counter mac-format)
+ mac))))))))))
+ (kill-buffer buf)
+ (when (buffer-name obuf)
+ (switch-to-buffer obuf))
+ (when finish-hook
+ (funcall finish-hook)))))
+
+(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.
+ "\\<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."
+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' or `edit-last-kbd-macro'."))
+ (error "This mode can be enabled only by `edit-kbd-macro'"))
(put 'edmacro-mode 'mode-class 'special)
+\f
+;;; Formatting a keyboard macro as human-readable text.
-(if (boundp 'edmacro-mode-map) ()
- (setq edmacro-mode-map (make-sparse-keymap))
- (define-key edmacro-mode-map "\C-c\C-c" 'edmacro-finish-edit))
-
+(defun edmacro-format-keys (macro &optional verbose)
+ (setq macro (edmacro-fix-menu-commands macro))
+ (let* ((maps (append (current-minor-mode-maps)
+ (if (current-local-map)
+ (list (current-local-map)))
+ (list (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) (- ?\M-\^@ 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 (edmacro-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 (vconcat "M-" (edmacro-subseq rest-mac 0 i) " ")
+ (callf edmacro-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 edmacro-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 (vconcat "C-u " (edmacro-subseq rest-mac 1 i) " ")
+ (callf edmacro-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 (edmacro-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 (edmacro-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 (edmacro-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 (edmacro-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 '(?\A-\^@ ?\C-\^@ ?\H-\^@
+ ?\M-\^@ ?\s-\^@ ?\S-\^@)
+ when (/= (logand ch 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 (edmacro-sanitize-for-string prefix) desc)))
+ (unless (string-match " " desc)
+ (let ((times 1) (pos bind-len))
+ (while (not (edmacro-mismatch rest-mac rest-mac
+ 0 bind-len pos (+ 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 (edmacro-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-mismatch (cl-seq1 cl-seq2 cl-start1 cl-end1 cl-start2 cl-end2)
+ "Compare SEQ1 with SEQ2, return index of first mismatching element.
+Return nil if the sequences match. If one sequence is a prefix of the
+other, the return value indicates the end of the shorted sequence."
+ (let (cl-test cl-test-not cl-key cl-from-end)
+ (or cl-end1 (setq cl-end1 (length cl-seq1)))
+ (or cl-end2 (setq cl-end2 (length cl-seq2)))
+ (if cl-from-end
+ (progn
+ (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
+ (cl-check-match (elt cl-seq1 (1- cl-end1))
+ (elt cl-seq2 (1- cl-end2))))
+ (setq cl-end1 (1- cl-end1) cl-end2 (1- cl-end2)))
+ (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
+ (1- cl-end1)))
+ (let ((cl-p1 (and (listp cl-seq1) (nthcdr cl-start1 cl-seq1)))
+ (cl-p2 (and (listp cl-seq2) (nthcdr cl-start2 cl-seq2))))
+ (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
+ (cl-check-match (if cl-p1 (car cl-p1)
+ (aref cl-seq1 cl-start1))
+ (if cl-p2 (car cl-p2)
+ (aref cl-seq2 cl-start2))))
+ (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)
+ cl-start1 (1+ cl-start1) cl-start2 (1+ cl-start2)))
+ (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
+ cl-start1)))))
+
+(defun edmacro-subseq (seq start &optional end)
+ "Return the subsequence of SEQ from START to END.
+If END is omitted, it defaults to the length of the sequence.
+If START or END is negative, it counts from the end."
+ (if (stringp seq) (substring seq start end)
+ (let (len)
+ (and end (< end 0) (setq end (+ end (setq len (length seq)))))
+ (if (< start 0) (setq start (+ start (or len (setq len (length seq))))))
+ (cond ((listp seq)
+ (if (> start 0) (setq seq (nthcdr start seq)))
+ (if end
+ (let ((res nil))
+ (while (>= (setq end (1- end)) start)
+ (push (pop seq) res))
+ (nreverse res))
+ (copy-sequence seq)))
+ (t
+ (or end (setq end (or len (length seq))))
+ (let ((res (make-vector (max (- end start) 0) nil))
+ (i 0))
+ (while (< start end)
+ (aset res i (aref seq start))
+ (setq i (1+ i) start (1+ start)))
+ res))))))
+
+(defun edmacro-sanitize-for-string (seq)
+ "Convert a key sequence vector into a string.
+The string represents the same events; Meta is indicated by bit 7.
+This function assumes that the events can be stored in a string."
+ (setq seq (copy-sequence seq))
+ (loop for i below (length seq) do
+ (when (logand (aref seq i) 128)
+ (setf (aref seq i) (logand (aref seq i) 127))))
+ seq)
+
+(defun edmacro-fix-menu-commands (macro &optional noerror)
+ (if (vectorp macro)
+ (let (result)
+ ;; Make a list of the elements.
+ (setq macro (append macro nil))
+ (dolist (ev macro)
+ (cond ((atom ev)
+ (push ev result))
+ ((eq (car ev) 'help-echo))
+ ((equal ev '(menu-bar))
+ (push 'menu-bar result))
+ ((equal (cadadr ev) '(menu-bar))
+ (push (vector 'menu-bar (car ev)) result))
+ ;; It would be nice to do pop-up menus, too, but not enough
+ ;; info is recorded in macros to make this possible.
+ (noerror
+ ;; Just ignore mouse events.
+ nil)
+ (t
+ (error "Macros with mouse clicks are not %s"
+ "supported by this command"))))
+ ;; Reverse them again and make them back into a vector.
+ (vconcat (nreverse result)))
+ macro))
+\f
+;;; Parsing a human-readable keyboard macro.
+
+(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-number (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 (cdr (assq (aref word 0)
+ '((?A . ?\A-\^@) (?C . ?\C-\^@)
+ (?H . ?\H-\^@) (?M . ?\M-\^@)
+ (?s . ?\s-\^@) (?S . ?\S-\^@)))))
+ (incf prefix 2)
+ (callf substring word 2))
+ (when (string-match "^\\^.$" word)
+ (incf bits ?\C-\^@)
+ (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 ?\M-\^@) (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 ?\C-\^@) 0) (stringp word)
+ ;; We used to accept . and ? here,
+ ;; but . is simply wrong,
+ ;; and C-? is not used (we use DEL instead).
+ (string-match "[@-_a-z]" word))
+ (setq key (list (+ bits (- ?\C-\^@)
+ (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 (edmacro-subseq res 2 -2)))
+ (if (and (not need-vector)
+ (loop for ch across res
+ always (and (char-valid-p ch)
+ (let ((ch2 (logand ch (lognot ?\M-\^@))))
+ (and (>= ch2 0) (<= ch2 127))))))
+ (concat (loop for ch across res
+ collect (if (= (logand ch ?\M-\^@) 0)
+ ch (+ ch 128))))
+ res)))
+
+(provide 'edmacro)
+
+;;; arch-tag: 726807b4-3ae6-49de-b0ae-b9590973e0d7
;;; edmacro.el ends here