Mercurial > hg > xemacs-beta

comparison lisp/map-ynp.el @ 380:8626e4521993 r21-2-5

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-5
author cvs
date Mon, 13 Aug 2007 11:07:10 +0200
parents 41ff10fd062f
children 2f8bb876ab1d
comparison
equal deleted inserted replaced
379:76b7d63099ad 380:8626e4521993
88 (next (if (or (and list (symbolp list)) 88 (next (if (or (and list (symbolp list))
89 (subrp list) 89 (subrp list)
90 (compiled-function-p list) 90 (compiled-function-p list)
91 (and (consp list) 91 (and (consp list)
92 (eq (car list) 'lambda))) 92 (eq (car list) 'lambda)))
93 (function (lambda () 93 #'(lambda () (setq elt (funcall list)))
94 (setq elt (funcall list)))) 94 #'(lambda ()
95 (function (lambda () 95 (if list
96 (if list 96 (progn
97 (progn 97 (setq elt (car list)
98 (setq elt (car list) 98 list (cdr list))
99 list (cdr list)) 99 t)
100 t) 100 nil)))))
101 nil))))))
102 (if (should-use-dialog-box-p) 101 (if (should-use-dialog-box-p)
103 ;; Make a list describing a dialog box. 102 ;; Make a list describing a dialog box.
104 (let (;; (object (capitalize (or (nth 0 help) "object"))) 103 (let (;; (object (capitalize (or (nth 0 help) "object")))
105 ;; (objects (capitalize (or (nth 1 help) "objects"))) 104 ;; (objects (capitalize (or (nth 1 help) "objects")))
106 ;; (action (capitalize (or (nth 2 help) "act on"))) 105 ;; (action (capitalize (or (nth 2 help) "act on")))
121 ; (or (and help (nth 5 help)) "Quit"))) 120 ; (or (and help (nth 5 help)) "Quit")))
122 ; . exit) 121 ; . exit)
123 ("Yes All" . automatic) 122 ("Yes All" . automatic)
124 ("No All" . exit) 123 ("No All" . exit)
125 ("Cancel" . quit) 124 ("Cancel" . quit)
126 ,@(mapcar (lambda (elt) 125 ,@(mapcar #'(lambda (elt)
127 (cons (capitalize (nth 2 elt)) 126 (cons (capitalize (nth 2 elt))
128 (vector (nth 1 elt)))) 127 (vector (nth 1 elt))))
129 action-alist)) 128 action-alist))
130 mouse-event last-command-event)) 129 mouse-event last-command-event))
131 (setq user-keys (if action-alist 130 (setq user-keys (if action-alist
132 (concat (mapconcat (function 131 (concat (mapconcat #'(lambda (elt)
133 (lambda (elt) 132 (key-description
134 (key-description 133 (if (characterp (car elt))
135 (if (characterp (car elt)) 134 ;; XEmacs
136 ;; XEmacs 135 (char-to-string (car elt))
137 (char-to-string (car elt)) 136 (car elt))))
138 (car elt)))))
139 action-alist ", ") 137 action-alist ", ")
140 " ") 138 " ")
141 "") 139 "")
142 ;; Make a map that defines each user key as a vector containing 140 ;; Make a map that defines each user key as a vector containing
143 ;; its definition. 141 ;; its definition.
154 (set-keymap-parents foomap (list query-replace-map)) 152 (set-keymap-parents foomap (list query-replace-map))
155 foomap))) 153 foomap)))
156 (unwind-protect 154 (unwind-protect
157 (progn 155 (progn
158 (if (stringp prompter) 156 (if (stringp prompter)
159 (setq prompter (` (lambda (object) 157 (setq prompter `(lambda (object)
160 (format (, prompter) object))))) 158 (format ,prompter object))))
161 (while (funcall next) 159 (while (funcall next)
162 (setq prompt (funcall prompter elt)) 160 (setq prompt (funcall prompter elt))
163 (cond ((stringp prompt) 161 (cond ((stringp prompt)
164 ;; Prompt the user about this object. 162 ;; Prompt the user about this object.
165 (setq quit-flag nil) 163 (setq quit-flag nil)
184 prompt user-keys 182 prompt user-keys
185 (key-description (vector help-char)) 183 (key-description (vector help-char))
186 (single-key-description char)))) 184 (single-key-description char))))
187 (setq def (lookup-key map (vector char)))) 185 (setq def (lookup-key map (vector char))))
188 (cond ((eq def 'exit) 186 (cond ((eq def 'exit)
189 (setq next (function (lambda () nil)))) 187 (setq next #'(lambda () nil)))
190 ((eq def 'act) 188 ((eq def 'act)
191 ;; Act on the object. 189 ;; Act on the object.
192 (funcall actor elt) 190 (funcall actor elt)
193 (setq actions (1+ actions))) 191 (setq actions (1+ actions)))
194 ((eq def 'skip) 192 ((eq def 'skip)
199 (funcall actor elt) 197 (funcall actor elt)
200 (setq actions (1+ actions) 198 (setq actions (1+ actions)
201 next (function (lambda () nil)))) 199 next (function (lambda () nil))))
202 ((or (eq def 'quit) (eq def 'exit-prefix)) 200 ((or (eq def 'quit) (eq def 'exit-prefix))
203 (setq quit-flag t) 201 (setq quit-flag t)
204 (setq next (` (lambda () 202 (setq next `(lambda ()
205 (setq next '(, next)) 203 (setq next ',next)
206 '(, elt))))) 204 ',elt)))
207 ((eq def 'automatic) 205 ((eq def 'automatic)
208 ;; Act on this and all following objects. 206 ;; Act on this and all following objects.
209 ;; (if (funcall prompter elt) ; Emacs 207 ;; (if (funcall prompter elt) ; Emacs
210 (if (eval (funcall prompter elt)) 208 (if (eval (funcall prompter elt))
211 (progn 209 (progn
242 action object)))) 240 action object))))
243 (save-excursion 241 (save-excursion
244 (set-buffer standard-output) 242 (set-buffer standard-output)
245 (help-mode))) 243 (help-mode)))
246 244
247 (setq next (` (lambda () 245 (setq next `(lambda ()
248 (setq next '(, next)) 246 (setq next ',next)
249 '(, elt))))) 247 ',elt)))
250 ((vectorp def) 248 ((vectorp def)
251 ;; A user-defined key. 249 ;; A user-defined key.
252 (if (funcall (aref def 0) elt) ;Call its function. 250 (if (funcall (aref def 0) elt) ;Call its function.
253 ;; The function has eaten this object. 251 ;; The function has eaten this object.
254 (setq actions (1+ actions)) 252 (setq actions (1+ actions))
255 ;; Regurgitated; try again. 253 ;; Regurgitated; try again.
256 (setq next (` (lambda () 254 (setq next `(lambda ()
257 (setq next '(, next)) 255 (setq next ',next)
258 '(, elt)))))) 256 ',elt))))
259 ;((and (consp char) ; Emacs 257 ;((and (consp char) ; Emacs
260 ; (eq (car char) 'switch-frame)) 258 ; (eq (car char) 'switch-frame))
261 ; ;; switch-frame event. Put it off until we're done. 259 ; ;; switch-frame event. Put it off until we're done.
262 ; (setq delayed-switch-frame char) 260 ; (setq delayed-switch-frame char)
263 ; (setq next (` (lambda () 261 ; (setq next `(lambda ()
264 ; (setq next '(, next)) 262 ; (setq next ',next)
265 ; '(, elt))))) 263 ; ',elt)))
266 (t 264 (t
267 ;; Random char. 265 ;; Random char.
268 (message "Type %s for help." 266 (message "Type %s for help."
269 (key-description (vector help-char))) 267 (key-description (vector help-char)))
270 (beep) 268 (beep)
271 (sit-for 1) 269 (sit-for 1)
272 (setq next (` (lambda () 270 (setq next `(lambda ()
273 (setq next '(, next)) 271 (setq next ',next)
274 '(, elt))))))) 272 ',elt)))))
275 ((eval prompt) 273 ((eval prompt)
276 (progn 274 (progn
277 (funcall actor elt) 275 (funcall actor elt)
278 (setq actions (1+ actions))))))) 276 (setq actions (1+ actions)))))))
279 ;;(if delayed-switch-frame 277 ;;(if delayed-switch-frame