diff options
| -rw-r--r-- | lisp/macros.el | 80 |
1 files changed, 43 insertions, 37 deletions
diff --git a/lisp/macros.el b/lisp/macros.el index 4344a04f306..b0673db2824 100644 --- a/lisp/macros.el +++ b/lisp/macros.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; macros.el --- non-primitive commands for keyboard macros. | 1 | ;;; macros.el --- non-primitive commands for keyboard macros. |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Maintainer: FSF | 5 | ;; Maintainer: FSF |
| 6 | 6 | ||
| @@ -52,42 +52,48 @@ bindings. | |||
| 52 | To save a kbd macro, visit a file of Lisp code such as your `~/.emacs', | 52 | To save a kbd macro, visit a file of Lisp code such as your `~/.emacs', |
| 53 | use this command, and then save the file." | 53 | use this command, and then save the file." |
| 54 | (interactive "CInsert kbd macro (name): \nP") | 54 | (interactive "CInsert kbd macro (name): \nP") |
| 55 | (insert "(fset '") | 55 | (let (definition) |
| 56 | (prin1 macroname (current-buffer)) | 56 | (if (string= (symbol-name macroname) "") |
| 57 | (insert "\n ") | 57 | (progn |
| 58 | (let ((beg (point)) end) | 58 | (setq macroname 'last-kbd-macro definition last-kbd-macro) |
| 59 | (prin1 (symbol-function macroname) (current-buffer)) | 59 | (insert "(setq ")) |
| 60 | (setq end (point-marker)) | 60 | (setq definition (symbol-function macroname)) |
| 61 | (goto-char beg) | 61 | (insert "(fset '")) |
| 62 | (while (< (point) end) | 62 | (prin1 macroname (current-buffer)) |
| 63 | (let ((char (following-char))) | 63 | (insert "\n ") |
| 64 | (cond ((< char 32) | 64 | (let ((beg (point)) end) |
| 65 | (delete-region (point) (1+ (point))) | 65 | (prin1 definition (current-buffer)) |
| 66 | (insert "\\C-" (+ 96 char))) | 66 | (setq end (point-marker)) |
| 67 | ((< char 127) | 67 | (goto-char beg) |
| 68 | (forward-char 1)) | 68 | (while (< (point) end) |
| 69 | ((= char 127) | 69 | (let ((char (following-char))) |
| 70 | (delete-region (point) (1+ (point))) | 70 | (cond ((< char 32) |
| 71 | (insert "\\C-?")) | 71 | (delete-region (point) (1+ (point))) |
| 72 | ((< char 160) | 72 | (insert "\\C-" (+ 96 char))) |
| 73 | (delete-region (point) (1+ (point))) | 73 | ((< char 127) |
| 74 | (insert "\\M-C-" (- char 32))) | 74 | (forward-char 1)) |
| 75 | ((< char 255) | 75 | ((= char 127) |
| 76 | (delete-region (point) (1+ (point))) | 76 | (delete-region (point) (1+ (point))) |
| 77 | (insert "\\M-" (- char 128))) | 77 | (insert "\\C-?")) |
| 78 | ((= char 255) | 78 | ((< char 160) |
| 79 | (delete-region (point) (1+ (point))) | 79 | (delete-region (point) (1+ (point))) |
| 80 | (insert "\\M-C-?")))))) | 80 | (insert "\\M-C-" (- char 32))) |
| 81 | (insert ")\n") | 81 | ((< char 255) |
| 82 | (if keys | 82 | (delete-region (point) (1+ (point))) |
| 83 | (let ((keys (where-is-internal macroname nil))) | 83 | (insert "\\M-" (- char 128))) |
| 84 | (while keys | 84 | ((= char 255) |
| 85 | (insert "(global-set-key ") | 85 | (delete-region (point) (1+ (point))) |
| 86 | (prin1 (car keys) (current-buffer)) | 86 | (insert "\\M-C-?")))))) |
| 87 | (insert " '") | 87 | (insert ")\n") |
| 88 | (prin1 macroname (current-buffer)) | 88 | (if keys |
| 89 | (insert ")\n") | 89 | (let ((keys (where-is-internal macroname nil))) |
| 90 | (setq keys (cdr keys)))))) | 90 | (while keys |
| 91 | (insert "(global-set-key ") | ||
| 92 | (prin1 (car keys) (current-buffer)) | ||
| 93 | (insert " '") | ||
| 94 | (prin1 macroname (current-buffer)) | ||
| 95 | (insert ")\n") | ||
| 96 | (setq keys (cdr keys))))))) | ||
| 91 | 97 | ||
| 92 | ;;;###autoload | 98 | ;;;###autoload |
| 93 | (defun kbd-macro-query (flag) | 99 | (defun kbd-macro-query (flag) |