lisp/edmacro.el

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