# deref.tcl # # Copyright 2001 by Larry Smith # Wild Open Source, Inc # License: BSD # # deref will return the value of the given variable name. # If followed by an integer count, it will continue to # dereference the name until it reaches the specified # depth. If no depth is specified, it will continue to # dereference until a value is found not starting with # a $. proc name { varname { depth 0 } } { set prevname "" if { $depth == 0 } { set varname \$$varname while { [ string index $varname 0] == "\$" } { set varname [ string range $varname 1 end ] set prevname $varname set varname [ uplevel set $varname ] } } for { set i 0 } { $i < $depth } { incr i } { set prevname $varname set varname [ uplevel set $varname ] } return $prevname } proc value { varname { depth 0 } } { if { $depth == 0 } { set varname \$$varname while { [ string index $varname 0] == "\$" } { set varname [ string range $varname 1 end ] set varname [ uplevel set $varname ] } } for { set i 0 } { $i < $depth } { incr i } { set varname [ uplevel set $varname ] } return $varname } #---------------------------------- # test and demo source deref.tcl set a b set b c set c d if { "d" == "[value a 3 ]" } { puts "test 1: pass" } else { puts "test 1: fail" } set [ name a 3 ] "x" if { "x" == "[value a 3 ]" } { puts "test 2: pass" } else { puts "test 2: fail" } set a \$b set b \$c set c d if { "d" == "[ value a ]" } { puts "test 3: pass" } else { puts "test 3: fail" } set [ name a ] "x" if { "x" == "[value a ]" } { puts "test 4: pass" } else { puts "test 4: fail" } set a x if { "x" == "[ value a ]" } { puts "test 5: pass" } else { puts "test 5: fail" } set [name a] "y" if { "y" == "[ value a ]" } { puts "test 6: pass" } else { puts "test 6: fail" } set [name a 1 ] "x" if { "x" == "[ value a 1 ]" } { puts "test 7: pass" } else { puts "test 7: fail" }