Mercurial > emacs
changeset 109:d649664df7e0
Initial revision
| author | David Lawrence <tale@gnu.org> |
|---|---|
| date | Mon, 22 Oct 1990 07:14:13 +0000 |
| parents | 8644955999f0 |
| children | 2968112113f9 |
| files | lisp/edmacro.el |
| diffstat | 1 files changed, 640 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/edmacro.el Mon Oct 22 07:14:13 1990 +0000 @@ -0,0 +1,640 @@ +;; Keyboard macro editor for GNU Emacs. Version 1.02. +;; Copyright (C) 1990 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 1, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;; Original from: Dave Gillespie, daveg@csvax.caltech.edu. + +;; To use, type `M-x edit-last-kbd-macro' to edit the most recently +;; defined keyboard macro. If you have used `M-x name-last-kbd-macro' +;; to give a keyboard macro a name, type `M-x edit-kbd-macro' to edit +;; the macro by name. When you are done editing, type `C-c C-c' to +;; record your changes back into the original keyboard macro. + +;;; The user-level commands for editing macros. + +(defun edit-last-kbd-macro (&optional prefix buffer hook) + "Edit the most recently defined keyboard macro." + (interactive "P") + (edmacro-edit-macro last-kbd-macro + (function (lambda (x arg) (setq last-kbd-macro x))) + prefix buffer hook)) + +(defun edit-kbd-macro (cmd &optional prefix buffer hook in-hook out-hook) + "Edit a keyboard macro which has been assigned a name by name-last-kbd-macro. +\(See also edit-last-kbd-macro.)" + (interactive "CCommand name: \nP") + (and cmd + (edmacro-edit-macro (if in-hook + (funcall in-hook cmd) + (symbol-function cmd)) + (or out-hook + (list 'lambda '(x arg) + (list 'fset + (list 'quote cmd) + 'x))) + prefix buffer hook cmd))) + +(defun read-kbd-macro (start end) + "Read the region as a keyboard macro definition. +The region is interpreted as spelled-out keystrokes, e.g., `M-x abc RET'. +The resulting macro is installed as the \"current\" keyboard macro. + +Symbols: RET, SPC, TAB, DEL, LFD, NUL; C-key; M-key. (Must be uppercase.) + REM marks the rest of a line as a comment. + Whitespace is ignored; other characters are copied into the macro." + (interactive "r") + (setq last-kbd-macro (edmacro-parse-keys (buffer-substring start end))) + (if (and (string-match "\\`\C-x(" last-kbd-macro) + (string-match "\C-x)\\'" last-kbd-macro)) + (setq last-kbd-macro (substring last-kbd-macro 2 -2)))) + +;;; Formatting a keyboard macro as human-readable text. + +(defun edmacro-print-macro (macro-str local-map) + (let ((save-map (current-local-map)) + (print-escape-newlines t) + key-symbol key-str key-last prefix-arg this-prefix) + (unwind-protect + (progn + (use-local-map local-map) + (while (edmacro-peek-char) + (edmacro-read-key) + (setq this-prefix prefix-arg) + (or (memq key-symbol '(digit-argument + negative-argument + universal-argument)) + (null prefix-arg) + (progn + (cond ((consp prefix-arg) + (insert (format "prefix-arg (%d)\n" + (car prefix-arg)))) + ((eq prefix-arg '-) + (insert "prefix-arg -\n")) + ((numberp prefix-arg) + (insert (format "prefix-arg %d\n" prefix-arg)))) + (setq prefix-arg nil))) + (cond ((null key-symbol) + (insert "type \"") + (edmacro-insert-string macro-str) + (insert "\"\n") + (setq macro-str "")) + ((eq key-symbol 'digit-argument) + (edmacro-prefix-arg key-last nil prefix-arg)) + ((eq key-symbol 'negative-argument) + (edmacro-prefix-arg ?- nil prefix-arg)) + ((eq key-symbol 'universal-argument) + (let* ((c-u 4) (argstartchar key-last) + (char (edmacro-read-char))) + (while (= char argstartchar) + (setq c-u (* 4 c-u) + char (edmacro-read-char))) + (edmacro-prefix-arg char c-u nil))) + ((eq key-symbol 'self-insert-command) + (insert "insert ") + (if (and (>= key-last 32) (<= key-last 126)) + (let ((str "")) + (while (or (and (eq key-symbol + 'self-insert-command) + (< (length str) 60) + (>= key-last 32) + (<= key-last 126)) + (and (memq key-symbol + '(backward-delete-char + delete-backward-char + backward-delete-char-untabify)) + (> (length str) 0))) + (if (eq key-symbol 'self-insert-command) + (setq str (concat str + (char-to-string key-last))) + (setq str (substring str 0 -1))) + (edmacro-read-key)) + (insert "\"" str "\"\n") + (edmacro-unread-chars key-str)) + (insert "\"") + (edmacro-insert-string (char-to-string key-last)) + (insert "\"\n"))) + ((and (eq key-symbol 'quoted-insert) + (edmacro-peek-char)) + (insert "quoted-insert\n") + (let ((ch (edmacro-read-char)) + ch2) + (if (and (>= ch ?0) (<= ch ?7)) + (progn + (setq ch (- ch ?0) + ch2 (edmacro-read-char)) + (if ch2 + (if (and (>= ch2 ?0) (<= ch2 ?7)) + (progn + (setq ch (+ (* ch 8) (- ch2 ?0)) + ch2 (edmacro-read-char)) + (if ch2 + (if (and (>= ch2 ?0) (<= ch2 ?7)) + (setq ch (+ (* ch 8) (- ch2 ?0))) + (edmacro-unread-chars ch2)))) + (edmacro-unread-chars ch2))))) + (if (or (and (>= ch ?0) (<= ch ?7)) + (< ch 32) (> ch 126)) + (insert (format "type \"\\%03o\"\n" ch)) + (insert "type \"" (char-to-string ch) "\"\n")))) + ((memq key-symbol '(isearch-forward + isearch-backward + isearch-forward-regexp + isearch-backward-regexp)) + (insert (symbol-name key-symbol) "\n") + (edmacro-isearch-argument)) + ((eq key-symbol 'execute-extended-command) + (edmacro-read-argument obarray 'commandp)) + (t + (let ((cust (get key-symbol 'edmacro-print))) + (if cust + (funcall cust) + (insert (symbol-name key-symbol)) + (indent-to 30) + (insert " # ") + (edmacro-insert-string key-str) + (insert "\n") + (let ((int (edmacro-get-interactive key-symbol))) + (if (string-match "\\`\\*" int) + (setq int (substring int 1))) + (while (> (length int) 0) + (cond ((= (aref int 0) ?a) + (edmacro-read-argument + obarray nil)) + ((memq (aref int 0) '(?b ?B ?D ?f ?F ?n + ?s ?S ?x ?X)) + (edmacro-read-argument)) + ((and (= (aref int 0) ?c) + (edmacro-peek-char)) + (insert "type \"") + (edmacro-insert-string + (char-to-string + (edmacro-read-char))) + (insert "\"\n")) + ((= (aref int 0) ?C) + (edmacro-read-argument + obarray 'commandp)) + ((= (aref int 0) ?k) + (edmacro-read-key) + (if key-symbol + (progn + (insert "type \"") + (edmacro-insert-string key-str) + (insert "\"\n")) + (edmacro-unread-chars key-str))) + ((= (aref int 0) ?N) + (or this-prefix + (edmacro-read-argument))) + ((= (aref int 0) ?v) + (edmacro-read-argument + obarray 'user-variable-p))) + (let ((nl (string-match "\n" int))) + (setq int (if nl + (substring int (1+ nl)) + ""))))))))))) + (use-local-map save-map)))) + +(defun edmacro-prefix-arg (char c-u value) + (let ((sign 1)) + (if (and (numberp value) (< value 0)) + (setq sign -1 value (- value))) + (if (eq value '-) + (setq sign -1 value nil)) + (while (and char (= ?- char)) + (setq sign (- sign) c-u nil) + (setq char (edmacro-read-char))) + (while (and char (>= char ?0) (<= char ?9)) + (setq value (+ (* (if (numberp value) value 0) 10) (- char ?0)) c-u nil) + (setq char (edmacro-read-char))) + (setq prefix-arg + (cond (c-u (list c-u)) + ((numberp value) (* value sign)) + ((= sign -1) '-))) + (edmacro-unread-chars char))) + +(defun edmacro-insert-string (str) + (let ((i 0) j ch) + (while (< i (length str)) + (if (and (> (setq ch (aref str i)) 127) + (< ch 160)) + (progn + (setq ch (- ch 128)) + (insert "\\M-"))) + (if (< ch 32) + (cond ((= ch 8) (insret "\\b")) + ((= ch 9) (insert "\\t")) + ((= ch 10) (insert "\\n")) + ((= ch 13) (insert "\\r")) + ((= ch 27) (insert "\\e")) + (t (insert "\\C-" (char-to-string (downcase (+ ch 64)))))) + (if (< ch 127) + (if (or (= ch 34) (= ch 92)) + (insert "\\" (char-to-string ch)) + (setq j i) + (while (and (< (setq i (1+ i)) (length str)) + (>= (setq ch (aref str i)) 32) + (/= ch 34) (/= ch 92) + (< ch 127))) + (insert (substring str j i)) + (setq i (1- i))) + (if (memq ch '(127 255)) + (insert (format "\\%03o" ch)) + (insert "\\M-" (char-to-string (- ch 128)))))) + (setq i (1+ i))))) + +(defun edmacro-lookup-key (map) + (let ((loc (and map (lookup-key map macro-str))) + (glob (lookup-key (current-global-map) macro-str)) + (loc-str macro-str) + (glob-str macro-str)) + (and (integerp loc) + (setq loc-str (substring macro-str 0 loc) + loc (lookup-key map loc-str))) + (and (consp loc) + (setq loc nil)) + (or loc + (setq loc-str "")) + (and (integerp glob) + (setq glob-str (substring macro-str 0 glob) + glob (lookup-key (current-global-map) glob-str))) + (and (consp glob) + (setq glob nil)) + (or glob + (setq glob-str "")) + (if (> (length glob-str) (length loc-str)) + (setq key-symbol glob + key-str glob-str) + (setq key-symbol loc + key-str loc-str)) + (setq key-last (and (> (length key-str) 0) + (logand (aref key-str (1- (length key-str))) 127))) + key-symbol)) + +(defun edmacro-read-argument (&optional obarray pred) ;; currently ignored + (let ((str "") + (min-bsp 0) + (exec (eq key-symbol 'execute-extended-command)) + str-base) + (while (progn + (edmacro-lookup-key (current-global-map)) + (or (and (eq key-symbol 'self-insert-command) + (< (length str) 60)) + (memq key-symbol + '(backward-delete-char + delete-backward-char + backward-delete-char-untabify)) + (eq key-last 9))) + (setq macro-str (substring macro-str (length key-str))) + (or (and (eq key-last 9) + obarray + (let ((comp (try-completion str obarray pred))) + (and (stringp comp) + (> (length comp) (length str)) + (setq str comp)))) + (if (or (eq key-symbol 'self-insert-command) + (and (or (eq key-last 9) + (<= (length str) min-bsp)) + (setq min-bsp (+ (length str) (length key-str))))) + (setq str (concat str key-str)) + (setq str (substring str 0 -1))))) + (setq str-base str + str (concat str key-str) + macro-str (substring macro-str (length key-str))) + (if exec + (let ((comp (try-completion str-base obarray pred))) + (if (if (stringp comp) + (and (commandp (intern comp)) + (setq str-base comp)) + (commandp (intern str-base))) + (insert str-base "\n") + (insert "execute-extended-command\n") + (insert "type \"") + (edmacro-insert-string str) + (insert "\"\n"))) + (if (> (length str) 0) + (progn + (insert "type \"") + (edmacro-insert-string str) + (insert "\"\n")))))) + +(defun edmacro-isearch-argument () + (let ((str "") + (min-bsp 0) + ch) + (while (and (setq ch (edmacro-read-char)) + (or (<= ch 127) (not search-exit-option)) + (not (eq ch search-exit-char)) + (or (eq ch search-repeat-char) + (eq ch search-reverse-char) + (eq ch search-delete-char) + (eq ch search-yank-word-char) + (eq ch search-yank-line-char) + (eq ch search-quote-char) + (eq ch ?\r) + (eq ch ?\t) + (not search-exit-option) + (and (/= ch 127) (>= ch 32)))) + (if (and (eq ch search-quote-char) + (edmacro-peek-char)) + (setq str (concat str (char-to-string ch) + (char-to-string (edmacro-read-char))) + min-bsp (length str)) + (if (or (and (< ch 127) (>= ch 32)) + (eq ch search-yank-word-char) + (eq ch search-yank-line-char) + (and (or (not (eq ch search-delete-char)) + (<= (length str) min-bsp)) + (setq min-bsp (1+ (length str))))) + (setq str (concat str (char-to-string ch))) + (setq str (substring str 0 -1))))) + (if (eq ch search-exit-char) + (if (= (length str) 0) ;; non-incremental search + (progn + (setq str (concat str (char-to-string ch))) + (and (eq (edmacro-peek-char) ?\C-w) + (progn + (setq str (concat str "\C-w")) + (edmacro-read-char))) + (if (> (length str) 0) + (progn + (insert "type \"") + (edmacro-insert-string str) + (insert "\"\n"))) + (edmacro-read-argument) + (setq str ""))) + (edmacro-unread-chars ch)) + (if (> (length str) 0) + (progn + (insert "type \"") + (edmacro-insert-string str) + (insert "\\e\"\n"))))) + +;;; Get the next keystroke-sequence from the input stream. +;;; Sets key-symbol, key-str, and key-last as a side effect. +(defun edmacro-read-key () + (edmacro-lookup-key (current-local-map)) + (and key-symbol + (setq macro-str (substring macro-str (length key-str))))) + +(defun edmacro-peek-char () + (and (> (length macro-str) 0) + (aref macro-str 0))) + +(defun edmacro-read-char () + (and (> (length macro-str) 0) + (prog1 + (aref macro-str 0) + (setq macro-str (substring macro-str 1))))) + +(defun edmacro-unread-chars (chars) + (and (integerp chars) + (setq chars (char-to-string chars))) + (and chars + (setq macro-str (concat chars macro-str)))) + +(defun edmacro-dump (mac) + (set-mark-command nil) + (insert "\n\n") + (edmacro-print-macro mac (current-local-map))) + +;;; Parse a string of spelled-out keystrokes, as produced by key-description. + +(defun edmacro-parse-keys (str) + (let ((pos 0) + (mac "") + part) + (while (and (< pos (length str)) + (string-match "[^ \t\n]+" str pos)) + (setq pos (match-end 0) + part (substring str (match-beginning 0) (match-end 0)) + mac (concat mac + (if (and (> (length part) 2) + (= (aref part 1) ?-) + (= (aref part 0) ?M)) + (progn + (setq part (substring part 2)) + "\e") + (if (and (> (length part) 4) + (= (aref part 0) ?C) + (= (aref part 1) ?-) + (= (aref part 2) ?M) + (= (aref part 3) ?-)) + (progn + (setq part (concat "C-" (substring part 4))) + "\e") + "")) + (or (cdr (assoc part '( ( "NUL" . "\0" ) + ( "RET" . "\r" ) + ( "LFD" . "\n" ) + ( "TAB" . "\t" ) + ( "ESC" . "\e" ) + ( "SPC" . " " ) + ( "DEL" . "\177" ) + ( "C-?" . "\177" ) + ( "C-2" . "\0" ) + ( "C-SPC" . "\0") ))) + (and (equal part "REM") + (setq pos (or (string-match "\n" str pos) + (length str))) + "") + (and (= (length part) 3) + (= (aref part 0) ?C) + (= (aref part 1) ?-) + (char-to-string (logand (aref part 2) 31))) + part)))) + mac)) + +;;; Parse a keyboard macro description in edmacro-print-macro's format. + +(defun edmacro-read-macro (&optional map) + (or map (setq map (current-local-map))) + (let ((macro-str "")) + (while (not (progn + (skip-chars-forward " \t\n") + (eobp))) + (cond ((looking-at "#")) ;; comment + ((looking-at "prefix-arg[ \t]*-[ \t]*\n") + (edmacro-append-chars "\C-u-")) + ((looking-at "prefix-arg[ \t]*\\(-?[0-9]+\\)[ \t]*\n") + (edmacro-append-chars (concat "\C-u" (edmacro-match-string 1)))) + ((looking-at "prefix-arg[ \t]*(\\([0-9]+\\))[ \t]*\n") + (let ((val (string-to-int (edmacro-match-string 1)))) + (while (> val 1) + (or (= (% val 4) 0) + (error "Bad prefix argument value")) + (edmacro-append-chars "\C-u") + (setq val (/ val 4))))) + ((looking-at "prefix-arg") + (error "Bad prefix argument syntax")) + ((looking-at "insert ") + (forward-char 7) + (edmacro-append-chars (read (current-buffer))) + (if (< (current-column) 7) + (forward-line -1))) + ((looking-at "type ") + (forward-char 5) + (edmacro-append-chars (read (current-buffer))) + (if (< (current-column) 5) + (forward-line -1))) + ((looking-at "keys \\(.*\\)\n") + (goto-char (1- (match-end 0))) + (edmacro-append-chars (edmacro-parse-keys + (buffer-substring (match-beginning 1) + (match-end 1))))) + ((looking-at "\\([-a-zA-z0-9_]+\\)[ \t]*\\(.*\\)\n") + (let* ((func (intern (edmacro-match-string 1))) + (arg (edmacro-match-string 2)) + (cust (get func 'edmacro-read))) + (if cust + (funcall cust arg) + (or (commandp func) + (error "Not an Emacs command")) + (or (equal arg "") + (string-match "\\`#" arg) + (error "Unexpected argument to command")) + (let ((keys + (or (where-is-internal func map t) + (where-is-internal func (current-global-map) t)))) + (if keys + (edmacro-append-chars keys) + (edmacro-append-chars (concat "\ex" + (symbol-name func) + "\n"))))))) + (t (error "Syntax error"))) + (forward-line 1)) + macro-str)) + +(defun edmacro-append-chars (chars) + (setq macro-str (concat macro-str chars))) + +(defun edmacro-match-string (n) + (if (match-beginning n) + (buffer-substring (match-beginning n) (match-end n)) + "")) + +(defun edmacro-get-interactive (func) + (if (symbolp func) + (let ((cust (get func 'edmacro-interactive))) + (if cust + cust + (edmacro-get-interactive (symbol-function func)))) + (or (and (eq (car-safe func) 'lambda) + (let ((int (if (consp (nth 2 func)) + (nth 2 func) + (nth 3 func)))) + (and (eq (car-safe int) 'interactive) + (stringp (nth 1 int)) + (nth 1 int)))) + ""))) + +(put 'search-forward 'edmacro-interactive "s") +(put 'search-backward 'edmacro-interactive "s") +(put 'word-search-forward 'edmacro-interactive "s") +(put 'word-search-backward 'edmacro-interactive "s") +(put 're-search-forward 'edmacro-interactive "s") +(put 're-search-backward 'edmacro-interactive "s") +(put 'switch-to-buffer 'edmacro-interactive "B") +(put 'kill-buffer 'edmacro-interactive "B") +(put 'rename-buffer 'edmacro-interactive "B\nB") +(put 'goto-char 'edmacro-interactive "N") +(put 'global-set-key 'edmacro-interactive "k\nC") +(put 'global-unset-key 'edmacro-interactive "k") +(put 'local-set-key 'edmacro-interactive "k\nC") +(put 'local-unset-key 'edmacro-interactive "k") + +;;; Think about kbd-macro-query + +;;; Edit a keyboard macro in another buffer. +;;; (Prefix argument is currently ignored.) + +(defun edmacro-edit-macro (mac repl &optional prefix buffer hook arg) + (or (stringp mac) + (error "Not a keyboard macro")) + (let ((oldbuf (current-buffer)) + (local (current-local-map)) + (buf (get-buffer-create (or buffer "*Edit Macro*")))) + (set-buffer buf) + (kill-all-local-variables) + (use-local-map edmacro-mode-map) + (setq buffer-read-only nil + major-mode 'edmacro-mode + mode-name "Edit Macro") + (set (make-local-variable 'edmacro-original-buffer) oldbuf) + (set (make-local-variable 'edmacro-replace-function) repl) + (set (make-local-variable 'edmacro-replace-argument) arg) + (set (make-local-variable 'edmacro-finish-hook) hook) + (erase-buffer) + (insert "# Keyboard Macro Editor. Press C-c C-c to finish; press C-x k RET to cancel.\n") + (insert "# Original keys: " (key-description mac) "\n\n") + (message "Formatting keyboard macro...") + (edmacro-print-macro mac local) + (switch-to-buffer buf) + (goto-char (point-min)) + (forward-line 3) + (recenter '(4)) + (set-buffer-modified-p nil) + (message "Formatting keyboard macro...done") + (run-hooks 'edmacro-format-hook))) + +(defun edmacro-finish-edit () + (interactive) + (or (and (boundp 'edmacro-original-buffer) + (boundp 'edmacro-replace-function) + (boundp 'edmacro-replace-argument) + (boundp 'edmacro-finish-hook) + (eq major-mode 'edmacro-mode)) + (error "This command is valid only in buffers created by edit-kbd-macro.")) + (let ((buf (current-buffer)) + (str (buffer-string)) + (func edmacro-replace-function) + (arg edmacro-replace-argument) + (hook edmacro-finish-hook)) + (goto-char (point-min)) + (run-hooks 'edmacro-compile-hook) + (and (buffer-modified-p) + func + (progn + (message "Compiling keyboard macro...") + (let ((mac (edmacro-read-macro + (and (buffer-name edmacro-original-buffer) + (save-excursion + (set-buffer edmacro-original-buffer) + (current-local-map)))))) + (and (buffer-name edmacro-original-buffer) + (switch-to-buffer edmacro-original-buffer)) + (funcall func mac arg)) + (message "Compiling keyboard macro...done"))) + (kill-buffer buf) + (if hook + (funcall hook arg)))) + +(defun edmacro-mode () + "Keyboard Macro Editing mode. Press C-c C-c to save and exit. +To abort the edit, just kill this buffer with C-x k RET. + +The keyboard macro is represented as a series of M-x style command names. +Keystrokes which do not correspond to simple M-x commands are written as +\"type\" commands. When you press C-c C-c, edmacro converts each command +back into a suitable keystroke sequence; \"type\" commands are converted +directly back into keystrokes." + (interactive) + (error "This mode can be enabled only by edit-kbd-macro or edit-last-kbd-macro.")) +(put 'edmacro-mode 'mode-class 'special) + +(if (boundp 'edmacro-mode-map) () + (setq edmacro-mode-map (make-sparse-keymap)) + (define-key edmacro-mode-map "\C-c\C-c" 'edmacro-finish-edit))