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 | # RCS: @(#) $Id: dialog.tcl,v 1.8 2000/04/18 02:18:33 ericm Exp $ |
---|
7 | # |
---|
8 | # Copyright (c) 1992-1993 The Regents of the University of California. |
---|
9 | # Copyright (c) 1994-1997 Sun Microsystems, Inc. |
---|
10 | # |
---|
11 | # See the file "license.terms" for information on usage and redistribution |
---|
12 | # of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
13 | # |
---|
14 | |
---|
15 | # |
---|
16 | # tk_dialog: |
---|
17 | # |
---|
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. |
---|
21 | # |
---|
22 | # Arguments: |
---|
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 |
---|
28 | # (-1 means none). |
---|
29 | # args - One or more strings to display in buttons across the |
---|
30 | # bottom of the dialog box. |
---|
31 | |
---|
32 | proc tk_dialog {w title text bitmap default args} { |
---|
33 | global tkPriv tcl_platform |
---|
34 | |
---|
35 | # Check that $default was properly given |
---|
36 | if {[string is int $default]} { |
---|
37 | if {$default >= [llength $args]} { |
---|
38 | return -code error "default button index greater than number of\ |
---|
39 | buttons specified for tk_dialog" |
---|
40 | } |
---|
41 | } elseif {[string equal {} $default]} { |
---|
42 | set default -1 |
---|
43 | } else { |
---|
44 | set default [lsearch -exact $args $default] |
---|
45 | } |
---|
46 | |
---|
47 | # 1. Create the top-level window and divide it into top |
---|
48 | # and bottom parts. |
---|
49 | |
---|
50 | catch {destroy $w} |
---|
51 | toplevel $w -class Dialog |
---|
52 | wm title $w $title |
---|
53 | wm iconname $w Dialog |
---|
54 | wm protocol $w WM_DELETE_WINDOW { } |
---|
55 | |
---|
56 | # Dialog boxes should be transient with respect to their parent, |
---|
57 | # so that they will always stay on top of their parent window. However, |
---|
58 | # some window managers will create the window as withdrawn if the parent |
---|
59 | # window is withdrawn or iconified. Combined with the grab we put on the |
---|
60 | # window, this can hang the entire application. Therefore we only make |
---|
61 | # the dialog transient if the parent is viewable. |
---|
62 | # |
---|
63 | if { [winfo viewable [winfo toplevel [winfo parent $w]]] } { |
---|
64 | wm transient $w [winfo toplevel [winfo parent $w]] |
---|
65 | } |
---|
66 | |
---|
67 | if {[string equal $tcl_platform(platform) "macintosh"]} { |
---|
68 | unsupported1 style $w dBoxProc |
---|
69 | } |
---|
70 | |
---|
71 | frame $w.bot |
---|
72 | frame $w.top |
---|
73 | if {[string equal $tcl_platform(platform) "unix"]} { |
---|
74 | $w.bot configure -relief raised -bd 1 |
---|
75 | $w.top configure -relief raised -bd 1 |
---|
76 | } |
---|
77 | pack $w.bot -side bottom -fill both |
---|
78 | pack $w.top -side top -fill both -expand 1 |
---|
79 | |
---|
80 | # 2. Fill the top part with bitmap and message (use the option |
---|
81 | # database for -wraplength and -font so that they can be |
---|
82 | # overridden by the caller). |
---|
83 | |
---|
84 | option add *Dialog.msg.wrapLength 3i widgetDefault |
---|
85 | if {[string equal $tcl_platform(platform) "macintosh"]} { |
---|
86 | option add *Dialog.msg.font system widgetDefault |
---|
87 | } else { |
---|
88 | option add *Dialog.msg.font {Times 12} widgetDefault |
---|
89 | } |
---|
90 | |
---|
91 | label $w.msg -justify left -text $text |
---|
92 | pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m |
---|
93 | if {[string compare $bitmap ""]} { |
---|
94 | if {[string equal $tcl_platform(platform) "macintosh"] && \ |
---|
95 | [string equal $bitmap "error"]} { |
---|
96 | set bitmap "stop" |
---|
97 | } |
---|
98 | label $w.bitmap -bitmap $bitmap |
---|
99 | pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m |
---|
100 | } |
---|
101 | |
---|
102 | # 3. Create a row of buttons at the bottom of the dialog. |
---|
103 | |
---|
104 | set i 0 |
---|
105 | foreach but $args { |
---|
106 | button $w.button$i -text $but -command [list set tkPriv(button) $i] |
---|
107 | if {$i == $default} { |
---|
108 | $w.button$i configure -default active |
---|
109 | } else { |
---|
110 | $w.button$i configure -default normal |
---|
111 | } |
---|
112 | grid $w.button$i -in $w.bot -column $i -row 0 -sticky ew -padx 10 |
---|
113 | grid columnconfigure $w.bot $i |
---|
114 | # We boost the size of some Mac buttons for l&f |
---|
115 | if {[string equal $tcl_platform(platform) "macintosh"]} { |
---|
116 | set tmp [string tolower $but] |
---|
117 | if {[string equal $tmp "ok"] || [string equal $tmp "cancel"]} { |
---|
118 | grid columnconfigure $w.bot $i -minsize [expr {59 + 20}] |
---|
119 | } |
---|
120 | } |
---|
121 | incr i |
---|
122 | } |
---|
123 | |
---|
124 | # 4. Create a binding for <Return> on the dialog if there is a |
---|
125 | # default button. |
---|
126 | |
---|
127 | if {$default >= 0} { |
---|
128 | bind $w <Return> " |
---|
129 | [list $w.button$default] configure -state active -relief sunken |
---|
130 | update idletasks |
---|
131 | after 100 |
---|
132 | set tkPriv(button) $default |
---|
133 | " |
---|
134 | } |
---|
135 | |
---|
136 | # 5. Create a <Destroy> binding for the window that sets the |
---|
137 | # button variable to -1; this is needed in case something happens |
---|
138 | # that destroys the window, such as its parent window being destroyed. |
---|
139 | |
---|
140 | bind $w <Destroy> {set tkPriv(button) -1} |
---|
141 | |
---|
142 | # 6. Withdraw the window, then update all the geometry information |
---|
143 | # so we know how big it wants to be, then center the window in the |
---|
144 | # display and de-iconify it. |
---|
145 | |
---|
146 | wm withdraw $w |
---|
147 | update idletasks |
---|
148 | set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \ |
---|
149 | - [winfo vrootx [winfo parent $w]]}] |
---|
150 | set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \ |
---|
151 | - [winfo vrooty [winfo parent $w]]}] |
---|
152 | wm geom $w +$x+$y |
---|
153 | wm deiconify $w |
---|
154 | |
---|
155 | # 7. Set a grab and claim the focus too. |
---|
156 | |
---|
157 | set oldFocus [focus] |
---|
158 | set oldGrab [grab current $w] |
---|
159 | if {[string compare $oldGrab ""]} { |
---|
160 | set grabStatus [grab status $oldGrab] |
---|
161 | } |
---|
162 | grab $w |
---|
163 | if {$default >= 0} { |
---|
164 | focus $w.button$default |
---|
165 | } else { |
---|
166 | focus $w |
---|
167 | } |
---|
168 | |
---|
169 | # 8. Wait for the user to respond, then restore the focus and |
---|
170 | # return the index of the selected button. Restore the focus |
---|
171 | # before deleting the window, since otherwise the window manager |
---|
172 | # may take the focus away so we can't redirect it. Finally, |
---|
173 | # restore any grab that was in effect. |
---|
174 | |
---|
175 | tkwait variable tkPriv(button) |
---|
176 | catch {focus $oldFocus} |
---|
177 | catch { |
---|
178 | # It's possible that the window has already been destroyed, |
---|
179 | # hence this "catch". Delete the Destroy handler so that |
---|
180 | # tkPriv(button) doesn't get reset by it. |
---|
181 | |
---|
182 | bind $w <Destroy> {} |
---|
183 | destroy $w |
---|
184 | } |
---|
185 | if {[string compare $oldGrab ""]} { |
---|
186 | if {[string compare $grabStatus "global"]} { |
---|
187 | grab $oldGrab |
---|
188 | } else { |
---|
189 | grab -global $oldGrab |
---|
190 | } |
---|
191 | } |
---|
192 | return $tkPriv(button) |
---|
193 | } |
---|