--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/python-2.5.2/win32/tcl/tix8.4/Tix.tcl Fri Apr 03 17:19:34 2009 +0100
@@ -0,0 +1,398 @@
+# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
+#
+# $Id: Tix.tcl,v 1.13 2004/12/24 01:27:54 hobbs Exp $
+#
+# Tix.tcl --
+#
+# This file implements the Tix application context class
+#
+# Copyright (c) 1993-1999 Ioi Kim Lam.
+# Copyright (c) 2000-2001 Tix Project Group.
+# Copyright (c) 2004 ActiveState
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+tixClass tixAppContext {
+ -superclass {}
+ -classname TixAppContext
+ -method {
+ cget configure addbitmapdir filedialog getbitmap getimage
+ option platform resetoptions setbitmap initstyle
+ }
+ -flag {
+ -binding -debug -extracmdargs -filedialog -fontset -grabmode
+ -haspixmap -libdir -scheme -schemepriority -percentsubst
+ }
+ -readonly {
+ -haspixmap
+ }
+ -configspec {
+ {-binding TK}
+ {-debug 0}
+ {-extracmdargs 1}
+ {-filedialog ""}
+ {-fontset WmDefault}
+ {-grabmode global}
+ {-haspixmap 0}
+ {-libdir ""}
+ {-percentsubst 0}
+ {-scheme WmDefault}
+ {-schemepriority 21}
+ }
+ -alias {
+ }
+}
+
+proc tixAppContext:Constructor {w} {
+ upvar #0 $w data
+ global tix_priv tix_library tixOption
+
+ if {[info exists data(initialized)]} {
+ error "tixAppContext has already be initialized"
+ } else {
+ set data(initialized) 1
+ }
+
+ set data(et) [string equal $tix_library ""]
+ set data(image) 0
+
+ # These options were set when Tix was loaded
+ #
+ 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) [file normalize $tix_library]
+ }
+ set tixOption(prioLevel) $tix_priv(-schemepriority)
+
+ # Compatibility stuff: the obsolete name courier_font has been changed to
+ # fixed_font
+ set tixOption(fixed_font) Courier
+ set tixOption(courier_font) $tixOption(fixed_font)
+
+ # Enable/Disable Intrinsics debugging
+ #
+ set tix_priv(debug) [string is true -strict $data(-debug)]
+
+ tixAppContext:BitmapInit $w
+ tixAppContext:FileDialogInit $w
+
+ # Clean up any error message generated by the above loop
+ set ::errorInfo ""
+}
+
+proc tixAppContext:initstyle {w} {
+ # Do the init stuff here that affects styles
+
+ upvar #0 $w data
+ global tix_priv
+
+ 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
+ #
+ set noconfig [list -class -colormap -container -menu -screen -use -visual]
+ set noconfig [lsort $noconfig]
+ foreach spec [. configure] {
+ set flag [lindex $spec 0]
+ if {[llength $spec] != 5
+ || [lsearch -exact -sorted $noconfig $flag] != -1} {
+ continue
+ }
+ set name [lindex $spec 1]
+ set class [lindex $spec 2]
+ set value [option get . $name $class]
+ catch {. configure $flag $value}
+ }
+}
+
+#----------------------------------------------------------------------
+# 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:StartupError {args} {
+ bgerror [join $args "\n"]
+}
+
+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 [file join $data(-libdir) pref]
+ set fontSetFile [file join $prefDir $data(-fontset).fsc]
+ if {[file exists $fontSetFile]} {
+ source $fontSetFile
+ tixPref:InitFontSet:$data(-fontset)
+ tixPref:SetFontSet:$data(-fontset)
+ } else {
+ tixAppContext:StartupError \
+ " Error: cannot use fontset \"$data(-fontset)\"" \
+ " Using default fontset "
+ tixSetDefaultFontset
+ }
+ } else {
+ if [catch {
+ tixPref:InitFontSet:$data(-fontset)
+ tixPref:SetFontSet:$data(-fontset)
+ }] {
+ # User chose non-existent fontset
+ #
+ tixAppContext:StartupError \
+ " Error: cannot use fontset \"$data(-fontset)\"" \
+ " Using default fontset "
+ tixSetDefaultFontset
+ }
+ }
+}
+
+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 [file join [file join $data(-libdir) pref] \
+ $data(-scheme).csc]
+ if {[file exists $schemeName]} {
+ source $schemeName
+ tixPref:SetScheme-Color:$data(-scheme)
+ } else {
+ tixAppContext:StartupError \
+ " Error: cannot use color scheme \"$data(-scheme)\"" \
+ " Using default color scheme"
+ tixSetDefaultScheme-Color
+ }
+ } else {
+ if [catch {tixPref:SetScheme-Color:$data(-scheme)}] {
+ # User chose non-existent color scheme
+ #
+ tixAppContext:StartupError \
+ " Error: cannot use color scheme \"$data(-scheme)\"" \
+ " Using default color scheme"
+ tixSetDefaultScheme-Color
+ }
+ }
+}
+
+#----------------------------------------------------------------------
+# 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 [file join $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
+ }
+}
+
+#----------------------------------------------------------------------
+# 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 tix_priv
+
+ if {[info exists data(img:$name)]} {
+ return $data(img:$name)
+ }
+
+ if {![info exists tix_priv(isSafe)]} {
+ foreach dir $data(bitmapdirs) {
+ foreach {ext type} {
+ xpm pixmap
+ gif photo
+ ppm photo
+ xbm bitmap
+ "" bitmap
+ } {
+ set file [file join $dir $name.$ext]
+ if {[file exists $file]
+ && ![catch {
+ set img tiximage$data(image)
+ set data(img:$name) \
+ [image create $type $img -file $file]
+ }]} {
+ incr data(image)
+ break
+ }
+ }
+ if {[info exists data(img:$name)]} {
+ return $data(img:$name)
+ }
+ }
+ }
+
+ if {![info exists data(img:$name)]} {
+ catch {
+ set img tiximage$data(image)
+ # This is for compiled-in images
+ set data(img:$name) [image create pixmap $img -id $name]
+ } err
+ if {[string match internal* $err]} {
+ error $err
+ } else {
+ incr data(image)
+ }
+ }
+
+ 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) {
+ if {$ext eq ".xbm" &&
+ [file exists [file join $dir $bitmapname.xbm]]} {
+ set data(bmp:$bitmapname) \
+ @[file join $dir $bitmapname.xbm]
+ break
+ }
+ if {[file exists [file join $dir $bitmapname]]} {
+ set data(bmp:$bitmapname) @[file join $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 ""}} {
+ global tixOption
+
+ if {$action eq "get"} {
+ if {$option == ""} {return [lsort [array names tixOption]]}
+ return $tixOption($option)
+ }
+}
+
+proc tixAppContext:platform {w} {
+ return $::tcl_platform(platform)
+}
+
+proc tixDebug {message {level "1"}} {
+ set debug [tix cget -debug]
+ if {![string is true -strict $debug]} { return }
+
+ if {$debug > 0} {
+ # use $level here
+ if {[catch {fconfigure stderr}]} {
+ # This will happen under PYTHONW.EXE or frozen Windows apps
+ proc tixDebug args {}
+ } else {
+ puts stderr $message
+ }
+ }
+}
+
+if {![llength [info commands toplevel]]} {
+ interp alias {} toplevel {} frame
+}