projects / OpenSPARC-T2-DV / blame
? search:
summary | tags | clone url | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Initial commit of OpenSPARC T2 design and verification files.
[OpenSPARC-T2-DV] / tools / src / nas,5.n2.os.2 / lib / python / lib / tk8.4 / msgbox.tcl
CommitLineData
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#
16namespace eval ::tk::dialog {}
17
18image create bitmap ::tk::dialog::b1 -foreground black \
19-data "#define b1_width 32\n#define b1_height 32
20static 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};"
32image create bitmap ::tk::dialog::b2 -foreground white \
33-data "#define b2_width 32\n#define b2_height 32
34static 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};"
46image create bitmap ::tk::dialog::q -foreground blue \
47-data "#define q_width 32\n#define q_height 32
48static 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};"
60image create bitmap ::tk::dialog::i -foreground blue \
61-data "#define i_width 32\n#define i_height 32
62static 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};"
74image create bitmap ::tk::dialog::w1 -foreground black \
75-data "#define w1_width 32\n#define w1_height 32
76static 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};"
88image create bitmap ::tk::dialog::w2 -foreground yellow \
89-data "#define w2_width 32\n#define w2_height 32
90static 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};"
102image create bitmap ::tk::dialog::w3 -foreground black \
103-data "#define w3_width 32\n#define w3_height 32
104static 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#
133proc ::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}
Full OpenSPARC design & verification tarball including full HDL.