source: proiecte/pmake3d/make3d_original/Make3dSingleImageStanford_version0.1/third_party/vrippack-0.31/lib/linux/tk8.4/msgbox.tcl @ 37

Last change on this file since 37 was 37, checked in by (none), 14 years ago

Added original make3d
File size: 15.6 KB
Line 
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}
Note: See TracBrowser for help on using the repository browser.