1 ;;; dialog.el --- Dialog-box support for XEmacs
3 ;; Copyright (C) 1991-4, 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 2000 Ben Wing.
6 ;; Maintainer: XEmacs Development Team
7 ;; Keywords: extensions, internal, dumped
9 ;; This file is part of XEmacs.
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)
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.
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.
26 ;;; Synched up with: Not in FSF.
30 ;; This file is dumped with XEmacs (when dialog boxes are compiled in).
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.
41 (defun yes-or-no-p-dialog-box (prompt)
42 "Ask user a yes-or-no question with a popup dialog box.
43 Return t if the answer is \"yes\".
44 Takes one argument, which is the string to display to ask the question."
46 (make-dialog-box 'question
49 :buttons '(["Yes" (dialog-box-finish t)]
50 ["No" (dialog-box-finish nil)]
52 ["Cancel" (dialog-box-cancel)]))))
54 ;; FSF has a similar function `x-popup-dialog'.
55 (defun get-dialog-box-response (position contents)
56 "Pop up a dialog box and return user's selection.
57 POSITION specifies which frame to use.
58 This is normally an event or a window or frame.
59 If POSITION is t or nil, it means to use the frame the mouse is on.
60 The dialog box appears in the middle of the specified frame.
62 CONTENTS specifies the alternatives to display in the dialog box.
63 It is a list of the form (TITLE ITEM1 ITEM2...).
64 Each ITEM is a cons cell (STRING . VALUE).
65 The return value is VALUE from the chosen item.
67 An ITEM may also be just a string--that makes a nonselectable item.
68 An ITEM may also be nil--that means to put all preceding items
69 on the left of the dialog box and all following items on the right."
72 (select-frame (event-frame position)))
74 (select-frame position))
76 (select-window position)))
77 (make-dialog-box 'question
78 :question (car contents)
86 ;;this will never get selected
89 `[,(car x) (dialog-box-finish ',(cdr x)) t])))
92 (defun message-box (fmt &rest args)
93 "Display a message, in a dialog box if possible.
94 If the selected device has no dialog-box support, use the echo area.
95 The arguments are the same as to `format'.
97 If the only argument is nil, clear any existing message; let the
98 minibuffer contents show."
99 (if (and (null fmt) (null args))
103 (let ((str (apply 'format fmt args)))
104 (if (device-on-window-system-p)
105 (get-dialog-box-response nil (list str (cons "%_OK" t)))
106 (display-message 'message str))
109 (defun message-or-box (fmt &rest args)
110 "Display a message in a dialog box or in the echo area.
111 If this command was invoked with the mouse, use a dialog box.
112 Otherwise, use the echo area.
113 The arguments are the same as to `format'.
115 If the only argument is nil, clear any existing message; let the
116 minibuffer contents show."
117 (if (should-use-dialog-box-p)
118 (apply 'message-box fmt args)
119 (apply 'message fmt args)))
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:
129 The title of the dialog box's window.
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'.
139 ---------------------------------------------------------------------------
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.
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'.)
156 A file dialog box, of the type typically used in the window system
157 XEmacs is running on.
169 A dialog box used when printing (e.g. number of pages, printer).
172 A dialog box for setting page options (e.g. margins) for printing.
175 A find/replace dialog box.
178 An MS Windows-specific standard dialog box type similar to `question'.
180 ---------------------------------------------------------------------------
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.)
188 The keywords allowed for `general' are
191 The widget spec -- anything that can be passed to `make-glyph'.
194 The title of the frame.
196 The frame is made a child of this frame (defaults to the selected frame).
199 Additional properties of the frame, as well as `dialog-frame-plist'.
201 ---------------------------------------------------------------------------
205 The keywords allowed are
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'.
211 The title of the frame.
213 A string, the question.
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:
219 [ \"name\" callback <active-p> ]
220 [ \"name\" callback <active-p> \"suffix\" ]
221 [ \"name\" callback :<keyword> <value> :<keyword> <value> ... ]
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.
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 %.
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'.
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.
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'.
243 ---------------------------------------------------------------------------
247 The keywords allowed are
250 The initial filename to be placed in the dialog box (defaults to nothing).
252 The initial directory to be selected in the dialog box (defaults to the
253 current buffer's `default-directory).
255 A list of (filter-desc filter ...)
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
265 ---------------------------------------------------------------------------
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.
273 The keywords allowed are
276 An 'msprinter device.
278 A printer settings object.
280 Exactly one of these keywords must be given.
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 device 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
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.
300 The DEVICE is destroyed and an error is signaled in case of
301 initialization problem with the new printer.
303 See also the `page-setup' and `print-setup' dialog boxes.
305 ---------------------------------------------------------------------------
307 For type `page-setup':
309 This invokes the Windows standard Page Setup dialog.
310 This dialog is usually invoked in response to the Page Setup command,
311 and used to choose such parameters as page orientation, print margins
312 etc. Note that this dialog contains the \"Printer\" button, which
313 invokes the Printer Setup dialog so that the user can update the
314 printer options or even select a different printer as well.
316 The keywords allowed are
319 An 'msprinter device.
321 A printer settings object.
323 A plist of job properties.
325 Exactly one of these keywords must be given.
327 The function brings up the Page Setup dialog, where the user
328 can select a different printer and/or change printer options.
329 Connection name can change as a result of selecting a different printer
330 device. If a device is specified, then changes are stored into the
331 settings object currently selected into that printer. If a settings
332 object is supplied, then changes are recorded into it, and, it it is
333 selected into a printer, then changes are propagated to that printer
336 :properties specifies a plist of job properties;
337 see `default-msprinter-frame-plist' for the complete list. The plist
338 is used to initialize the dialog.
340 Return value is nil if the user has canceled the dialog. Otherwise,
341 it is a new plist, containing the new list of properties.
343 NOTE: The margin properties (returned by this function) are *NOT* stored
344 into the print-settings or device object.
346 The DEVICE is destroyed and an error is signaled in case of
347 initialization problem with the new printer.
349 See also the `print' and `print-setup' dialogs.
351 ---------------------------------------------------------------------------
353 For type `print-setup':
355 This invokes the Windows standard Print Setup dialog.
356 This dialog is usually invoked when the user selects the Printer Setup
359 The keywords allowed are
362 An 'msprinter device.
364 A printer settings object.
366 Exactly one of these keywords must be given.
368 The function brings up the Print Setup dialog, where the user
369 can select a different printer and/or change printer options.
370 Connection name can change as a result of selecting a different printer
371 device. If a printer is specified, then changes are stored into the
372 settings object currently selected into that printer. If a settings
373 object is supplied, then changes are recorded into it, and, it it is
374 selected into a printer, then changes are propagated to that printer
377 Return value is nil if the user has canceled the dialog. Otherwise, it
378 is a new plist, with the following properties:
379 name Printer device name, even if unchanged by the user.
381 The printer device is destroyed and an error is signaled if new printer
382 is selected by the user, but cannot be initialized.
384 See also the `print' and `page-setup' dialogs.
386 ---------------------------------------------------------------------------
388 For type `mswindows-message':
390 The keywords allowed are
393 The title of the dialog box.
395 The string to display.
397 A symbol or list of symbols:
399 -- To specify the buttons in the message box:
402 The message box contains three push buttons: Abort, Retry, and Ignore.
404 The message box contains one push button: OK. This is the default.
406 The message box contains two push buttons: OK and Cancel.
408 The message box contains two push buttons: Retry and Cancel.
410 The message box contains two push buttons: Yes and No.
412 The message box contains three push buttons: Yes, No, and Cancel.
415 -- To display an icon in the message box:
417 iconexclamation, iconwarning
418 An exclamation-point icon appears in the message box.
419 iconinformation, iconasterisk
420 An icon consisting of a lowercase letter i in a circle appears in
423 A question-mark icon appears in the message box.
424 iconstop, iconerror, iconhand
425 A stop-sign icon appears in the message box.
428 -- To indicate the default button:
431 The first button is the default button. This is the default.
433 The second button is the default button.
435 The third button is the default button.
437 The fourth button is the default button.
440 -- To indicate the modality of the dialog box:
443 The user must respond to the message box before continuing work in
444 the window identified by the hWnd parameter. However, the user can
445 move to the windows of other applications and work in those windows.
446 Depending on the hierarchy of windows in the application, the user
447 may be able to move to other windows within the application. All
448 child windows of the parent of the message box are automatically
449 disabled, but popup windows are not. This is the default.
451 Same as applmodal except that the message box has the WS_EX_TOPMOST
452 style. Use system-modal message boxes to notify the user of serious,
453 potentially damaging errors that require immediate attention (for
454 example, running out of memory). This flag has no effect on the
455 user's ability to interact with windows other than those associated
458 Same as applmodal except that all the top-level windows belonging to
459 the current task are disabled if the hWnd parameter is NULL. Use
460 this flag when the calling application or library does not have a
461 window handle available but still needs to prevent input to other
462 windows in the current application without suspending other
466 In addition, you can specify the following flags:
469 The desktop currently receiving input must be a default desktop;
470 otherwise, the function fails. A default desktop is one an
471 application runs on after the user has logged on.
473 Adds a Help button to the message box. Choosing the Help button or
474 pressing F1 generates a Help event.
476 The text is right-justified.
478 Displays message and caption text using right-to-left reading order
479 on Hebrew and Arabic systems.
481 The message box becomes the foreground window. Internally, Windows
482 calls the SetForegroundWindow function for the message box.
484 The message box is created with the WS_EX_TOPMOST window style.
486 Windows NT only: The caller is a service notifying the user of an
487 event. The function displays a message box on the current active
488 desktop, even if there is no user logged on to the computer. If
489 this flag is set, the hWnd parameter must be NULL. This is so the
490 message box can appear on a desktop other than the desktop
491 corresponding to the hWnd.
494 The return value is one of the following menu-item values returned by
498 Abort button was selected.
500 Cancel button was selected.
502 Ignore button was selected.
504 No button was selected.
506 OK button was selected.
508 Retry button was selected.
510 Yes button was selected.
512 If a message box has a Cancel button, the function returns the
513 `cancel' value if either the ESC key is pressed or the Cancel button
514 is selected. If the message box has no Cancel button, pressing ESC has
516 (flet ((dialog-box-modal-loop (thunk)
517 (let* ((frames (frame-list))
519 ;; ok, this is extremely tricky. normally a modal
520 ;; dialog will pop itself down using (dialog-box-finish)
521 ;; or (dialog-box-cancel), which throws back to this
522 ;; catch. but question dialog boxes pop down themselves
523 ;; regardless, so a badly written question dialog box
524 ;; that does not use (dialog-box-finish) could seriously
525 ;; wedge us. furthermore, we disable all other frames
526 ;; in order to implement modality; we need to restore
527 ;; them before the dialog box is destroyed, because
528 ;; otherwise windows at least will notice that no top-
529 ;; level window can have the focus and will shift the
530 ;; focus to a different app, raising it and obscuring us.
531 ;; so we create `delete-dialog-box-hook', which is
532 ;; called right *before* the dialog box gets destroyed.
533 ;; here, we put a hook on it, and when it's our dialog
534 ;; box and not someone else's that's being destroyed,
535 ;; we reenable all the frames and remove the hook.
536 ;; BUT ... we still have to deal with exiting the
537 ;; modal loop in case it doesn't happen before us.
538 ;; we can't do this until after the callbacks for this
539 ;; dialog box get executed, and that doesn't happen until
540 ;; after the dialog box is destroyed. so to keep things
541 ;; synchronous, we enqueue an eval event, which goes into
542 ;; the same queue as the misc-user events encapsulating
543 ;; the dialog callbacks and will go after it (because
544 ;; destroying the dialog box happens after processing
545 ;; its selection). if the dialog boxes are written
546 ;; properly, we don't see this eval event, because we've
547 ;; already exited our modal loop. (Thus, we make sure the
548 ;; function given in this eval event is actually defined
549 ;; and does nothing.) If we do see it, though, we know
550 ;; that we encountered a badly written dialog box and
551 ;; need to exit now. Currently we just return nil, but
552 ;; maybe we should signal an error or issue a warning.
553 (catch 'internal-dialog-box-finish
554 (let ((id (eval thunk))
559 (mapc 'enable-frame ',frames)
561 'internal-make-dialog-box-exit did)
562 (remove-hook 'delete-dialog-box-hook
564 (add-hook 'delete-dialog-box-hook sym)
565 (mapc 'disable-frame frames)
568 (let ((event (next-event)))
569 (if (and (eval-event-p event)
570 (eq (event-function event)
571 'internal-make-dialog-box-exit)
572 (eq (event-object event) id))
574 (dispatch-event event)))))))))
577 (signal 'quit nil)))))
582 (:parent (selected-frame))
587 (flet ((create-dialog-box-frame ()
588 (let* ((ftop (frame-property cl-parent 'top))
589 (fleft (frame-property cl-parent 'left))
590 (fwidth (frame-pixel-width cl-parent))
591 (fheight (frame-pixel-height cl-parent))
592 (fonth (font-height (face-font 'default)))
593 (fontw (font-width (face-font 'default)))
594 (cl-properties (append cl-properties
596 (dfheight (plist-get cl-properties 'height))
597 (dfwidth (plist-get cl-properties 'width))
598 (unmapped (plist-get cl-properties
599 'initially-unmapped))
600 (gutter-spec cl-spec)
601 (name (or (plist-get cl-properties 'name) "XEmacs"))
603 (plist-remprop cl-properties 'initially-unmapped)
604 ;; allow the user to just provide a glyph
605 (or (glyphp cl-spec) (setq cl-spec (make-glyph cl-spec)))
606 (setq gutter-spec (copy-sequence "\n"))
607 (set-extent-begin-glyph (make-extent 0 1 gutter-spec)
609 ;; under FVWM at least, if I don't specify the
610 ;; initial position, it ends up always at (0, 0).
611 ;; xwininfo doesn't tell me that there are any
612 ;; program-specified position hints, so it must be
613 ;; an FVWM bug. So just be smashing and position in
614 ;; the center of the selected frame.
617 (append cl-properties
618 `(popup ,cl-parent initially-unmapped t
619 menubar-visible-p nil
621 default-toolbar-visible-p nil
622 top-gutter-visible-p t
625 top-gutter ,gutter-spec
628 modeline-shadow-thickness 0
629 vertical-scrollbar-visible-p nil
630 horizontal-scrollbar-visible-p nil
632 left ,(+ fleft (- (/ fwidth 2)
636 top ,(+ ftop (- (/ fheight 2)
640 (set-face-foreground 'modeline [default foreground] frame)
641 (set-face-background 'modeline [default background] frame)
642 (unless unmapped (make-frame-visible frame))
643 (let ((newbuf (generate-new-buffer " *dialog box*")))
644 (set-buffer-dedicated-frame newbuf frame)
645 (set-frame-property frame 'dialog-box-buffer newbuf)
646 (set-window-buffer (frame-root-window frame) newbuf)
647 (with-current-buffer newbuf
648 (set (make-local-variable 'frame-title-format)
650 (add-local-hook 'delete-frame-hook
655 'dialog-box-buffer))))))
658 (dialog-box-modal-loop '(create-dialog-box-frame))
659 (create-dialog-box-frame)))))
664 (remf cl-keys :modal)
666 (dialog-box-modal-loop `(make-dialog-box-internal ',type
668 (make-dialog-box-internal type cl-keys))))
670 (make-dialog-box-internal type cl-keys)))))
672 (defun dialog-box-finish (result)
673 "Exit a modal dialog box, returning RESULT.
674 This is meant to be executed from a dialog box callback function."
675 (throw 'internal-dialog-box-finish (list result)))
677 (defun dialog-box-cancel ()
678 "Cancel a modal dialog box.
679 This is meant to be executed from a dialog box callback function."
680 (throw 'internal-dialog-box-finish 'cancel))
682 ;; an eval event, used as a trigger inside of the dialog modal loop.
683 (defun internal-make-dialog-box-exit (did)
686 (make-obsolete 'popup-dialog-box 'make-dialog-box)
687 (defun popup-dialog-box (desc)
688 "Obsolete equivalent of (make-dialog-box 'question ...).
690 \(popup-dialog-box (QUESTION BUTTONS ...)
694 \(make-dialog-box 'question :question QUESTION :buttons BUTTONS)"
695 (check-argument-type 'stringp (car desc))
696 (or (consp (cdr desc))
698 "Dialog descriptor must supply at least one button"
700 (make-dialog-box 'question :question (car desc) :buttons (cdr desc)))
702 ;;; dialog.el ends here
projects / chise / xemacs-chise.git.1 / blob