Mercurial > hg > xemacs-beta

comparison lisp/prim/macros.el @ 22:8fc7fe29b841 r19-15b94

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b94
author cvs
date Mon, 13 Aug 2007 08:50:29 +0200
parents 0293115a14e9
children 131b0175ea99
comparison
equal deleted inserted replaced
21:b88636d63495 22:8fc7fe29b841
28 28
29 ;; Extension commands for keyboard macros. These permit you to assign 29 ;; Extension commands for keyboard macros. These permit you to assign
30 ;; a name to the last-defined keyboard macro, expand and insert the 30 ;; a name to the last-defined keyboard macro, expand and insert the
31 ;; lisp corresponding to a macro, query the user from within a macro, 31 ;; lisp corresponding to a macro, query the user from within a macro,
32 ;; or apply a macro to each line in the reason. 32 ;; or apply a macro to each line in the reason.
33
34 ;; This file is largely superseded by edmacro.el as of XEmacs 20.1. -sb
33 35
34 ;;; Code: 36 ;;; Code:
35 37
36 ;;;###autoload 38 ;;;###autoload
37 (defun name-last-kbd-macro (symbol) 39 (defun name-last-kbd-macro (symbol)
48 (not (vectorp (symbol-function symbol))) 50 (not (vectorp (symbol-function symbol)))
49 (error "Function %s is already defined and not a keyboard macro." 51 (error "Function %s is already defined and not a keyboard macro."
50 symbol)) 52 symbol))
51 (fset symbol last-kbd-macro)) 53 (fset symbol last-kbd-macro))
52 54
53 (defun insert-kbd-macro-pretty-string (string) 55 ;(defun insert-kbd-macro-pretty-string (string)
54 ;; Convert control characters to the traditional readable representation: 56 ; ;; Convert control characters to the traditional readable representation:
55 ;; put the four characters \M-x in the buffer instead of the one char \370, 57 ; ;; put the four characters \M-x in the buffer instead of the one char \370,
56 ;; which would deceptively print as `oslash' with the default settings. 58 ; ;; which would deceptively print as `oslash' with the default settings.
57 (save-restriction 59 ; (save-restriction
58 (narrow-to-region (point) (point)) 60 ; (narrow-to-region (point) (point))
59 (prin1 string (current-buffer)) 61 ; (prin1 string (current-buffer))
60 (goto-char (1+ (point-min))) 62 ; (goto-char (1+ (point-min)))
61 (while (not (eobp)) 63 ; (while (not (eobp))
62 (cond ((= (following-char) 0) (insert "\\C-@") (delete-char 1)) 64 ; (cond ((= (following-char) 0) (insert "\\C-@") (delete-char 1))
63 ((= (following-char) ?\n) (insert "\\n") (delete-char 1)) 65 ; ((= (following-char) ?\n) (insert "\\n") (delete-char 1))
64 ((= (following-char) ?\r) (insert "\\r") (delete-char 1)) 66 ; ((= (following-char) ?\r) (insert "\\r") (delete-char 1))
65 ((= (following-char) ?\t) (insert "\\t") (delete-char 1)) 67 ; ((= (following-char) ?\t) (insert "\\t") (delete-char 1))
66 ((= (following-char) ?\e) (insert "\\e") (delete-char 1)) 68 ; ((= (following-char) ?\e) (insert "\\e") (delete-char 1))
67 ((= (following-char) 127) (insert "\\C-?") (delete-char 1)) 69 ; ((= (following-char) 127) (insert "\\C-?") (delete-char 1))
68 ((= (following-char) 128) (insert "\\M-\\C-@") (delete-char 1)) 70 ; ((= (following-char) 128) (insert "\\M-\\C-@") (delete-char 1))
69 ((= (following-char) 255) (insert "\\M-\\C-?") (delete-char 1)) 71 ; ((= (following-char) 255) (insert "\\M-\\C-?") (delete-char 1))
70 ((and (> (following-char) 127) (< (following-char) 155)) 72 ; ((and (> (following-char) 127) (< (following-char) 155))
71 (insert "\\M-\\C-") 73 ; (insert "\\M-\\C-")
72 (insert (- (following-char) 32)) 74 ; (insert (- (following-char) 32))
73 (delete-char 1) 75 ; (delete-char 1)
74 (forward-char -1)) 76 ; (forward-char -1))
75 ((and (>= (following-char) 155) (< (following-char) 160)) 77 ; ((and (>= (following-char) 155) (< (following-char) 160))
76 (insert "\\M-\\C-") 78 ; (insert "\\M-\\C-")
77 (insert (- (following-char) 64)) 79 ; (insert (- (following-char) 64))
78 (delete-char 1) 80 ; (delete-char 1)
79 (forward-char -1)) 81 ; (forward-char -1))
80 ((>= (following-char) 160) 82 ; ((>= (following-char) 160)
81 (insert "\\M-") 83 ; (insert "\\M-")
82 (insert (- (following-char) 128)) 84 ; (insert (- (following-char) 128))
83 (delete-char 1) 85 ; (delete-char 1)
84 (forward-char -1)) 86 ; (forward-char -1))
85 ((< (following-char) 27) 87 ; ((< (following-char) 27)
86 ;;(insert "\\^") (insert (+ (following-char) 64)) 88 ; ;;(insert "\\^") (insert (+ (following-char) 64))
87 (insert "\\C-") (insert (+ (following-char) 96)) 89 ; (insert "\\C-") (insert (+ (following-char) 96))
88 (delete-char 1) 90 ; (delete-char 1)
89 (forward-char -1)) 91 ; (forward-char -1))
90 ((< (following-char) 32) 92 ; ((< (following-char) 32)
91 ;;(insert "\\^") (insert (+ (following-char) 64)) 93 ; ;;(insert "\\^") (insert (+ (following-char) 64))
92 (insert "\\C-") (insert (+ (following-char) 64)) 94 ; (insert "\\C-") (insert (+ (following-char) 64))
93 (delete-char 1) 95 ; (delete-char 1)
94 (forward-char -1)) 96 ; (forward-char -1))
95 (t 97 ; (t
96 (forward-char 1)))))) 98 ; (forward-char 1))))))
97 99
98 ;;;###autoload 100 ;; ;;;###autoload
99 (defun insert-kbd-macro (macroname &optional keys) 101 ;(defun insert-kbd-macro (macroname &optional keys)
100 "Insert in buffer the definition of kbd macro NAME, as Lisp code. 102 ; "Insert in buffer the definition of kbd macro NAME, as Lisp code.
101 Optional second argument KEYS means also record the keys it is on 103 ;Optional second argument KEYS means also record the keys it is on
102 \(this is the prefix argument, when calling interactively). 104 ;\(this is the prefix argument, when calling interactively).
103 105
104 This Lisp code will, when executed, define the kbd macro with the 106 ;This Lisp code will, when executed, define the kbd macro with the
105 same definition it has now. If you say to record the keys, 107 ;same definition it has now. If you say to record the keys,
106 the Lisp code will also rebind those keys to the macro. 108 ;the Lisp code will also rebind those keys to the macro.
107 Only global key bindings are recorded since executing this Lisp code 109 ;Only global key bindings are recorded since executing this Lisp code
108 always makes global bindings. 110 ;always makes global bindings.
109 111
110 To save a kbd macro, visit a file of Lisp code such as your `~/.emacs', 112 ;To save a kbd macro, visit a file of Lisp code such as your `~/.emacs',
111 use this command, and then save the file." 113 ;use this command, and then save the file."
112 (interactive "CInsert kbd macro (name): \nP") 114 ; (interactive "CInsert kbd macro (name): \nP")
113 (let (definition) 115 ; (let (definition)
114 (if (string= (symbol-name macroname) "") 116 ; (if (string= (symbol-name macroname) "")
115 (progn 117 ; (progn
116 (setq macroname 'last-kbd-macro 118 ; (setq macroname 'last-kbd-macro
117 definition last-kbd-macro) 119 ; definition last-kbd-macro)
118 (insert "(setq ")) 120 ; (insert "(setq "))
119 (progn 121 ; (progn
120 (setq definition (symbol-function macroname)) 122 ; (setq definition (symbol-function macroname))
121 (insert "(fset '"))) 123 ; (insert "(fset '")))
122 (prin1 macroname (current-buffer)) 124 ; (prin1 macroname (current-buffer))
123 (insert "\n ") 125 ; (insert "\n ")
124 (let ((string (events-to-keys definition t))) 126 ; (let ((string (events-to-keys definition t)))
125 (if (stringp string) 127 ; (if (stringp string)
126 (insert-kbd-macro-pretty-string string) 128 ; (insert-kbd-macro-pretty-string string)
127 (prin1 string (current-buffer)))) 129 ; (prin1 string (current-buffer))))
128 (insert ")\n") 130 ; (insert ")\n")
129 (if keys 131 ; (if keys
130 (let ((keys (where-is-internal macroname))) 132 ; (let ((keys (where-is-internal macroname)))
131 (while keys 133 ; (while keys
132 (insert "(global-set-key ") 134 ; (insert "(global-set-key ")
133 (prin1 (car keys) (current-buffer)) 135 ; (prin1 (car keys) (current-buffer))
134 (insert " '") 136 ; (insert " '")
135 (prin1 macroname (current-buffer)) 137 ; (prin1 macroname (current-buffer))
136 (insert ")\n") 138 ; (insert ")\n")
137 (setq keys (cdr keys))))))) 139 ; (setq keys (cdr keys)))))))
138 140
139 ;;;###autoload 141 ;;;###autoload
140 (defun kbd-macro-query (flag) 142 (defun kbd-macro-query (flag)
141 "Query user during kbd macro execution. 143 "Query user during kbd macro execution.
142 With prefix argument, enters recursive edit, 144 With prefix argument, enters recursive edit,