| 1 | ;;; edmacro.el --- keyboard macro editor |
| 2 | |
| 3 | ;; Copyright (C) 1990 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Author: Dave Gillespie <daveg@csvax.caltech.edu> |
| 6 | ;; Maintainer: FSF |
| 7 | ;; Version: 1.02 |
| 8 | |
| 9 | ;; This file is part of GNU Emacs. |
| 10 | |
| 11 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 12 | ;; it under the terms of the GNU General Public License as published by |
| 13 | ;; the Free Software Foundation; either version 2, or (at your option) |
| 14 | ;; any later version. |
| 15 | |
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 19 | ;; GNU General Public License for more details. |
| 20 | |
| 21 | ;; You should have received a copy of the GNU General Public License |
| 22 | ;; along with GNU Emacs; see the file COPYING. If not, write to |
| 23 | ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. |
| 24 | |
| 25 | ;;; Commentary: |
| 26 | |
| 27 | ;; To use, type `M-x edit-last-kbd-macro' to edit the most recently |
| 28 | ;; defined keyboard macro. If you have used `M-x name-last-kbd-macro' |
| 29 | ;; to give a keyboard macro a name, type `M-x edit-kbd-macro' to edit |
| 30 | ;; the macro by name. When you are done editing, type `C-c C-c' to |
| 31 | ;; record your changes back into the original keyboard macro. |
| 32 | |
| 33 | ;;; Code: |
| 34 | \f |
| 35 | ;;; The user-level commands for editing macros. |
| 36 | |
| 37 | ;;;###autoload |
| 38 | (defun edit-last-kbd-macro (&optional prefix buffer hook) |
| 39 | "Edit the most recently defined keyboard macro." |
| 40 | (interactive "P") |
| 41 | (edmacro-edit-macro last-kbd-macro |
| 42 | (function (lambda (x arg) (setq last-kbd-macro x))) |
| 43 | prefix buffer hook)) |
| 44 | |
| 45 | ;;;###autoload |
| 46 | (defun edit-kbd-macro (cmd &optional prefix buffer hook in-hook out-hook) |
| 47 | "Edit a keyboard macro which has been given a name by `name-last-kbd-macro'. |
| 48 | \(See also `edit-last-kbd-macro'.)" |
| 49 | (interactive "CCommand name: \nP") |
| 50 | (and cmd |
| 51 | (edmacro-edit-macro (if in-hook |
| 52 | (funcall in-hook cmd) |
| 53 | (symbol-function cmd)) |
| 54 | (or out-hook |
| 55 | (list 'lambda '(x arg) |
| 56 | (list 'fset |
| 57 | (list 'quote cmd) |
| 58 | 'x))) |
| 59 | prefix buffer hook cmd))) |
| 60 | |
| 61 | ;;;###autoload |
| 62 | (defun read-kbd-macro (start end) |
| 63 | "Read the region as a keyboard macro definition. |
| 64 | The region is interpreted as spelled-out keystrokes, e.g., \"M-x abc RET\". |
| 65 | The resulting macro is installed as the \"current\" keyboard macro. |
| 66 | |
| 67 | Symbols: RET, SPC, TAB, DEL, LFD, NUL; C-key; M-key. (Must be uppercase.) |
| 68 | REM marks the rest of a line as a comment. |
| 69 | Whitespace is ignored; other characters are copied into the macro." |
| 70 | (interactive "r") |
| 71 | (setq last-kbd-macro (edmacro-parse-keys (buffer-substring start end))) |
| 72 | (if (and (string-match "\\`\C-x(" last-kbd-macro) |
| 73 | (string-match "\C-x)\\'" last-kbd-macro)) |
| 74 | (setq last-kbd-macro (substring last-kbd-macro 2 -2)))) |
| 75 | \f |
| 76 | ;;; Formatting a keyboard macro as human-readable text. |
| 77 | |
| 78 | (defun edmacro-print-macro (macro-str local-map) |
| 79 | (let ((save-map (current-local-map)) |
| 80 | (print-escape-newlines t) |
| 81 | key-symbol key-str key-last prefix-arg this-prefix) |
| 82 | (unwind-protect |
| 83 | (progn |
| 84 | (use-local-map local-map) |
| 85 | (while (edmacro-peek-char) |
| 86 | (edmacro-read-key) |
| 87 | (setq this-prefix prefix-arg) |
| 88 | (or (memq key-symbol '(digit-argument |
| 89 | negative-argument |
| 90 | universal-argument)) |
| 91 | (null prefix-arg) |
| 92 | (progn |
| 93 | (cond ((consp prefix-arg) |
| 94 | (insert (format "prefix-arg (%d)\n" |
| 95 | (car prefix-arg)))) |
| 96 | ((eq prefix-arg '-) |
| 97 | (insert "prefix-arg -\n")) |
| 98 | ((numberp prefix-arg) |
| 99 | (insert (format "prefix-arg %d\n" prefix-arg)))) |
| 100 | (setq prefix-arg nil))) |
| 101 | (cond ((null key-symbol) |
| 102 | (insert "type \"") |
| 103 | (edmacro-insert-string macro-str) |
| 104 | (insert "\"\n") |
| 105 | (setq macro-str "")) |
| 106 | ((eq key-symbol 'digit-argument) |
| 107 | (edmacro-prefix-arg key-last nil prefix-arg)) |
| 108 | ((eq key-symbol 'negative-argument) |
| 109 | (edmacro-prefix-arg ?- nil prefix-arg)) |
| 110 | ((eq key-symbol 'universal-argument) |
| 111 | (let* ((c-u 4) (argstartchar key-last) |
| 112 | (char (edmacro-read-char))) |
| 113 | (while (= char argstartchar) |
| 114 | (setq c-u (* 4 c-u) |
| 115 | char (edmacro-read-char))) |
| 116 | (edmacro-prefix-arg char c-u nil))) |
| 117 | ((eq key-symbol 'self-insert-command) |
| 118 | (insert "insert ") |
| 119 | (if (and (>= key-last 32) (<= key-last 126)) |
| 120 | (let ((str "")) |
| 121 | (while (or (and (eq key-symbol |
| 122 | 'self-insert-command) |
| 123 | (< (length str) 60) |
| 124 | (>= key-last 32) |
| 125 | (<= key-last 126)) |
| 126 | (and (memq key-symbol |
| 127 | '(backward-delete-char |
| 128 | delete-backward-char |
| 129 | backward-delete-char-untabify)) |
| 130 | (> (length str) 0))) |
| 131 | (if (eq key-symbol 'self-insert-command) |
| 132 | (setq str (concat str |
| 133 | (char-to-string key-last))) |
| 134 | (setq str (substring str 0 -1))) |
| 135 | (edmacro-read-key)) |
| 136 | (insert "\"" str "\"\n") |
| 137 | (edmacro-unread-chars key-str)) |
| 138 | (insert "\"") |
| 139 | (edmacro-insert-string (char-to-string key-last)) |
| 140 | (insert "\"\n"))) |
| 141 | ((and (eq key-symbol 'quoted-insert) |
| 142 | (edmacro-peek-char)) |
| 143 | (insert "quoted-insert\n") |
| 144 | (let ((ch (edmacro-read-char)) |
| 145 | ch2) |
| 146 | (if (and (>= ch ?0) (<= ch ?7)) |
| 147 | (progn |
| 148 | (setq ch (- ch ?0) |
| 149 | ch2 (edmacro-read-char)) |
| 150 | (if ch2 |
| 151 | (if (and (>= ch2 ?0) (<= ch2 ?7)) |
| 152 | (progn |
| 153 | (setq ch (+ (* ch 8) (- ch2 ?0)) |
| 154 | ch2 (edmacro-read-char)) |
| 155 | (if ch2 |
| 156 | (if (and (>= ch2 ?0) (<= ch2 ?7)) |
| 157 | (setq ch (+ (* ch 8) (- ch2 ?0))) |
| 158 | (edmacro-unread-chars ch2)))) |
| 159 | (edmacro-unread-chars ch2))))) |
| 160 | (if (or (and (>= ch ?0) (<= ch ?7)) |
| 161 | (< ch 32) (> ch 126)) |
| 162 | (insert (format "type \"\\%03o\"\n" ch)) |
| 163 | (insert "type \"" (char-to-string ch) "\"\n")))) |
| 164 | ((memq key-symbol '(isearch-forward |
| 165 | isearch-backward |
| 166 | isearch-forward-regexp |
| 167 | isearch-backward-regexp)) |
| 168 | (insert (symbol-name key-symbol) "\n") |
| 169 | (edmacro-isearch-argument)) |
| 170 | ((eq key-symbol 'execute-extended-command) |
| 171 | (edmacro-read-argument obarray 'commandp)) |
| 172 | (t |
| 173 | (let ((cust (get key-symbol 'edmacro-print))) |
| 174 | (if cust |
| 175 | (funcall cust) |
| 176 | (insert (symbol-name key-symbol)) |
| 177 | (indent-to 30) |
| 178 | (insert " # ") |
| 179 | (edmacro-insert-string key-str) |
| 180 | (insert "\n") |
| 181 | (let ((int (edmacro-get-interactive key-symbol))) |
| 182 | (if (string-match "\\`\\*" int) |
| 183 | (setq int (substring int 1))) |
| 184 | (while (> (length int) 0) |
| 185 | (cond ((= (aref int 0) ?a) |
| 186 | (edmacro-read-argument |
| 187 | obarray nil)) |
| 188 | ((memq (aref int 0) '(?b ?B ?D ?f ?F ?n |
| 189 | ?s ?S ?x ?X)) |
| 190 | (edmacro-read-argument)) |
| 191 | ((and (= (aref int 0) ?c) |
| 192 | (edmacro-peek-char)) |
| 193 | (insert "type \"") |
| 194 | (edmacro-insert-string |
| 195 | (char-to-string |
| 196 | (edmacro-read-char))) |
| 197 | (insert "\"\n")) |
| 198 | ((= (aref int 0) ?C) |
| 199 | (edmacro-read-argument |
| 200 | obarray 'commandp)) |
| 201 | ((= (aref int 0) ?k) |
| 202 | (edmacro-read-key) |
| 203 | (if key-symbol |
| 204 | (progn |
| 205 | (insert "type \"") |
| 206 | (edmacro-insert-string key-str) |
| 207 | (insert "\"\n")) |
| 208 | (edmacro-unread-chars key-str))) |
| 209 | ((= (aref int 0) ?N) |
| 210 | (or this-prefix |
| 211 | (edmacro-read-argument))) |
| 212 | ((= (aref int 0) ?v) |
| 213 | (edmacro-read-argument |
| 214 | obarray 'user-variable-p))) |
| 215 | (let ((nl (string-match "\n" int))) |
| 216 | (setq int (if nl |
| 217 | (substring int (1+ nl)) |
| 218 | ""))))))))))) |
| 219 | (use-local-map save-map)))) |
| 220 | |
| 221 | (defun edmacro-prefix-arg (char c-u value) |
| 222 | (let ((sign 1)) |
| 223 | (if (and (numberp value) (< value 0)) |
| 224 | (setq sign -1 value (- value))) |
| 225 | (if (eq value '-) |
| 226 | (setq sign -1 value nil)) |
| 227 | (while (and char (= ?- char)) |
| 228 | (setq sign (- sign) c-u nil) |
| 229 | (setq char (edmacro-read-char))) |
| 230 | (while (and char (>= char ?0) (<= char ?9)) |
| 231 | (setq value (+ (* (if (numberp value) value 0) 10) (- char ?0)) c-u nil) |
| 232 | (setq char (edmacro-read-char))) |
| 233 | (setq prefix-arg |
| 234 | (cond (c-u (list c-u)) |
| 235 | ((numberp value) (* value sign)) |
| 236 | ((= sign -1) '-))) |
| 237 | (edmacro-unread-chars char))) |
| 238 | |
| 239 | (defun edmacro-insert-string (str) |
| 240 | (let ((i 0) j ch) |
| 241 | (while (< i (length str)) |
| 242 | (if (and (> (setq ch (aref str i)) 127) |
| 243 | (< ch 160)) |
| 244 | (progn |
| 245 | (setq ch (- ch 128)) |
| 246 | (insert "\\M-"))) |
| 247 | (if (< ch 32) |
| 248 | (cond ((= ch 8) (insret "\\b")) |
| 249 | ((= ch 9) (insert "\\t")) |
| 250 | ((= ch 10) (insert "\\n")) |
| 251 | ((= ch 13) (insert "\\r")) |
| 252 | ((= ch 27) (insert "\\e")) |
| 253 | (t (insert "\\C-" (char-to-string (downcase (+ ch 64)))))) |
| 254 | (if (< ch 127) |
| 255 | (if (or (= ch 34) (= ch 92)) |
| 256 | (insert "\\" (char-to-string ch)) |
| 257 | (setq j i) |
| 258 | (while (and (< (setq i (1+ i)) (length str)) |
| 259 | (>= (setq ch (aref str i)) 32) |
| 260 | (/= ch 34) (/= ch 92) |
| 261 | (< ch 127))) |
| 262 | (insert (substring str j i)) |
| 263 | (setq i (1- i))) |
| 264 | (if (memq ch '(127 255)) |
| 265 | (insert (format "\\%03o" ch)) |
| 266 | (insert "\\M-" (char-to-string (- ch 128)))))) |
| 267 | (setq i (1+ i))))) |
| 268 | |
| 269 | (defun edmacro-lookup-key (map) |
| 270 | (let ((loc (and map (lookup-key map macro-str))) |
| 271 | (glob (lookup-key (current-global-map) macro-str)) |
| 272 | (loc-str macro-str) |
| 273 | (glob-str macro-str)) |
| 274 | (and (integerp loc) |
| 275 | (setq loc-str (substring macro-str 0 loc) |
| 276 | loc (lookup-key map loc-str))) |
| 277 | (and (consp loc) |
| 278 | (setq loc nil)) |
| 279 | (or loc |
| 280 | (setq loc-str "")) |
| 281 | (and (integerp glob) |
| 282 | (setq glob-str (substring macro-str 0 glob) |
| 283 | glob (lookup-key (current-global-map) glob-str))) |
| 284 | (and (consp glob) |
| 285 | (setq glob nil)) |
| 286 | (or glob |
| 287 | (setq glob-str "")) |
| 288 | (if (> (length glob-str) (length loc-str)) |
| 289 | (setq key-symbol glob |
| 290 | key-str glob-str) |
| 291 | (setq key-symbol loc |
| 292 | key-str loc-str)) |
| 293 | (setq key-last (and (> (length key-str) 0) |
| 294 | (logand (aref key-str (1- (length key-str))) 127))) |
| 295 | key-symbol)) |
| 296 | |
| 297 | (defun edmacro-read-argument (&optional obarray pred) ;; currently ignored |
| 298 | (let ((str "") |
| 299 | (min-bsp 0) |
| 300 | (exec (eq key-symbol 'execute-extended-command)) |
| 301 | str-base) |
| 302 | (while (progn |
| 303 | (edmacro-lookup-key (current-global-map)) |
| 304 | (or (and (eq key-symbol 'self-insert-command) |
| 305 | (< (length str) 60)) |
| 306 | (memq key-symbol |
| 307 | '(backward-delete-char |
| 308 | delete-backward-char |
| 309 | backward-delete-char-untabify)) |
| 310 | (eq key-last 9))) |
| 311 | (setq macro-str (substring macro-str (length key-str))) |
| 312 | (or (and (eq key-last 9) |
| 313 | obarray |
| 314 | (let ((comp (try-completion str obarray pred))) |
| 315 | (and (stringp comp) |
| 316 | (> (length comp) (length str)) |
| 317 | (setq str comp)))) |
| 318 | (if (or (eq key-symbol 'self-insert-command) |
| 319 | (and (or (eq key-last 9) |
| 320 | (<= (length str) min-bsp)) |
| 321 | (setq min-bsp (+ (length str) (length key-str))))) |
| 322 | (setq str (concat str key-str)) |
| 323 | (setq str (substring str 0 -1))))) |
| 324 | (setq str-base str |
| 325 | str (concat str key-str) |
| 326 | macro-str (substring macro-str (length key-str))) |
| 327 | (if exec |
| 328 | (let ((comp (try-completion str-base obarray pred))) |
| 329 | (if (if (stringp comp) |
| 330 | (and (commandp (intern comp)) |
| 331 | (setq str-base comp)) |
| 332 | (commandp (intern str-base))) |
| 333 | (insert str-base "\n") |
| 334 | (insert "execute-extended-command\n") |
| 335 | (insert "type \"") |
| 336 | (edmacro-insert-string str) |
| 337 | (insert "\"\n"))) |
| 338 | (if (> (length str) 0) |
| 339 | (progn |
| 340 | (insert "type \"") |
| 341 | (edmacro-insert-string str) |
| 342 | (insert "\"\n")))))) |
| 343 | |
| 344 | (defun edmacro-isearch-argument () |
| 345 | (let ((str "") |
| 346 | (min-bsp 0) |
| 347 | ch) |
| 348 | (while (and (setq ch (edmacro-read-char)) |
| 349 | (or (<= ch 127) (not search-exit-option)) |
| 350 | (not (eq ch search-exit-char)) |
| 351 | (or (eq ch search-repeat-char) |
| 352 | (eq ch search-reverse-char) |
| 353 | (eq ch search-delete-char) |
| 354 | (eq ch search-yank-word-char) |
| 355 | (eq ch search-yank-line-char) |
| 356 | (eq ch search-quote-char) |
| 357 | (eq ch ?\r) |
| 358 | (eq ch ?\t) |
| 359 | (not search-exit-option) |
| 360 | (and (/= ch 127) (>= ch 32)))) |
| 361 | (if (and (eq ch search-quote-char) |
| 362 | (edmacro-peek-char)) |
| 363 | (setq str (concat str (char-to-string ch) |
| 364 | (char-to-string (edmacro-read-char))) |
| 365 | min-bsp (length str)) |
| 366 | (if (or (and (< ch 127) (>= ch 32)) |
| 367 | (eq ch search-yank-word-char) |
| 368 | (eq ch search-yank-line-char) |
| 369 | (and (or (not (eq ch search-delete-char)) |
| 370 | (<= (length str) min-bsp)) |
| 371 | (setq min-bsp (1+ (length str))))) |
| 372 | (setq str (concat str (char-to-string ch))) |
| 373 | (setq str (substring str 0 -1))))) |
| 374 | (if (eq ch search-exit-char) |
| 375 | (if (= (length str) 0) ;; non-incremental search |
| 376 | (progn |
| 377 | (setq str (concat str (char-to-string ch))) |
| 378 | (and (eq (edmacro-peek-char) ?\C-w) |
| 379 | (progn |
| 380 | (setq str (concat str "\C-w")) |
| 381 | (edmacro-read-char))) |
| 382 | (if (> (length str) 0) |
| 383 | (progn |
| 384 | (insert "type \"") |
| 385 | (edmacro-insert-string str) |
| 386 | (insert "\"\n"))) |
| 387 | (edmacro-read-argument) |
| 388 | (setq str ""))) |
| 389 | (edmacro-unread-chars ch)) |
| 390 | (if (> (length str) 0) |
| 391 | (progn |
| 392 | (insert "type \"") |
| 393 | (edmacro-insert-string str) |
| 394 | (insert "\\e\"\n"))))) |
| 395 | |
| 396 | ;;; Get the next keystroke-sequence from the input stream. |
| 397 | ;;; Sets key-symbol, key-str, and key-last as a side effect. |
| 398 | (defun edmacro-read-key () |
| 399 | (edmacro-lookup-key (current-local-map)) |
| 400 | (and key-symbol |
| 401 | (setq macro-str (substring macro-str (length key-str))))) |
| 402 | |
| 403 | (defun edmacro-peek-char () |
| 404 | (and (> (length macro-str) 0) |
| 405 | (aref macro-str 0))) |
| 406 | |
| 407 | (defun edmacro-read-char () |
| 408 | (and (> (length macro-str) 0) |
| 409 | (prog1 |
| 410 | (aref macro-str 0) |
| 411 | (setq macro-str (substring macro-str 1))))) |
| 412 | |
| 413 | (defun edmacro-unread-chars (chars) |
| 414 | (and (integerp chars) |
| 415 | (setq chars (char-to-string chars))) |
| 416 | (and chars |
| 417 | (setq macro-str (concat chars macro-str)))) |
| 418 | |
| 419 | (defun edmacro-dump (mac) |
| 420 | (set-mark-command nil) |
| 421 | (insert "\n\n") |
| 422 | (edmacro-print-macro mac (current-local-map))) |
| 423 | \f |
| 424 | ;;; Parse a string of spelled-out keystrokes, as produced by key-description. |
| 425 | |
| 426 | (defun edmacro-parse-keys (str) |
| 427 | (let ((pos 0) |
| 428 | (mac "") |
| 429 | part) |
| 430 | (while (and (< pos (length str)) |
| 431 | (string-match "[^ \t\n]+" str pos)) |
| 432 | (setq pos (match-end 0) |
| 433 | part (substring str (match-beginning 0) (match-end 0)) |
| 434 | mac (concat mac |
| 435 | (if (and (> (length part) 2) |
| 436 | (= (aref part 1) ?-) |
| 437 | (= (aref part 0) ?M)) |
| 438 | (progn |
| 439 | (setq part (substring part 2)) |
| 440 | "\e") |
| 441 | (if (and (> (length part) 4) |
| 442 | (= (aref part 0) ?C) |
| 443 | (= (aref part 1) ?-) |
| 444 | (= (aref part 2) ?M) |
| 445 | (= (aref part 3) ?-)) |
| 446 | (progn |
| 447 | (setq part (concat "C-" (substring part 4))) |
| 448 | "\e") |
| 449 | "")) |
| 450 | (or (cdr (assoc part '( ( "NUL" . "\0" ) |
| 451 | ( "RET" . "\r" ) |
| 452 | ( "LFD" . "\n" ) |
| 453 | ( "TAB" . "\t" ) |
| 454 | ( "ESC" . "\e" ) |
| 455 | ( "SPC" . " " ) |
| 456 | ( "DEL" . "\177" ) |
| 457 | ( "C-?" . "\177" ) |
| 458 | ( "C-2" . "\0" ) |
| 459 | ( "C-SPC" . "\0") ))) |
| 460 | (and (equal part "REM") |
| 461 | (setq pos (or (string-match "\n" str pos) |
| 462 | (length str))) |
| 463 | "") |
| 464 | (and (= (length part) 3) |
| 465 | (= (aref part 0) ?C) |
| 466 | (= (aref part 1) ?-) |
| 467 | (char-to-string (logand (aref part 2) 31))) |
| 468 | part)))) |
| 469 | mac)) |
| 470 | \f |
| 471 | ;;; Parse a keyboard macro description in edmacro-print-macro's format. |
| 472 | |
| 473 | (defun edmacro-read-macro (&optional map) |
| 474 | (or map (setq map (current-local-map))) |
| 475 | (let ((macro-str "")) |
| 476 | (while (not (progn |
| 477 | (skip-chars-forward " \t\n") |
| 478 | (eobp))) |
| 479 | (cond ((looking-at "#")) ;; comment |
| 480 | ((looking-at "prefix-arg[ \t]*-[ \t]*\n") |
| 481 | (edmacro-append-chars "\C-u-")) |
| 482 | ((looking-at "prefix-arg[ \t]*\\(-?[0-9]+\\)[ \t]*\n") |
| 483 | (edmacro-append-chars (concat "\C-u" (edmacro-match-string 1)))) |
| 484 | ((looking-at "prefix-arg[ \t]*(\\([0-9]+\\))[ \t]*\n") |
| 485 | (let ((val (string-to-int (edmacro-match-string 1)))) |
| 486 | (while (> val 1) |
| 487 | (or (= (% val 4) 0) |
| 488 | (error "Bad prefix argument value")) |
| 489 | (edmacro-append-chars "\C-u") |
| 490 | (setq val (/ val 4))))) |
| 491 | ((looking-at "prefix-arg") |
| 492 | (error "Bad prefix argument syntax")) |
| 493 | ((looking-at "insert ") |
| 494 | (forward-char 7) |
| 495 | (edmacro-append-chars (read (current-buffer))) |
| 496 | (if (< (current-column) 7) |
| 497 | (forward-line -1))) |
| 498 | ((looking-at "type ") |
| 499 | (forward-char 5) |
| 500 | (edmacro-append-chars (read (current-buffer))) |
| 501 | (if (< (current-column) 5) |
| 502 | (forward-line -1))) |
| 503 | ((looking-at "keys \\(.*\\)\n") |
| 504 | (goto-char (1- (match-end 0))) |
| 505 | (edmacro-append-chars (edmacro-parse-keys |
| 506 | (buffer-substring (match-beginning 1) |
| 507 | (match-end 1))))) |
| 508 | ((looking-at "\\([-a-zA-z0-9_]+\\)[ \t]*\\(.*\\)\n") |
| 509 | (let* ((func (intern (edmacro-match-string 1))) |
| 510 | (arg (edmacro-match-string 2)) |
| 511 | (cust (get func 'edmacro-read))) |
| 512 | (if cust |
| 513 | (funcall cust arg) |
| 514 | (or (commandp func) |
| 515 | (error "Not an Emacs command")) |
| 516 | (or (equal arg "") |
| 517 | (string-match "\\`#" arg) |
| 518 | (error "Unexpected argument to command")) |
| 519 | (let ((keys |
| 520 | (or (where-is-internal func map t) |
| 521 | (where-is-internal func (current-global-map) t)))) |
| 522 | (if keys |
| 523 | (edmacro-append-chars keys) |
| 524 | (edmacro-append-chars (concat "\ex" |
| 525 | (symbol-name func) |
| 526 | "\n"))))))) |
| 527 | (t (error "Syntax error"))) |
| 528 | (forward-line 1)) |
| 529 | macro-str)) |
| 530 | |
| 531 | (defun edmacro-append-chars (chars) |
| 532 | (setq macro-str (concat macro-str chars))) |
| 533 | |
| 534 | (defun edmacro-match-string (n) |
| 535 | (if (match-beginning n) |
| 536 | (buffer-substring (match-beginning n) (match-end n)) |
| 537 | "")) |
| 538 | |
| 539 | (defun edmacro-get-interactive (func) |
| 540 | (if (symbolp func) |
| 541 | (let ((cust (get func 'edmacro-interactive))) |
| 542 | (if cust |
| 543 | cust |
| 544 | (edmacro-get-interactive (symbol-function func)))) |
| 545 | (or (and (eq (car-safe func) 'lambda) |
| 546 | (let ((int (if (consp (nth 2 func)) |
| 547 | (nth 2 func) |
| 548 | (nth 3 func)))) |
| 549 | (and (eq (car-safe int) 'interactive) |
| 550 | (stringp (nth 1 int)) |
| 551 | (nth 1 int)))) |
| 552 | ""))) |
| 553 | |
| 554 | (put 'search-forward 'edmacro-interactive "s") |
| 555 | (put 'search-backward 'edmacro-interactive "s") |
| 556 | (put 'word-search-forward 'edmacro-interactive "s") |
| 557 | (put 'word-search-backward 'edmacro-interactive "s") |
| 558 | (put 're-search-forward 'edmacro-interactive "s") |
| 559 | (put 're-search-backward 'edmacro-interactive "s") |
| 560 | (put 'switch-to-buffer 'edmacro-interactive "B") |
| 561 | (put 'kill-buffer 'edmacro-interactive "B") |
| 562 | (put 'rename-buffer 'edmacro-interactive "B\nB") |
| 563 | (put 'goto-char 'edmacro-interactive "N") |
| 564 | (put 'global-set-key 'edmacro-interactive "k\nC") |
| 565 | (put 'global-unset-key 'edmacro-interactive "k") |
| 566 | (put 'local-set-key 'edmacro-interactive "k\nC") |
| 567 | (put 'local-unset-key 'edmacro-interactive "k") |
| 568 | |
| 569 | ;;; Think about kbd-macro-query |
| 570 | |
| 571 | ;;; Edit a keyboard macro in another buffer. |
| 572 | ;;; (Prefix argument is currently ignored.) |
| 573 | |
| 574 | (defun edmacro-edit-macro (mac repl &optional prefix buffer hook arg) |
| 575 | (or (stringp mac) |
| 576 | (error "Not a keyboard macro")) |
| 577 | (let ((oldbuf (current-buffer)) |
| 578 | (local (current-local-map)) |
| 579 | (buf (get-buffer-create (or buffer "*Edit Macro*")))) |
| 580 | (set-buffer buf) |
| 581 | (kill-all-local-variables) |
| 582 | (use-local-map edmacro-mode-map) |
| 583 | (setq buffer-read-only nil |
| 584 | major-mode 'edmacro-mode |
| 585 | mode-name "Edit Macro") |
| 586 | (set (make-local-variable 'edmacro-original-buffer) oldbuf) |
| 587 | (set (make-local-variable 'edmacro-replace-function) repl) |
| 588 | (set (make-local-variable 'edmacro-replace-argument) arg) |
| 589 | (set (make-local-variable 'edmacro-finish-hook) hook) |
| 590 | (erase-buffer) |
| 591 | (insert "# Keyboard Macro Editor. Press C-c C-c to finish; press C-x k RET to cancel.\n") |
| 592 | (insert "# Original keys: " (key-description mac) "\n\n") |
| 593 | (message "Formatting keyboard macro...") |
| 594 | (edmacro-print-macro mac local) |
| 595 | (switch-to-buffer buf) |
| 596 | (goto-char (point-min)) |
| 597 | (forward-line 3) |
| 598 | (recenter '(4)) |
| 599 | (set-buffer-modified-p nil) |
| 600 | (message "Formatting keyboard macro...done") |
| 601 | (run-hooks 'edmacro-format-hook))) |
| 602 | |
| 603 | (defun edmacro-finish-edit () |
| 604 | (interactive) |
| 605 | (or (and (boundp 'edmacro-original-buffer) |
| 606 | (boundp 'edmacro-replace-function) |
| 607 | (boundp 'edmacro-replace-argument) |
| 608 | (boundp 'edmacro-finish-hook) |
| 609 | (eq major-mode 'edmacro-mode)) |
| 610 | (error "This command is valid only in buffers created by `edit-kbd-macro'.")) |
| 611 | (let ((buf (current-buffer)) |
| 612 | (str (buffer-string)) |
| 613 | (func edmacro-replace-function) |
| 614 | (arg edmacro-replace-argument) |
| 615 | (hook edmacro-finish-hook)) |
| 616 | (goto-char (point-min)) |
| 617 | (run-hooks 'edmacro-compile-hook) |
| 618 | (and (buffer-modified-p) |
| 619 | func |
| 620 | (progn |
| 621 | (message "Compiling keyboard macro...") |
| 622 | (let ((mac (edmacro-read-macro |
| 623 | (and (buffer-name edmacro-original-buffer) |
| 624 | (save-excursion |
| 625 | (set-buffer edmacro-original-buffer) |
| 626 | (current-local-map)))))) |
| 627 | (and (buffer-name edmacro-original-buffer) |
| 628 | (switch-to-buffer edmacro-original-buffer)) |
| 629 | (funcall func mac arg)) |
| 630 | (message "Compiling keyboard macro...done"))) |
| 631 | (kill-buffer buf) |
| 632 | (if hook |
| 633 | (funcall hook arg)))) |
| 634 | |
| 635 | (defun edmacro-mode () |
| 636 | "\\<edmacro-mode-map>Keyboard Macro Editing mode. Press \\[edmacro-finish-edit] to save and exit. |
| 637 | To abort the edit, just kill this buffer with \\[kill-buffer] RET. |
| 638 | |
| 639 | The keyboard macro is represented as a series of M-x style command names. |
| 640 | Keystrokes which do not correspond to simple M-x commands are written as |
| 641 | \"type\" commands. When you press \\[edmacro-finish-edit], edmacro converts each command |
| 642 | back into a suitable keystroke sequence; \"type\" commands are converted |
| 643 | directly back into keystrokes." |
| 644 | (interactive) |
| 645 | (error "This mode can be enabled only by `edit-kbd-macro' or `edit-last-kbd-macro'.")) |
| 646 | (put 'edmacro-mode 'mode-class 'special) |
| 647 | |
| 648 | (if (boundp 'edmacro-mode-map) () |
| 649 | (setq edmacro-mode-map (make-sparse-keymap)) |
| 650 | (define-key edmacro-mode-map "\C-c\C-c" 'edmacro-finish-edit)) |
| 651 | |
| 652 | ;;; edmacro.el ends here |