Mercurial > hg > xemacs-beta
comparison lisp/minibuf.el @ 2730:7031e143e4ee
[xemacs-hg @ 2005-04-14 05:58:45 by michaels]
2005-04-12 Mike Sperber <mike@xemacs.org>
* minibuf.el (get-user-response): Move here from dialog.el so it
works even when dialogs are not available.
* dialog.el: See above.
| author | michaels |
|---|---|
| date | Thu, 14 Apr 2005 05:58:46 +0000 |
| parents | 139afe9fb2ee |
| children | 5df5ea55d3fc |
comparison
equal
deleted
inserted
replaced
| 2729:d3c4655e9c06 | 2730:7031e143e4ee |
|---|---|
| 2242 (or force-dialog-box-use | 2242 (or force-dialog-box-use |
| 2243 (button-press-event-p last-command-event) | 2243 (button-press-event-p last-command-event) |
| 2244 (button-release-event-p last-command-event) | 2244 (button-release-event-p last-command-event) |
| 2245 (misc-user-event-p last-command-event)))) | 2245 (misc-user-event-p last-command-event)))) |
| 2246 | 2246 |
| 2247 (defun get-user-response (position question answers) | |
| 2248 "Ask a question and get a response from the user, in minibuffer or dialog box. | |
| 2249 POSITION specifies which frame to use. | |
| 2250 This is normally an event or a window or frame. | |
| 2251 If POSITION is t or nil, it means to use the frame the mouse is on. | |
| 2252 The dialog box appears in the middle of the specified frame. | |
| 2253 | |
| 2254 QUESTION is the question to ask (it should end with a question mark followed | |
| 2255 by a space). | |
| 2256 | |
| 2257 ANSWERS are the possible answers. It is a list; each item looks like | |
| 2258 | |
| 2259 (KEY BUTTON-TEXT RESPONSE) | |
| 2260 | |
| 2261 where KEY is the key to be pressed in the minibuffer, BUTTON-TEXT is the | |
| 2262 text to be displayed in a dialog box button (you should put %_ in it to | |
| 2263 indicate the accelerator), and RESPONSE is a value (typically a symbol) | |
| 2264 to be returned if the user selects this response. KEY should be either a | |
| 2265 single character or a string; which one you use needs to be consistent for | |
| 2266 all responses and determines whether the user responds by hitting a single | |
| 2267 key or typing in a string and hitting ENTER. | |
| 2268 | |
| 2269 An item may also be just a string--that makes a nonselectable item in the | |
| 2270 dialog box and is ignored in the minibuffer. | |
| 2271 | |
| 2272 An item may also be nil -- that means to put all preceding items | |
| 2273 on the left of the dialog box and all following items on the right; ignored | |
| 2274 in the minibuffer." | |
| 2275 (if (should-use-dialog-box-p) | |
| 2276 (get-dialog-box-response | |
| 2277 position | |
| 2278 (cons question | |
| 2279 (mapcar #'(lambda (x) | |
| 2280 (cond | |
| 2281 ((null x) nil) | |
| 2282 ((stringp x) x) | |
| 2283 (t (cons (second x) (third x))))) | |
| 2284 answers))) | |
| 2285 (save-excursion | |
| 2286 (let* ((answers (remove-if-not #'consp answers)) | |
| 2287 (possible | |
| 2288 (gettext | |
| 2289 (flet ((car-to-string-if (x) | |
| 2290 (setq x (car x)) | |
| 2291 (if (stringp x) x (char-to-string x)))) | |
| 2292 (concat (mapconcat #'car-to-string-if | |
| 2293 (butlast answers) ", ") " or " | |
| 2294 (car-to-string-if (car (last answers))))))) | |
| 2295 (question (gettext question)) | |
| 2296 (p (format "%s(%s) " question possible))) | |
| 2297 (block nil | |
| 2298 (if (stringp (caar answers)) | |
| 2299 ;; based on yes-or-no-p. | |
| 2300 (while t | |
| 2301 (let* ((ans (downcase (read-string p nil t))) ;no history | |
| 2302 (res (member* ans answers :test #'equal :key #'car))) | |
| 2303 (if res (return (third (car res))) | |
| 2304 (ding nil 'yes-or-no-p) | |
| 2305 (discard-input) | |
| 2306 (message "Please answer %s." possible) | |
| 2307 (sleep-for 2)))) | |
| 2308 ;; based on y-or-n-p. | |
| 2309 (save-excursion | |
| 2310 (let* ((pre "") event) | |
| 2311 (while t | |
| 2312 (if (let ((cursor-in-echo-area t) | |
| 2313 (inhibit-quit t)) | |
| 2314 (message "%s%s(%s) " pre question possible) | |
| 2315 (setq event (next-command-event event)) | |
| 2316 (condition-case nil | |
| 2317 (prog1 | |
| 2318 (or quit-flag (eq 'keyboard-quit | |
| 2319 (key-binding event))) | |
| 2320 (setq quit-flag nil)) | |
| 2321 (wrong-type-argument t))) | |
| 2322 (progn | |
| 2323 (message "%s%s(%s) %s" pre question possible | |
| 2324 (single-key-description event)) | |
| 2325 (setq quit-flag nil) | |
| 2326 (signal 'quit '()))) | |
| 2327 (let* ((keys (events-to-keys (vector event))) | |
| 2328 (def (lookup-key query-replace-map keys))) | |
| 2329 (cond | |
| 2330 ; ((eq def 'skip) | |
| 2331 ; (message "%s%sNo" question possible) | |
| 2332 ; (return nil)) | |
| 2333 ; ((eq def 'act) | |
| 2334 ; (message "%s%sYes" question possible) | |
| 2335 ; (return t)) | |
| 2336 ((eq def 'recenter) | |
| 2337 (recenter)) | |
| 2338 ((or (eq def 'quit) (eq def 'exit-prefix)) | |
| 2339 (signal 'quit '())) | |
| 2340 ((button-release-event-p event) ; ignore them | |
| 2341 nil) | |
| 2342 (t | |
| 2343 (let ((res (member* (event-to-character event) answers | |
| 2344 :key #'car))) | |
| 2345 (if res (return (third (car res))) | |
| 2346 (message "%s%s(%s) %s" pre question possible | |
| 2347 (single-key-description event)) | |
| 2348 (ding nil 'y-or-n-p) | |
| 2349 (discard-input) | |
| 2350 (if (= (length pre) 0) | |
| 2351 (setq pre (format "Please answer %s. " | |
| 2352 ;; 17 parens! a record in | |
| 2353 ;; our lisp code. | |
| 2354 possible))))))))))))))))) | |
| 2355 | |
| 2247 ;;; minibuf.el ends here | 2356 ;;; minibuf.el ends here |