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