3 # This file defines the procedure tk_dialog, which creates a dialog
4 # box containing a bitmap, a message, and one or more buttons.
6 # RCS: @(#) $Id: dialog.tcl,v 1.14.2.3 2006/01/25 18:21:41 dgp Exp $
8 # Copyright (c) 1992-1993 The Regents of the University of California.
9 # Copyright (c) 1994-1997 Sun Microsystems, Inc.
11 # See the file "license.terms" for information on usage and redistribution
12 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
18 # This procedure displays a dialog box, waits for a button in the dialog
19 # to be invoked, then returns the index of the selected button. If the
20 # dialog somehow gets destroyed, -1 is returned.
23 # w - Window to use for dialog top-level.
24 # title - Title to display in dialog's decorative frame.
25 # text - Message to display in dialog.
26 # bitmap - Bitmap to display in dialog (empty string means none).
27 # default - Index of button that is to display the default ring
29 # args - One or more strings to display in buttons across the
30 # bottom of the dialog box.
32 proc ::tk_dialog {w title
text bitmap default args
} {
36 # Check that $default was properly given
37 if {[string is integer
-strict $default]} {
38 if {$default >= [llength $args]} {
39 return -code error "default button index greater than number of\
40 buttons specified for tk_dialog"
42 # Never call if -strict option is omitted in previous test !
43 } elseif
{"" eq
$default} {
46 set default [lsearch -exact $args $default]
49 # 1. Create the top-level window and divide it into top
53 toplevel $w -class Dialog
56 wm protocol
$w WM_DELETE_WINDOW
{ }
58 # Dialog boxes should be transient with respect to their parent,
59 # so that they will always stay on top of their parent window. However,
60 # some window managers will create the window as withdrawn if the parent
61 # window is withdrawn or iconified. Combined with the grab we put on the
62 # window, this can hang the entire application. Therefore we only make
63 # the dialog transient if the parent is viewable.
65 if {[winfo viewable
[winfo toplevel [winfo parent
$w]]] } {
66 wm transient
$w [winfo toplevel [winfo parent
$w]]
69 set windowingsystem
[tk windowingsystem
]
71 if {$tcl_platform(platform
) eq
"macintosh" ||
$windowingsystem eq
"aqua"} {
72 ::tk::unsupported::MacWindowStyle style
$w dBoxProc
77 if {$windowingsystem eq
"x11"} {
78 $w.bot configure
-relief raised
-bd 1
79 $w.top configure
-relief raised
-bd 1
81 pack $w.bot
-side bottom
-fill both
82 pack $w.top
-side top
-fill both
-expand 1
84 # 2. Fill the top part with bitmap and message (use the option
85 # database for -wraplength and -font so that they can be
86 # overridden by the caller).
88 option add
*Dialog.msg.wrapLength
3i widgetDefault
89 if {$tcl_platform(platform
) eq
"macintosh" ||
$windowingsystem eq
"aqua"} {
90 option add
*Dialog.msg.
font system widgetDefault
92 option add
*Dialog.msg.
font {Times
12} widgetDefault
95 label $w.msg
-justify left
-text $text
96 pack $w.msg
-in $w.top
-side right
-expand 1 -fill both
-padx 3m
-pady 3m
98 if {($tcl_platform(platform
) eq
"macintosh"
99 ||
$windowingsystem eq
"aqua") && ($bitmap eq
"error")} {
102 label $w.
bitmap -bitmap $bitmap
103 pack $w.
bitmap -in $w.top
-side left
-padx 3m
-pady 3m
106 # 3. Create a row of buttons at the bottom of the dialog.
110 button $w.
button$i -text $but -command [list set ::tk::Priv(button) $i]
111 if {$i == $default} {
112 $w.
button$i configure
-default active
114 $w.
button$i configure
-default normal
116 grid $w.
button$i -in $w.bot
-column $i -row 0 -sticky ew
\
118 grid columnconfigure
$w.bot
$i
119 # We boost the size of some Mac buttons for l&f
120 if {$tcl_platform(platform
) eq
"macintosh" ||
$windowingsystem eq
"aqua"} {
121 set tmp
[string tolower
$but]
122 if {$tmp eq
"ok" ||
$tmp eq
"cancel"} {
123 grid columnconfigure
$w.bot
$i -minsize [expr {59 + 20}]
129 # 4. Create a binding for <Return> on the dialog if there is a
134 [list $w.button$default] configure -state active -relief sunken
137 set ::tk::Priv(button) $default
141 # 5. Create a <Destroy> binding for the window that sets the
142 # button variable to -1; this is needed in case something happens
143 # that destroys the window, such as its parent window being destroyed.
145 bind $w <Destroy
> {set ::tk::Priv(button) -1}
147 # 6. Withdraw the window, then update all the geometry information
148 # so we know how big it wants to be, then center the window in the
149 # display and de-iconify it.
153 set x
[expr {[winfo screenwidth
$w]/2 - [winfo reqwidth
$w]/2 \
154 - [winfo vrootx
[winfo parent
$w]]}]
155 set y
[expr {[winfo screenheight
$w]/2 - [winfo reqheight
$w]/2 \
156 - [winfo vrooty
[winfo parent
$w]]}]
157 # Make sure that the window is on the screen and set the maximum
158 # size of the window is the size of the screen. That'll let things
159 # fail fairly gracefully when very large messages are used. [Bug 827535]
166 wm maxsize
$w [winfo screenwidth
$w] [winfo screenheight
$w]
167 wm geometry
$w +$x+$y
172 # 7. Set a grab and claim the focus too.
175 set oldGrab
[grab current
$w]
176 if {$oldGrab ne
""} {
177 set grabStatus
[grab status
$oldGrab]
181 focus $w.
button$default
186 # 8. Wait for the user to respond, then restore the focus and
187 # return the index of the selected button. Restore the focus
188 # before deleting the window, since otherwise the window manager
189 # may take the focus away so we can't redirect it. Finally,
190 # restore any grab that was in effect.
192 vwait ::tk::Priv(button)
193 catch {focus $oldFocus}
195 # It's possible that the window has already been destroyed,
196 # hence this "catch". Delete the Destroy handler so that
197 # Priv(button) doesn't get reset by it.
202 if {$oldGrab ne
""} {
203 if {$grabStatus ne
"global"} {
206 grab -global $oldGrab