source: proiecte/pmake3d/make3d_original/Make3dSingleImageStanford_version0.1/third_party/vrippack-0.31/src/vrip/lib/tk/msgbox.tcl @ 37

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

Added original make3d
File size: 14.9 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.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#
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# 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#
133proc 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}
Note: See TracBrowser for help on using the repository browser.