;;; dialog.el --- Dialog-box support for XEmacs
;; Copyright (C) 1991-4, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 2000 Ben Wing.
;; Maintainer: XEmacs Development Team
;; Keywords: extensions, internal, dumped
Return t if the answer is \"yes\".
Takes one argument, which is the string to display to ask the question."
(save-selected-frame
- (popup-dialog-box
- (list prompt ["Yes" yes t] ["No" no t] nil ["Cancel" cancel t]))
- (let (event)
- (catch 'ynp-done
- (while t
- (setq event (next-command-event event))
- (when (misc-user-event-p event)
- (message "%s" (event-object event))
- (case (event-object event)
- ((yes) (throw 'ynp-done t))
- ((no) (throw 'ynp-done nil))
- ((cancel menu-no-selection-hook) (signal 'quit nil))))
- (unless (button-release-event-p event) ; don't beep twice
- (beep)
- (message "please answer the dialog box")))))))
-
-(defun yes-or-no-p-maybe-dialog-box (prompt)
- "Ask user a yes-or-no question. Return t if answer is yes.
-The question is asked with a dialog box or the minibuffer, as appropriate.
-Takes one argument, which is the string to display to ask the question.
-It should end in a space; `yes-or-no-p' adds `(yes or no) ' to it.
-The user must confirm the answer with RET,
-and can edit it until it as been confirmed."
- (if (should-use-dialog-box-p)
- (yes-or-no-p-dialog-box prompt)
- (yes-or-no-p-minibuf prompt)))
-
-(defun y-or-n-p-maybe-dialog-box (prompt)
- "Ask user a \"y or n\" question. Return t if answer is \"y\".
-Takes one argument, which is the string to display to ask the question.
-The question is asked with a dialog box or the minibuffer, as appropriate.
-It should end in a space; `y-or-n-p' adds `(y or n) ' to it.
-No confirmation of the answer is requested; a single character is enough.
-Also accepts Space to mean yes, or Delete to mean no."
- (if (should-use-dialog-box-p)
- (yes-or-no-p-dialog-box prompt)
- (y-or-n-p-minibuf prompt)))
-
-(when (fboundp 'popup-dialog-box)
- (fset 'yes-or-no-p 'yes-or-no-p-maybe-dialog-box)
- (fset 'y-or-n-p 'y-or-n-p-maybe-dialog-box))
+ (make-dialog-box 'question
+ :question prompt
+ :modal t
+ :buttons '(["Yes" (dialog-box-finish t)]
+ ["No" (dialog-box-finish nil)]
+ nil
+ ["Cancel" (dialog-box-cancel)]))))
-;; this is call-compatible with the horribly-named FSF Emacs function
-;; `x-popup-dialog'. I refuse to use that name.
+;; FSF has a similar function `x-popup-dialog'.
(defun get-dialog-box-response (position contents)
- ;; by Stig@hackvan.com
- ;; modified by pez@atlantic2.sbi.com
"Pop up a dialog box and return user's selection.
POSITION specifies which frame to use.
This is normally an event or a window or frame.
(select-frame position))
((windowp position)
(select-window position)))
- (let ((dbox (cons (car contents)
- (mapcar #'(lambda (x)
- (cond
- ((null x)
- nil)
- ((stringp x)
- `[,x 'ignore nil]) ;this will never get
- ;selected
- (t
- `[,(car x) (throw 'result ',(cdr x)) t])))
- (cdr contents))
- )))
- (catch 'result
- (popup-dialog-box dbox)
- (dispatch-event (next-command-event)))))
+ (make-dialog-box 'question
+ :question (car contents)
+ :modal t
+ :buttons
+ (mapcar #'(lambda (x)
+ (cond
+ ((null x)
+ nil)
+ ((stringp x)
+ ;;this will never get selected
+ `[,x 'ignore nil])
+ (t
+ `[,(car x) (dialog-box-finish ',(cdr x)) t])))
+ (cdr contents))))
(defun message-box (fmt &rest args)
"Display a message, in a dialog box if possible.
str)))
(defun message-or-box (fmt &rest args)
- "Display a message in a dialog box or in the echo area.\n\
-If this command was invoked with the mouse, use a dialog box.\n\
+ "Display a message in a dialog box or in the echo area.
+If this command was invoked with the mouse, use a dialog box.
Otherwise, use the echo area.
The arguments are the same as to `format'.
(apply 'message-box fmt args)
(apply 'message fmt args)))
-(defun make-dialog-box (&optional spec props parent)
- "Create a frame suitable for use as a general dialog box.
-The frame is made a child of PARENT (defaults to the selected frame),
-and has additional properties PROPS, as well as `dialog-frame-plist'.
-SPEC is a string or glyph to be placed in the gutter. If INVISIBLE is
-non-nil then the frame is initially unmapped.
-Normally the created frame has no modelines, menubars, scrollbars,
-minibuffer or toolbars and is entirely covered by its gutter."
- (or parent (setq parent (selected-frame)))
- (let* ((ftop (frame-property parent 'top))
- (fleft (frame-property parent 'left))
- (fwidth (frame-pixel-width parent))
- (fheight (frame-pixel-height parent))
- (fonth (font-height (face-font 'default)))
- (fontw (font-width (face-font 'default)))
- (props (append props dialog-frame-plist))
- (dfheight (plist-get props 'height))
- (dfwidth (plist-get props 'width))
- (unmapped (plist-get props 'initially-unmapped))
- (gutter-spec spec)
- (name (or (plist-get props 'name) "XEmacs"))
- (frame nil))
- (plist-remprop props 'initially-unmapped)
- ;; allow the user to just provide a glyph
- (when (glyphp spec)
- (setq gutter-spec (copy-sequence "\n"))
- (set-extent-begin-glyph (make-extent 0 1 gutter-spec) spec))
- ;; under FVWM at least, if I don't specify the initial position,
- ;; it ends up always at (0, 0). xwininfo doesn't tell me
- ;; that there are any program-specified position hints, so
- ;; it must be an FVWM bug. So just be smashing and position
- ;; in the center of the selected frame.
- (setq frame (make-frame
- (append props
- `(popup ,parent initially-unmapped t
- menubar-visible-p nil
- has-modeline-p nil
- default-toolbar-visible-p nil
- top-gutter-visible-p t
- top-gutter-height ,(* dfheight fonth)
- top-gutter ,gutter-spec
- minibuffer none
- name ,name
- modeline-shadow-thickness 0
- vertical-scrollbar-visible-p nil
- horizontal-scrollbar-visible-p nil
- unsplittable t
- left ,(+ fleft (- (/ fwidth 2)
- (/ (* dfwidth fontw)
- 2)))
- top ,(+ ftop (- (/ fheight 2)
- (/ (* dfheight fonth)
- 2)))))))
- (set-face-foreground 'modeline [default foreground] frame)
- (set-face-background 'modeline [default background] frame)
- (unless unmapped (make-frame-visible frame))
- frame))
+(defun make-dialog-box (type &rest cl-keys)
+ "Pop up a dialog box.
+TYPE is a symbol, the type of dialog box. Remaining arguments are
+keyword-value pairs, specifying the particular characteristics of the
+dialog box. The allowed keywords are particular to each type, but
+some standard keywords are common to many types:
+
+:title
+ The title of the dialog box's window.
+
+:modal
+ If true, indicates that XEmacs will wait until the user is \"done\"
+ with the dialog box (usually, this means that a response has been
+ given). Typically, the response is returned. NOTE: Some dialog
+ boxes are always modal. If the dialog box is modal, `make-dialog-box'
+ returns immediately. The return value will be either nil or a
+ dialog box handle of some sort, e.g. a frame for type `general'.
+
+---------------------------------------------------------------------------
+
+Recognized types are
+
+general
+ A dialog box consisting of an XEmacs glyph, typically a `layout'
+ widget specifying a dialog box arrangement. This is the most
+ general and powerful dialog box type, but requires more work than
+ the other types below.
+
+question
+ A simple dialog box that displays a question and contains one or
+ more user-defined buttons to specify possible responses. (This is
+ compatible with the old built-in dialog boxes formerly specified
+ using `popup-dialog-box'.)
+
+file
+ A file dialog box, of the type typically used in the window system
+ XEmacs is running on.
+
+color
+ A color picker.
+
+find
+ A find dialog box.
+
+font
+ A font chooser.
+
+print
+ A dialog box used when printing (e.g. number of pages, printer).
+
+page-setup
+ A dialog box for setting page options (e.g. margins) for printing.
+
+replace
+ A find/replace dialog box.
+
+mswindows-message
+ An MS Windows-specific standard dialog box type similar to `question'.
+
+---------------------------------------------------------------------------
+
+For type `general':
+
+This type creates a frame and puts the specified widget layout in it.
+\(Currently this is done by eliminating all areas but the gutter and placing
+the layout there; but this is an implementation detail and may change.)
+
+The keywords allowed for `general' are
+
+:spec
+ The widget spec -- anything that can be passed to `make-glyph'.
+
+:title
+ The title of the frame.
+:parent
+ The frame is made a child of this frame (defaults to the selected frame).
+
+:properties
+ Additional properties of the frame, as well as `dialog-frame-plist'.
+
+---------------------------------------------------------------------------
+
+For type `question':
+
+The keywords allowed are
+
+:modal
+ t or nil. When t, the dialog box callback should exit the dialog box
+ using the functions `dialog-box-finish' or `dialog-box-cancel'.
+:title
+ The title of the frame.
+:question
+ A string, the question.
+:buttons
+ A list, describing the buttons below the question. Each of these is a
+ vector, the syntax of which is essentially the same as that of popup menu
+ items. They may have any of the following forms:
+
+ [ \"name\" callback <active-p> ]
+ [ \"name\" callback <active-p> \"suffix\" ]
+ [ \"name\" callback :<keyword> <value> :<keyword> <value> ... ]
+
+ The name is the string to display on the button; it is filtered through the
+ resource database, so it is possible for resources to override what string
+ is actually displayed.
+
+ Accelerators can be indicated in the string by putting the sequence
+ \"%_\" before the character corresponding to the key that will invoke
+ the button. Uppercase and lowercase accelerators are equivalent. The
+ sequence \"%%\" is also special, and is translated into a single %.
+
+ If the `callback' of a button is a symbol, then it must name a command.
+ It will be invoked with `call-interactively'. If it is a list, then it is
+ evaluated with `eval'.
+
+ One (and only one) of the buttons may be `nil'. This marker means that all
+ following buttons should be flushright instead of flushleft.
+
+ Though the keyword/value syntax is supported for dialog boxes just as in
+ popup menus, the only keyword which is both meaningful and fully implemented
+ for dialog box buttons is `:active'.
+
+---------------------------------------------------------------------------
+
+For type `file':
+
+The keywords allowed are
+
+:initial-filename
+ The initial filename to be placed in the dialog box (defaults to nothing).
+:initial-directory
+ The initial directory to be selected in the dialog box (defaults to the
+ current buffer's `default-directory).
+:filter-list
+ A list of (filter-desc filter ...)
+:title
+ The title of the dialog box (defaults to \"Open\").
+:allow-multi-select t or nil
+:create-prompt-on-nonexistent t or nil
+:overwrite-prompt t or nil
+:file-must-exist t or nil
+:no-network-button t or nil
+:no-read-only-return t or nil
+
+---------------------------------------------------------------------------
+
+For type `print':
+
+This invokes the Windows standard Print dialog.
+This dialog is usually invoked when the user selects the Print command.
+After the user presses OK, the program should start actual printout.
+
+The keywords allowed are
+
+:device
+ An 'msprinter device.
+:print-settings
+ A printer settings object.
+
+Exactly one of these keywords must be given.
+
+The function brings up the Print dialog, where the user can
+select a different printer and/or change printer options. Connection
+name can change as a result of selecting a different printer device. If
+a printer is specified, then changes are stored into the settings object
+currently selected into that printer. If a settings object is supplied,
+then changes are recorded into it, and, it it is selected into a
+printer, then changes are propagated to that printer
+too.
+
+Return value is nil if the user has canceled the dialog. Otherwise, it
+is a new plist, with the following properties:
+ name Printer device name, even if unchanged by the user.
+ from-page First page to print, 1-based. If not specified by the user,
+ then this value is not included in the plist.
+ to-page Last page to print, inclusive, 1-based. If not specified by
+ the user, then this value is not included in the plist.
+ copies Number of copies to print. Always returned.
+
+The DEVICE is destroyed and an error is signaled in case of
+initialization problem with the new printer.
+
+See also the `page-setup' and `print-setup' dialog boxes.
+
+---------------------------------------------------------------------------
+
+For type `page-setup':
+
+This invokes the Windows standard Page Setup dialog.
+This dialog is usually invoked in response to the Page Setup command, and
+used to chose such parameters as page orientation, print margins etc.
+Note that this dialog contains the \"Printer\" button, which invokes
+the Printer Setup dialog (see `msprinter-print-setup-dialog') so that the
+user can update the printer options or even select a different printer
+as well.
+
+The keywords allowed are
+
+:device
+ An 'msprinter device.
+:print-settings
+ A printer settings object.
+:properties
+ A plist of job properties.
+
+Exactly one of these keywords must be given.
+
+The function brings up the Page Setup dialog, where the user
+can select a different printer and/or change printer options.
+Connection name can change as a result of selecting a different printer
+device. If a printer is specified, then changes are stored into the
+settings object currently selected into that printer. If a settings
+object is supplied, then changes are recorded into it, and, it it is
+selected into a printer, then changes are propagated to that printer
+too.
+
+:properties specifies a plist of job properties;
+see `default-msprinter-frame-plist' for the complete list. The plist
+is used to initialize the dialog.
+
+Return value is nil if the user has canceled the dialog. Otherwise,
+it is a new plist, containing the new list of properties.
+
+The DEVICE is destroyed and an error is signaled in case of
+initialization problem with the new printer.
+
+See also the `print' and `print-setup' dialogs.
+
+---------------------------------------------------------------------------
+
+For type `print-setup':
+
+This invokes the Windows standard Print Setup dialog.
+This dialog is usually invoked when the user selects the Printer Setup
+command.
+
+The keywords allowed are
+
+:device
+ An 'msprinter device.
+:print-settings
+ A printer settings object.
+
+Exactly one of these keywords must be given.
+
+The function brings up the Print Setup dialog, where the user
+can select a different printer and/or change printer options.
+Connection name can change as a result of selecting a different printer
+device. If a printer is specified, then changes are stored into the
+settings object currently selected into that printer. If a settings
+object is supplied, then changes are recorded into it, and, it it is
+selected into a printer, then changes are propagated to that printer
+too.
+
+Return value is nil if the user has canceled the dialog. Otherwise, it
+is a new plist, with the following properties:
+ name Printer device name, even if unchanged by the user.
+
+The printer device is destroyed and an error is signaled if new printer
+is selected by the user, but cannot be initialized.
+
+See also the `print' and `page-setup' dialogs.
+
+---------------------------------------------------------------------------
+
+For type `mswindows-message':
+
+The keywords allowed are
+
+:title
+ The title of the dialog box.
+:message
+ The string to display.
+:flags
+ A symbol or list of symbols:
+
+ -- To specify the buttons in the message box:
+
+ abortretryignore
+ The message box contains three push buttons: Abort, Retry, and Ignore.
+ ok
+ The message box contains one push button: OK. This is the default.
+ okcancel
+ The message box contains two push buttons: OK and Cancel.
+ retrycancel
+ The message box contains two push buttons: Retry and Cancel.
+ yesno
+ The message box contains two push buttons: Yes and No.
+ yesnocancel
+ The message box contains three push buttons: Yes, No, and Cancel.
+
+
+ -- To display an icon in the message box:
+
+ iconexclamation, iconwarning
+ An exclamation-point icon appears in the message box.
+ iconinformation, iconasterisk
+ An icon consisting of a lowercase letter i in a circle appears in
+ the message box.
+ iconquestion
+ A question-mark icon appears in the message box.
+ iconstop, iconerror, iconhand
+ A stop-sign icon appears in the message box.
+
+
+ -- To indicate the default button:
+
+ defbutton1
+ The first button is the default button. This is the default.
+ defbutton2
+ The second button is the default button.
+ defbutton3
+ The third button is the default button.
+ defbutton4
+ The fourth button is the default button.
+
+
+ -- To indicate the modality of the dialog box:
+
+ applmodal
+ The user must respond to the message box before continuing work in
+ the window identified by the hWnd parameter. However, the user can
+ move to the windows of other applications and work in those windows.
+ Depending on the hierarchy of windows in the application, the user
+ may be able to move to other windows within the application. All
+ child windows of the parent of the message box are automatically
+ disabled, but popup windows are not. This is the default.
+ systemmodal
+ Same as applmodal except that the message box has the WS_EX_TOPMOST
+ style. Use system-modal message boxes to notify the user of serious,
+ potentially damaging errors that require immediate attention (for
+ example, running out of memory). This flag has no effect on the
+ user's ability to interact with windows other than those associated
+ with hWnd.
+ taskmodal
+ Same as applmodal except that all the top-level windows belonging to
+ the current task are disabled if the hWnd parameter is NULL. Use
+ this flag when the calling application or library does not have a
+ window handle available but still needs to prevent input to other
+ windows in the current application without suspending other
+ applications.
+
+
+ In addition, you can specify the following flags:
+
+ default-desktop-only
+ The desktop currently receiving input must be a default desktop;
+ otherwise, the function fails. A default desktop is one an
+ application runs on after the user has logged on.
+ help
+ Adds a Help button to the message box. Choosing the Help button or
+ pressing F1 generates a Help event.
+ right
+ The text is right-justified.
+ rtlreading
+ Displays message and caption text using right-to-left reading order
+ on Hebrew and Arabic systems.
+ setforeground
+ The message box becomes the foreground window. Internally, Windows
+ calls the SetForegroundWindow function for the message box.
+ topmost
+ The message box is created with the WS_EX_TOPMOST window style.
+ service-notification
+ Windows NT only: The caller is a service notifying the user of an
+ event. The function displays a message box on the current active
+ desktop, even if there is no user logged on to the computer. If
+ this flag is set, the hWnd parameter must be NULL. This is so the
+ message box can appear on a desktop other than the desktop
+ corresponding to the hWnd.
+
+
+ The return value is one of the following menu-item values returned by
+ the dialog box:
+
+ abort
+ Abort button was selected.
+ cancel
+ Cancel button was selected.
+ ignore
+ Ignore button was selected.
+ no
+ No button was selected.
+ ok
+ OK button was selected.
+ retry
+ Retry button was selected.
+ yes
+ Yes button was selected.
+
+ If a message box has a Cancel button, the function returns the
+ `cancel' value if either the ESC key is pressed or the Cancel button
+ is selected. If the message box has no Cancel button, pressing ESC has
+ no effect."
+ (flet ((dialog-box-modal-loop (thunk)
+ (let* ((frames (frame-list))
+ (result
+ ;; ok, this is extremely tricky. normally a modal
+ ;; dialog will pop itself down using (dialog-box-finish)
+ ;; or (dialog-box-cancel), which throws back to this
+ ;; catch. but question dialog boxes pop down themselves
+ ;; regardless, so a badly written question dialog box
+ ;; that does not use (dialog-box-finish) could seriously
+ ;; wedge us. furthermore, we disable all other frames
+ ;; in order to implement modality; we need to restore
+ ;; them before the dialog box is destroyed, because
+ ;; otherwise windows at least will notice that no top-
+ ;; level window can have the focus and will shift the
+ ;; focus to a different app, raising it and obscuring us.
+ ;; so we create `delete-dialog-box-hook', which is
+ ;; called right *before* the dialog box gets destroyed.
+ ;; here, we put a hook on it, and when it's our dialog
+ ;; box and not someone else's that's being destroyed,
+ ;; we reenable all the frames and remove the hook.
+ ;; BUT ... we still have to deal with exiting the
+ ;; modal loop in case it doesn't happen before us.
+ ;; we can't do this until after the callbacks for this
+ ;; dialog box get executed, and that doesn't happen until
+ ;; after the dialog box is destroyed. so to keep things
+ ;; synchronous, we enqueue an eval event, which goes into
+ ;; the same queue as the misc-user events encapsulating
+ ;; the dialog callbacks and will go after it (because
+ ;; destroying the dialog box happens after processing
+ ;; its selection). if the dialog boxes are written
+ ;; properly, we don't see this eval event, because we've
+ ;; already exited our modal loop. (Thus, we make sure the
+ ;; function given in this eval event is actually defined
+ ;; and does nothing.) If we do see it, though, we know
+ ;; that we encountered a badly written dialog box and
+ ;; need to exit now. Currently we just return nil, but
+ ;; maybe we should signal an error or issue a warning.
+ (catch 'internal-dialog-box-finish
+ (let ((id (eval thunk))
+ (sym (gensym)))
+ (fset sym
+ `(lambda (did)
+ (when (eq ',id did)
+ (mapc 'enable-frame ',frames)
+ (enqueue-eval-event
+ 'internal-make-dialog-box-exit did)
+ (remove-hook 'delete-dialog-box-hook
+ ',sym))))
+ (add-hook 'delete-dialog-box-hook sym)
+ (mapc 'disable-frame frames)
+ (block nil
+ (while t
+ (let ((event (next-event)))
+ (if (and (eval-event-p event)
+ (eq (event-function event)
+ 'internal-make-dialog-box-exit)
+ (eq (event-object event) id))
+ (return '(nil))
+ (dispatch-event event)))))))))
+ (if (listp result)
+ (car result)
+ (signal 'quit nil)))))
+ (case type
+ (general
+ (cl-parsing-keywords
+ ((:title "XEmacs")
+ (:parent (selected-frame))
+ :modal
+ :properties
+ :spec)
+ ()
+ (flet ((create-dialog-box-frame ()
+ (let* ((ftop (frame-property cl-parent 'top))
+ (fleft (frame-property cl-parent 'left))
+ (fwidth (frame-pixel-width cl-parent))
+ (fheight (frame-pixel-height cl-parent))
+ (fonth (font-height (face-font 'default)))
+ (fontw (font-width (face-font 'default)))
+ (cl-properties (append cl-properties
+ dialog-frame-plist))
+ (dfheight (plist-get cl-properties 'height))
+ (dfwidth (plist-get cl-properties 'width))
+ (unmapped (plist-get cl-properties
+ 'initially-unmapped))
+ (gutter-spec cl-spec)
+ (name (or (plist-get cl-properties 'name) "XEmacs"))
+ (frame nil))
+ (plist-remprop cl-properties 'initially-unmapped)
+ ;; allow the user to just provide a glyph
+ (or (glyphp cl-spec) (setq cl-spec (make-glyph cl-spec)))
+ (setq gutter-spec (copy-sequence "\n"))
+ (set-extent-begin-glyph (make-extent 0 1 gutter-spec)
+ cl-spec)
+ ;; under FVWM at least, if I don't specify the
+ ;; initial position, it ends up always at (0, 0).
+ ;; xwininfo doesn't tell me that there are any
+ ;; program-specified position hints, so it must be
+ ;; an FVWM bug. So just be smashing and position in
+ ;; the center of the selected frame.
+ (setq frame
+ (make-frame
+ (append cl-properties
+ `(popup ,cl-parent initially-unmapped t
+ menubar-visible-p nil
+ has-modeline-p nil
+ default-toolbar-visible-p nil
+ top-gutter-visible-p t
+ top-gutter-height ,
+ (* dfheight fonth)
+ top-gutter ,gutter-spec
+ minibuffer none
+ name ,name
+ modeline-shadow-thickness 0
+ vertical-scrollbar-visible-p nil
+ horizontal-scrollbar-visible-p nil
+ unsplittable t
+ left ,(+ fleft (- (/ fwidth 2)
+ (/ (* dfwidth
+ fontw)
+ 2)))
+ top ,(+ ftop (- (/ fheight 2)
+ (/ (* dfheight
+ fonth)
+ 2)))))))
+ (set-face-foreground 'modeline [default foreground] frame)
+ (set-face-background 'modeline [default background] frame)
+ (unless unmapped (make-frame-visible frame))
+ (let ((newbuf (generate-new-buffer " *dialog box*")))
+ (set-buffer-dedicated-frame newbuf frame)
+ (set-frame-property frame 'dialog-box-buffer newbuf)
+ (with-current-buffer newbuf
+ (setq frame-title-format cl-title)
+ (make-local-hook 'delete-frame-hook)
+ (add-hook 'delete-frame-hook
+ #'(lambda (frame)
+ (kill-buffer
+ (frame-property
+ frame
+ 'dialog-box-buffer))))))
+ frame)))
+ (if cl-modal
+ (dialog-box-modal-loop '(create-dialog-box-frame))
+ (create-dialog-box-frame)))))
+ (question
+ (cl-parsing-keywords
+ ((:modal nil))
+ t
+ (remf cl-keys :modal)
+ (if cl-modal
+ (dialog-box-modal-loop `(make-dialog-box-internal ',type
+ ',cl-keys))
+ (make-dialog-box-internal type cl-keys))))
+ (t
+ (make-dialog-box-internal type cl-keys)))))
+
+(defun dialog-box-finish (result)
+ "Exit a modal dialog box, returning RESULT.
+This is meant to be executed from a dialog box callback function."
+ (throw 'internal-dialog-box-finish (list result)))
+
+(defun dialog-box-cancel ()
+ "Cancel a modal dialog box.
+This is meant to be executed from a dialog box callback function."
+ (throw 'internal-dialog-box-finish 'cancel))
+
+;; an eval event, used as a trigger inside of the dialog modal loop.
+(defun internal-make-dialog-box-exit (did)
+ nil)
+
+(make-obsolete 'popup-dialog-box 'make-dialog-box)
+(defun popup-dialog-box (desc)
+ "Obsolete equivalent of (make-dialog-box 'question ...).
+
+\(popup-dialog-box (QUESTION BUTTONS ...)
+
+is equivalent to
+\(make-dialog-box 'question :question QUESTION :buttons BUTTONS)"
+ (check-argument-type 'stringp (car desc))
+ (or (consp (cdr desc))
+ (error 'syntax-error
+ "Dialog descriptor must supply at least one button"
+ desc))
+ (make-dialog-box 'question :question (car desc) :buttons (cdr desc)))
;;; dialog.el ends here
projects / chise / xemacs-chise.git.1 / blobdiff