Updated 2011-08-13 13:19:36 by RLE

Tagging variables with metadata ("an exercise in trace-abuse")
  # 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