Mercurial > hg > xemacs-beta

comparison lisp/dialog.el @ 442:abe6d1db359e r21-2-36

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-36
author cvs
date Mon, 13 Aug 2007 11:35:02 +0200
parents 41ff10fd062f
children 576fb035e263
comparison
equal deleted inserted replaced
441:72a7cfa4a488 442:abe6d1db359e
1 ;;; dialog.el --- Dialog-box support for XEmacs 1 ;;; dialog.el --- Dialog-box support for XEmacs
2 2
3 ;; Copyright (C) 1991-4, 1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1991-4, 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 2000 Ben Wing.
4 5
5 ;; Maintainer: XEmacs Development Team 6 ;; Maintainer: XEmacs Development Team
6 ;; Keywords: extensions, internal, dumped 7 ;; Keywords: extensions, internal, dumped
7 8
8 ;; This file is part of XEmacs. 9 ;; This file is part of XEmacs.
26 27
27 ;;; Commentary: 28 ;;; Commentary:
28 29
29 ;; This file is dumped with XEmacs (when dialog boxes are compiled in). 30 ;; This file is dumped with XEmacs (when dialog boxes are compiled in).
30 31
32 ;; Dialog boxes are non-modal at the C level, but made modal at the
33 ;; Lisp level via hacks in functions such as yes-or-no-p-dialog-box
34 ;; below. Perhaps there should be truly modal dialog boxes
35 ;; implemented at the C level for safety. All code using dialog boxes
36 ;; should be careful to assume that the environment, for example the
37 ;; current buffer, might be completely different after returning from
38 ;; yes-or-no-p-dialog-box, but such code is difficult to write and test.
39
31 ;;; Code: 40 ;;; Code:
32 (defun yes-or-no-p-dialog-box (prompt) 41 (defun yes-or-no-p-dialog-box (prompt)
33 "Ask user a \"y or n\" question with a popup dialog box. 42 "Ask user a yes-or-no question with a popup dialog box.
34 Returns t if answer is \"yes\". 43 Return t if the answer is \"yes\".
35 Takes one argument, which is the string to display to ask the question." 44 Takes one argument, which is the string to display to ask the question."
36 (let ((echo-keystrokes 0) 45 (save-selected-frame
37 event) 46 (make-dialog-box 'question
38 (popup-dialog-box 47 :question prompt
39 ;; "Non-violent language please!" says Robin. 48 :modal t
40 (cons prompt '(["Yes" yes t] ["No" no t] nil ["Cancel" abort t]))) 49 :buttons '(["Yes" (dialog-box-finish t)]
41 ; (cons prompt '(["Yes" yes t] ["No" no t] nil ["Abort" abort t]))) 50 ["No" (dialog-box-finish nil)]
42 (catch 'ynp-done 51 nil
43 (while t 52 ["Cancel" (dialog-box-cancel)]))))
44 (setq event (next-command-event event)) 53
45 (cond ((and (misc-user-event-p event) (eq (event-object event) 'yes)) 54 ;; FSF has a similar function `x-popup-dialog'.
46 (throw 'ynp-done t))
47 ((and (misc-user-event-p event) (eq (event-object event) 'no))
48 (throw 'ynp-done nil))
49 ((and (misc-user-event-p event)
50 (or (eq (event-object event) 'abort)
51 (eq (event-object event) 'menu-no-selection-hook)))
52 (signal 'quit nil))
53 ((button-release-event-p event) ;; don't beep twice
54 nil)
55 (t
56 (beep)
57 (message "please answer the dialog box")))))))
58
59 (defun yes-or-no-p-maybe-dialog-box (prompt)
60 "Ask user a yes-or-no question. Return t if answer is yes.
61 The question is asked with a dialog box or the minibuffer, as appropriate.
62 Takes one argument, which is the string to display to ask the question.
63 It should end in a space; `yes-or-no-p' adds `(yes or no) ' to it.
64 The user must confirm the answer with RET,
65 and can edit it until it as been confirmed."
66 (if (should-use-dialog-box-p)
67 (yes-or-no-p-dialog-box prompt)
68 (yes-or-no-p-minibuf prompt)))
69
70 (defun y-or-n-p-maybe-dialog-box (prompt)
71 "Ask user a \"y or n\" question. Return t if answer is \"y\".
72 Takes one argument, which is the string to display to ask the question.
73 The question is asked with a dialog box or the minibuffer, as appropriate.
74 It should end in a space; `y-or-n-p' adds `(y or n) ' to it.
75 No confirmation of the answer is requested; a single character is enough.
76 Also accepts Space to mean yes, or Delete to mean no."
77 (if (should-use-dialog-box-p)
78 (yes-or-no-p-dialog-box prompt)
79 (y-or-n-p-minibuf prompt)))
80
81 (if (fboundp 'popup-dialog-box)
82 (progn
83 (fset 'yes-or-no-p 'yes-or-no-p-maybe-dialog-box)
84 (fset 'y-or-n-p 'y-or-n-p-maybe-dialog-box)))
85
86 ;; this is call-compatible with the horribly-named FSF Emacs function
87 ;; `x-popup-dialog'. I refuse to use that name.
88 (defun get-dialog-box-response (position contents) 55 (defun get-dialog-box-response (position contents)
89 ;; by Stig@hackvan.com
90 ;; modified by pez@atlantic2.sbi.com
91 "Pop up a dialog box and return user's selection. 56 "Pop up a dialog box and return user's selection.
92 POSITION specifies which frame to use. 57 POSITION specifies which frame to use.
93 This is normally an event or a window or frame. 58 This is normally an event or a window or frame.
94 If POSITION is t or nil, it means to use the frame the mouse is on. 59 If POSITION is t or nil, it means to use the frame the mouse is on.
95 The dialog box appears in the middle of the specified frame. 60 The dialog box appears in the middle of the specified frame.
107 (select-frame (event-frame position))) 72 (select-frame (event-frame position)))
108 ((framep position) 73 ((framep position)
109 (select-frame position)) 74 (select-frame position))
110 ((windowp position) 75 ((windowp position)
111 (select-window position))) 76 (select-window position)))
112 (let ((dbox (cons (car contents) 77 (make-dialog-box 'question
113 (mapcar #'(lambda (x) 78 :question (car contents)
114 (cond 79 :modal t
115 ((null x) 80 :buttons
116 nil) 81 (mapcar #'(lambda (x)
117 ((stringp x) 82 (cond
118 `[,x 'ignore nil]) ;this will never get 83 ((null x)
119 ;selected 84 nil)
120 (t 85 ((stringp x)
121 `[,(car x) (throw 'result ',(cdr x)) t]))) 86 ;;this will never get selected
122 (cdr contents)) 87 `[,x 'ignore nil])
123 ))) 88 (t
124 (catch 'result 89 `[,(car x) (dialog-box-finish ',(cdr x)) t])))
125 (popup-dialog-box dbox) 90 (cdr contents))))
126 (dispatch-event (next-command-event)))))
127 91
128 (defun message-box (fmt &rest args) 92 (defun message-box (fmt &rest args)
129 "Display a message, in a dialog box if possible. 93 "Display a message, in a dialog box if possible.
130 If the selected device has no dialog-box support, use the echo area. 94 If the selected device has no dialog-box support, use the echo area.
131 The arguments are the same as to `format'. 95 The arguments are the same as to `format'.
136 (progn 100 (progn
137 (clear-message nil) 101 (clear-message nil)
138 nil) 102 nil)
139 (let ((str (apply 'format fmt args))) 103 (let ((str (apply 'format fmt args)))
140 (if (device-on-window-system-p) 104 (if (device-on-window-system-p)
141 (get-dialog-box-response nil (list str (cons "OK" t))) 105 (get-dialog-box-response nil (list str (cons "%_OK" t)))
142 (display-message 'message str)) 106 (display-message 'message str))
143 str))) 107 str)))
144 108
145 (defun message-or-box (fmt &rest args) 109 (defun message-or-box (fmt &rest args)
146 "Display a message in a dialog box or in the echo area.\n\ 110 "Display a message in a dialog box or in the echo area.
147 If this command was invoked with the mouse, use a dialog box.\n\ 111 If this command was invoked with the mouse, use a dialog box.
148 Otherwise, use the echo area. 112 Otherwise, use the echo area.
149 The arguments are the same as to `format'. 113 The arguments are the same as to `format'.
150 114
151 If the only argument is nil, clear any existing message; let the 115 If the only argument is nil, clear any existing message; let the
152 minibuffer contents show." 116 minibuffer contents show."
153 (if (should-use-dialog-box-p) 117 (if (should-use-dialog-box-p)
154 (apply 'message-box fmt args) 118 (apply 'message-box fmt args)
155 (apply 'message fmt args))) 119 (apply 'message fmt args)))
156 120
121 (defun make-dialog-box (type &rest cl-keys)
122 "Pop up a dialog box.
123 TYPE is a symbol, the type of dialog box. Remaining arguments are
124 keyword-value pairs, specifying the particular characteristics of the
125 dialog box. The allowed keywords are particular to each type, but
126 some standard keywords are common to many types:
127
128 :title
129 The title of the dialog box's window.
130
131 :modal
132 If true, indicates that XEmacs will wait until the user is \"done\"
133 with the dialog box (usually, this means that a response has been
134 given). Typically, the response is returned. NOTE: Some dialog
135 boxes are always modal. If the dialog box is modal, `make-dialog-box'
136 returns immediately. The return value will be either nil or a
137 dialog box handle of some sort, e.g. a frame for type `general'.
138
139 ---------------------------------------------------------------------------
140
141 Recognized types are
142
143 general
144 A dialog box consisting of an XEmacs glyph, typically a `layout'
145 widget specifying a dialog box arrangement. This is the most
146 general and powerful dialog box type, but requires more work than
147 the other types below.
148
149 question
150 A simple dialog box that displays a question and contains one or
151 more user-defined buttons to specify possible responses. (This is
152 compatible with the old built-in dialog boxes formerly specified
153 using `popup-dialog-box'.)
154
155 file
156 A file dialog box, of the type typically used in the window system
157 XEmacs is running on.
158
159 color
160 A color picker.
161
162 find
163 A find dialog box.
164
165 font
166 A font chooser.
167
168 print
169 A dialog box used when printing (e.g. number of pages, printer).
170
171 page-setup
172 A dialog box for setting page options (e.g. margins) for printing.
173
174 replace
175 A find/replace dialog box.
176
177 mswindows-message
178 An MS Windows-specific standard dialog box type similar to `question'.
179
180 ---------------------------------------------------------------------------
181
182 For type `general':
183
184 This type creates a frame and puts the specified widget layout in it.
185 \(Currently this is done by eliminating all areas but the gutter and placing
186 the layout there; but this is an implementation detail and may change.)
187
188 The keywords allowed for `general' are
189
190 :spec
191 The widget spec -- anything that can be passed to `make-glyph'.
192
193 :title
194 The title of the frame.
195 :parent
196 The frame is made a child of this frame (defaults to the selected frame).
197
198 :properties
199 Additional properties of the frame, as well as `dialog-frame-plist'.
200
201 ---------------------------------------------------------------------------
202
203 For type `question':
204
205 The keywords allowed are
206
207 :modal
208 t or nil. When t, the dialog box callback should exit the dialog box
209 using the functions `dialog-box-finish' or `dialog-box-cancel'.
210 :title
211 The title of the frame.
212 :question
213 A string, the question.
214 :buttons
215 A list, describing the buttons below the question. Each of these is a
216 vector, the syntax of which is essentially the same as that of popup menu
217 items. They may have any of the following forms:
218
219 [ \"name\" callback <active-p> ]
220 [ \"name\" callback <active-p> \"suffix\" ]
221 [ \"name\" callback :<keyword> <value> :<keyword> <value> ... ]
222
223 The name is the string to display on the button; it is filtered through the
224 resource database, so it is possible for resources to override what string
225 is actually displayed.
226
227 Accelerators can be indicated in the string by putting the sequence
228 \"%_\" before the character corresponding to the key that will invoke
229 the button. Uppercase and lowercase accelerators are equivalent. The
230 sequence \"%%\" is also special, and is translated into a single %.
231
232 If the `callback' of a button is a symbol, then it must name a command.
233 It will be invoked with `call-interactively'. If it is a list, then it is
234 evaluated with `eval'.
235
236 One (and only one) of the buttons may be `nil'. This marker means that all
237 following buttons should be flushright instead of flushleft.
238
239 Though the keyword/value syntax is supported for dialog boxes just as in
240 popup menus, the only keyword which is both meaningful and fully implemented
241 for dialog box buttons is `:active'.
242
243 ---------------------------------------------------------------------------
244
245 For type `file':
246
247 The keywords allowed are
248
249 :initial-filename
250 The initial filename to be placed in the dialog box (defaults to nothing).
251 :initial-directory
252 The initial directory to be selected in the dialog box (defaults to the
253 current buffer's `default-directory).
254 :filter-list
255 A list of (filter-desc filter ...)
256 :title
257 The title of the dialog box (defaults to \"Open\").
258 :allow-multi-select t or nil
259 :create-prompt-on-nonexistent t or nil
260 :overwrite-prompt t or nil
261 :file-must-exist t or nil
262 :no-network-button t or nil
263 :no-read-only-return t or nil
264
265 ---------------------------------------------------------------------------
266
267 For type `print':
268
269 This invokes the Windows standard Print dialog.
270 This dialog is usually invoked when the user selects the Print command.
271 After the user presses OK, the program should start actual printout.
272
273 The keywords allowed are
274
275 :device
276 An 'msprinter device.
277 :print-settings
278 A printer settings object.
279
280 Exactly one of these keywords must be given.
281
282 The function brings up the Print dialog, where the user can
283 select a different printer and/or change printer options. Connection
284 name can change as a result of selecting a different printer device. If
285 a printer is specified, then changes are stored into the settings object
286 currently selected into that printer. If a settings object is supplied,
287 then changes are recorded into it, and, it it is selected into a
288 printer, then changes are propagated to that printer
289 too.
290
291 Return value is nil if the user has canceled the dialog. Otherwise, it
292 is a new plist, with the following properties:
293 name Printer device name, even if unchanged by the user.
294 from-page First page to print, 1-based. If not specified by the user,
295 then this value is not included in the plist.
296 to-page Last page to print, inclusive, 1-based. If not specified by
297 the user, then this value is not included in the plist.
298 copies Number of copies to print. Always returned.
299
300 The DEVICE is destroyed and an error is signaled in case of
301 initialization problem with the new printer.
302
303 See also the `page-setup' and `print-setup' dialog boxes.
304
305 ---------------------------------------------------------------------------
306
307 For type `page-setup':
308
309 This invokes the Windows standard Page Setup dialog.
310 This dialog is usually invoked in response to the Page Setup command, and
311 used to chose such parameters as page orientation, print margins etc.
312 Note that this dialog contains the \"Printer\" button, which invokes
313 the Printer Setup dialog (see `msprinter-print-setup-dialog') so that the
314 user can update the printer options or even select a different printer
315 as well.
316
317 The keywords allowed are
318
319 :device
320 An 'msprinter device.
321 :print-settings
322 A printer settings object.
323 :properties
324 A plist of job properties.
325
326 Exactly one of these keywords must be given.
327
328 The function brings up the Page Setup dialog, where the user
329 can select a different printer and/or change printer options.
330 Connection name can change as a result of selecting a different printer
331 device. If a printer is specified, then changes are stored into the
332 settings object currently selected into that printer. If a settings
333 object is supplied, then changes are recorded into it, and, it it is
334 selected into a printer, then changes are propagated to that printer
335 too.
336
337 :properties specifies a plist of job properties;
338 see `default-msprinter-frame-plist' for the complete list. The plist
339 is used to initialize the dialog.
340
341 Return value is nil if the user has canceled the dialog. Otherwise,
342 it is a new plist, containing the new list of properties.
343
344 The DEVICE is destroyed and an error is signaled in case of
345 initialization problem with the new printer.
346
347 See also the `print' and `print-setup' dialogs.
348
349 ---------------------------------------------------------------------------
350
351 For type `print-setup':
352
353 This invokes the Windows standard Print Setup dialog.
354 This dialog is usually invoked when the user selects the Printer Setup
355 command.
356
357 The keywords allowed are
358
359 :device
360 An 'msprinter device.
361 :print-settings
362 A printer settings object.
363
364 Exactly one of these keywords must be given.
365
366 The function brings up the Print Setup dialog, where the user
367 can select a different printer and/or change printer options.
368 Connection name can change as a result of selecting a different printer
369 device. If a printer is specified, then changes are stored into the
370 settings object currently selected into that printer. If a settings
371 object is supplied, then changes are recorded into it, and, it it is
372 selected into a printer, then changes are propagated to that printer
373 too.
374
375 Return value is nil if the user has canceled the dialog. Otherwise, it
376 is a new plist, with the following properties:
377 name Printer device name, even if unchanged by the user.
378
379 The printer device is destroyed and an error is signaled if new printer
380 is selected by the user, but cannot be initialized.
381
382 See also the `print' and `page-setup' dialogs.
383
384 ---------------------------------------------------------------------------
385
386 For type `mswindows-message':
387
388 The keywords allowed are
389
390 :title
391 The title of the dialog box.
392 :message
393 The string to display.
394 :flags
395 A symbol or list of symbols:
396
397 -- To specify the buttons in the message box:
398
399 abortretryignore
400 The message box contains three push buttons: Abort, Retry, and Ignore.
401 ok
402 The message box contains one push button: OK. This is the default.
403 okcancel
404 The message box contains two push buttons: OK and Cancel.
405 retrycancel
406 The message box contains two push buttons: Retry and Cancel.
407 yesno
408 The message box contains two push buttons: Yes and No.
409 yesnocancel
410 The message box contains three push buttons: Yes, No, and Cancel.
411
412
413 -- To display an icon in the message box:
414
415 iconexclamation, iconwarning
416 An exclamation-point icon appears in the message box.
417 iconinformation, iconasterisk
418 An icon consisting of a lowercase letter i in a circle appears in
419 the message box.
420 iconquestion
421 A question-mark icon appears in the message box.
422 iconstop, iconerror, iconhand
423 A stop-sign icon appears in the message box.
424
425
426 -- To indicate the default button:
427
428 defbutton1
429 The first button is the default button. This is the default.
430 defbutton2
431 The second button is the default button.
432 defbutton3
433 The third button is the default button.
434 defbutton4
435 The fourth button is the default button.
436
437
438 -- To indicate the modality of the dialog box:
439
440 applmodal
441 The user must respond to the message box before continuing work in
442 the window identified by the hWnd parameter. However, the user can
443 move to the windows of other applications and work in those windows.
444 Depending on the hierarchy of windows in the application, the user
445 may be able to move to other windows within the application. All
446 child windows of the parent of the message box are automatically
447 disabled, but popup windows are not. This is the default.
448 systemmodal
449 Same as applmodal except that the message box has the WS_EX_TOPMOST
450 style. Use system-modal message boxes to notify the user of serious,
451 potentially damaging errors that require immediate attention (for
452 example, running out of memory). This flag has no effect on the
453 user's ability to interact with windows other than those associated
454 with hWnd.
455 taskmodal
456 Same as applmodal except that all the top-level windows belonging to
457 the current task are disabled if the hWnd parameter is NULL. Use
458 this flag when the calling application or library does not have a
459 window handle available but still needs to prevent input to other
460 windows in the current application without suspending other
461 applications.
462
463
464 In addition, you can specify the following flags:
465
466 default-desktop-only
467 The desktop currently receiving input must be a default desktop;
468 otherwise, the function fails. A default desktop is one an
469 application runs on after the user has logged on.
470 help
471 Adds a Help button to the message box. Choosing the Help button or
472 pressing F1 generates a Help event.
473 right
474 The text is right-justified.
475 rtlreading
476 Displays message and caption text using right-to-left reading order
477 on Hebrew and Arabic systems.
478 setforeground
479 The message box becomes the foreground window. Internally, Windows
480 calls the SetForegroundWindow function for the message box.
481 topmost
482 The message box is created with the WS_EX_TOPMOST window style.
483 service-notification
484 Windows NT only: The caller is a service notifying the user of an
485 event. The function displays a message box on the current active
486 desktop, even if there is no user logged on to the computer. If
487 this flag is set, the hWnd parameter must be NULL. This is so the
488 message box can appear on a desktop other than the desktop
489 corresponding to the hWnd.
490
491
492 The return value is one of the following menu-item values returned by
493 the dialog box:
494
495 abort
496 Abort button was selected.
497 cancel
498 Cancel button was selected.
499 ignore
500 Ignore button was selected.
501 no
502 No button was selected.
503 ok
504 OK button was selected.
505 retry
506 Retry button was selected.
507 yes
508 Yes button was selected.
509
510 If a message box has a Cancel button, the function returns the
511 `cancel' value if either the ESC key is pressed or the Cancel button
512 is selected. If the message box has no Cancel button, pressing ESC has
513 no effect."
514 (flet ((dialog-box-modal-loop (thunk)
515 (let* ((frames (frame-list))
516 (result
517 ;; ok, this is extremely tricky. normally a modal
518 ;; dialog will pop itself down using (dialog-box-finish)
519 ;; or (dialog-box-cancel), which throws back to this
520 ;; catch. but question dialog boxes pop down themselves
521 ;; regardless, so a badly written question dialog box
522 ;; that does not use (dialog-box-finish) could seriously
523 ;; wedge us. furthermore, we disable all other frames
524 ;; in order to implement modality; we need to restore
525 ;; them before the dialog box is destroyed, because
526 ;; otherwise windows at least will notice that no top-
527 ;; level window can have the focus and will shift the
528 ;; focus to a different app, raising it and obscuring us.
529 ;; so we create `delete-dialog-box-hook', which is
530 ;; called right *before* the dialog box gets destroyed.
531 ;; here, we put a hook on it, and when it's our dialog
532 ;; box and not someone else's that's being destroyed,
533 ;; we reenable all the frames and remove the hook.
534 ;; BUT ... we still have to deal with exiting the
535 ;; modal loop in case it doesn't happen before us.
536 ;; we can't do this until after the callbacks for this
537 ;; dialog box get executed, and that doesn't happen until
538 ;; after the dialog box is destroyed. so to keep things
539 ;; synchronous, we enqueue an eval event, which goes into
540 ;; the same queue as the misc-user events encapsulating
541 ;; the dialog callbacks and will go after it (because
542 ;; destroying the dialog box happens after processing
543 ;; its selection). if the dialog boxes are written
544 ;; properly, we don't see this eval event, because we've
545 ;; already exited our modal loop. (Thus, we make sure the
546 ;; function given in this eval event is actually defined
547 ;; and does nothing.) If we do see it, though, we know
548 ;; that we encountered a badly written dialog box and
549 ;; need to exit now. Currently we just return nil, but
550 ;; maybe we should signal an error or issue a warning.
551 (catch 'internal-dialog-box-finish
552 (let ((id (eval thunk))
553 (sym (gensym)))
554 (fset sym
555 `(lambda (did)
556 (when (eq ',id did)
557 (mapc 'enable-frame ',frames)
558 (enqueue-eval-event
559 'internal-make-dialog-box-exit did)
560 (remove-hook 'delete-dialog-box-hook
561 ',sym))))
562 (add-hook 'delete-dialog-box-hook sym)
563 (mapc 'disable-frame frames)
564 (block nil
565 (while t
566 (let ((event (next-event)))
567 (if (and (eval-event-p event)
568 (eq (event-function event)
569 'internal-make-dialog-box-exit)
570 (eq (event-object event) id))
571 (return '(nil))
572 (dispatch-event event)))))))))
573 (if (listp result)
574 (car result)
575 (signal 'quit nil)))))
576 (case type
577 (general
578 (cl-parsing-keywords
579 ((:title "XEmacs")
580 (:parent (selected-frame))
581 :modal
582 :properties
583 :spec)
584 ()
585 (flet ((create-dialog-box-frame ()
586 (let* ((ftop (frame-property cl-parent 'top))
587 (fleft (frame-property cl-parent 'left))
588 (fwidth (frame-pixel-width cl-parent))
589 (fheight (frame-pixel-height cl-parent))
590 (fonth (font-height (face-font 'default)))
591 (fontw (font-width (face-font 'default)))
592 (cl-properties (append cl-properties
593 dialog-frame-plist))
594 (dfheight (plist-get cl-properties 'height))
595 (dfwidth (plist-get cl-properties 'width))
596 (unmapped (plist-get cl-properties
597 'initially-unmapped))
598 (gutter-spec cl-spec)
599 (name (or (plist-get cl-properties 'name) "XEmacs"))
600 (frame nil))
601 (plist-remprop cl-properties 'initially-unmapped)
602 ;; allow the user to just provide a glyph
603 (or (glyphp cl-spec) (setq cl-spec (make-glyph cl-spec)))
604 (setq gutter-spec (copy-sequence "\n"))
605 (set-extent-begin-glyph (make-extent 0 1 gutter-spec)
606 cl-spec)
607 ;; under FVWM at least, if I don't specify the
608 ;; initial position, it ends up always at (0, 0).
609 ;; xwininfo doesn't tell me that there are any
610 ;; program-specified position hints, so it must be
611 ;; an FVWM bug. So just be smashing and position in
612 ;; the center of the selected frame.
613 (setq frame
614 (make-frame
615 (append cl-properties
616 `(popup ,cl-parent initially-unmapped t
617 menubar-visible-p nil
618 has-modeline-p nil
619 default-toolbar-visible-p nil
620 top-gutter-visible-p t
621 top-gutter-height ,
622 (* dfheight fonth)
623 top-gutter ,gutter-spec
624 minibuffer none
625 name ,name
626 modeline-shadow-thickness 0
627 vertical-scrollbar-visible-p nil
628 horizontal-scrollbar-visible-p nil
629 unsplittable t
630 left ,(+ fleft (- (/ fwidth 2)
631 (/ (* dfwidth
632 fontw)
633 2)))
634 top ,(+ ftop (- (/ fheight 2)
635 (/ (* dfheight
636 fonth)
637 2)))))))
638 (set-face-foreground 'modeline [default foreground] frame)
639 (set-face-background 'modeline [default background] frame)
640 (unless unmapped (make-frame-visible frame))
641 (let ((newbuf (generate-new-buffer " *dialog box*")))
642 (set-buffer-dedicated-frame newbuf frame)
643 (set-frame-property frame 'dialog-box-buffer newbuf)
644 (with-current-buffer newbuf
645 (setq frame-title-format cl-title)
646 (make-local-hook 'delete-frame-hook)
647 (add-hook 'delete-frame-hook
648 #'(lambda (frame)
649 (kill-buffer
650 (frame-property
651 frame
652 'dialog-box-buffer))))))
653 frame)))
654 (if cl-modal
655 (dialog-box-modal-loop '(create-dialog-box-frame))
656 (create-dialog-box-frame)))))
657 (question
658 (cl-parsing-keywords
659 ((:modal nil))
660 t
661 (remf cl-keys :modal)
662 (if cl-modal
663 (dialog-box-modal-loop `(make-dialog-box-internal ',type
664 ',cl-keys))
665 (make-dialog-box-internal type cl-keys))))
666 (t
667 (make-dialog-box-internal type cl-keys)))))
668
669 (defun dialog-box-finish (result)
670 "Exit a modal dialog box, returning RESULT.
671 This is meant to be executed from a dialog box callback function."
672 (throw 'internal-dialog-box-finish (list result)))
673
674 (defun dialog-box-cancel ()
675 "Cancel a modal dialog box.
676 This is meant to be executed from a dialog box callback function."
677 (throw 'internal-dialog-box-finish 'cancel))
678
679 ;; an eval event, used as a trigger inside of the dialog modal loop.
680 (defun internal-make-dialog-box-exit (did)
681 nil)
682
683 (make-obsolete 'popup-dialog-box 'make-dialog-box)
684 (defun popup-dialog-box (desc)
685 "Obsolete equivalent of (make-dialog-box 'question ...).
686
687 \(popup-dialog-box (QUESTION BUTTONS ...)
688
689 is equivalent to
690
691 \(make-dialog-box 'question :question QUESTION :buttons BUTTONS)"
692 (check-argument-type 'stringp (car desc))
693 (or (consp (cdr desc))
694 (error 'syntax-error
695 "Dialog descriptor must supply at least one button"
696 desc))
697 (make-dialog-box 'question :question (car desc) :buttons (cdr desc)))
698
157 ;;; dialog.el ends here 699 ;;; dialog.el ends here