|
209
|
1 ;;; dialog.el --- Dialog-box support for XEmacs
|
|
|
2
|
|
|
3 ;; Copyright (C) 1991-4, 1997 Free Software Foundation, Inc.
|
|
844
|
4 ;; Copyright (C) 2000, 2002 Ben Wing.
|
|
209
|
5
|
|
|
6 ;; Maintainer: XEmacs Development Team
|
|
|
7 ;; Keywords: extensions, internal, dumped
|
|
|
8
|
|
|
9 ;; This file is part of XEmacs.
|
|
|
10
|
|
|
11 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
12 ;; under the terms of the GNU General Public License as published by
|
|
|
13 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
14 ;; any later version.
|
|
|
15
|
|
|
16 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
19 ;; General Public License for more details.
|
|
|
20
|
|
|
21 ;; You should have received a copy of the GNU General Public License
|
|
|
22 ;; along with XEmacs; see the file COPYING. If not, write to the
|
|
|
23 ;; Free Software Foundation, 59 Temple Place - Suite 330,
|
|
|
24 ;; Boston, MA 02111-1307, USA.
|
|
|
25
|
|
|
26 ;;; Synched up with: Not in FSF.
|
|
|
27
|
|
844
|
28 ;;; Authorship: Mostly written or rewritten by Ben Wing; some old old stuff
|
|
|
29 ;;; that underlies some current code was written by JWZ.
|
|
|
30
|
|
209
|
31 ;;; Commentary:
|
|
|
32
|
|
|
33 ;; This file is dumped with XEmacs (when dialog boxes are compiled in).
|
|
|
34
|
|
442
|
35 ;; Dialog boxes are non-modal at the C level, but made modal at the
|
|
|
36 ;; Lisp level via hacks in functions such as yes-or-no-p-dialog-box
|
|
|
37 ;; below. Perhaps there should be truly modal dialog boxes
|
|
|
38 ;; implemented at the C level for safety. All code using dialog boxes
|
|
|
39 ;; should be careful to assume that the environment, for example the
|
|
|
40 ;; current buffer, might be completely different after returning from
|
|
|
41 ;; yes-or-no-p-dialog-box, but such code is difficult to write and test.
|
|
|
42
|
|
209
|
43 ;;; Code:
|
|
|
44 (defun yes-or-no-p-dialog-box (prompt)
|
|
442
|
45 "Ask user a yes-or-no question with a popup dialog box.
|
|
|
46 Return t if the answer is \"yes\".
|
|
209
|
47 Takes one argument, which is the string to display to ask the question."
|
|
442
|
48 (save-selected-frame
|
|
|
49 (make-dialog-box 'question
|
|
|
50 :question prompt
|
|
|
51 :modal t
|
|
|
52 :buttons '(["Yes" (dialog-box-finish t)]
|
|
|
53 ["No" (dialog-box-finish nil)]
|
|
|
54 nil
|
|
|
55 ["Cancel" (dialog-box-cancel)]))))
|
|
209
|
56
|
|
442
|
57 ;; FSF has a similar function `x-popup-dialog'.
|
|
209
|
58 (defun get-dialog-box-response (position contents)
|
|
|
59 "Pop up a dialog box and return user's selection.
|
|
|
60 POSITION specifies which frame to use.
|
|
|
61 This is normally an event or a window or frame.
|
|
|
62 If POSITION is t or nil, it means to use the frame the mouse is on.
|
|
|
63 The dialog box appears in the middle of the specified frame.
|
|
|
64
|
|
|
65 CONTENTS specifies the alternatives to display in the dialog box.
|
|
|
66 It is a list of the form (TITLE ITEM1 ITEM2...).
|
|
|
67 Each ITEM is a cons cell (STRING . VALUE).
|
|
|
68 The return value is VALUE from the chosen item.
|
|
|
69
|
|
|
70 An ITEM may also be just a string--that makes a nonselectable item.
|
|
|
71 An ITEM may also be nil--that means to put all preceding items
|
|
|
72 on the left of the dialog box and all following items on the right."
|
|
|
73 (cond
|
|
|
74 ((eventp position)
|
|
|
75 (select-frame (event-frame position)))
|
|
|
76 ((framep position)
|
|
|
77 (select-frame position))
|
|
|
78 ((windowp position)
|
|
|
79 (select-window position)))
|
|
442
|
80 (make-dialog-box 'question
|
|
|
81 :question (car contents)
|
|
|
82 :modal t
|
|
|
83 :buttons
|
|
|
84 (mapcar #'(lambda (x)
|
|
|
85 (cond
|
|
|
86 ((null x)
|
|
|
87 nil)
|
|
|
88 ((stringp x)
|
|
|
89 ;;this will never get selected
|
|
|
90 `[,x 'ignore nil])
|
|
|
91 (t
|
|
|
92 `[,(car x) (dialog-box-finish ',(cdr x)) t])))
|
|
|
93 (cdr contents))))
|
|
209
|
94
|
|
844
|
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
|
|
209
|
205 (defun message-box (fmt &rest args)
|
|
|
206 "Display a message, in a dialog box if possible.
|
|
|
207 If the selected device has no dialog-box support, use the echo area.
|
|
|
208 The arguments are the same as to `format'.
|
|
|
209
|
|
|
210 If the only argument is nil, clear any existing message; let the
|
|
|
211 minibuffer contents show."
|
|
|
212 (if (and (null fmt) (null args))
|
|
|
213 (progn
|
|
|
214 (clear-message nil)
|
|
|
215 nil)
|
|
|
216 (let ((str (apply 'format fmt args)))
|
|
|
217 (if (device-on-window-system-p)
|
|
442
|
218 (get-dialog-box-response nil (list str (cons "%_OK" t)))
|
|
209
|
219 (display-message 'message str))
|
|
|
220 str)))
|
|
|
221
|
|
|
222 (defun message-or-box (fmt &rest args)
|
|
442
|
223 "Display a message in a dialog box or in the echo area.
|
|
|
224 If this command was invoked with the mouse, use a dialog box.
|
|
209
|
225 Otherwise, use the echo area.
|
|
|
226 The arguments are the same as to `format'.
|
|
|
227
|
|
|
228 If the only argument is nil, clear any existing message; let the
|
|
|
229 minibuffer contents show."
|
|
|
230 (if (should-use-dialog-box-p)
|
|
|
231 (apply 'message-box fmt args)
|
|
|
232 (apply 'message fmt args)))
|
|
|
233
|
|
442
|
234 (defun make-dialog-box (type &rest cl-keys)
|
|
|
235 "Pop up a dialog box.
|
|
|
236 TYPE is a symbol, the type of dialog box. Remaining arguments are
|
|
|
237 keyword-value pairs, specifying the particular characteristics of the
|
|
|
238 dialog box. The allowed keywords are particular to each type, but
|
|
|
239 some standard keywords are common to many types:
|
|
|
240
|
|
|
241 :title
|
|
|
242 The title of the dialog box's window.
|
|
|
243
|
|
|
244 :modal
|
|
|
245 If true, indicates that XEmacs will wait until the user is \"done\"
|
|
|
246 with the dialog box (usually, this means that a response has been
|
|
|
247 given). Typically, the response is returned. NOTE: Some dialog
|
|
|
248 boxes are always modal. If the dialog box is modal, `make-dialog-box'
|
|
|
249 returns immediately. The return value will be either nil or a
|
|
|
250 dialog box handle of some sort, e.g. a frame for type `general'.
|
|
|
251
|
|
|
252 ---------------------------------------------------------------------------
|
|
|
253
|
|
|
254 Recognized types are
|
|
|
255
|
|
|
256 general
|
|
|
257 A dialog box consisting of an XEmacs glyph, typically a `layout'
|
|
|
258 widget specifying a dialog box arrangement. This is the most
|
|
|
259 general and powerful dialog box type, but requires more work than
|
|
|
260 the other types below.
|
|
|
261
|
|
|
262 question
|
|
|
263 A simple dialog box that displays a question and contains one or
|
|
|
264 more user-defined buttons to specify possible responses. (This is
|
|
|
265 compatible with the old built-in dialog boxes formerly specified
|
|
|
266 using `popup-dialog-box'.)
|
|
|
267
|
|
|
268 file
|
|
|
269 A file dialog box, of the type typically used in the window system
|
|
|
270 XEmacs is running on.
|
|
|
271
|
|
|
272 color
|
|
|
273 A color picker.
|
|
|
274
|
|
|
275 find
|
|
|
276 A find dialog box.
|
|
|
277
|
|
|
278 font
|
|
|
279 A font chooser.
|
|
|
280
|
|
|
281 print
|
|
|
282 A dialog box used when printing (e.g. number of pages, printer).
|
|
|
283
|
|
|
284 page-setup
|
|
|
285 A dialog box for setting page options (e.g. margins) for printing.
|
|
|
286
|
|
|
287 replace
|
|
|
288 A find/replace dialog box.
|
|
|
289
|
|
|
290 mswindows-message
|
|
|
291 An MS Windows-specific standard dialog box type similar to `question'.
|
|
|
292
|
|
|
293 ---------------------------------------------------------------------------
|
|
|
294
|
|
|
295 For type `general':
|
|
|
296
|
|
|
297 This type creates a frame and puts the specified widget layout in it.
|
|
|
298 \(Currently this is done by eliminating all areas but the gutter and placing
|
|
|
299 the layout there; but this is an implementation detail and may change.)
|
|
|
300
|
|
|
301 The keywords allowed for `general' are
|
|
|
302
|
|
|
303 :spec
|
|
|
304 The widget spec -- anything that can be passed to `make-glyph'.
|
|
|
305 :title
|
|
|
306 The title of the frame.
|
|
|
307 :parent
|
|
|
308 The frame is made a child of this frame (defaults to the selected frame).
|
|
|
309 :properties
|
|
|
310 Additional properties of the frame, as well as `dialog-frame-plist'.
|
|
863
|
311 :autosize
|
|
|
312 If t the frame is sized to exactly fit the widgets given by :spec.
|
|
442
|
313
|
|
|
314 ---------------------------------------------------------------------------
|
|
|
315
|
|
|
316 For type `question':
|
|
|
317
|
|
|
318 The keywords allowed are
|
|
|
319
|
|
|
320 :modal
|
|
|
321 t or nil. When t, the dialog box callback should exit the dialog box
|
|
|
322 using the functions `dialog-box-finish' or `dialog-box-cancel'.
|
|
|
323 :title
|
|
|
324 The title of the frame.
|
|
|
325 :question
|
|
|
326 A string, the question.
|
|
|
327 :buttons
|
|
|
328 A list, describing the buttons below the question. Each of these is a
|
|
|
329 vector, the syntax of which is essentially the same as that of popup menu
|
|
|
330 items. They may have any of the following forms:
|
|
|
331
|
|
|
332 [ \"name\" callback <active-p> ]
|
|
|
333 [ \"name\" callback <active-p> \"suffix\" ]
|
|
|
334 [ \"name\" callback :<keyword> <value> :<keyword> <value> ... ]
|
|
|
335
|
|
|
336 The name is the string to display on the button; it is filtered through the
|
|
|
337 resource database, so it is possible for resources to override what string
|
|
|
338 is actually displayed.
|
|
|
339
|
|
|
340 Accelerators can be indicated in the string by putting the sequence
|
|
|
341 \"%_\" before the character corresponding to the key that will invoke
|
|
|
342 the button. Uppercase and lowercase accelerators are equivalent. The
|
|
|
343 sequence \"%%\" is also special, and is translated into a single %.
|
|
|
344
|
|
|
345 If the `callback' of a button is a symbol, then it must name a command.
|
|
|
346 It will be invoked with `call-interactively'. If it is a list, then it is
|
|
|
347 evaluated with `eval'.
|
|
|
348
|
|
|
349 One (and only one) of the buttons may be `nil'. This marker means that all
|
|
|
350 following buttons should be flushright instead of flushleft.
|
|
|
351
|
|
|
352 Though the keyword/value syntax is supported for dialog boxes just as in
|
|
|
353 popup menus, the only keyword which is both meaningful and fully implemented
|
|
|
354 for dialog box buttons is `:active'.
|
|
|
355
|
|
|
356 ---------------------------------------------------------------------------
|
|
|
357
|
|
|
358 For type `file':
|
|
|
359
|
|
|
360 The keywords allowed are
|
|
|
361
|
|
|
362 :initial-filename
|
|
|
363 The initial filename to be placed in the dialog box (defaults to nothing).
|
|
|
364 :initial-directory
|
|
|
365 The initial directory to be selected in the dialog box (defaults to the
|
|
|
366 current buffer's `default-directory).
|
|
|
367 :filter-list
|
|
|
368 A list of (filter-desc filter ...)
|
|
|
369 :title
|
|
|
370 The title of the dialog box (defaults to \"Open\").
|
|
|
371 :allow-multi-select t or nil
|
|
|
372 :create-prompt-on-nonexistent t or nil
|
|
|
373 :overwrite-prompt t or nil
|
|
|
374 :file-must-exist t or nil
|
|
|
375 :no-network-button t or nil
|
|
|
376 :no-read-only-return t or nil
|
|
|
377
|
|
|
378 ---------------------------------------------------------------------------
|
|
|
379
|
|
673
|
380 For type `directory':
|
|
|
381
|
|
|
382 The keywords allowed are
|
|
|
383
|
|
|
384 :initial-directory
|
|
|
385 The initial directory to be selected in the dialog box (defaults to the
|
|
|
386 current buffer's `default-directory).
|
|
|
387 :title
|
|
|
388 The title of the dialog box (defaults to \"Open\").
|
|
|
389
|
|
|
390 ---------------------------------------------------------------------------
|
|
|
391
|
|
442
|
392 For type `print':
|
|
|
393
|
|
|
394 This invokes the Windows standard Print dialog.
|
|
|
395 This dialog is usually invoked when the user selects the Print command.
|
|
|
396 After the user presses OK, the program should start actual printout.
|
|
|
397
|
|
|
398 The keywords allowed are
|
|
|
399
|
|
|
400 :device
|
|
|
401 An 'msprinter device.
|
|
|
402 :print-settings
|
|
|
403 A printer settings object.
|
|
510
|
404 :allow-selection
|
|
|
405 t or nil -- whether the \"Selection\" button is enabled (defaults to nil).
|
|
|
406 :allow-pages
|
|
|
407 t or nil -- whether the \"Pages\" button and associated edit controls
|
|
|
408 are enabled (defaults to t).
|
|
|
409 :selected-page-button
|
|
|
410 `all', `selection', or `pages' -- which page button is initially
|
|
|
411 selected.
|
|
442
|
412
|
|
510
|
413 Exactly one of :device and :print-settings must be given.
|
|
442
|
414
|
|
|
415 The function brings up the Print dialog, where the user can
|
|
506
|
416 select a different printer and/or change printer options. Connection
|
|
442
|
417 name can change as a result of selecting a different printer device. If
|
|
506
|
418 a device is specified, then changes are stored into the settings object
|
|
442
|
419 currently selected into that printer. If a settings object is supplied,
|
|
629
|
420 then changes are recorded into it, and, it is selected into a
|
|
442
|
421 printer, then changes are propagated to that printer
|
|
|
422 too.
|
|
|
423
|
|
|
424 Return value is nil if the user has canceled the dialog. Otherwise, it
|
|
|
425 is a new plist, with the following properties:
|
|
510
|
426 name Printer device name, even if unchanged by the user.
|
|
|
427 from-page First page to print, 1-based. Returned if
|
|
|
428 `selected-page-button' is `pages'.
|
|
|
429 user, then this value is not included in the plist.
|
|
|
430 to-page Last page to print, inclusive, 1-based. Returned if
|
|
|
431 `selected-page-button' is `pages'.
|
|
|
432 copies Number of copies to print. Always returned.
|
|
|
433 selected-page-button Which page button was selected (`all', `selection',
|
|
|
434 or `pages').
|
|
442
|
435
|
|
|
436 The DEVICE is destroyed and an error is signaled in case of
|
|
|
437 initialization problem with the new printer.
|
|
|
438
|
|
510
|
439 See also the `page-setup' dialog box type.
|
|
442
|
440
|
|
|
441 ---------------------------------------------------------------------------
|
|
|
442
|
|
|
443 For type `page-setup':
|
|
|
444
|
|
|
445 This invokes the Windows standard Page Setup dialog.
|
|
506
|
446 This dialog is usually invoked in response to the Page Setup command,
|
|
|
447 and used to choose such parameters as page orientation, print margins
|
|
|
448 etc. Note that this dialog contains the \"Printer\" button, which
|
|
|
449 invokes the Printer Setup dialog so that the user can update the
|
|
|
450 printer options or even select a different printer as well.
|
|
442
|
451
|
|
|
452 The keywords allowed are
|
|
|
453
|
|
|
454 :device
|
|
|
455 An 'msprinter device.
|
|
|
456 :print-settings
|
|
|
457 A printer settings object.
|
|
|
458 :properties
|
|
|
459 A plist of job properties.
|
|
|
460
|
|
|
461 Exactly one of these keywords must be given.
|
|
|
462
|
|
|
463 The function brings up the Page Setup dialog, where the user
|
|
|
464 can select a different printer and/or change printer options.
|
|
|
465 Connection name can change as a result of selecting a different printer
|
|
506
|
466 device. If a device is specified, then changes are stored into the
|
|
442
|
467 settings object currently selected into that printer. If a settings
|
|
629
|
468 object is supplied, then changes are recorded into it, and, it is
|
|
442
|
469 selected into a printer, then changes are propagated to that printer
|
|
|
470 too.
|
|
|
471
|
|
|
472 :properties specifies a plist of job properties;
|
|
|
473 see `default-msprinter-frame-plist' for the complete list. The plist
|
|
|
474 is used to initialize the dialog.
|
|
|
475
|
|
|
476 Return value is nil if the user has canceled the dialog. Otherwise,
|
|
|
477 it is a new plist, containing the new list of properties.
|
|
|
478
|
|
506
|
479 NOTE: The margin properties (returned by this function) are *NOT* stored
|
|
|
480 into the print-settings or device object.
|
|
|
481
|
|
442
|
482 The DEVICE is destroyed and an error is signaled in case of
|
|
|
483 initialization problem with the new printer.
|
|
|
484
|
|
510
|
485 See also the `print' dialog box type.
|
|
442
|
486
|
|
|
487 ---------------------------------------------------------------------------
|
|
|
488
|
|
|
489 For type `mswindows-message':
|
|
|
490
|
|
|
491 The keywords allowed are
|
|
|
492
|
|
|
493 :title
|
|
|
494 The title of the dialog box.
|
|
|
495 :message
|
|
|
496 The string to display.
|
|
|
497 :flags
|
|
|
498 A symbol or list of symbols:
|
|
|
499
|
|
|
500 -- To specify the buttons in the message box:
|
|
|
501
|
|
|
502 abortretryignore
|
|
|
503 The message box contains three push buttons: Abort, Retry, and Ignore.
|
|
|
504 ok
|
|
|
505 The message box contains one push button: OK. This is the default.
|
|
|
506 okcancel
|
|
|
507 The message box contains two push buttons: OK and Cancel.
|
|
|
508 retrycancel
|
|
|
509 The message box contains two push buttons: Retry and Cancel.
|
|
|
510 yesno
|
|
|
511 The message box contains two push buttons: Yes and No.
|
|
|
512 yesnocancel
|
|
|
513 The message box contains three push buttons: Yes, No, and Cancel.
|
|
|
514
|
|
|
515
|
|
|
516 -- To display an icon in the message box:
|
|
|
517
|
|
|
518 iconexclamation, iconwarning
|
|
|
519 An exclamation-point icon appears in the message box.
|
|
|
520 iconinformation, iconasterisk
|
|
|
521 An icon consisting of a lowercase letter i in a circle appears in
|
|
|
522 the message box.
|
|
|
523 iconquestion
|
|
|
524 A question-mark icon appears in the message box.
|
|
|
525 iconstop, iconerror, iconhand
|
|
|
526 A stop-sign icon appears in the message box.
|
|
|
527
|
|
|
528
|
|
|
529 -- To indicate the default button:
|
|
|
530
|
|
|
531 defbutton1
|
|
|
532 The first button is the default button. This is the default.
|
|
|
533 defbutton2
|
|
|
534 The second button is the default button.
|
|
|
535 defbutton3
|
|
|
536 The third button is the default button.
|
|
|
537 defbutton4
|
|
|
538 The fourth button is the default button.
|
|
|
539
|
|
|
540
|
|
|
541 -- To indicate the modality of the dialog box:
|
|
|
542
|
|
|
543 applmodal
|
|
|
544 The user must respond to the message box before continuing work in
|
|
|
545 the window identified by the hWnd parameter. However, the user can
|
|
|
546 move to the windows of other applications and work in those windows.
|
|
|
547 Depending on the hierarchy of windows in the application, the user
|
|
|
548 may be able to move to other windows within the application. All
|
|
|
549 child windows of the parent of the message box are automatically
|
|
|
550 disabled, but popup windows are not. This is the default.
|
|
|
551 systemmodal
|
|
|
552 Same as applmodal except that the message box has the WS_EX_TOPMOST
|
|
|
553 style. Use system-modal message boxes to notify the user of serious,
|
|
|
554 potentially damaging errors that require immediate attention (for
|
|
|
555 example, running out of memory). This flag has no effect on the
|
|
|
556 user's ability to interact with windows other than those associated
|
|
|
557 with hWnd.
|
|
|
558 taskmodal
|
|
|
559 Same as applmodal except that all the top-level windows belonging to
|
|
|
560 the current task are disabled if the hWnd parameter is NULL. Use
|
|
|
561 this flag when the calling application or library does not have a
|
|
|
562 window handle available but still needs to prevent input to other
|
|
|
563 windows in the current application without suspending other
|
|
|
564 applications.
|
|
|
565
|
|
|
566
|
|
|
567 In addition, you can specify the following flags:
|
|
|
568
|
|
|
569 default-desktop-only
|
|
|
570 The desktop currently receiving input must be a default desktop;
|
|
|
571 otherwise, the function fails. A default desktop is one an
|
|
|
572 application runs on after the user has logged on.
|
|
|
573 help
|
|
|
574 Adds a Help button to the message box. Choosing the Help button or
|
|
|
575 pressing F1 generates a Help event.
|
|
|
576 right
|
|
|
577 The text is right-justified.
|
|
|
578 rtlreading
|
|
|
579 Displays message and caption text using right-to-left reading order
|
|
|
580 on Hebrew and Arabic systems.
|
|
|
581 setforeground
|
|
|
582 The message box becomes the foreground window. Internally, Windows
|
|
|
583 calls the SetForegroundWindow function for the message box.
|
|
|
584 topmost
|
|
|
585 The message box is created with the WS_EX_TOPMOST window style.
|
|
|
586 service-notification
|
|
|
587 Windows NT only: The caller is a service notifying the user of an
|
|
|
588 event. The function displays a message box on the current active
|
|
|
589 desktop, even if there is no user logged on to the computer. If
|
|
|
590 this flag is set, the hWnd parameter must be NULL. This is so the
|
|
|
591 message box can appear on a desktop other than the desktop
|
|
|
592 corresponding to the hWnd.
|
|
|
593
|
|
|
594
|
|
|
595 The return value is one of the following menu-item values returned by
|
|
|
596 the dialog box:
|
|
|
597
|
|
|
598 abort
|
|
|
599 Abort button was selected.
|
|
|
600 cancel
|
|
|
601 Cancel button was selected.
|
|
|
602 ignore
|
|
|
603 Ignore button was selected.
|
|
|
604 no
|
|
|
605 No button was selected.
|
|
|
606 ok
|
|
|
607 OK button was selected.
|
|
|
608 retry
|
|
|
609 Retry button was selected.
|
|
|
610 yes
|
|
|
611 Yes button was selected.
|
|
|
612
|
|
|
613 If a message box has a Cancel button, the function returns the
|
|
|
614 `cancel' value if either the ESC key is pressed or the Cancel button
|
|
|
615 is selected. If the message box has no Cancel button, pressing ESC has
|
|
|
616 no effect."
|
|
|
617 (flet ((dialog-box-modal-loop (thunk)
|
|
|
618 (let* ((frames (frame-list))
|
|
|
619 (result
|
|
|
620 ;; ok, this is extremely tricky. normally a modal
|
|
|
621 ;; dialog will pop itself down using (dialog-box-finish)
|
|
|
622 ;; or (dialog-box-cancel), which throws back to this
|
|
|
623 ;; catch. but question dialog boxes pop down themselves
|
|
|
624 ;; regardless, so a badly written question dialog box
|
|
|
625 ;; that does not use (dialog-box-finish) could seriously
|
|
|
626 ;; wedge us. furthermore, we disable all other frames
|
|
|
627 ;; in order to implement modality; we need to restore
|
|
|
628 ;; them before the dialog box is destroyed, because
|
|
|
629 ;; otherwise windows at least will notice that no top-
|
|
|
630 ;; level window can have the focus and will shift the
|
|
|
631 ;; focus to a different app, raising it and obscuring us.
|
|
|
632 ;; so we create `delete-dialog-box-hook', which is
|
|
|
633 ;; called right *before* the dialog box gets destroyed.
|
|
|
634 ;; here, we put a hook on it, and when it's our dialog
|
|
|
635 ;; box and not someone else's that's being destroyed,
|
|
|
636 ;; we reenable all the frames and remove the hook.
|
|
|
637 ;; BUT ... we still have to deal with exiting the
|
|
|
638 ;; modal loop in case it doesn't happen before us.
|
|
|
639 ;; we can't do this until after the callbacks for this
|
|
|
640 ;; dialog box get executed, and that doesn't happen until
|
|
|
641 ;; after the dialog box is destroyed. so to keep things
|
|
|
642 ;; synchronous, we enqueue an eval event, which goes into
|
|
|
643 ;; the same queue as the misc-user events encapsulating
|
|
|
644 ;; the dialog callbacks and will go after it (because
|
|
|
645 ;; destroying the dialog box happens after processing
|
|
|
646 ;; its selection). if the dialog boxes are written
|
|
|
647 ;; properly, we don't see this eval event, because we've
|
|
|
648 ;; already exited our modal loop. (Thus, we make sure the
|
|
|
649 ;; function given in this eval event is actually defined
|
|
|
650 ;; and does nothing.) If we do see it, though, we know
|
|
|
651 ;; that we encountered a badly written dialog box and
|
|
|
652 ;; need to exit now. Currently we just return nil, but
|
|
|
653 ;; maybe we should signal an error or issue a warning.
|
|
|
654 (catch 'internal-dialog-box-finish
|
|
|
655 (let ((id (eval thunk))
|
|
|
656 (sym (gensym)))
|
|
|
657 (fset sym
|
|
|
658 `(lambda (did)
|
|
|
659 (when (eq ',id did)
|
|
|
660 (mapc 'enable-frame ',frames)
|
|
|
661 (enqueue-eval-event
|
|
|
662 'internal-make-dialog-box-exit did)
|
|
|
663 (remove-hook 'delete-dialog-box-hook
|
|
|
664 ',sym))))
|
|
1066
|
665 (if (framep id)
|
|
|
666 (add-hook 'delete-frame-hook sym)
|
|
|
667 (add-hook 'delete-dialog-box-hook sym))
|
|
442
|
668 (mapc 'disable-frame frames)
|
|
|
669 (block nil
|
|
|
670 (while t
|
|
|
671 (let ((event (next-event)))
|
|
|
672 (if (and (eval-event-p event)
|
|
|
673 (eq (event-function event)
|
|
|
674 'internal-make-dialog-box-exit)
|
|
|
675 (eq (event-object event) id))
|
|
|
676 (return '(nil))
|
|
|
677 (dispatch-event event)))))))))
|
|
|
678 (if (listp result)
|
|
|
679 (car result)
|
|
|
680 (signal 'quit nil)))))
|
|
|
681 (case type
|
|
|
682 (general
|
|
|
683 (cl-parsing-keywords
|
|
|
684 ((:title "XEmacs")
|
|
|
685 (:parent (selected-frame))
|
|
|
686 :modal
|
|
|
687 :properties
|
|
863
|
688 :autosize
|
|
442
|
689 :spec)
|
|
|
690 ()
|
|
|
691 (flet ((create-dialog-box-frame ()
|
|
|
692 (let* ((ftop (frame-property cl-parent 'top))
|
|
|
693 (fleft (frame-property cl-parent 'left))
|
|
|
694 (fwidth (frame-pixel-width cl-parent))
|
|
|
695 (fheight (frame-pixel-height cl-parent))
|
|
|
696 (fonth (font-height (face-font 'default)))
|
|
|
697 (fontw (font-width (face-font 'default)))
|
|
|
698 (cl-properties (append cl-properties
|
|
|
699 dialog-frame-plist))
|
|
|
700 (dfheight (plist-get cl-properties 'height))
|
|
|
701 (dfwidth (plist-get cl-properties 'width))
|
|
|
702 (unmapped (plist-get cl-properties
|
|
|
703 'initially-unmapped))
|
|
|
704 (gutter-spec cl-spec)
|
|
|
705 (name (or (plist-get cl-properties 'name) "XEmacs"))
|
|
|
706 (frame nil))
|
|
|
707 (plist-remprop cl-properties 'initially-unmapped)
|
|
|
708 ;; allow the user to just provide a glyph
|
|
|
709 (or (glyphp cl-spec) (setq cl-spec (make-glyph cl-spec)))
|
|
|
710 (setq gutter-spec (copy-sequence "\n"))
|
|
|
711 (set-extent-begin-glyph (make-extent 0 1 gutter-spec)
|
|
|
712 cl-spec)
|
|
|
713 ;; under FVWM at least, if I don't specify the
|
|
|
714 ;; initial position, it ends up always at (0, 0).
|
|
|
715 ;; xwininfo doesn't tell me that there are any
|
|
|
716 ;; program-specified position hints, so it must be
|
|
|
717 ;; an FVWM bug. So just be smashing and position in
|
|
|
718 ;; the center of the selected frame.
|
|
|
719 (setq frame
|
|
|
720 (make-frame
|
|
|
721 (append cl-properties
|
|
502
|
722 `(popup
|
|
|
723 ,cl-parent initially-unmapped t
|
|
|
724 menubar-visible-p nil
|
|
|
725 has-modeline-p nil
|
|
|
726 default-toolbar-visible-p nil
|
|
|
727 top-gutter-visible-p t
|
|
|
728 top-gutter-height ,(* dfheight fonth)
|
|
|
729 top-gutter ,gutter-spec
|
|
|
730 minibuffer none
|
|
|
731 name ,name
|
|
|
732 modeline-shadow-thickness 0
|
|
|
733 vertical-scrollbar-visible-p nil
|
|
|
734 horizontal-scrollbar-visible-p nil
|
|
|
735 unsplittable t
|
|
863
|
736 internal-border-width 8
|
|
502
|
737 left ,(+ fleft (- (/ fwidth 2)
|
|
|
738 (/ (* dfwidth
|
|
|
739 fontw)
|
|
|
740 2)))
|
|
|
741 top ,(+ ftop (- (/ fheight 2)
|
|
|
742 (/ (* dfheight
|
|
|
743 fonth)
|
|
|
744 2)))))))
|
|
442
|
745 (set-face-foreground 'modeline [default foreground] frame)
|
|
|
746 (set-face-background 'modeline [default background] frame)
|
|
863
|
747 ;; resize before mapping
|
|
|
748 (when cl-autosize
|
|
1126
|
749 (set-frame-displayable-pixel-size
|
|
863
|
750 frame
|
|
|
751 (image-instance-width
|
|
|
752 (glyph-image-instance cl-spec
|
|
|
753 (frame-selected-window frame)))
|
|
|
754 (image-instance-height
|
|
|
755 (glyph-image-instance cl-spec
|
|
|
756 (frame-selected-window frame)))))
|
|
|
757 ;; somehow, even though the resizing is supposed
|
|
|
758 ;; to be while the frame is not visible, a
|
|
|
759 ;; visible resize is perceptible
|
|
442
|
760 (unless unmapped (make-frame-visible frame))
|
|
|
761 (let ((newbuf (generate-new-buffer " *dialog box*")))
|
|
|
762 (set-buffer-dedicated-frame newbuf frame)
|
|
|
763 (set-frame-property frame 'dialog-box-buffer newbuf)
|
|
502
|
764 (set-window-buffer (frame-root-window frame) newbuf)
|
|
442
|
765 (with-current-buffer newbuf
|
|
502
|
766 (set (make-local-variable 'frame-title-format)
|
|
|
767 cl-title)
|
|
|
768 (add-local-hook 'delete-frame-hook
|
|
|
769 #'(lambda (frame)
|
|
|
770 (kill-buffer
|
|
|
771 (frame-property
|
|
|
772 frame
|
|
|
773 'dialog-box-buffer))))))
|
|
442
|
774 frame)))
|
|
|
775 (if cl-modal
|
|
|
776 (dialog-box-modal-loop '(create-dialog-box-frame))
|
|
|
777 (create-dialog-box-frame)))))
|
|
|
778 (question
|
|
|
779 (cl-parsing-keywords
|
|
|
780 ((:modal nil))
|
|
|
781 t
|
|
|
782 (remf cl-keys :modal)
|
|
|
783 (if cl-modal
|
|
|
784 (dialog-box-modal-loop `(make-dialog-box-internal ',type
|
|
|
785 ',cl-keys))
|
|
|
786 (make-dialog-box-internal type cl-keys))))
|
|
|
787 (t
|
|
|
788 (make-dialog-box-internal type cl-keys)))))
|
|
|
789
|
|
|
790 (defun dialog-box-finish (result)
|
|
|
791 "Exit a modal dialog box, returning RESULT.
|
|
|
792 This is meant to be executed from a dialog box callback function."
|
|
|
793 (throw 'internal-dialog-box-finish (list result)))
|
|
|
794
|
|
|
795 (defun dialog-box-cancel ()
|
|
|
796 "Cancel a modal dialog box.
|
|
|
797 This is meant to be executed from a dialog box callback function."
|
|
|
798 (throw 'internal-dialog-box-finish 'cancel))
|
|
|
799
|
|
|
800 ;; an eval event, used as a trigger inside of the dialog modal loop.
|
|
|
801 (defun internal-make-dialog-box-exit (did)
|
|
|
802 nil)
|
|
|
803
|
|
|
804 (make-obsolete 'popup-dialog-box 'make-dialog-box)
|
|
|
805 (defun popup-dialog-box (desc)
|
|
|
806 "Obsolete equivalent of (make-dialog-box 'question ...).
|
|
|
807
|
|
|
808 \(popup-dialog-box (QUESTION BUTTONS ...)
|
|
|
809
|
|
|
810 is equivalent to
|
|
|
811
|
|
|
812 \(make-dialog-box 'question :question QUESTION :buttons BUTTONS)"
|
|
|
813 (check-argument-type 'stringp (car desc))
|
|
|
814 (or (consp (cdr desc))
|
|
|
815 (error 'syntax-error
|
|
|
816 "Dialog descriptor must supply at least one button"
|
|
|
817 desc))
|
|
|
818 (make-dialog-box 'question :question (car desc) :buttons (cdr desc)))
|
|
|
819
|
|
209
|
820 ;;; dialog.el ends here
|
