lisp/dialog.el

   1 ;;; dialog.el --- Dialog-box support for XEmacs
   2
   3 ;; Copyright (C) 1991-4, 1997 Free Software Foundation, Inc.
   4 ;; Copyright (C) 2000 Ben Wing.
   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
  28 ;;; Commentary:
  29
  30 ;; This file is dumped with XEmacs (when dialog boxes are compiled in).
  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
  40 ;;; Code:
  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\", nil if \"no\".  Takes one argument,
  44 the question string to display."
  45   (save-selected-frame
  46     (make-dialog-box 'question
  47                      :question prompt
  48                      :modal t
  49                      :buttons '(["Yes" (dialog-box-finish t)]
  50                                 ["No" (dialog-box-finish nil)]
  51                                 nil
  52                                 ["Cancel" (dialog-box-cancel)]))))
  53
  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.
  61
  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.
  66
  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."
  70   (cond
  71    ((eventp position)
  72     (select-frame (event-frame position)))
  73    ((framep position)
  74     (select-frame position))
  75    ((windowp position)
  76     (select-window position)))
  77   (make-dialog-box 'question
  78                    :question (car contents)
  79                    :modal t
  80                    :buttons
  81                    (mapcar #'(lambda (x)
  82                                (cond
  83                                 ((null x)
  84                                  nil)
  85                                 ((stringp x)
  86                                  ;;this will never get selected
  87                                  `[,x 'ignore nil])
  88                                 (t
  89                                  `[,(car x) (dialog-box-finish ',(cdr x)) t])))
  90                            (cdr contents))))
  91
  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'.
  96
  97 If the only argument is nil, clear any existing message; let the
  98 minibuffer contents show."
  99   (if (and (null fmt) (null args))
 100       (progn
 101         (clear-message nil)
 102         nil)
 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))
 107       str)))
 108
 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'.
 114
 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)))
 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 :title
 193   The title of the frame.
 194 :parent
 195   The frame is made a child of this frame (defaults to the selected frame).
 196 :properties
 197   Additional properties of the frame, as well as `dialog-frame-plist'.
 198 :autosize
 199   If t the frame is sized to exactly fit the widgets given by :spec.
 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 `directory':
 268
 269 The keywords allowed are
 270
 271 :initial-directory
 272   The initial directory to be selected in the dialog box (defaults to the
 273   current buffer's `default-directory).
 274 :title
 275   The title of the dialog box (defaults to \"Open\").
 276
 277 ---------------------------------------------------------------------------
 278
 279 For type `print':
 280
 281 This invokes the Windows standard Print dialog.
 282 This dialog is usually invoked when the user selects the Print command.
 283 After the user presses OK, the program should start actual printout.
 284
 285 The keywords allowed are
 286
 287 :device
 288   An 'msprinter device.
 289 :print-settings
 290   A printer settings object.
 291 :allow-selection
 292   t or nil -- whether the \"Selection\" button is enabled (defaults to nil).
 293 :allow-pages
 294   t or nil -- whether the \"Pages\" button and associated edit controls
 295   are enabled (defaults to t).
 296 :selected-page-button
 297   `all', `selection', or `pages' -- which page button is initially
 298   selected.
 299
 300 Exactly one of :device and :print-settings must be given.
 301
 302 The function brings up the Print dialog, where the user can
 303 select a different printer and/or change printer options.  Connection
 304 name can change as a result of selecting a different printer device.  If
 305 a device is specified, then changes are stored into the settings object
 306 currently selected into that printer.  If a settings object is supplied,
 307 then changes are recorded into it, and, it is selected into a
 308 printer, then changes are propagated to that printer
 309 too.
 310
 311 Return value is nil if the user has canceled the dialog.  Otherwise, it
 312 is a new plist, with the following properties:
 313   name                   Printer device name, even if unchanged by the user.
 314   from-page              First page to print, 1-based.  Returned if
 315                          `selected-page-button' is `pages'.
 316                          user, then this value is not included in the plist.
 317   to-page                Last page to print, inclusive, 1-based.  Returned if
 318                          `selected-page-button' is `pages'.
 319   copies                 Number of copies to print.  Always returned.
 320   selected-page-button   Which page button was selected (`all', `selection',
 321                          or `pages').
 322
 323 The DEVICE is destroyed and an error is signaled in case of
 324 initialization problem with the new printer.
 325
 326 See also the `page-setup' dialog box type.
 327
 328 ---------------------------------------------------------------------------
 329
 330 For type `page-setup':
 331
 332 This invokes the Windows standard Page Setup dialog.
 333 This dialog is usually invoked in response to the Page Setup command,
 334 and used to choose such parameters as page orientation, print margins
 335 etc.  Note that this dialog contains the \"Printer\" button, which
 336 invokes the Printer Setup dialog so that the user can update the
 337 printer options or even select a different printer as well.
 338
 339 The keywords allowed are
 340
 341 :device
 342   An 'msprinter device.
 343 :print-settings
 344   A printer settings object.
 345 :properties
 346   A plist of job properties.
 347
 348 Exactly one of these keywords must be given.
 349
 350 The function brings up the Page Setup dialog, where the user
 351 can select a different printer and/or change printer options.
 352 Connection name can change as a result of selecting a different printer
 353 device.  If a device is specified, then changes are stored into the
 354 settings object currently selected into that printer.  If a settings
 355 object is supplied, then changes are recorded into it, and, it is
 356 selected into a printer, then changes are propagated to that printer
 357 too.
 358
 359 :properties specifies a plist of job properties;
 360 see `default-msprinter-frame-plist' for the complete list.  The plist
 361 is used to initialize the dialog.
 362
 363 Return value is nil if the user has canceled the dialog.  Otherwise,
 364 it is a new plist, containing the new list of properties.
 365
 366 NOTE: The margin properties (returned by this function) are *NOT* stored
 367 into the print-settings or device object.
 368
 369 The DEVICE is destroyed and an error is signaled in case of
 370 initialization problem with the new printer.
 371
 372 See also the `print' dialog box type.
 373
 374 ---------------------------------------------------------------------------
 375
 376 For type `mswindows-message':
 377
 378 The keywords allowed are
 379
 380 :title
 381   The title of the dialog box.
 382 :message
 383   The string to display.
 384 :flags
 385   A symbol or list of symbols:
 386
 387     -- To specify the buttons in the message box:
 388
 389     abortretryignore
 390       The message box contains three push buttons: Abort, Retry, and Ignore.
 391     ok
 392       The message box contains one push button: OK. This is the default.
 393     okcancel
 394       The message box contains two push buttons: OK and Cancel.
 395     retrycancel
 396       The message box contains two push buttons: Retry and Cancel.
 397     yesno
 398       The message box contains two push buttons: Yes and No.
 399     yesnocancel
 400       The message box contains three push buttons: Yes, No, and Cancel.
 401
 402
 403     -- To display an icon in the message box:
 404
 405     iconexclamation, iconwarning
 406       An exclamation-point icon appears in the message box.
 407     iconinformation, iconasterisk
 408       An icon consisting of a lowercase letter i in a circle appears in
 409       the message box.
 410     iconquestion
 411       A question-mark icon appears in the message box.
 412     iconstop, iconerror, iconhand
 413       A stop-sign icon appears in the message box.
 414
 415
 416     -- To indicate the default button:
 417
 418     defbutton1
 419       The first button is the default button.  This is the default.
 420     defbutton2
 421       The second button is the default button.
 422     defbutton3
 423       The third button is the default button.
 424     defbutton4
 425       The fourth button is the default button.
 426
 427
 428     -- To indicate the modality of the dialog box:
 429
 430     applmodal
 431       The user must respond to the message box before continuing work in
 432       the window identified by the hWnd parameter. However, the user can
 433       move to the windows of other applications and work in those windows.
 434       Depending on the hierarchy of windows in the application, the user
 435       may be able to move to other windows within the application. All
 436       child windows of the parent of the message box are automatically
 437       disabled, but popup windows are not.  This is the default.
 438     systemmodal
 439       Same as applmodal except that the message box has the WS_EX_TOPMOST
 440       style. Use system-modal message boxes to notify the user of serious,
 441       potentially damaging errors that require immediate attention (for
 442       example, running out of memory). This flag has no effect on the
 443       user's ability to interact with windows other than those associated
 444       with hWnd.
 445     taskmodal
 446       Same as applmodal except that all the top-level windows belonging to
 447       the current task are disabled if the hWnd parameter is NULL. Use
 448       this flag when the calling application or library does not have a
 449       window handle available but still needs to prevent input to other
 450       windows in the current application without suspending other
 451       applications.
 452
 453
 454     In addition, you can specify the following flags:
 455
 456     default-desktop-only
 457       The desktop currently receiving input must be a default desktop;
 458       otherwise, the function fails. A default desktop is one an
 459       application runs on after the user has logged on.
 460     help
 461       Adds a Help button to the message box. Choosing the Help button or
 462       pressing F1 generates a Help event.
 463     right
 464       The text is right-justified.
 465     rtlreading
 466       Displays message and caption text using right-to-left reading order
 467       on Hebrew and Arabic systems.
 468     setforeground
 469       The message box becomes the foreground window. Internally, Windows
 470       calls the SetForegroundWindow function for the message box.
 471     topmost
 472       The message box is created with the WS_EX_TOPMOST window style.
 473     service-notification
 474       Windows NT only: The caller is a service notifying the user of an
 475       event. The function displays a message box on the current active
 476       desktop, even if there is no user logged on to the computer.  If
 477       this flag is set, the hWnd parameter must be NULL. This is so the
 478       message box can appear on a desktop other than the desktop
 479       corresponding to the hWnd.
 480
 481
 482   The return value is one of the following menu-item values returned by
 483   the dialog box:
 484
 485   abort
 486     Abort button was selected.
 487   cancel
 488     Cancel button was selected.
 489   ignore
 490     Ignore button was selected.
 491   no
 492     No button was selected.
 493   ok
 494     OK button was selected.
 495   retry
 496     Retry button was selected.
 497   yes
 498     Yes button was selected.
 499
 500   If a message box has a Cancel button, the function returns the
 501   `cancel' value if either the ESC key is pressed or the Cancel button
 502   is selected.  If the message box has no Cancel button, pressing ESC has
 503   no effect."
 504   (flet ((dialog-box-modal-loop (thunk)
 505            (let* ((frames (frame-list))
 506                   (result
 507                    ;; ok, this is extremely tricky.  normally a modal
 508                    ;; dialog will pop itself down using (dialog-box-finish)
 509                    ;; or (dialog-box-cancel), which throws back to this
 510                    ;; catch.  but question dialog boxes pop down themselves
 511                    ;; regardless, so a badly written question dialog box
 512                    ;; that does not use (dialog-box-finish) could seriously
 513                    ;; wedge us.  furthermore, we disable all other frames
 514                    ;; in order to implement modality; we need to restore
 515                    ;; them before the dialog box is destroyed, because
 516                    ;; otherwise windows at least will notice that no top-
 517                    ;; level window can have the focus and will shift the
 518                    ;; focus to a different app, raising it and obscuring us.
 519                    ;; so we create `delete-dialog-box-hook', which is
 520                    ;; called right *before* the dialog box gets destroyed.
 521                    ;; here, we put a hook on it, and when it's our dialog
 522                    ;; box and not someone else's that's being destroyed,
 523                    ;; we reenable all the frames and remove the hook.
 524                    ;; BUT ...  we still have to deal with exiting the
 525                    ;; modal loop in case it doesn't happen before us.
 526                    ;; we can't do this until after the callbacks for this
 527                    ;; dialog box get executed, and that doesn't happen until
 528                    ;; after the dialog box is destroyed.  so to keep things
 529                    ;; synchronous, we enqueue an eval event, which goes into
 530                    ;; the same queue as the misc-user events encapsulating
 531                    ;; the dialog callbacks and will go after it (because
 532                    ;; destroying the dialog box happens after processing
 533                    ;; its selection).  if the dialog boxes are written
 534                    ;; properly, we don't see this eval event, because we've
 535                    ;; already exited our modal loop. (Thus, we make sure the
 536                    ;; function given in this eval event is actually defined
 537                    ;; and does nothing.) If we do see it, though, we know
 538                    ;; that we encountered a badly written dialog box and
 539                    ;; need to exit now.  Currently we just return nil, but
 540                    ;; maybe we should signal an error or issue a warning.
 541                    (catch 'internal-dialog-box-finish
 542                      (let ((id (eval thunk))
 543                            (sym (gensym)))
 544                        (fset sym
 545                              `(lambda (did)
 546                                 (when (eq ',id did)
 547                                   (mapc 'enable-frame ',frames)
 548                                   (enqueue-eval-event
 549                                    'internal-make-dialog-box-exit did)
 550                                   (remove-hook 'delete-dialog-box-hook
 551                                                ',sym))))
 552                        (if (framep id)
 553                            (add-hook 'delete-frame-hook sym)
 554                          (add-hook 'delete-dialog-box-hook sym))
 555                        (mapc 'disable-frame frames)
 556                        (block nil
 557                          (while t
 558                            (let ((event (next-event)))
 559                              (if (and (eval-event-p event)
 560                                       (eq (event-function event)
 561                                           'internal-make-dialog-box-exit)
 562                                       (eq (event-object event) id))
 563                                  (return '(nil))
 564                                (dispatch-event event)))))))))
 565              (if (listp result)
 566                  (car result)
 567                (signal 'quit nil)))))
 568     (case type
 569       (general
 570         (cl-parsing-keywords
 571             ((:title "XEmacs")
 572              (:parent (selected-frame))
 573              :modal
 574              :properties
 575              :autosize
 576              :spec)
 577             ()
 578           (flet ((create-dialog-box-frame ()
 579                    (let* ((ftop (frame-property cl-parent 'top))
 580                           (fleft (frame-property cl-parent 'left))
 581                           (fwidth (frame-pixel-width cl-parent))
 582                           (fheight (frame-pixel-height cl-parent))
 583                           (fonth (font-height (face-font 'default)))
 584                           (fontw (font-width (face-font 'default)))
 585                           (cl-properties (append cl-properties
 586                                                  dialog-frame-plist))
 587                           (dfheight (plist-get cl-properties 'height))
 588                           (dfwidth (plist-get cl-properties 'width))
 589                           (unmapped (plist-get cl-properties
 590                                                'initially-unmapped))
 591                           (gutter-spec cl-spec)
 592                           (name (or (plist-get cl-properties 'name) "XEmacs"))
 593                           (frame nil))
 594                      (plist-remprop cl-properties 'initially-unmapped)
 595                      ;; allow the user to just provide a glyph
 596                      (or (glyphp cl-spec) (setq cl-spec (make-glyph cl-spec)))
 597                      (setq gutter-spec (copy-sequence "\n"))
 598                      (set-extent-begin-glyph (make-extent 0 1 gutter-spec)
 599                                              cl-spec)
 600                      ;; under FVWM at least, if I don't specify the
 601                      ;; initial position, it ends up always at (0, 0).
 602                      ;; xwininfo doesn't tell me that there are any
 603                      ;; program-specified position hints, so it must be
 604                      ;; an FVWM bug.  So just be smashing and position in
 605                      ;; the center of the selected frame.
 606                      (setq frame
 607                            (make-frame
 608                             (append cl-properties
 609                                     `(popup ,cl-parent initially-unmapped t
 610                                             menubar-visible-p nil
 611                                             has-modeline-p nil
 612                                             default-toolbar-visible-p nil
 613                                             top-gutter-visible-p t
 614                                             top-gutter-height ,
 615                                             (* dfheight fonth)
 616                                             top-gutter ,gutter-spec
 617                                             minibuffer none
 618                                             name ,name
 619                                             modeline-shadow-thickness 0
 620                                             vertical-scrollbar-visible-p nil
 621                                             horizontal-scrollbar-visible-p nil
 622                                             unsplittable t
 623                                             internal-border-width 8
 624                                             left ,(+ fleft (- (/ fwidth 2)
 625                                                               (/ (* dfwidth
 626                                                                     fontw)
 627                                                                  2)))
 628                                             top ,(+ ftop (- (/ fheight 2)
 629                                                             (/ (* dfheight
 630                                                                   fonth)
 631                                                                2)))))))
 632                      (set-face-foreground 'modeline [default foreground] frame)
 633                      (set-face-background 'modeline [default background] frame)
 634                      ;; resize before mapping
 635                      (when cl-autosize
 636                        (set-frame-pixel-size
 637                         frame
 638                         (image-instance-width
 639                          (glyph-image-instance cl-spec
 640                                                (frame-selected-window frame)))
 641                         (image-instance-height
 642                          (glyph-image-instance cl-spec
 643                                                (frame-selected-window frame)))))
 644                      ;; somehow, even though the resizing is supposed
 645                      ;; to be while the frame is not visible, a
 646                      ;; visible resize is perceptible
 647                      (unless unmapped (make-frame-visible frame))
 648                      (let ((newbuf (generate-new-buffer " *dialog box*")))
 649                        (set-buffer-dedicated-frame newbuf frame)
 650                        (set-frame-property frame 'dialog-box-buffer newbuf)
 651                        (set-window-buffer (frame-root-window frame) newbuf)
 652                        (with-current-buffer newbuf
 653                          (set (make-local-variable 'frame-title-format)
 654                               cl-title)
 655                          (add-local-hook 'delete-frame-hook
 656                                          #'(lambda (frame)
 657                                              (kill-buffer
 658                                               (frame-property
 659                                                frame
 660                                                'dialog-box-buffer))))))
 661                      frame)))
 662             (if cl-modal
 663                 (dialog-box-modal-loop '(create-dialog-box-frame))
 664               (create-dialog-box-frame)))))
 665       (question
 666         (cl-parsing-keywords
 667             ((:modal nil))
 668             t
 669           (remf cl-keys :modal)
 670           (if cl-modal
 671               (dialog-box-modal-loop `(make-dialog-box-internal ',type
 672                                                                 ',cl-keys))
 673             (make-dialog-box-internal type cl-keys))))
 674       (t
 675         (make-dialog-box-internal type cl-keys)))))
 676
 677 (defun dialog-box-finish (result)
 678   "Exit a modal dialog box, returning RESULT.
 679 This is meant to be executed from a dialog box callback function."
 680   (throw 'internal-dialog-box-finish (list result)))
 681
 682 (defun dialog-box-cancel ()
 683   "Cancel a modal dialog box.
 684 This is meant to be executed from a dialog box callback function."
 685   (throw 'internal-dialog-box-finish 'cancel))
 686
 687 ;; an eval event, used as a trigger inside of the dialog modal loop.
 688 (defun internal-make-dialog-box-exit (did)
 689   nil)
 690
 691 (make-obsolete 'popup-dialog-box 'make-dialog-box)
 692 (defun popup-dialog-box (desc)
 693   "Obsolete equivalent of (make-dialog-box 'question ...).
 694
 695 \(popup-dialog-box (QUESTION BUTTONS ...)
 696
 697 is equivalent to
 698
 699 \(make-dialog-box 'question :question QUESTION :buttons BUTTONS)"
 700   (check-argument-type 'stringp (car desc))
 701   (or (consp (cdr desc))
 702       (error 'syntax-error
 703              "Dialog descriptor must supply at least one button"
 704              desc))
 705   (make-dialog-box 'question :question (car desc) :buttons (cdr desc)))
 706
 707 ;;; dialog.el ends here