dialog.tcl 5.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175
  1. # dialog.tcl --
  2. #
  3. # This file defines the procedure tk_dialog, which creates a dialog
  4. # box containing a bitmap, a message, and one or more buttons.
  5. #
  6. # Copyright (c) 1992-1993 The Regents of the University of California.
  7. # Copyright (c) 1994-1997 Sun Microsystems, Inc.
  8. #
  9. # See the file "license.terms" for information on usage and redistribution
  10. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11. #
  12. #
  13. # ::tk_dialog:
  14. #
  15. # This procedure displays a dialog box, waits for a button in the dialog
  16. # to be invoked, then returns the index of the selected button. If the
  17. # dialog somehow gets destroyed, -1 is returned.
  18. #
  19. # Arguments:
  20. # w - Window to use for dialog top-level.
  21. # title - Title to display in dialog's decorative frame.
  22. # text - Message to display in dialog.
  23. # bitmap - Bitmap to display in dialog (empty string means none).
  24. # default - Index of button that is to display the default ring
  25. # (-1 means none).
  26. # args - One or more strings to display in buttons across the
  27. # bottom of the dialog box.
  28. proc ::tk_dialog {w title text bitmap default args} {
  29. variable ::tk::Priv
  30. # Check that $default was properly given
  31. if {[string is integer -strict $default]} {
  32. if {$default >= [llength $args]} {
  33. return -code error -errorcode {TK DIALOG BAD_DEFAULT} \
  34. "default button index greater than number of buttons\
  35. specified for tk_dialog"
  36. }
  37. } elseif {"" eq $default} {
  38. set default -1
  39. } else {
  40. set default [lsearch -exact $args $default]
  41. }
  42. set windowingsystem [tk windowingsystem]
  43. # 1. Create the top-level window and divide it into top
  44. # and bottom parts.
  45. destroy $w
  46. toplevel $w -class Dialog
  47. wm title $w $title
  48. wm iconname $w Dialog
  49. wm protocol $w WM_DELETE_WINDOW { }
  50. # Dialog boxes should be transient with respect to their parent,
  51. # so that they will always stay on top of their parent window. However,
  52. # some window managers will create the window as withdrawn if the parent
  53. # window is withdrawn or iconified. Combined with the grab we put on the
  54. # window, this can hang the entire application. Therefore we only make
  55. # the dialog transient if the parent is viewable.
  56. #
  57. if {[winfo viewable [winfo toplevel [winfo parent $w]]] } {
  58. wm transient $w [winfo toplevel [winfo parent $w]]
  59. }
  60. if {$windowingsystem eq "aqua"} {
  61. ::tk::unsupported::MacWindowStyle style $w moveableModal {}
  62. } elseif {$windowingsystem eq "x11"} {
  63. wm attributes $w -type dialog
  64. }
  65. frame $w.bot
  66. frame $w.top
  67. if {$windowingsystem eq "x11"} {
  68. $w.bot configure -relief raised -bd 1
  69. $w.top configure -relief raised -bd 1
  70. }
  71. pack $w.bot -side bottom -fill both
  72. pack $w.top -side top -fill both -expand 1
  73. grid anchor $w.bot center
  74. # 2. Fill the top part with bitmap and message (use the option
  75. # database for -wraplength and -font so that they can be
  76. # overridden by the caller).
  77. option add *Dialog.msg.wrapLength 3i widgetDefault
  78. option add *Dialog.msg.font TkCaptionFont widgetDefault
  79. label $w.msg -justify left -text $text
  80. pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
  81. if {$bitmap ne ""} {
  82. if {$windowingsystem eq "aqua" && $bitmap eq "error"} {
  83. set bitmap "stop"
  84. }
  85. label $w.bitmap -bitmap $bitmap
  86. pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
  87. }
  88. # 3. Create a row of buttons at the bottom of the dialog.
  89. set i 0
  90. foreach but $args {
  91. button $w.button$i -text $but -command [list set ::tk::Priv(button) $i]
  92. if {$i == $default} {
  93. $w.button$i configure -default active
  94. } else {
  95. $w.button$i configure -default normal
  96. }
  97. grid $w.button$i -in $w.bot -column $i -row 0 -sticky ew \
  98. -padx 10 -pady 4
  99. grid columnconfigure $w.bot $i
  100. # We boost the size of some Mac buttons for l&f
  101. if {$windowingsystem eq "aqua"} {
  102. set tmp [string tolower $but]
  103. if {$tmp eq "ok" || $tmp eq "cancel"} {
  104. grid columnconfigure $w.bot $i -minsize 90
  105. }
  106. grid configure $w.button$i -pady 7
  107. }
  108. incr i
  109. }
  110. # 4. Create a binding for <Return> on the dialog if there is a
  111. # default button.
  112. # Convention also dictates that if the keyboard focus moves among the
  113. # the buttons that the <Return> binding affects the button with the focus.
  114. if {$default >= 0} {
  115. bind $w <Return> [list $w.button$default invoke]
  116. }
  117. bind $w <<PrevWindow>> [list bind $w <Return> {[tk_focusPrev %W] invoke}]
  118. bind $w <<NextWindow>> [list bind $w <Return> {[tk_focusNext %W] invoke}]
  119. # 5. Create a <Destroy> binding for the window that sets the
  120. # button variable to -1; this is needed in case something happens
  121. # that destroys the window, such as its parent window being destroyed.
  122. bind $w <Destroy> {set ::tk::Priv(button) -1}
  123. # 6. Withdraw the window, then update all the geometry information
  124. # so we know how big it wants to be, then center the window in the
  125. # display (Motif style) and de-iconify it.
  126. ::tk::PlaceWindow $w
  127. tkwait visibility $w
  128. # 7. Set a grab and claim the focus too.
  129. if {$default >= 0} {
  130. set focus $w.button$default
  131. } else {
  132. set focus $w
  133. }
  134. tk::SetFocusGrab $w $focus
  135. # 8. Wait for the user to respond, then restore the focus and
  136. # return the index of the selected button. Restore the focus
  137. # before deleting the window, since otherwise the window manager
  138. # may take the focus away so we can't redirect it. Finally,
  139. # restore any grab that was in effect.
  140. vwait ::tk::Priv(button)
  141. catch {
  142. # It's possible that the window has already been destroyed,
  143. # hence this "catch". Delete the Destroy handler so that
  144. # Priv(button) doesn't get reset by it.
  145. bind $w <Destroy> {}
  146. }
  147. tk::RestoreFocusGrab $w $focus
  148. return $Priv(button)
  149. }