mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-11 09:20:51 +00:00
e5695faec4
This is of little consequence in practice since the input is always a vector of keys representing a prefix, where bit 7 isn't likely to be set when higher bits are set, but it silences a (justified) warning.
683 lines
26 KiB
EmacsLisp
683 lines
26 KiB
EmacsLisp
;;; edmacro.el --- keyboard macro editor -*- lexical-binding: t; -*-
|
||
|
||
;; Copyright (C) 1993-1994, 2001-2022 Free Software Foundation, Inc.
|
||
|
||
;; Author: Dave Gillespie <daveg@synaptics.com>
|
||
;; Keywords: abbrev
|
||
|
||
;; This file is part of GNU Emacs.
|
||
|
||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||
;; it under the terms of the GNU General Public License as published by
|
||
;; the Free Software Foundation, either version 3 of the License, or
|
||
;; (at your option) any later version.
|
||
|
||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;; GNU General Public License for more details.
|
||
|
||
;; You should have received a copy of the GNU General Public License
|
||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||
|
||
;;; Commentary:
|
||
|
||
;;; 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 300 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.
|
||
|
||
;;; Code:
|
||
|
||
(require 'cl-lib)
|
||
(require 'seq)
|
||
(require 'kmacro)
|
||
|
||
;;; The user-level commands for editing macros.
|
||
|
||
(defcustom 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."
|
||
:type 'boolean
|
||
:group 'kmacro)
|
||
|
||
(defvar-keymap edmacro-mode-map
|
||
"C-c C-c" #'edmacro-finish-edit
|
||
"C-c C-q" #'edmacro-insert-key)
|
||
|
||
(defface edmacro-label
|
||
'((default :inherit bold)
|
||
(((class color) (background dark)) :foreground "light blue")
|
||
(((min-colors 88) (class color) (background light)) :foreground "DarkBlue")
|
||
(((class color) (background light)) :foreground "blue")
|
||
(t :inherit bold))
|
||
"Face used for labels in `edit-kbd-macro'."
|
||
:version "29.1"
|
||
:group 'kmacro)
|
||
|
||
(defvar edmacro-mode-font-lock-keywords
|
||
`((,(rx bol (group (or "Command" "Key" "Macro") ":")) 0 'edmacro-label)
|
||
(,(rx bol
|
||
(group ";; Keyboard Macro Editor. Press ")
|
||
(group (*? any))
|
||
(group " to finish; press "))
|
||
(1 'font-lock-comment-face)
|
||
(2 'help-key-binding)
|
||
(3 'font-lock-comment-face)
|
||
(,(rx (group (*? any))
|
||
(group " to cancel" (* any)))
|
||
nil nil
|
||
(1 'help-key-binding)
|
||
(2 'font-lock-comment-face)))
|
||
(,(rx (one-or-more ";") (zero-or-more any)) 0 'font-lock-comment-face)))
|
||
|
||
(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 `\\[kmacro-end-and-call-macro]' or \\`RET' to edit the last
|
||
keyboard macro, `\\[view-lossage]' to edit the last 300
|
||
keystrokes as a keyboard macro, or `\\[execute-extended-command]'
|
||
to edit a macro by its command name.
|
||
With a prefix argument, format the macro in a more concise way."
|
||
(interactive
|
||
(list (read-key-sequence (substitute-command-keys "Keyboard macro to edit \
|
||
\(\\[kmacro-end-and-call-macro], \\[execute-extended-command], \\[view-lossage],\
|
||
or keys): "))
|
||
current-prefix-arg))
|
||
(when keys
|
||
(let ((cmd (if (arrayp keys) (key-binding keys) keys))
|
||
(cmd-noremap (when (arrayp keys) (key-binding keys nil t)))
|
||
(mac nil) (mac-counter nil) (mac-format nil))
|
||
(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))
|
||
(memq cmd-noremap '(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))
|
||
((memq 'execute-extended-command (list cmd cmd-noremap))
|
||
(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)))
|
||
((or (memq cmd '(view-lossage electric-view-lossage))
|
||
(memq cmd-noremap '(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 (kmacro-p mac)
|
||
(setq mac (kmacro--keys mac)
|
||
mac-counter (kmacro--counter mac)
|
||
mac-format (kmacro--format mac)))
|
||
(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")
|
||
(setq-local edmacro-original-buffer oldbuf)
|
||
(setq-local edmacro-finish-hook finish-hook)
|
||
(setq-local edmacro-store-hook store-hook)
|
||
(setq-local font-lock-defaults
|
||
'(edmacro-mode-font-lock-keywords nil nil nil nil))
|
||
(setq font-lock-multiline nil)
|
||
(erase-buffer)
|
||
(insert (substitute-command-keys
|
||
(concat
|
||
;; When editing this, make sure to update
|
||
;; `edmacro-mode-font-lock-keywords' to match.
|
||
";; Keyboard Macro Editor. Press \\[edmacro-finish-edit] "
|
||
"to finish; press \\[kill-buffer] \\`RET' to cancel.\n")
|
||
;; Use 'no-face argument to not conflict with font-lock.
|
||
'no-face))
|
||
(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")
|
||
(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 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.
|
||
|
||
(defun edmacro-finish-edit ()
|
||
(interactive nil edmacro-mode)
|
||
(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)
|
||
(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 (match-string 1)))
|
||
(unless (equal str "")
|
||
(setq cmd (and (not (equal str "none"))
|
||
(intern str)))
|
||
(and (fboundp cmd) (not (arrayp (symbol-function cmd)))
|
||
(not (get cmd 'kmacro))
|
||
(not (y-or-n-p
|
||
(format
|
||
"Command %s is already defined; proceed?"
|
||
cmd)))
|
||
(keyboard-quit))))
|
||
t)
|
||
((looking-at "Key:\\(.*\\)$")
|
||
(when edmacro-store-hook
|
||
(error "\"Key\" line not allowed in this context"))
|
||
(let ((key (kbd (match-string 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-p 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; proceed?"
|
||
(edmacro-format-keys key 1))))
|
||
(keyboard-quit))))))
|
||
t)
|
||
((looking-at "Counter:[ \t]*\\([^ \t\n]*\\)[ \t]*$")
|
||
(when edmacro-store-hook
|
||
(error "\"Counter\" line not allowed in this context"))
|
||
(let ((str (match-string 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 (match-string 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 (kmacro mac mac-counter mac-format))))
|
||
(if no-keys
|
||
(when cmd
|
||
(cl-loop for key in (where-is-internal cmd '(keymap)) do
|
||
(global-unset-key key)))
|
||
(when keys
|
||
(if (= (length mac) 0)
|
||
(cl-loop for key in keys do (global-unset-key key))
|
||
(cl-loop for key in keys do
|
||
(global-set-key key
|
||
(or cmd
|
||
(kmacro mac mac-counter
|
||
mac-format))))))))))
|
||
(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: " edmacro-mode)
|
||
(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-format-keys (macro &optional verbose)
|
||
(setq macro (edmacro-fix-menu-commands macro))
|
||
(let* ((maps (current-active-maps))
|
||
(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)
|
||
(cl-loop for i below (length macro) do
|
||
(when (>= (aref rest-mac i) 128)
|
||
(cl-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 (cl-subseq rest-mac 0 1))
|
||
'(digit-argument negative-argument))
|
||
(let ((i 1))
|
||
(while (memq (aref rest-mac i) (cdr mdigs))
|
||
(cl-incf i))
|
||
(and (not (memq (aref rest-mac i) pkeys))
|
||
(prog1 (vconcat "M-" (cl-subseq rest-mac 0 i) " ")
|
||
(cl-callf cl-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)
|
||
(cl-incf i))
|
||
(and (not (memq (aref rest-mac i) pkeys))
|
||
(prog1 (cl-loop repeat i concat "C-u ")
|
||
(cl-callf cl-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) ?-)
|
||
(cl-incf i))
|
||
(while (memq (aref rest-mac i)
|
||
'(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
|
||
(cl-incf i))
|
||
(and (not (memq (aref rest-mac i) pkeys))
|
||
(prog1 (vconcat "C-u " (cl-subseq rest-mac 1 i) " ")
|
||
(cl-callf cl-subseq rest-mac i)))))))
|
||
(bind-len (apply #'max 1
|
||
(cl-loop for map in maps
|
||
for b = (lookup-key map rest-mac)
|
||
when b collect b)))
|
||
(key (cl-subseq rest-mac 0 bind-len))
|
||
(fkey nil) tlen tkey
|
||
(bind (or (cl-loop for map in maps for b = (lookup-key map key)
|
||
thereis (and (not (integerp b)) b))
|
||
(and (setq fkey (lookup-key local-function-key-map rest-mac))
|
||
(setq tlen fkey tkey (cl-subseq rest-mac 0 tlen)
|
||
fkey (lookup-key local-function-key-map tkey))
|
||
(cl-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
|
||
(cl-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 (cl-subseq rest-mac 0 text)))
|
||
(when (string-match "^[ACHMsS]-." desc)
|
||
(setq text 2)
|
||
(cl-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 (cl-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
|
||
(lambda (ch)
|
||
(cond
|
||
((integerp ch)
|
||
(concat
|
||
(cl-loop for pf across "ACHMsS"
|
||
for bit in '( ?\A-\0 ?\C-\0 ?\H-\0
|
||
?\M-\0 ?\s-\0 ?\S-\0)
|
||
when (/= (logand ch bit) 0)
|
||
concat (format "%c-" pf))
|
||
(let ((ch2 (logand ch (1- (ash 1 18)))))
|
||
(cond ((<= ch2 32)
|
||
(pcase ch2
|
||
(0 "NUL") (9 "TAB") (10 "LFD")
|
||
(13 "RET") (27 "ESC") (32 "SPC")
|
||
(_
|
||
(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-search " " desc)
|
||
(let ((times 1) (pos bind-len))
|
||
(while (not (cl-mismatch rest-mac rest-mac
|
||
:start1 0 :end1 bind-len
|
||
:start2 pos :end2 (+ bind-len pos)))
|
||
(cl-incf times)
|
||
(cl-incf pos bind-len))
|
||
(when (> times 1)
|
||
(setq desc (format "%d*%s" times desc))
|
||
(setq bind-len (* bind-len times)))))
|
||
(setq rest-mac (cl-subseq rest-mac bind-len))
|
||
(if verbose
|
||
(progn
|
||
(unless (equal res "") (cl-callf concat res "\n"))
|
||
(cl-callf concat res desc)
|
||
(when (and bind (or (stringp bind) (symbolp bind)))
|
||
(cl-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
|
||
(cl-callf concat res "\n ")
|
||
(setq len 1))
|
||
(unless (equal res "")
|
||
(cl-callf concat res " ")
|
||
(cl-incf len)))
|
||
(cl-callf concat res desc)
|
||
(cl-incf len (length desc)))))
|
||
res))
|
||
|
||
(defun edmacro-sanitize-for-string (seq)
|
||
"Convert a key sequence vector SEQ 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))
|
||
(cl-loop for i below (length seq) do
|
||
(when (/= (logand (aref seq i) 128) 0)
|
||
(setf (aref seq i) (logand (aref seq i) 127))))
|
||
seq)
|
||
|
||
;; These are needed in a --without-x build.
|
||
(defvar mouse-wheel-down-event)
|
||
(defvar mouse-wheel-up-event)
|
||
(defvar mouse-wheel-right-event)
|
||
(defvar mouse-wheel-left-event)
|
||
|
||
(defun edmacro-fix-menu-commands (macro &optional noerror)
|
||
(if (vectorp macro)
|
||
(let (result)
|
||
;; Not preloaded in a --without-x build.
|
||
(require 'mwheel)
|
||
;; 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))
|
||
((eq (car ev) 'switch-frame))
|
||
((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.
|
||
((or (mouse-event-p ev) (mouse-movement-p ev)
|
||
(memq (event-basic-type ev)
|
||
(list mouse-wheel-down-event mouse-wheel-up-event
|
||
mouse-wheel-right-event
|
||
mouse-wheel-left-event)))
|
||
nil)
|
||
(noerror nil)
|
||
(t
|
||
(error "`edmacro-fix-menu-commands': Unsupported event: %S"
|
||
ev))))
|
||
;; Reverse them again and make them back into a vector.
|
||
(vconcat (nreverse result)))
|
||
macro))
|
||
|
||
|
||
;;; Parsing a human-readable keyboard macro.
|
||
|
||
(defun edmacro-parse-keys (string &optional _need-vector)
|
||
(let ((result (kbd string)))
|
||
(if (stringp result)
|
||
(seq-into result 'vector)
|
||
result)))
|
||
|
||
(provide 'edmacro)
|
||
|
||
;;; edmacro.el ends here
|