Mercurial > hg > xemacs-beta
comparison lisp/dialog.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 | bcb5d65d0d94 |
| children | fbafdc1bb4d2 308d34e9f07d |
comparison
equal
deleted
inserted
replaced
| 2729:d3c4655e9c06 | 2730:7031e143e4ee |
|---|---|
| 89 ;;this will never get selected | 89 ;;this will never get selected |
| 90 `[,x 'ignore nil]) | 90 `[,x 'ignore nil]) |
| 91 (t | 91 (t |
| 92 `[,(car x) (dialog-box-finish ',(cdr x)) t]))) | 92 `[,(car x) (dialog-box-finish ',(cdr x)) t]))) |
| 93 (cdr contents)))) | 93 (cdr contents)))) |
| 94 | |
| 95 (defun get-user-response (position question answers) | |
| 96 "Ask a question and get a response from the user, in minibuffer or dialog box. | |
| 97 POSITION specifies which frame to use. | |
| 98 This is normally an event or a window or frame. | |
| 99 If POSITION is t or nil, it means to use the frame the mouse is on. | |
| 100 The dialog box appears in the middle of the specified frame. | |
| 101 | |
| 102 QUESTION is the question to ask (it should end with a question mark followed | |
| 103 by a space). | |
| 104 | |
| 105 ANSWERS are the possible answers. It is a list; each item looks like | |
| 106 | |
| 107 (KEY BUTTON-TEXT RESPONSE) | |
| 108 | |
| 109 where KEY is the key to be pressed in the minibuffer, BUTTON-TEXT is the | |
| 110 text to be displayed in a dialog box button (you should put %_ in it to | |
| 111 indicate the accelerator), and RESPONSE is a value (typically a symbol) | |
| 112 to be returned if the user selects this response. KEY should be either a | |
| 113 single character or a string; which one you use needs to be consistent for | |
| 114 all responses and determines whether the user responds by hitting a single | |
| 115 key or typing in a string and hitting ENTER. | |
| 116 | |
| 117 An item may also be just a string--that makes a nonselectable item in the | |
| 118 dialog box and is ignored in the minibuffer. | |
| 119 | |
| 120 An item may also be nil -- that means to put all preceding items | |
| 121 on the left of the dialog box and all following items on the right; ignored | |
| 122 in the minibuffer." | |
| 123 (if (should-use-dialog-box-p) | |
| 124 (get-dialog-box-response | |
| 125 position | |
| 126 (cons question | |
| 127 (mapcar #'(lambda (x) | |
| 128 (cond | |
| 129 ((null x) nil) | |
| 130 ((stringp x) x) | |
| 131 (t (cons (second x) (third x))))) | |
| 132 answers))) | |
| 133 (save-excursion | |
| 134 (let* ((answers (remove-if-not #'consp answers)) | |
| 135 (possible | |
| 136 (gettext | |
| 137 (flet ((car-to-string-if (x) | |
| 138 (setq x (car x)) | |
| 139 (if (stringp x) x (char-to-string x)))) | |
| 140 (concat (mapconcat #'car-to-string-if | |
| 141 (butlast answers) ", ") " or " | |
| 142 (car-to-string-if (car (last answers))))))) | |
| 143 (question (gettext question)) | |
| 144 (p (format "%s(%s) " question possible))) | |
| 145 (block nil | |
| 146 (if (stringp (caar answers)) | |
| 147 ;; based on yes-or-no-p. | |
| 148 (while t | |
| 149 (let* ((ans (downcase (read-string p nil t))) ;no history | |
| 150 (res (member* ans answers :test #'equal :key #'car))) | |
| 151 (if res (return (third (car res))) | |
| 152 (ding nil 'yes-or-no-p) | |
| 153 (discard-input) | |
| 154 (message "Please answer %s." possible) | |
| 155 (sleep-for 2)))) | |
| 156 ;; based on y-or-n-p. | |
| 157 (save-excursion | |
| 158 (let* ((pre "") event) | |
| 159 (while t | |
| 160 (if (let ((cursor-in-echo-area t) | |
| 161 (inhibit-quit t)) | |
| 162 (message "%s%s(%s) " pre question possible) | |
| 163 (setq event (next-command-event event)) | |
| 164 (condition-case nil | |
| 165 (prog1 | |
| 166 (or quit-flag (eq 'keyboard-quit | |
| 167 (key-binding event))) | |
| 168 (setq quit-flag nil)) | |
| 169 (wrong-type-argument t))) | |
| 170 (progn | |
| 171 (message "%s%s(%s) %s" pre question possible | |
| 172 (single-key-description event)) | |
| 173 (setq quit-flag nil) | |
| 174 (signal 'quit '()))) | |
| 175 (let* ((keys (events-to-keys (vector event))) | |
| 176 (def (lookup-key query-replace-map keys))) | |
| 177 (cond | |
| 178 ; ((eq def 'skip) | |
| 179 ; (message "%s%sNo" question possible) | |
| 180 ; (return nil)) | |
| 181 ; ((eq def 'act) | |
| 182 ; (message "%s%sYes" question possible) | |
| 183 ; (return t)) | |
| 184 ((eq def 'recenter) | |
| 185 (recenter)) | |
| 186 ((or (eq def 'quit) (eq def 'exit-prefix)) | |
| 187 (signal 'quit '())) | |
| 188 ((button-release-event-p event) ; ignore them | |
| 189 nil) | |
| 190 (t | |
| 191 (let ((res (member* (event-to-character event) answers | |
| 192 :key #'car))) | |
| 193 (if res (return (third (car res))) | |
| 194 (message "%s%s(%s) %s" pre question possible | |
| 195 (single-key-description event)) | |
| 196 (ding nil 'y-or-n-p) | |
| 197 (discard-input) | |
| 198 (if (= (length pre) 0) | |
| 199 (setq pre (format "Please answer %s. " | |
| 200 ;; 17 parens! a record in | |
| 201 ;; our lisp code. | |
| 202 possible))))))))))))))))) | |
| 203 | |
| 204 | 94 |
| 205 (defun message-box (fmt &rest args) | 95 (defun message-box (fmt &rest args) |
| 206 "Display a message, in a dialog box if possible. | 96 "Display a message, in a dialog box if possible. |
| 207 If the selected device has no dialog-box support, use the echo area. | 97 If the selected device has no dialog-box support, use the echo area. |
| 208 The arguments are the same as to `format'. | 98 The arguments are the same as to `format'. |