diff -r 000000000000 -r ae805ac0140d python-2.5.2/win32/tcl/tix8.4/Variable.tcl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/python-2.5.2/win32/tcl/tix8.4/Variable.tcl Fri Apr 03 17:19:34 2009 +0100 @@ -0,0 +1,101 @@ +# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*- +# +# $Id: Variable.tcl,v 1.4 2001/12/09 05:04:02 idiscovery Exp $ +# +# Variable.tcl -- +# +# Routines in this file are used to set up and operate variables +# for classes that support the -variable option +# +# Copyright (c) 1993-1999 Ioi Kim Lam. +# Copyright (c) 2000-2001 Tix Project Group. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# + + + +# tixVariable:ConfigVariable -- +# +# Set up the -variable option for the object $w +# +# Side effects: +# +# data(-variable) is changed to the name of the global variable +# if the global variable exists, data(-value) takes the value of this +# variable. +# if the global variable does not exist, it is created with the +# current data(-value) +# +# Return value: +# +# true is data(-value) is changed, indicating that data(-command) +# should be invoked. +# +proc tixVariable:ConfigVariable {w arg} { + upvar #0 $w data + + set changed 0 + + if {$data(-variable) != ""} { + uplevel #0 \ + [list trace vdelete $data(-variable) w "tixVariable:TraceProc $w"] + } + + if {$arg != ""} { + if {[uplevel #0 info exists [list $arg]]} { + # This global variable exists, we use its value + # + set data(-value) [uplevel #0 set [list $arg]] + set changed 1 + } else { + # This global variable does not exist; let's set it + # + uplevel #0 [list set $arg $data(-value)] + } + uplevel #0 \ + [list trace variable $arg w "tixVariable:TraceProc $w"] + } + + return $changed +} + +proc tixVariable:UpdateVariable {w} { + upvar #0 $w data + + if {$data(-variable) != ""} { + uplevel #0 \ + [list trace vdelete $data(-variable) w "tixVariable:TraceProc $w"] + uplevel #0 \ + [list set $data(-variable) $data(-value)] + uplevel #0 \ + [list trace variable $data(-variable) w "tixVariable:TraceProc $w"] + + # just in case someone has another trace and restricted my change + # + set data(-value) [uplevel #0 set [list $data(-variable)]] + } +} + +proc tixVariable:TraceProc {w name1 name2 op} { + upvar #0 $w data + set varname $data(-variable) + + if {[catch {$w config -value [uplevel #0 [list set $varname]]} err]} { + uplevel #0 [list set $varname [list [$w cget -value]]] + error $err + } + return +} + +proc tixVariable:DeleteVariable {w} { + upvar #0 $w data + + # Must delete the trace command of the -variable + # + if {$data(-variable) != ""} { + uplevel #0 \ + [list trace vdelete $data(-variable) w "tixVariable:TraceProc $w"] + } +}