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.10 2000/04/19 09:25:53 hobbs 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 | # tkMessageBox -- |
---|
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 tkMessageBox {args} { |
---|
134 | global tkPriv tcl_platform tk_strictMotif |
---|
135 | |
---|
136 | set w tkPrivMsgBox |
---|
137 | upvar #0 $w data |
---|
138 | |
---|
139 | # |
---|
140 | # The default value of the title is space (" ") not the empty string |
---|
141 | # because for some window managers, a |
---|
142 | # wm title .foo "" |
---|
143 | # causes the window title to be "foo" instead of the empty string. |
---|
144 | # |
---|
145 | set specs { |
---|
146 | {-default "" "" ""} |
---|
147 | {-icon "" "" "info"} |
---|
148 | {-message "" "" ""} |
---|
149 | {-parent "" "" .} |
---|
150 | {-title "" "" " "} |
---|
151 | {-type "" "" "ok"} |
---|
152 | } |
---|
153 | |
---|
154 | tclParseConfigSpec $w $specs "" $args |
---|
155 | |
---|
156 | if {[lsearch -exact {info warning error question} $data(-icon)] == -1} { |
---|
157 | error "bad -icon value \"$data(-icon)\": must be error, info, question, or warning" |
---|
158 | } |
---|
159 | if {[string equal $tcl_platform(platform) "macintosh"]} { |
---|
160 | switch -- $data(-icon) { |
---|
161 | "error" {set data(-icon) "stop"} |
---|
162 | "warning" {set data(-icon) "caution"} |
---|
163 | "info" {set data(-icon) "note"} |
---|
164 | } |
---|
165 | } |
---|
166 | |
---|
167 | if {![winfo exists $data(-parent)]} { |
---|
168 | error "bad window path name \"$data(-parent)\"" |
---|
169 | } |
---|
170 | |
---|
171 | switch -- $data(-type) { |
---|
172 | abortretryignore { |
---|
173 | set buttons { |
---|
174 | {abort -width 6 -text Abort -under 0} |
---|
175 | {retry -width 6 -text Retry -under 0} |
---|
176 | {ignore -width 6 -text Ignore -under 0} |
---|
177 | } |
---|
178 | } |
---|
179 | ok { |
---|
180 | set buttons { |
---|
181 | {ok -width 6 -text OK -under 0} |
---|
182 | } |
---|
183 | if {[string equal $data(-default) ""]} { |
---|
184 | set data(-default) "ok" |
---|
185 | } |
---|
186 | } |
---|
187 | okcancel { |
---|
188 | set buttons { |
---|
189 | {ok -width 6 -text OK -under 0} |
---|
190 | {cancel -width 6 -text Cancel -under 0} |
---|
191 | } |
---|
192 | } |
---|
193 | retrycancel { |
---|
194 | set buttons { |
---|
195 | {retry -width 6 -text Retry -under 0} |
---|
196 | {cancel -width 6 -text Cancel -under 0} |
---|
197 | } |
---|
198 | } |
---|
199 | yesno { |
---|
200 | set buttons { |
---|
201 | {yes -width 6 -text Yes -under 0} |
---|
202 | {no -width 6 -text No -under 0} |
---|
203 | } |
---|
204 | } |
---|
205 | yesnocancel { |
---|
206 | set buttons { |
---|
207 | {yes -width 6 -text Yes -under 0} |
---|
208 | {no -width 6 -text No -under 0} |
---|
209 | {cancel -width 6 -text Cancel -under 0} |
---|
210 | } |
---|
211 | } |
---|
212 | default { |
---|
213 | error "bad -type value \"$data(-type)\": must be abortretryignore, ok, okcancel, retrycancel, yesno, or yesnocancel" |
---|
214 | } |
---|
215 | } |
---|
216 | |
---|
217 | if {[string compare $data(-default) ""]} { |
---|
218 | set valid 0 |
---|
219 | foreach btn $buttons { |
---|
220 | if {[string equal [lindex $btn 0] $data(-default)]} { |
---|
221 | set valid 1 |
---|
222 | break |
---|
223 | } |
---|
224 | } |
---|
225 | if {!$valid} { |
---|
226 | error "invalid default button \"$data(-default)\"" |
---|
227 | } |
---|
228 | } |
---|
229 | |
---|
230 | # 2. Set the dialog to be a child window of $parent |
---|
231 | # |
---|
232 | # |
---|
233 | if {[string compare $data(-parent) .]} { |
---|
234 | set w $data(-parent).__tk__messagebox |
---|
235 | } else { |
---|
236 | set w .__tk__messagebox |
---|
237 | } |
---|
238 | |
---|
239 | # 3. Create the top-level window and divide it into top |
---|
240 | # and bottom parts. |
---|
241 | |
---|
242 | catch {destroy $w} |
---|
243 | toplevel $w -class Dialog |
---|
244 | wm title $w $data(-title) |
---|
245 | wm iconname $w Dialog |
---|
246 | wm protocol $w WM_DELETE_WINDOW { } |
---|
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 $tcl_platform(platform) "macintosh"]} { |
---|
260 | unsupported1 style $w dBoxProc |
---|
261 | } |
---|
262 | |
---|
263 | frame $w.bot |
---|
264 | pack $w.bot -side bottom -fill both |
---|
265 | frame $w.top |
---|
266 | pack $w.top -side top -fill both -expand 1 |
---|
267 | if {[string compare $tcl_platform(platform) "macintosh"]} { |
---|
268 | $w.bot configure -relief raised -bd 1 |
---|
269 | $w.top configure -relief raised -bd 1 |
---|
270 | } |
---|
271 | |
---|
272 | # 4. Fill the top part with bitmap and message (use the option |
---|
273 | # database for -wraplength and -font so that they can be |
---|
274 | # overridden by the caller). |
---|
275 | |
---|
276 | option add *Dialog.msg.wrapLength 3i widgetDefault |
---|
277 | if {[string equal $tcl_platform(platform) "macintosh"]} { |
---|
278 | option add *Dialog.msg.font system widgetDefault |
---|
279 | } else { |
---|
280 | option add *Dialog.msg.font {Times 18} widgetDefault |
---|
281 | } |
---|
282 | |
---|
283 | label $w.msg -anchor nw -justify left -text $data(-message) |
---|
284 | if {[string compare $data(-icon) ""]} { |
---|
285 | if {[string equal $tcl_platform(platform) "macintosh"] \ |
---|
286 | || ([winfo depth $w] < 4) || $tk_strictMotif} { |
---|
287 | label $w.bitmap -bitmap $data(-icon) |
---|
288 | } else { |
---|
289 | canvas $w.bitmap -width 32 -height 32 -highlightthickness 0 |
---|
290 | switch $data(-icon) { |
---|
291 | error { |
---|
292 | $w.bitmap create oval 0 0 31 31 -fill red -outline black |
---|
293 | $w.bitmap create line 9 9 23 23 -fill white -width 4 |
---|
294 | $w.bitmap create line 9 23 23 9 -fill white -width 4 |
---|
295 | } |
---|
296 | info { |
---|
297 | $w.bitmap create image 0 0 -anchor nw \ |
---|
298 | -image ::tk::dialog::b1 |
---|
299 | $w.bitmap create image 0 0 -anchor nw \ |
---|
300 | -image ::tk::dialog::b2 |
---|
301 | $w.bitmap create image 0 0 -anchor nw \ |
---|
302 | -image ::tk::dialog::i |
---|
303 | } |
---|
304 | question { |
---|
305 | $w.bitmap create image 0 0 -anchor nw \ |
---|
306 | -image ::tk::dialog::b1 |
---|
307 | $w.bitmap create image 0 0 -anchor nw \ |
---|
308 | -image ::tk::dialog::b2 |
---|
309 | $w.bitmap create image 0 0 -anchor nw \ |
---|
310 | -image ::tk::dialog::q |
---|
311 | } |
---|
312 | default { |
---|
313 | $w.bitmap create image 0 0 -anchor nw \ |
---|
314 | -image ::tk::dialog::w1 |
---|
315 | $w.bitmap create image 0 0 -anchor nw \ |
---|
316 | -image ::tk::dialog::w2 |
---|
317 | $w.bitmap create image 0 0 -anchor nw \ |
---|
318 | -image ::tk::dialog::w3 |
---|
319 | } |
---|
320 | } |
---|
321 | } |
---|
322 | } |
---|
323 | grid $w.bitmap $w.msg -in $w.top -sticky news -padx 2m -pady 2m |
---|
324 | grid columnconfigure $w.top 1 -weight 1 |
---|
325 | grid rowconfigure $w.top 0 -weight 1 |
---|
326 | |
---|
327 | # 5. Create a row of buttons at the bottom of the dialog. |
---|
328 | |
---|
329 | set i 0 |
---|
330 | foreach but $buttons { |
---|
331 | set name [lindex $but 0] |
---|
332 | set opts [lrange $but 1 end] |
---|
333 | if {![llength $opts]} { |
---|
334 | # Capitalize the first letter of $name |
---|
335 | set capName [string toupper $name 0] |
---|
336 | set opts [list -text $capName] |
---|
337 | } |
---|
338 | |
---|
339 | eval button [list $w.$name] $opts [list -command [list set tkPriv(button) $name]] |
---|
340 | |
---|
341 | if {[string equal $name $data(-default)]} { |
---|
342 | $w.$name configure -default active |
---|
343 | } |
---|
344 | pack $w.$name -in $w.bot -side left -expand 1 -padx 3m -pady 2m |
---|
345 | |
---|
346 | # create the binding for the key accelerator, based on the underline |
---|
347 | # |
---|
348 | set underIdx [$w.$name cget -under] |
---|
349 | if {$underIdx >= 0} { |
---|
350 | set key [string index [$w.$name cget -text] $underIdx] |
---|
351 | bind $w <Alt-[string tolower $key]> [list $w.$name invoke] |
---|
352 | bind $w <Alt-[string toupper $key]> [list $w.$name invoke] |
---|
353 | } |
---|
354 | incr i |
---|
355 | } |
---|
356 | |
---|
357 | if {[string compare {} $data(-default)]} { |
---|
358 | bind $w <FocusIn> { |
---|
359 | if {[string equal Button [winfo class %W]]} { |
---|
360 | %W configure -default active |
---|
361 | } |
---|
362 | } |
---|
363 | bind $w <FocusOut> { |
---|
364 | if {[string equal Button [winfo class %W]]} { |
---|
365 | %W configure -default normal |
---|
366 | } |
---|
367 | } |
---|
368 | } |
---|
369 | |
---|
370 | # 6. Create a binding for <Return> on the dialog |
---|
371 | |
---|
372 | bind $w <Return> { |
---|
373 | if {[string equal Button [winfo class %W]]} { |
---|
374 | tkButtonInvoke %W |
---|
375 | } |
---|
376 | } |
---|
377 | |
---|
378 | # 7. Withdraw the window, then update all the geometry information |
---|
379 | # so we know how big it wants to be, then center the window in the |
---|
380 | # display and de-iconify it. |
---|
381 | |
---|
382 | ::tk::PlaceWindow $w widget $data(-parent) |
---|
383 | |
---|
384 | # 8. Set a grab and claim the focus too. |
---|
385 | |
---|
386 | if {[string compare $data(-default) ""]} { |
---|
387 | set focus $w.$data(-default) |
---|
388 | } else { |
---|
389 | set focus $w |
---|
390 | } |
---|
391 | ::tk::SetFocusGrab $w $focus |
---|
392 | |
---|
393 | # 9. Wait for the user to respond, then restore the focus and |
---|
394 | # return the index of the selected button. Restore the focus |
---|
395 | # before deleting the window, since otherwise the window manager |
---|
396 | # may take the focus away so we can't redirect it. Finally, |
---|
397 | # restore any grab that was in effect. |
---|
398 | |
---|
399 | tkwait variable tkPriv(button) |
---|
400 | |
---|
401 | ::tk::RestoreFocusGrab $w $focus |
---|
402 | |
---|
403 | return $tkPriv(button) |
---|
404 | } |
---|