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