# jcw, 2003-02-09
proc vtag {vref args} {
if {[llength $args] > 1} { error "wrong # of args: vtag $vref ?value?" }
upvar 1 $vref v
foreach x [trace info variable v] {
if {[llength [lindex $x 0]] == 1 && [llength [lindex $x 1]] == 2 &&
[lindex $x 0] eq "unset" && [lindex $x 1 0] eq "#vtag#"} {
set r [lindex $x 1 1]
if {[llength $args] == 0} {
return $r
} else {
trace remove variable v unset $r
}
}
}
if {[llength $args] == 0} { error "no vtag set on $vref" }
set y [lindex $args 0]
trace add variable v unset [list #vtag# $y]
return $y
}
set a 1
puts " a = $a"
catch { vtag a } e
puts " vtag a = error: $e"
puts " SETTING VTAG OF A TO AHA..."
vtag a aha
puts " vtag a = [vtag a]"
puts " UNSET A"
unset a
catch { vtag a } e
puts " vtag a = error: $e"Output:
a = 1 vtag a = error: no vtag set on a SETTING VTAG OF A TO AHA... vtag a = aha UNSET A vtag a = error: no vtag set on a
