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