Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | # msgbox.tcl -- |
2 | # | |
3 | # Implements messageboxes for platforms that do not have native | |
4 | # messagebox support. | |
5 | # | |
6 | # RCS: @(#) $Id: msgbox.tcl,v 1.24.2.2 2004/05/13 23:28:34 dkf Exp $ | |
7 | # | |
8 | # Copyright (c) 1994-1997 Sun Microsystems, Inc. | |
9 | # | |
10 | # See the file "license.terms" for information on usage and redistribution | |
11 | # of this file, and for a DISCLAIMER OF ALL WARRANTIES. | |
12 | # | |
13 | ||
14 | # Ensure existence of ::tk::dialog namespace | |
15 | # | |
16 | namespace eval ::tk::dialog {} | |
17 | ||
18 | image create bitmap ::tk::dialog::b1 -foreground black \ | |
19 | -data "#define b1_width 32\n#define b1_height 32 | |
20 | static unsigned char q1_bits[] = { | |
21 | 0x00, 0xf8, 0x1f, 0x00, 0x00, 0x07, 0xe0, 0x00, 0xc0, 0x00, 0x00, 0x03, | |
22 | 0x20, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x08, 0x08, 0x00, 0x00, 0x10, | |
23 | 0x04, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x40, | |
24 | 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, | |
25 | 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, | |
26 | 0x01, 0x00, 0x00, 0x80, 0x02, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x40, | |
27 | 0x04, 0x00, 0x00, 0x20, 0x08, 0x00, 0x00, 0x10, 0x10, 0x00, 0x00, 0x08, | |
28 | 0x60, 0x00, 0x00, 0x04, 0x80, 0x03, 0x80, 0x03, 0x00, 0x0c, 0x78, 0x00, | |
29 | 0x00, 0x30, 0x04, 0x00, 0x00, 0x40, 0x04, 0x00, 0x00, 0x40, 0x04, 0x00, | |
30 | 0x00, 0x80, 0x04, 0x00, 0x00, 0x00, 0x05, 0x00, 0x00, 0x00, 0x06, 0x00, | |
31 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};" | |
32 | image create bitmap ::tk::dialog::b2 -foreground white \ | |
33 | -data "#define b2_width 32\n#define b2_height 32 | |
34 | static unsigned char b2_bits[] = { | |
35 | 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x1f, 0x00, 0x00, 0xff, 0xff, 0x00, | |
36 | 0xc0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x07, 0xf0, 0xff, 0xff, 0x0f, | |
37 | 0xf8, 0xff, 0xff, 0x1f, 0xfc, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x3f, | |
38 | 0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f, | |
39 | 0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f, | |
40 | 0xfe, 0xff, 0xff, 0x7f, 0xfc, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x3f, | |
41 | 0xf8, 0xff, 0xff, 0x1f, 0xf0, 0xff, 0xff, 0x0f, 0xe0, 0xff, 0xff, 0x07, | |
42 | 0x80, 0xff, 0xff, 0x03, 0x00, 0xfc, 0x7f, 0x00, 0x00, 0xf0, 0x07, 0x00, | |
43 | 0x00, 0xc0, 0x03, 0x00, 0x00, 0x80, 0x03, 0x00, 0x00, 0x80, 0x03, 0x00, | |
44 | 0x00, 0x00, 0x03, 0x00, 0x00, 0x00, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, | |
45 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};" | |
46 | image create bitmap ::tk::dialog::q -foreground blue \ | |
47 | -data "#define q_width 32\n#define q_height 32 | |
48 | static unsigned char q_bits[] = { | |
49 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, | |
50 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x07, 0x00, | |
51 | 0x00, 0x10, 0x0f, 0x00, 0x00, 0x18, 0x1e, 0x00, 0x00, 0x38, 0x1e, 0x00, | |
52 | 0x00, 0x38, 0x1e, 0x00, 0x00, 0x10, 0x0f, 0x00, 0x00, 0x80, 0x07, 0x00, | |
53 | 0x00, 0xc0, 0x01, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0xc0, 0x00, 0x00, | |
54 | 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0xe0, 0x01, 0x00, | |
55 | 0x00, 0xe0, 0x01, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, | |
56 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, | |
57 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, | |
58 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, | |
59 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};" | |
60 | image create bitmap ::tk::dialog::i -foreground blue \ | |
61 | -data "#define i_width 32\n#define i_height 32 | |
62 | static unsigned char i_bits[] = { | |
63 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, | |
64 | 0x00, 0xe0, 0x01, 0x00, 0x00, 0xf0, 0x03, 0x00, 0x00, 0xf0, 0x03, 0x00, | |
65 | 0x00, 0xe0, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, | |
66 | 0x00, 0xf8, 0x03, 0x00, 0x00, 0xf0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00, | |
67 | 0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00, | |
68 | 0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00, 0x00, 0xf0, 0x07, 0x00, | |
69 | 0x00, 0xf8, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, | |
70 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, | |
71 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, | |
72 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, | |
73 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};" | |
74 | image create bitmap ::tk::dialog::w1 -foreground black \ | |
75 | -data "#define w1_width 32\n#define w1_height 32 | |
76 | static unsigned char w1_bits[] = { | |
77 | 0x00, 0x80, 0x01, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x20, 0x04, 0x00, | |
78 | 0x00, 0x10, 0x04, 0x00, 0x00, 0x10, 0x08, 0x00, 0x00, 0x08, 0x08, 0x00, | |
79 | 0x00, 0x08, 0x10, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x04, 0x20, 0x00, | |
80 | 0x00, 0x02, 0x20, 0x00, 0x00, 0x02, 0x40, 0x00, 0x00, 0x01, 0x40, 0x00, | |
81 | 0x00, 0x01, 0x80, 0x00, 0x80, 0x00, 0x80, 0x00, 0x80, 0x00, 0x00, 0x01, | |
82 | 0x40, 0x00, 0x00, 0x01, 0x40, 0x00, 0x00, 0x02, 0x20, 0x00, 0x00, 0x02, | |
83 | 0x20, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x08, | |
84 | 0x08, 0x00, 0x00, 0x08, 0x08, 0x00, 0x00, 0x10, 0x04, 0x00, 0x00, 0x10, | |
85 | 0x04, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x20, 0x01, 0x00, 0x00, 0x40, | |
86 | 0x01, 0x00, 0x00, 0x40, 0x01, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x20, | |
87 | 0xfc, 0xff, 0xff, 0x1f, 0x00, 0x00, 0x00, 0x00};" | |
88 | image create bitmap ::tk::dialog::w2 -foreground yellow \ | |
89 | -data "#define w2_width 32\n#define w2_height 32 | |
90 | static unsigned char w2_bits[] = { | |
91 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0xc0, 0x03, 0x00, | |
92 | 0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xf0, 0x07, 0x00, | |
93 | 0x00, 0xf0, 0x0f, 0x00, 0x00, 0xf8, 0x0f, 0x00, 0x00, 0xf8, 0x1f, 0x00, | |
94 | 0x00, 0xfc, 0x1f, 0x00, 0x00, 0xfc, 0x3f, 0x00, 0x00, 0xfe, 0x3f, 0x00, | |
95 | 0x00, 0xfe, 0x7f, 0x00, 0x00, 0xff, 0x7f, 0x00, 0x00, 0xff, 0xff, 0x00, | |
96 | 0x80, 0xff, 0xff, 0x00, 0x80, 0xff, 0xff, 0x01, 0xc0, 0xff, 0xff, 0x01, | |
97 | 0xc0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x07, | |
98 | 0xf0, 0xff, 0xff, 0x07, 0xf0, 0xff, 0xff, 0x0f, 0xf8, 0xff, 0xff, 0x0f, | |
99 | 0xf8, 0xff, 0xff, 0x1f, 0xfc, 0xff, 0xff, 0x1f, 0xfe, 0xff, 0xff, 0x3f, | |
100 | 0xfe, 0xff, 0xff, 0x3f, 0xfe, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x1f, | |
101 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};" | |
102 | image create bitmap ::tk::dialog::w3 -foreground black \ | |
103 | -data "#define w3_width 32\n#define w3_height 32 | |
104 | static unsigned char w3_bits[] = { | |
105 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, | |
106 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, | |
107 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, | |
108 | 0x00, 0xc0, 0x03, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x07, 0x00, | |
109 | 0x00, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x07, 0x00, | |
110 | 0x00, 0xc0, 0x03, 0x00, 0x00, 0xc0, 0x03, 0x00, 0x00, 0xc0, 0x03, 0x00, | |
111 | 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, | |
112 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0xc0, 0x03, 0x00, | |
113 | 0x00, 0xc0, 0x03, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, | |
114 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, | |
115 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};" | |
116 | ||
117 | # ::tk::MessageBox -- | |
118 | # | |
119 | # Pops up a messagebox with an application-supplied message with | |
120 | # an icon and a list of buttons. This procedure will be called | |
121 | # by tk_messageBox if the platform does not have native | |
122 | # messagebox support, or if the particular type of messagebox is | |
123 | # not supported natively. | |
124 | # | |
125 | # Color icons are used on Unix displays that have a color | |
126 | # depth of 4 or more and $tk_strictMotif is not on. | |
127 | # | |
128 | # This procedure is a private procedure shouldn't be called | |
129 | # directly. Call tk_messageBox instead. | |
130 | # | |
131 | # See the user documentation for details on what tk_messageBox does. | |
132 | # | |
133 | proc ::tk::MessageBox {args} { | |
134 | global tcl_platform tk_strictMotif | |
135 | variable ::tk::Priv | |
136 | ||
137 | set w ::tk::PrivMsgBox | |
138 | upvar $w data | |
139 | ||
140 | # | |
141 | # The default value of the title is space (" ") not the empty string | |
142 | # because for some window managers, a | |
143 | # wm title .foo "" | |
144 | # causes the window title to be "foo" instead of the empty string. | |
145 | # | |
146 | set specs { | |
147 | {-default "" "" ""} | |
148 | {-icon "" "" "info"} | |
149 | {-message "" "" ""} | |
150 | {-parent "" "" .} | |
151 | {-title "" "" " "} | |
152 | {-type "" "" "ok"} | |
153 | } | |
154 | ||
155 | tclParseConfigSpec $w $specs "" $args | |
156 | ||
157 | if {[lsearch -exact {info warning error question} $data(-icon)] == -1} { | |
158 | error "bad -icon value \"$data(-icon)\": must be error, info, question, or warning" | |
159 | } | |
160 | if {[string equal [tk windowingsystem] "classic"] | |
161 | || [string equal [tk windowingsystem] "aqua"]} { | |
162 | switch -- $data(-icon) { | |
163 | "error" {set data(-icon) "stop"} | |
164 | "warning" {set data(-icon) "caution"} | |
165 | "info" {set data(-icon) "note"} | |
166 | } | |
167 | } | |
168 | ||
169 | if {![winfo exists $data(-parent)]} { | |
170 | error "bad window path name \"$data(-parent)\"" | |
171 | } | |
172 | ||
173 | switch -- $data(-type) { | |
174 | abortretryignore { | |
175 | set names [list abort retry ignore] | |
176 | set labels [list &Abort &Retry &Ignore] | |
177 | } | |
178 | ok { | |
179 | set names [list ok] | |
180 | set labels {&OK} | |
181 | } | |
182 | okcancel { | |
183 | set names [list ok cancel] | |
184 | set labels [list &OK &Cancel] | |
185 | } | |
186 | retrycancel { | |
187 | set names [list retry cancel] | |
188 | set labels [list &Retry &Cancel] | |
189 | } | |
190 | yesno { | |
191 | set names [list yes no] | |
192 | set labels [list &Yes &No] | |
193 | } | |
194 | yesnocancel { | |
195 | set names [list yes no cancel] | |
196 | set labels [list &Yes &No &Cancel] | |
197 | } | |
198 | default { | |
199 | error "bad -type value \"$data(-type)\": must be\ | |
200 | abortretryignore, ok, okcancel, retrycancel,\ | |
201 | yesno, or yesnocancel" | |
202 | } | |
203 | } | |
204 | ||
205 | set buttons {} | |
206 | foreach name $names lab $labels { | |
207 | lappend buttons [list $name -text [mc $lab]] | |
208 | } | |
209 | ||
210 | # If no default button was specified, the default default is the | |
211 | # first button (Bug: 2218). | |
212 | ||
213 | if {$data(-default) == ""} { | |
214 | set data(-default) [lindex [lindex $buttons 0] 0] | |
215 | } | |
216 | ||
217 | set valid 0 | |
218 | foreach btn $buttons { | |
219 | if {[string equal [lindex $btn 0] $data(-default)]} { | |
220 | set valid 1 | |
221 | break | |
222 | } | |
223 | } | |
224 | if {!$valid} { | |
225 | error "invalid default button \"$data(-default)\"" | |
226 | } | |
227 | ||
228 | # 2. Set the dialog to be a child window of $parent | |
229 | # | |
230 | # | |
231 | if {[string compare $data(-parent) .]} { | |
232 | set w $data(-parent).__tk__messagebox | |
233 | } else { | |
234 | set w .__tk__messagebox | |
235 | } | |
236 | ||
237 | # 3. Create the top-level window and divide it into top | |
238 | # and bottom parts. | |
239 | ||
240 | catch {destroy $w} | |
241 | toplevel $w -class Dialog | |
242 | wm title $w $data(-title) | |
243 | wm iconname $w Dialog | |
244 | wm protocol $w WM_DELETE_WINDOW { } | |
245 | # There is only one background colour for the whole dialog | |
246 | set bg [$w cget -background] | |
247 | ||
248 | # Message boxes should be transient with respect to their parent so that | |
249 | # they always stay on top of the parent window. But some window managers | |
250 | # will simply create the child window as withdrawn if the parent is not | |
251 | # viewable (because it is withdrawn or iconified). This is not good for | |
252 | # "grab"bed windows. So only make the message box transient if the parent | |
253 | # is viewable. | |
254 | # | |
255 | if {[winfo viewable [winfo toplevel $data(-parent)]] } { | |
256 | wm transient $w $data(-parent) | |
257 | } | |
258 | ||
259 | if {[string equal [tk windowingsystem] "classic"] | |
260 | || [string equal [tk windowingsystem] "aqua"]} { | |
261 | unsupported::MacWindowStyle style $w dBoxProc | |
262 | } | |
263 | ||
264 | frame $w.bot -background $bg | |
265 | pack $w.bot -side bottom -fill both | |
266 | frame $w.top -background $bg | |
267 | pack $w.top -side top -fill both -expand 1 | |
268 | if {![string equal [tk windowingsystem] "classic"] | |
269 | && ![string equal [tk windowingsystem] "aqua"]} { | |
270 | $w.bot configure -relief raised -bd 1 | |
271 | $w.top configure -relief raised -bd 1 | |
272 | } | |
273 | ||
274 | # 4. Fill the top part with bitmap and message (use the option | |
275 | # database for -wraplength and -font so that they can be | |
276 | # overridden by the caller). | |
277 | ||
278 | option add *Dialog.msg.wrapLength 3i widgetDefault | |
279 | if {[string equal [tk windowingsystem] "classic"] | |
280 | || [string equal [tk windowingsystem] "aqua"]} { | |
281 | option add *Dialog.msg.font system widgetDefault | |
282 | } else { | |
283 | option add *Dialog.msg.font {Times 14} widgetDefault | |
284 | } | |
285 | ||
286 | label $w.msg -anchor nw -justify left -text $data(-message) \ | |
287 | -background $bg | |
288 | if {[string compare $data(-icon) ""]} { | |
289 | if {([string equal [tk windowingsystem] "classic"] | |
290 | || [string equal [tk windowingsystem] "aqua"]) | |
291 | || ([winfo depth $w] < 4) || $tk_strictMotif} { | |
292 | label $w.bitmap -bitmap $data(-icon) -background $bg | |
293 | } else { | |
294 | canvas $w.bitmap -width 32 -height 32 -highlightthickness 0 \ | |
295 | -background $bg | |
296 | switch $data(-icon) { | |
297 | error { | |
298 | $w.bitmap create oval 0 0 31 31 -fill red -outline black | |
299 | $w.bitmap create line 9 9 23 23 -fill white -width 4 | |
300 | $w.bitmap create line 9 23 23 9 -fill white -width 4 | |
301 | } | |
302 | info { | |
303 | $w.bitmap create image 0 0 -anchor nw \ | |
304 | -image ::tk::dialog::b1 | |
305 | $w.bitmap create image 0 0 -anchor nw \ | |
306 | -image ::tk::dialog::b2 | |
307 | $w.bitmap create image 0 0 -anchor nw \ | |
308 | -image ::tk::dialog::i | |
309 | } | |
310 | question { | |
311 | $w.bitmap create image 0 0 -anchor nw \ | |
312 | -image ::tk::dialog::b1 | |
313 | $w.bitmap create image 0 0 -anchor nw \ | |
314 | -image ::tk::dialog::b2 | |
315 | $w.bitmap create image 0 0 -anchor nw \ | |
316 | -image ::tk::dialog::q | |
317 | } | |
318 | default { | |
319 | $w.bitmap create image 0 0 -anchor nw \ | |
320 | -image ::tk::dialog::w1 | |
321 | $w.bitmap create image 0 0 -anchor nw \ | |
322 | -image ::tk::dialog::w2 | |
323 | $w.bitmap create image 0 0 -anchor nw \ | |
324 | -image ::tk::dialog::w3 | |
325 | } | |
326 | } | |
327 | } | |
328 | } | |
329 | grid $w.bitmap $w.msg -in $w.top -sticky news -padx 2m -pady 2m | |
330 | grid columnconfigure $w.top 1 -weight 1 | |
331 | grid rowconfigure $w.top 0 -weight 1 | |
332 | ||
333 | # 5. Create a row of buttons at the bottom of the dialog. | |
334 | ||
335 | set i 0 | |
336 | foreach but $buttons { | |
337 | set name [lindex $but 0] | |
338 | set opts [lrange $but 1 end] | |
339 | if {![llength $opts]} { | |
340 | # Capitalize the first letter of $name | |
341 | set capName [string toupper $name 0] | |
342 | set opts [list -text $capName] | |
343 | } | |
344 | ||
345 | eval [list tk::AmpWidget button $w.$name -padx 3m] $opts \ | |
346 | [list -command [list set tk::Priv(button) $name]] | |
347 | ||
348 | if {[string equal $name $data(-default)]} { | |
349 | $w.$name configure -default active | |
350 | } else { | |
351 | $w.$name configure -default normal | |
352 | } | |
353 | grid $w.$name -in $w.bot -row 0 -column $i -padx 3m -pady 2m -sticky ew | |
354 | grid columnconfigure $w.bot $i -uniform buttons | |
355 | incr i | |
356 | ||
357 | # create the binding for the key accelerator, based on the underline | |
358 | # | |
359 | # set underIdx [$w.$name cget -under] | |
360 | # if {$underIdx >= 0} { | |
361 | # set key [string index [$w.$name cget -text] $underIdx] | |
362 | # bind $w <Alt-[string tolower $key]> [list $w.$name invoke] | |
363 | # bind $w <Alt-[string toupper $key]> [list $w.$name invoke] | |
364 | # } | |
365 | } | |
366 | bind $w <Alt-Key> [list ::tk::AltKeyInDialog $w %A] | |
367 | ||
368 | if {[string compare {} $data(-default)]} { | |
369 | bind $w <FocusIn> { | |
370 | if {[string equal Button [winfo class %W]]} { | |
371 | %W configure -default active | |
372 | } | |
373 | } | |
374 | bind $w <FocusOut> { | |
375 | if {[string equal Button [winfo class %W]]} { | |
376 | %W configure -default normal | |
377 | } | |
378 | } | |
379 | } | |
380 | ||
381 | # 6. Create a binding for <Return> on the dialog | |
382 | ||
383 | bind $w <Return> { | |
384 | if {[string equal Button [winfo class %W]]} { | |
385 | tk::ButtonInvoke %W | |
386 | } | |
387 | } | |
388 | ||
389 | # 7. Withdraw the window, then update all the geometry information | |
390 | # so we know how big it wants to be, then center the window in the | |
391 | # display and de-iconify it. | |
392 | ||
393 | ::tk::PlaceWindow $w widget $data(-parent) | |
394 | ||
395 | # 8. Set a grab and claim the focus too. | |
396 | ||
397 | if {[string compare $data(-default) ""]} { | |
398 | set focus $w.$data(-default) | |
399 | } else { | |
400 | set focus $w | |
401 | } | |
402 | ::tk::SetFocusGrab $w $focus | |
403 | ||
404 | # 9. Wait for the user to respond, then restore the focus and | |
405 | # return the index of the selected button. Restore the focus | |
406 | # before deleting the window, since otherwise the window manager | |
407 | # may take the focus away so we can't redirect it. Finally, | |
408 | # restore any grab that was in effect. | |
409 | ||
410 | vwait ::tk::Priv(button) | |
411 | ||
412 | ::tk::RestoreFocusGrab $w $focus | |
413 | ||
414 | return $Priv(button) | |
415 | } |