Mercurial > emacs

comparison lisp/map-ynp.el @ 31710:6c1273035214

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(map-y-or-n-p): Check use-dialog-box. Don't lose with null `help'. Use modern backquote syntax.
author Dave Love <fx@gnu.org>
date Tue, 19 Sep 2000 11:57:07 +0000
parents a1b5109f447a
children 54b09b09e4bd
comparison
equal deleted inserted replaced
31709:5913c05f83ee 31710:6c1273035214
1 ;;; map-ynp.el --- General-purpose boolean question-asker. 1 ;;; map-ynp.el --- General-purpose boolean question-asker.
2 2
3 ;; Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. 3 ;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 2000 Free Software Foundation, Inc.
4 4
5 ;; Author: Roland McGrath <roland@gnu.org> 5 ;; Author: Roland McGrath <roland@gnu.org>
6 ;; Maintainer: FSF 6 ;; Maintainer: FSF
7 ;; Keywords: lisp, extensions 7 ;; Keywords: lisp, extensions
8 8
94 (progn 94 (progn
95 (setq elt (car list) 95 (setq elt (car list)
96 list (cdr list)) 96 list (cdr list))
97 t) 97 t)
98 nil)))))) 98 nil))))))
99 (if (listp last-nonmenu-event) 99 (if (and (listp last-nonmenu-event)
100 use-dialog-box)
100 ;; Make a list describing a dialog box. 101 ;; Make a list describing a dialog box.
101 (let ((object (capitalize (nth 0 help))) 102 (let ((object (if help (capitalize (nth 0 help))))
102 (objects (capitalize (nth 1 help))) 103 (objects (if help (capitalize (nth 1 help))))
103 (action (capitalize (nth 2 help)))) 104 (action (if help (capitalize (nth 2 help)))))
104 (setq map (` (("Yes" . act) ("No" . skip) ("Quit" . exit) 105 (setq map `(("Yes" . act) ("No" . skip) ("Quit" . exit)
105 ((, (if help (concat action " " object " And Quit") 106 (,(if help (concat action " " object " And Quit")
106 "Do it and Quit")) . act-and-exit) 107 "Do it and Quit") . act-and-exit)
107 ((, (if help (concat action " All " objects) 108 (,(if help (concat action " All " objects)
108 "Do All")) . automatic) 109 "Do All") . automatic)
109 (,@ (mapcar (lambda (elt) 110 ,@(mapcar (lambda (elt)
110 (cons (capitalize (nth 2 elt)) 111 (cons (capitalize (nth 2 elt))
111 (vector (nth 1 elt)))) 112 (vector (nth 1 elt))))
112 action-alist)))) 113 action-alist))
113 use-menus t 114 use-menus t
114 mouse-event last-nonmenu-event)) 115 mouse-event last-nonmenu-event))
115 (setq user-keys (if action-alist 116 (setq user-keys (if action-alist
116 (concat (mapconcat (function 117 (concat (mapconcat (function
117 (lambda (elt) 118 (lambda (elt)
128 action-alist) 129 action-alist)
129 query-replace-map)))) 130 query-replace-map))))
130 (unwind-protect 131 (unwind-protect
131 (progn 132 (progn
132 (if (stringp prompter) 133 (if (stringp prompter)
133 (setq prompter (` (lambda (object) 134 (setq prompter `(lambda (object)
134 (format (, prompter) object))))) 135 (format ,prompter object))))
135 (while (funcall next) 136 (while (funcall next)
136 (setq prompt (funcall prompter elt)) 137 (setq prompt (funcall prompter elt))
137 (cond ((stringp prompt) 138 (cond ((stringp prompt)
138 ;; Prompt the user about this object. 139 ;; Prompt the user about this object.
139 (setq quit-flag nil) 140 (setq quit-flag nil)
174 (funcall actor elt) 175 (funcall actor elt)
175 (setq actions (1+ actions) 176 (setq actions (1+ actions)
176 next (function (lambda () nil)))) 177 next (function (lambda () nil))))
177 ((or (eq def 'quit) (eq def 'exit-prefix)) 178 ((or (eq def 'quit) (eq def 'exit-prefix))
178 (setq quit-flag t) 179 (setq quit-flag t)
179 (setq next (` (lambda () 180 (setq next `(lambda ()
180 (setq next '(, next)) 181 (setq next ',next)
181 '(, elt))))) 182 ',elt)))
182 ((eq def 'automatic) 183 ((eq def 'automatic)
183 ;; Act on this and all following objects. 184 ;; Act on this and all following objects.
184 (if (funcall prompter elt) 185 (if (funcall prompter elt)
185 (progn 186 (progn
186 (funcall actor elt) 187 (funcall actor elt)
217 action object)))) 218 action object))))
218 (save-excursion 219 (save-excursion
219 (set-buffer standard-output) 220 (set-buffer standard-output)
220 (help-mode))) 221 (help-mode)))
221 222
222 (setq next (` (lambda () 223 (setq next (lambda ()
223 (setq next '(, next)) 224 (setq next ',next)
224 '(, elt))))) 225 ',elt)))
225 ((vectorp def) 226 ((vectorp def)
226 ;; A user-defined key. 227 ;; A user-defined key.
227 (if (funcall (aref def 0) elt) ;Call its function. 228 (if (funcall (aref def 0) elt) ;Call its function.
228 ;; The function has eaten this object. 229 ;; The function has eaten this object.
229 (setq actions (1+ actions)) 230 (setq actions (1+ actions))
230 ;; Regurgitated; try again. 231 ;; Regurgitated; try again.
231 (setq next (` (lambda () 232 (setq next (lambda ()
232 (setq next '(, next)) 233 (setq next ',next)
233 '(, elt)))))) 234 ',elt))))
234 ((and (consp char) 235 ((and (consp char)
235 (eq (car char) 'switch-frame)) 236 (eq (car char) 'switch-frame))
236 ;; switch-frame event. Put it off until we're done. 237 ;; switch-frame event. Put it off until we're done.
237 (setq delayed-switch-frame char) 238 (setq delayed-switch-frame char)
238 (setq next (` (lambda () 239 (setq next (lambda ()
239 (setq next '(, next)) 240 (setq next ',next)
240 '(, elt))))) 241 ',elt)))
241 (t 242 (t
242 ;; Random char. 243 ;; Random char.
243 (message "Type %s for help." 244 (message "Type %s for help."
244 (key-description (vector help-char))) 245 (key-description (vector help-char)))
245 (beep) 246 (beep)
246 (sit-for 1) 247 (sit-for 1)
247 (setq next (` (lambda () 248 (setq next (lambda ()
248 (setq next '(, next)) 249 (setq next ',next)
249 '(, elt))))))) 250 ',elt)))))
250 (prompt 251 (prompt
251 (funcall actor elt) 252 (funcall actor elt)
252 (setq actions (1+ actions)))))) 253 (setq actions (1+ actions))))))
253 (if delayed-switch-frame 254 (if delayed-switch-frame
254 (setq unread-command-events 255 (setq unread-command-events