URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tix/] [library/] [Tix.tcl] - Blame information for rev 1765

Details | Compare with Previous | View Log


# Tix.tcl --
#
#       This file implements the Tix application context class
#
# Copyright (c) 1996, Expert Interface Technologies
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
 
if 0 {
proc tix {} {
    # dummy proc. make sure the entry "tix" is in the tclIndex file
    #
}
}
 
tixClass tixAppContext {
    -superclass {}
    -classname  TixAppContext
    -method {
        cget configure addbitmapdir filedialog getbitmap getimage
        option platform resetoptions setbitmap
    }
    -flag {
        -binding -debug -extracmdargs -filedialog -fontset -grabmode
        -haspixmap -libdir -scheme -schemepriority -percentsubst
    }
    -readonly {
        -haspixmap
    }
    -configspec {
        {-binding               TK}
        {-debug                 false}
        {-extracmdargs          1}
        {-filedialog            ""}
        {-fontset               TK}
        {-grabmode              global}
        {-haspixmap             0}
        {-libdir                ""}
        {-percentsubst          0}
        {-scheme                TK}
        {-schemepriority        21}
    }
    -alias {
    }
}
 
proc tixAppContext:Constructor {w} {
    upvar #0 $w data
    global tix_priv env argv0 tixPriv
    global tix_library tixOption tcl_platform
 
    if {[info exists tcl_platform] && $tcl_platform(platform) == "windows"} {
        regsub -all "/" $tix_library \\ tix_library
    }
 
    if [info exists data(initialized)] {
        error "tixAppContext has already be initialized"
    } else {
        set data(initialized) 1
    }
 
    if [tixStrEq $tix_library ""] {
        set data(et) 1
    } else {
        set data(et) 0
    }
 
    set data(isStartUp) 1
    # Thses options were set when tixwish started up
    #
    set data(-binding)          $tix_priv(-binding)
    set data(-debug)            $tix_priv(-debug)
    set data(-fontset)          $tix_priv(-fontset)
    set data(-scheme)           $tix_priv(-scheme)
    set data(-schemepriority)   $tix_priv(-schemepriority)
 
    if ![info exists tix_priv(isSafe)] {
        set data(-libdir)       [tixFSAbsPath $tix_library]
    }
    set tixOption(prioLevel) $tix_priv(-schemepriority)
 
    # Enable/Disable Intrinsics debugging
    #
    if {$data(-debug)} {
        set tix_priv(debug) 1
    } else {
        set tix_priv(debug) 0
    }
 
    if ![info exists tix_priv(isSafe)] {
        tixAppContext:config-fontset $w $data(-fontset)
        tixAppContext:config-scheme  $w $data(-scheme)
    }
 
    tixAppContext:BitmapInit $w
    tixAppContext:FileDialogInit $w
 
    # Force the "." window to accept the new Tix options
    #
    foreach spec [. configure] {
        if {[llength $spec] > 2} {
            set flag  [lindex $spec 0]
            set name  [lindex $spec 1]
            set class [lindex $spec 2]
            set value [option get . $name $class]
            catch {. config $flag $value}
        }
    }
    # Clean up any error message generated by the above loop
    catch {uplevel #0 set errorInfo \"\"}
 
    set data(isStartUp) 0
 
    # Hack: if env(TIX_DEBUG_INTERACTIVE) is set, then
    # an interactive prompt is always printed
    #
    if {[info exists env(TIX_DEBUG_INTERACTIVE)] &&
        ![info exists tix_priv(slaveInterp)]} {
 
        # For widget programming, it is more convient to have the error
        # message printed on the terminal. For some extensive usage of
        # bindings, suce as in the case of tixBalloon, the default
        # therror just doesn't work.
        #
        proc tkerror {err} {
            global errorInfo
            puts $err
            puts $errorInfo
        }
    }
 
    #
    # Hack
    #
    if [info exists env(TIX_DEBUG_GEOMETRY)] {
        global tcl_interactive
        if {$tcl_interactive == 0} {
            wm geometry . $env(TIX_DEBUG_GEOMETRY)
        }
    }
}
 
#----------------------------------------------------------------------
#  Configurations
#
#----------------------------------------------------------------------
proc tixAppContext:resetoptions {w scheme fontset {schemePrio ""}} {
    upvar #0 $w data
 
    if {! $data(et)} {
        global tixOption
        option clear
 
        if {$schemePrio != ""} {
            set tixOption(prioLevel) $schemePrio
        }
        tixAppContext:config-scheme  $w $scheme
        tixAppContext:config-fontset $w $fontset
    }
}
 
proc tixAppContext:config-fontset {w value} {
    upvar #0 $w data
    global tix_priv tixOption
 
    set data(-fontset) $value
 
    #-----------------------------------
    # Initialization of options database
    #-----------------------------------
    # Load the fontset
    #
    if {!$data(et)} {
        set prefDir [tixFileJoin $data(-libdir) pref]
        set fontSetFile [tixFileJoin $prefDir $data(-fontset).fsc]
        if [file exists $fontSetFile] {
            source $fontSetFile
            tixPref:InitFontSet:$data(-fontset)
            tixAppContext:CheckFontSets $w
            tixPref:SetFontSet:$data(-fontset)
        } else {
            tixAppContext:StartupError \
                "\aError: cannot use fontset \"$data(-fontset)\""
            tixAppContext:StartupError \
                "       Using default fontset "
            tixSetDefaultFontset
            tixAppContext:CheckFontSets $w
        }
    } else {
        if [catch {
            tixPref:InitFontSet:$data(-fontset)
            tixAppContext:CheckFontSets $w
            tixPref:SetFontSet:$data(-fontset)
        }] {
            # User chose non-existent fontset
            #
            tixAppContext:StartupError \
                "\aError: cannot use fontset \"$data(-fontset)\""
            tixAppContext:StartupError \
                "       Using default fontset "
            tixSetDefaultFontset
            tixAppContext:CheckFontSets $w
        }
    }
 
    # Compatibility stuff: the obsolete name courier_font has been changed to
    # fixed_font
    set tixOption(courier_font) $tixOption(fixed_font)
}
 
proc tixAppContext:config-scheme {w value} {
    upvar #0 $w data
    global tix_priv
 
    set data(-scheme) $value
 
    # Load the color scheme
    #
    if {!$data(et)} {
        set schemeName [tixFileJoin [tixFileJoin $data(-libdir) pref] \
            $data(-scheme).csc]
        if [file exists $schemeName] {
            source $schemeName
            if {[winfo depth .] >= 8} {
                tixPref:SetScheme-Color:$data(-scheme)
            } else {
                tixPref:SetScheme-Mono:$data(-scheme)
            }
        } else {
            tixAppContext:StartupError \
                "\aError: cannot use color scheme \"$data(-scheme)\""
            tixAppContext:StartupError \
                "       Using default color scheme"
            if {[winfo depth .] >= 8} {
                tixSetDefaultScheme-Color
            } else {
                tixSetDefaultScheme-Mono
            }
        }
    } else {
        if [catch {
            if {[winfo depth .] >= 8} {
                tixPref:SetScheme-Color:$data(-scheme)
            } else {
                tixPref:SetScheme-Mono:$data(-scheme)
            }
        }] {
            # User chose non-existent color scheme
            #
            tixAppContext:StartupError \
                "\aError: cannot use color scheme \"$data(-scheme)\""
            tixAppContext:StartupError \
                "       Using default color scheme"
            if {[winfo depth .] >= 8} {
                tixSetDefaultScheme-Color
            } else {
                tixSetDefaultScheme-Mono
            }
        }
    }
}
 
#----------------------------------------------------------------------
#  Private methods
#
#----------------------------------------------------------------------
proc tixAppContext:BitmapInit {w} {
    upvar #0 $w data
 
    # See whether we have pixmap extension
    #
    set data(-haspixmap) true
 
    # Dynamically set the bitmap directory
    #
    if {! $data(et)} {
        set data(bitmapdirs) [list [tixFileJoin $data(-libdir) bitmaps]]
    } else {
        set data(bitmapdirs) ""
    }
}
 
proc tixAppContext:FileDialogInit {w} {
    upvar #0 $w data
 
    if {$data(-filedialog) == ""} {
        set data(-filedialog) [option get . fileDialog FileDialog]
    }
    if {$data(-filedialog) == ""} {
        set data(-filedialog) tixFileSelectDialog
    }
}
 
#----------------------------------------------------------------------
# If a font in the fontset is not available, use a default fontset.
#
proc tixAppContext:CheckFontSets  {w} {
    upvar #0 $w data
    global tixOption tcl_version
 
    if {$tcl_version >= "8.0"} {
        # fonts will never fail ..
        return
    }
 
    set default_font "fixed"
    set options {font bold_font menu_font italic_font fixed_font}
 
    if [winfo exists .tix-xxx-test] {
        destroy .tix-xxx-test
    }
    set lab [label .tix-xxx-test]
    foreach opt $options {
        if [catch {$lab config -font $tixOption($opt)}] {
            tixAppContext:StartupError \
                "\aError: cannot use font \"$tixOption($opt)\" as \"$opt\""
            puts  stderr \
                "       using \"$default_font\" instead"
 
            set tixOption($opt) $default_font
        }
    }
    destroy $lab
}
 
#----------------------------------------------------------------------
#       Public methods
#----------------------------------------------------------------------
proc tixAppContext:addbitmapdir {w bmpdir} {
    upvar #0 $w data
 
    if {[lsearch $data(bitmapdirs) $bmpdir] == "-1"} {
        lappend data(bitmapdirs) $bmpdir
    }
}
 
proc tixAppContext:getimage {w name} {
    upvar #0 $w data
    global tixPriv tix_priv
 
    if {[info exists data(img:$name)]} {
        return $data(img:$name)
    }
 
    if ![info exists tix_priv(isSafe)] {
        foreach dir $data(bitmapdirs) {
            if [file exists [tixFileJoin $dir $name.xpm]] {
                if {![catch {
                    set data(img:$name) \
                        [image create pixmap -file [tixFileJoin $dir $name.xpm]]
                }]} {
                    break
                }
            }
            if [file exists [tixFileJoin $dir $name.gif]] {
                global TRANSPARENT_GIF_COLOR
                if {![catch {
                    set data(img:$name) \
                        [image create photo -file [tixFileJoin $dir $name.gif]]
                }]} {
                    break
                }
            }
            if [file exists [tixFileJoin $dir $name.ppm]] {
                if {![catch {
                    set data(img:$name) \
                        [image create photo -file [tixFileJoin $dir $name.ppm]]
                }]} {
                    break
                }
            }
            if [file exists [tixFileJoin $dir $name.xbm]] {
                if {![catch {
                    set data(img:$name) \
                        [image create bitmap -file [tixFileJoin $dir $name.xbm]]
                }]} {
                    break
                }
            }
            if [file exists [tixFileJoin $dir $name]] {
                if {![catch {
                    set data(img:$name) \
                        [image create bitmap -file [tixFileJoin $dir $name]]
                }]} {
                    break
                }
            }
        }
    }
 
    if {![info exists data(img:$name)]} {
        catch {
            # This is for compiled-in images
            set data(img:$name) [image create pixmap -id $name]
        } err
        if [string match internal* $err] {
            error $err
        }
    }
 
    if {[info exists data(img:$name)]} {
        return $data(img:$name)
    } else {
        error "image file \"$name\" cannot be found"
    }
}
 
 
proc tixAppContext:getbitmap {w bitmapname} {
    upvar #0 $w data
    global tix_priv
 
    if {[info exists data(bmp:$bitmapname)]} {
        return $data(bmp:$bitmapname)
    } else {
        set ext [file extension $bitmapname]
        if {$ext == ""} {
            set ext .xbm
        }
 
        # This is the fallback value. If we can't find the bitmap in
        # the bitmap directories, then use the name of the bitmap
        # as the default value.
        #
        set data(bmp:$bitmapname) $bitmapname
 
        if [info exists tix_priv(isSafe)] {
            return $data(bmp:$bitmapname)
        }
 
        foreach dir $data(bitmapdirs) {
            case $ext {
                .xbm {
                    if [file exists [tixFileJoin $dir $bitmapname.xbm]] {
                        set data(bmp:$bitmapname) \
                            @[tixFileJoin $dir $bitmapname.xbm]
                        break
                    }
                    if [file exists [tixFileJoin $dir $bitmapname]] {
                        set data(bmp:$bitmapname) @[tixFileJoin $dir $bitmapname]
                        break
                    }
                }
                default {
                    if [file exists [tixFileJoin $dir $bitmapname]] {
                        set data(bmp:$bitmapname) @[tixFileJoin $dir $bitmapname]
                        break
                    }
                }
            }
        }
 
        return $data(bmp:$bitmapname)
    }
}
 
proc tixAppContext:filedialog {w {type tixFileSelectDialog}} {
    upvar #0 $w data
 
    if {$type == ""} {
        set type $data(-filedialog)
    }
    if {![info exists data(filedialog,$type)]} {
        set data(filedialog,$type) ""
    }
 
    if {$data(filedialog,$type) == "" || ![winfo exists $data(filedialog,$type)]} {
        set data(filedialog,$type) [$type .tixapp_filedialog_$type]
    }
 
    return $data(filedialog,$type)
}
 
proc tixAppContext:option {w action option {value ""}} {
    upvar #0 $w data
    global tixOption
 
    if {$action == "get"} {
        return $tixOption($option)
    }
}
 
proc tixAppContext:platform {w} {
    upvar #0 $w data
    global tixPriv
 
    if [info exists tixPriv(isWindows)] {
        return windows
    } else {
        return unix
    }
}
 
proc tixAppContext:StartupError {msg} {
    catch {
        puts stderr $msg
    }
}
 
if [tixStrEq [info command toplevel] ""] {
    proc toplevel {args} {
        return eval frame $args
    }
}

Browse

Tools

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tix/] [library/] [Tix.tcl] - Blame information for rev 1765

Line No.	Rev	Author	Line
1	578	markom	`# Tix.tcl --`
2			`#`
3			`# This file implements the Tix application context class`
4			`#`
5			`# Copyright (c) 1996, Expert Interface Technologies`
6			`#`
7			`# See the file "license.terms" for information on usage and redistribution`
8			`# of this file, and for a DISCLAIMER OF ALL WARRANTIES.`
9			`#`
10
11			`if 0 {`
12			`proc tix {} {`
13			`# dummy proc. make sure the entry "tix" is in the tclIndex file`
14			`#`
15			`}`
16			`}`
17
18			`tixClass tixAppContext {`
19			`-superclass {}`
20			`-classname TixAppContext`
21			`-method {`
22			`cget configure addbitmapdir filedialog getbitmap getimage`
23			`option platform resetoptions setbitmap`
24			`}`
25			`-flag {`
26			`-binding -debug -extracmdargs -filedialog -fontset -grabmode`
27			`-haspixmap -libdir -scheme -schemepriority -percentsubst`
28			`}`
29			`-readonly {`
30			`-haspixmap`
31			`}`
32			`-configspec {`
33			`{-binding TK}`
34			`{-debug false}`
35			`{-extracmdargs 1}`
36			`{-filedialog ""}`
37			`{-fontset TK}`
38			`{-grabmode global}`
39			`{-haspixmap 0}`
40			`{-libdir ""}`
41			`{-percentsubst 0}`
42			`{-scheme TK}`
43			`{-schemepriority 21}`
44			`}`
45			`-alias {`
46			`}`
47			`}`
48
49			`proc tixAppContext:Constructor {w} {`
50			`upvar #0 $w data`
51			`global tix_priv env argv0 tixPriv`
52			`global tix_library tixOption tcl_platform`
53
54			`if {[info exists tcl_platform] && $tcl_platform(platform) == "windows"} {`
55			`regsub -all "/" $tix_library \\ tix_library`
56			`}`
57
58			`if [info exists data(initialized)] {`
59			`error "tixAppContext has already be initialized"`
60			`} else {`
61			`set data(initialized) 1`
62			`}`
63
64			`if [tixStrEq $tix_library ""] {`
65			`set data(et) 1`
66			`} else {`
67			`set data(et) 0`
68			`}`
69
70			`set data(isStartUp) 1`
71			`# Thses options were set when tixwish started up`
72			`#`
73			`set data(-binding) $tix_priv(-binding)`
74			`set data(-debug) $tix_priv(-debug)`
75			`set data(-fontset) $tix_priv(-fontset)`
76			`set data(-scheme) $tix_priv(-scheme)`
77			`set data(-schemepriority) $tix_priv(-schemepriority)`
78
79			`if ![info exists tix_priv(isSafe)] {`
80			`set data(-libdir) [tixFSAbsPath $tix_library]`
81			`}`
82			`set tixOption(prioLevel) $tix_priv(-schemepriority)`
83
84			`# Enable/Disable Intrinsics debugging`
85			`#`
86			`if {$data(-debug)} {`
87			`set tix_priv(debug) 1`
88			`} else {`
89			`set tix_priv(debug) 0`
90			`}`
91
92			`if ![info exists tix_priv(isSafe)] {`
93			`tixAppContext:config-fontset $w $data(-fontset)`
94			`tixAppContext:config-scheme $w $data(-scheme)`
95			`}`
96
97			`tixAppContext:BitmapInit $w`
98			`tixAppContext:FileDialogInit $w`
99
100			`# Force the "." window to accept the new Tix options`
101			`#`
102			`foreach spec [. configure] {`
103			`if {[llength $spec] > 2} {`
104			`set flag [lindex $spec 0]`
105			`set name [lindex $spec 1]`
106			`set class [lindex $spec 2]`
107			`set value [option get . $name $class]`
108			`catch {. config $flag $value}`
109			`}`
110			`}`
111			`# Clean up any error message generated by the above loop`
112			`catch {uplevel #0 set errorInfo \"\"}`
113
114			`set data(isStartUp) 0`
115
116			`# Hack: if env(TIX_DEBUG_INTERACTIVE) is set, then`
117			`# an interactive prompt is always printed`
118			`#`
119			`if {[info exists env(TIX_DEBUG_INTERACTIVE)] &&`
120			`![info exists tix_priv(slaveInterp)]} {`
121
122			`# For widget programming, it is more convient to have the error`
123			`# message printed on the terminal. For some extensive usage of`
124			`# bindings, suce as in the case of tixBalloon, the default`
125			`# therror just doesn't work.`
126			`#`
127			`proc tkerror {err} {`
128			`global errorInfo`
129			`puts $err`
130			`puts $errorInfo`
131			`}`
132			`}`
133
134			`#`
135			`# Hack`
136			`#`
137			`if [info exists env(TIX_DEBUG_GEOMETRY)] {`
138			`global tcl_interactive`
139			`if {$tcl_interactive == 0} {`
140			`wm geometry . $env(TIX_DEBUG_GEOMETRY)`
141			`}`
142			`}`
143			`}`
144
145			`#----------------------------------------------------------------------`
146			`# Configurations`
147			`#`
148			`#----------------------------------------------------------------------`
149			`proc tixAppContext:resetoptions {w scheme fontset {schemePrio ""}} {`
150			`upvar #0 $w data`
151
152			`if {! $data(et)} {`
153			`global tixOption`
154			`option clear`
155
156			`if {$schemePrio != ""} {`
157			`set tixOption(prioLevel) $schemePrio`
158			`}`
159			`tixAppContext:config-scheme $w $scheme`
160			`tixAppContext:config-fontset $w $fontset`
161			`}`
162			`}`
163
164			`proc tixAppContext:config-fontset {w value} {`
165			`upvar #0 $w data`
166			`global tix_priv tixOption`
167
168			`set data(-fontset) $value`
169
170			`#-----------------------------------`
171			`# Initialization of options database`
172			`#-----------------------------------`
173			`# Load the fontset`
174			`#`
175			`if {!$data(et)} {`
176			`set prefDir [tixFileJoin $data(-libdir) pref]`
177			`set fontSetFile [tixFileJoin $prefDir $data(-fontset).fsc]`
178			`if [file exists $fontSetFile] {`
179			`source $fontSetFile`
180			`tixPref:InitFontSet:$data(-fontset)`
181			`tixAppContext:CheckFontSets $w`
182			`tixPref:SetFontSet:$data(-fontset)`
183			`} else {`
184			`tixAppContext:StartupError \`
185			`"\aError: cannot use fontset \"$data(-fontset)\""`
186			`tixAppContext:StartupError \`
187			`" Using default fontset "`
188			`tixSetDefaultFontset`
189			`tixAppContext:CheckFontSets $w`
190			`}`
191			`} else {`
192			`if [catch {`
193			`tixPref:InitFontSet:$data(-fontset)`
194			`tixAppContext:CheckFontSets $w`
195			`tixPref:SetFontSet:$data(-fontset)`
196			`}] {`
197			`# User chose non-existent fontset`
198			`#`
199			`tixAppContext:StartupError \`
200			`"\aError: cannot use fontset \"$data(-fontset)\""`
201			`tixAppContext:StartupError \`
202			`" Using default fontset "`
203			`tixSetDefaultFontset`
204			`tixAppContext:CheckFontSets $w`
205			`}`
206			`}`
207
208			`# Compatibility stuff: the obsolete name courier_font has been changed to`
209			`# fixed_font`
210			`set tixOption(courier_font) $tixOption(fixed_font)`
211			`}`
212
213			`proc tixAppContext:config-scheme {w value} {`
214			`upvar #0 $w data`
215			`global tix_priv`
216
217			`set data(-scheme) $value`
218
219			`# Load the color scheme`
220			`#`
221			`if {!$data(et)} {`
222			`set schemeName [tixFileJoin [tixFileJoin $data(-libdir) pref] \`
223			`$data(-scheme).csc]`
224			`if [file exists $schemeName] {`
225			`source $schemeName`
226			`if {[winfo depth .] >= 8} {`
227			`tixPref:SetScheme-Color:$data(-scheme)`
228			`} else {`
229			`tixPref:SetScheme-Mono:$data(-scheme)`
230			`}`
231			`} else {`
232			`tixAppContext:StartupError \`
233			`"\aError: cannot use color scheme \"$data(-scheme)\""`
234			`tixAppContext:StartupError \`
235			`" Using default color scheme"`
236			`if {[winfo depth .] >= 8} {`
237			`tixSetDefaultScheme-Color`
238			`} else {`
239			`tixSetDefaultScheme-Mono`
240			`}`
241			`}`
242			`} else {`
243			`if [catch {`
244			`if {[winfo depth .] >= 8} {`
245			`tixPref:SetScheme-Color:$data(-scheme)`
246			`} else {`
247			`tixPref:SetScheme-Mono:$data(-scheme)`
248			`}`
249			`}] {`
250			`# User chose non-existent color scheme`
251			`#`
252			`tixAppContext:StartupError \`
253			`"\aError: cannot use color scheme \"$data(-scheme)\""`
254			`tixAppContext:StartupError \`
255			`" Using default color scheme"`
256			`if {[winfo depth .] >= 8} {`
257			`tixSetDefaultScheme-Color`
258			`} else {`
259			`tixSetDefaultScheme-Mono`
260			`}`
261			`}`
262			`}`
263			`}`
264
265			`#----------------------------------------------------------------------`
266			`# Private methods`
267			`#`
268			`#----------------------------------------------------------------------`
269			`proc tixAppContext:BitmapInit {w} {`
270			`upvar #0 $w data`
271
272			`# See whether we have pixmap extension`
273			`#`
274			`set data(-haspixmap) true`
275
276			`# Dynamically set the bitmap directory`
277			`#`
278			`if {! $data(et)} {`
279			`set data(bitmapdirs) [list [tixFileJoin $data(-libdir) bitmaps]]`
280			`} else {`
281			`set data(bitmapdirs) ""`
282			`}`
283			`}`
284
285			`proc tixAppContext:FileDialogInit {w} {`
286			`upvar #0 $w data`
287
288			`if {$data(-filedialog) == ""} {`
289			`set data(-filedialog) [option get . fileDialog FileDialog]`
290			`}`
291			`if {$data(-filedialog) == ""} {`
292			`set data(-filedialog) tixFileSelectDialog`
293			`}`
294			`}`
295
296			`#----------------------------------------------------------------------`
297			`# If a font in the fontset is not available, use a default fontset.`
298			`#`
299			`proc tixAppContext:CheckFontSets {w} {`
300			`upvar #0 $w data`
301			`global tixOption tcl_version`
302
303			`if {$tcl_version >= "8.0"} {`
304			`# fonts will never fail ..`
305			`return`
306			`}`
307
308			`set default_font "fixed"`
309			`set options {font bold_font menu_font italic_font fixed_font}`
310
311			`if [winfo exists .tix-xxx-test] {`
312			`destroy .tix-xxx-test`
313			`}`
314			`set lab [label .tix-xxx-test]`
315			`foreach opt $options {`
316			`if [catch {$lab config -font $tixOption($opt)}] {`
317			`tixAppContext:StartupError \`
318			`"\aError: cannot use font \"$tixOption($opt)\" as \"$opt\""`
319			`puts stderr \`
320			`" using \"$default_font\" instead"`
321
322			`set tixOption($opt) $default_font`
323			`}`
324			`}`
325			`destroy $lab`
326			`}`
327
328			`#----------------------------------------------------------------------`
329			`# Public methods`
330			`#----------------------------------------------------------------------`
331			`proc tixAppContext:addbitmapdir {w bmpdir} {`
332			`upvar #0 $w data`
333
334			`if {[lsearch $data(bitmapdirs) $bmpdir] == "-1"} {`
335			`lappend data(bitmapdirs) $bmpdir`
336			`}`
337			`}`
338
339			`proc tixAppContext:getimage {w name} {`
340			`upvar #0 $w data`
341			`global tixPriv tix_priv`
342
343			`if {[info exists data(img:$name)]} {`
344			`return $data(img:$name)`
345			`}`
346
347			`if ![info exists tix_priv(isSafe)] {`
348			`foreach dir $data(bitmapdirs) {`
349			`if [file exists [tixFileJoin $dir $name.xpm]] {`
350			`if {![catch {`
351			`set data(img:$name) \`
352			`[image create pixmap -file [tixFileJoin $dir $name.xpm]]`
353			`}]} {`
354			`break`
355			`}`
356			`}`
357			`if [file exists [tixFileJoin $dir $name.gif]] {`
358			`global TRANSPARENT_GIF_COLOR`
359			`if {![catch {`
360			`set data(img:$name) \`
361			`[image create photo -file [tixFileJoin $dir $name.gif]]`
362			`}]} {`
363			`break`
364			`}`
365			`}`
366			`if [file exists [tixFileJoin $dir $name.ppm]] {`
367			`if {![catch {`
368			`set data(img:$name) \`
369			`[image create photo -file [tixFileJoin $dir $name.ppm]]`
370			`}]} {`
371			`break`
372			`}`
373			`}`
374			`if [file exists [tixFileJoin $dir $name.xbm]] {`
375			`if {![catch {`
376			`set data(img:$name) \`
377			`[image create bitmap -file [tixFileJoin $dir $name.xbm]]`
378			`}]} {`
379			`break`
380			`}`
381			`}`
382			`if [file exists [tixFileJoin $dir $name]] {`
383			`if {![catch {`
384			`set data(img:$name) \`
385			`[image create bitmap -file [tixFileJoin $dir $name]]`
386			`}]} {`
387			`break`
388			`}`
389			`}`
390			`}`
391			`}`
392
393			`if {![info exists data(img:$name)]} {`
394			`catch {`
395			`# This is for compiled-in images`
396			`set data(img:$name) [image create pixmap -id $name]`
397			`} err`
398			`if [string match internal* $err] {`
399			`error $err`
400			`}`
401			`}`
402
403			`if {[info exists data(img:$name)]} {`
404			`return $data(img:$name)`
405			`} else {`
406			`error "image file \"$name\" cannot be found"`
407			`}`
408			`}`
409
410
411			`proc tixAppContext:getbitmap {w bitmapname} {`
412			`upvar #0 $w data`
413			`global tix_priv`
414
415			`if {[info exists data(bmp:$bitmapname)]} {`
416			`return $data(bmp:$bitmapname)`
417			`} else {`
418			`set ext [file extension $bitmapname]`
419			`if {$ext == ""} {`
420			`set ext .xbm`
421			`}`
422
423			`# This is the fallback value. If we can't find the bitmap in`
424			`# the bitmap directories, then use the name of the bitmap`
425			`# as the default value.`
426			`#`
427			`set data(bmp:$bitmapname) $bitmapname`
428
429			`if [info exists tix_priv(isSafe)] {`
430			`return $data(bmp:$bitmapname)`
431			`}`
432
433			`foreach dir $data(bitmapdirs) {`
434			`case $ext {`
435			`.xbm {`
436			`if [file exists [tixFileJoin $dir $bitmapname.xbm]] {`
437			`set data(bmp:$bitmapname) \`
438			`@[tixFileJoin $dir $bitmapname.xbm]`
439			`break`
440			`}`
441			`if [file exists [tixFileJoin $dir $bitmapname]] {`
442			`set data(bmp:$bitmapname) @[tixFileJoin $dir $bitmapname]`
443			`break`
444			`}`
445			`}`
446			`default {`
447			`if [file exists [tixFileJoin $dir $bitmapname]] {`
448			`set data(bmp:$bitmapname) @[tixFileJoin $dir $bitmapname]`
449			`break`
450			`}`
451			`}`
452			`}`
453			`}`
454
455			`return $data(bmp:$bitmapname)`
456			`}`
457			`}`
458
459			`proc tixAppContext:filedialog {w {type tixFileSelectDialog}} {`
460			`upvar #0 $w data`
461
462			`if {$type == ""} {`
463			`set type $data(-filedialog)`
464			`}`
465			`if {![info exists data(filedialog,$type)]} {`
466			`set data(filedialog,$type) ""`
467			`}`
468
469			`if {$data(filedialog,$type) == "" \|\| ![winfo exists $data(filedialog,$type)]} {`
470			`set data(filedialog,$type) [$type .tixapp_filedialog_$type]`
471			`}`
472
473			`return $data(filedialog,$type)`
474			`}`
475
476			`proc tixAppContext:option {w action option {value ""}} {`
477			`upvar #0 $w data`
478			`global tixOption`
479
480			`if {$action == "get"} {`
481			`return $tixOption($option)`
482			`}`
483			`}`
484
485			`proc tixAppContext:platform {w} {`
486			`upvar #0 $w data`
487			`global tixPriv`
488
489			`if [info exists tixPriv(isWindows)] {`
490			`return windows`
491			`} else {`
492			`return unix`
493			`}`
494			`}`
495
496			`proc tixAppContext:StartupError {msg} {`
497			`catch {`
498			`puts stderr $msg`
499			`}`
500			`}`
501
502			`if [tixStrEq [info command toplevel] ""] {`
503			`proc toplevel {args} {`
504			`return eval frame $args`
505			`}`
506			`}`