Mercurial > hg > xemacs-beta

comparison lisp/prim/macros.el @ 173:8eaf7971accc r20-3b13

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b13
author cvs
date Mon, 13 Aug 2007 09:49:09 +0200
parents 0d2f883870bc
children
comparison
equal deleted inserted replaced
172:a38aed19690b 173:8eaf7971accc
20 ;; You should have received a copy of the GNU General Public License 20 ;; You should have received a copy of the GNU General Public License
21 ;; along with XEmacs; see the file COPYING. If not, write to the 21 ;; along with XEmacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, 59 Temple Place - Suite 330, 22 ;; Free Software Foundation, 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA. 23 ;; Boston, MA 02111-1307, USA.
24 24
25 ;;; Synched up with: FSF 19.30. 25 ;;; Synched up with: FSF 19.34.
26 26
27 ;;; Commentary: 27 ;;; Commentary:
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
48 (and (fboundp symbol) 48 (and (fboundp symbol)
49 (not (stringp (symbol-function symbol))) 49 (not (stringp (symbol-function symbol)))
50 (not (vectorp (symbol-function symbol))) 50 (not (vectorp (symbol-function symbol)))
51 (error "Function %s is already defined and not a keyboard macro." 51 (error "Function %s is already defined and not a keyboard macro."
52 symbol)) 52 symbol))
53 (if (string-equal symbol "")
54 (error "No command name given"))
53 (fset symbol last-kbd-macro)) 55 (fset symbol last-kbd-macro))
54 56
55 ;(defun insert-kbd-macro-pretty-string (string) 57 ;;; Moved here from edmacro.el:
56 ; ;; Convert control characters to the traditional readable representation: 58
57 ; ;; put the four characters \M-x in the buffer instead of the one char \370, 59 ;;;###autoload
58 ; ;; which would deceptively print as `oslash' with the default settings. 60 (defun insert-kbd-macro (macroname &optional keys)
59 ; (save-restriction 61 "Insert in buffer the definition of kbd macro NAME, as Lisp code.
60 ; (narrow-to-region (point) (point)) 62 Optional second arg KEYS means also record the keys it is on
61 ; (prin1 string (current-buffer)) 63 \(this is the prefix argument, when calling interactively).
62 ; (goto-char (1+ (point-min))) 64
63 ; (while (not (eobp)) 65 This Lisp code will, when executed, define the kbd macro with the same
64 ; (cond ((= (following-char) 0) (insert "\\C-@") (delete-char 1)) 66 definition it has now. If you say to record the keys, the Lisp code
65 ; ((= (following-char) ?\n) (insert "\\n") (delete-char 1)) 67 will also rebind those keys to the macro. Only global key bindings
66 ; ((= (following-char) ?\r) (insert "\\r") (delete-char 1)) 68 are recorded since executing this Lisp code always makes global
67 ; ((= (following-char) ?\t) (insert "\\t") (delete-char 1)) 69 bindings.
68 ; ((= (following-char) ?\e) (insert "\\e") (delete-char 1)) 70
69 ; ((= (following-char) 127) (insert "\\C-?") (delete-char 1)) 71 To save a kbd macro, visit a file of Lisp code such as your `~/.emacs',
70 ; ((= (following-char) 128) (insert "\\M-\\C-@") (delete-char 1)) 72 use this command, and then save the file."
71 ; ((= (following-char) 255) (insert "\\M-\\C-?") (delete-char 1)) 73 (interactive "CInsert kbd macro (name): \nP")
72 ; ((and (> (following-char) 127) (< (following-char) 155)) 74 (let (definition)
73 ; (insert "\\M-\\C-") 75 (if (string= (symbol-name macroname) "")
74 ; (insert (- (following-char) 32)) 76 (progn
75 ; (delete-char 1) 77 (setq definition (format-kbd-macro))
76 ; (forward-char -1)) 78 (insert "(setq last-kbd-macro"))
77 ; ((and (>= (following-char) 155) (< (following-char) 160)) 79 (setq definition (format-kbd-macro macroname))
78 ; (insert "\\M-\\C-") 80 (insert (format "(defalias '%s" macroname)))
79 ; (insert (- (following-char) 64)) 81 (if (> (length definition) 50)
80 ; (delete-char 1) 82 (insert " (read-kbd-macro\n")
81 ; (forward-char -1)) 83 (insert "\n (read-kbd-macro "))
82 ; ((>= (following-char) 160) 84 (prin1 definition (current-buffer))
83 ; (insert "\\M-") 85 (insert "))\n")
84 ; (insert (- (following-char) 128)) 86 (if keys
85 ; (delete-char 1) 87 (let ((keys (where-is-internal macroname)))
86 ; (forward-char -1)) 88 (while keys
87 ; ((< (following-char) 27) 89 (insert (format "(global-set-key %S '%s)\n" (car keys) macroname))
88 ; ;;(insert "\\^") (insert (+ (following-char) 64)) 90 (pop keys))))))
89 ; (insert "\\C-") (insert (+ (following-char) 96))
90 ; (delete-char 1)
91 ; (forward-char -1))
92 ; ((< (following-char) 32)
93 ; ;;(insert "\\^") (insert (+ (following-char) 64))
94 ; (insert "\\C-") (insert (+ (following-char) 64))
95 ; (delete-char 1)
96 ; (forward-char -1))
97 ; (t
98 ; (forward-char 1))))))
99
100 ;; ;;;###autoload
101 ;(defun insert-kbd-macro (macroname &optional keys)
102 ; "Insert in buffer the definition of kbd macro NAME, as Lisp code.
103 ;Optional second argument KEYS means also record the keys it is on
104 ;\(this is the prefix argument, when calling interactively).
105
106 ;This Lisp code will, when executed, define the kbd macro with the
107 ;same definition it has now. If you say to record the keys,
108 ;the Lisp code will also rebind those keys to the macro.
109 ;Only global key bindings are recorded since executing this Lisp code
110 ;always makes global bindings.
111
112 ;To save a kbd macro, visit a file of Lisp code such as your `~/.emacs',
113 ;use this command, and then save the file."
114 ; (interactive "CInsert kbd macro (name): \nP")
115 ; (let (definition)
116 ; (if (string= (symbol-name macroname) "")
117 ; (progn
118 ; (setq macroname 'last-kbd-macro
119 ; definition last-kbd-macro)
120 ; (insert "(setq "))
121 ; (progn
122 ; (setq definition (symbol-function macroname))
123 ; (insert "(fset '")))
124 ; (prin1 macroname (current-buffer))
125 ; (insert "\n ")
126 ; (let ((string (events-to-keys definition t)))
127 ; (if (stringp string)
128 ; (insert-kbd-macro-pretty-string string)
129 ; (prin1 string (current-buffer))))
130 ; (insert ")\n")
131 ; (if keys
132 ; (let ((keys (where-is-internal macroname)))
133 ; (while keys
134 ; (insert "(global-set-key ")
135 ; (prin1 (car keys) (current-buffer))
136 ; (insert " '")
137 ; (prin1 macroname (current-buffer))
138 ; (insert ")\n")
139 ; (setq keys (cdr keys)))))))
140 91
141 ;;;###autoload 92 ;;;###autoload
142 (defun kbd-macro-query (flag) 93 (defun kbd-macro-query (flag)
143 "Query user during kbd macro execution. 94 "Query user during kbd macro execution.
144 With prefix argument, enters recursive edit, 95 With prefix argument, enters recursive edit,
150 \\[skip] Skip the rest of this iteration, and start the next. 101 \\[skip] Skip the rest of this iteration, and start the next.
151 \\[exit] Stop the macro entirely right now. 102 \\[exit] Stop the macro entirely right now.
152 \\[recenter] Redisplay the frame, then ask again. 103 \\[recenter] Redisplay the frame, then ask again.
153 \\[edit] Enter recursive edit; ask again when you exit from that." 104 \\[edit] Enter recursive edit; ask again when you exit from that."
154 (interactive "P") 105 (interactive "P")
155 (or executing-macro 106 (or executing-kbd-macro
156 defining-kbd-macro 107 defining-kbd-macro
157 (error "Not defining or executing kbd macro")) 108 (error "Not defining or executing kbd macro"))
158 (if flag 109 (if flag
159 (let (executing-macro defining-kbd-macro) 110 (let (executing-kbd-macro defining-kbd-macro)
160 (recursive-edit)) 111 (recursive-edit))
161 (if (not executing-macro) 112 (if (not executing-kbd-macro)
162 nil 113 nil
163 (let ((loop t) 114 (let ((loop t)
164 (msg (substitute-command-keys 115 (msg (substitute-command-keys
165 "Proceed with macro?\\<query-replace-map>\ 116 "Proceed with macro?\\<query-replace-map>\
166 (\\[act], \\[skip], \\[exit], \\[recenter], \\[edit]) "))) 117 (\\[act], \\[skip], \\[exit], \\[recenter], \\[edit]) ")))
167 (while loop 118 (while loop
168 (let ((key (let ((executing-macro nil) 119 (let ((key (let ((executing-kbd-macro nil)
169 (defining-kbd-macro nil)) 120 (defining-kbd-macro nil))
170 (message msg) 121 (message "%s" msg)
171 (read-char))) 122 ;; XEmacs: avoid `read-char'.
123 (read-char-exclusive)))
172 def) 124 def)
173 (setq key (vector key)) 125 (setq key (vector key))
174 (setq def (lookup-key query-replace-map key)) 126 (setq def (lookup-key query-replace-map key))
175 (cond ((eq def 'act) 127 (cond ((eq def 'act)
176 (setq loop nil)) 128 (setq loop nil))
177 ((eq def 'skip) 129 ((eq def 'skip)
178 (setq loop nil) 130 (setq loop nil)
179 (setq executing-macro "")) 131 (setq executing-kbd-macro ""))
180 ((eq def 'exit) 132 ((eq def 'exit)
181 (setq loop nil) 133 (setq loop nil)
182 (setq executing-macro t)) 134 (setq executing-kbd-macro t))
183 ((eq def 'recenter) 135 ((eq def 'recenter)
184 (recenter nil)) 136 (recenter nil))
185 ((eq def 'edit) 137 ((eq def 'edit)
186 (let (executing-macro defining-kbd-macro) 138 (let (executing-kbd-macro defining-kbd-macro)
187 (recursive-edit))) 139 (recursive-edit)))
188 ((eq def 'quit) 140 ((eq def 'quit)
189 (setq quit-flag t)) 141 (setq quit-flag t))
190 (t 142 (t
191 (or (eq def 'help) 143 (or (eq def 'help)