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