Posted to tcl by aspect at Sun May 15 10:47:53 GMT 2011view pretty

#  Illustration for how [global] and [variable] (mostly) can be implemented
# in terms of [upvar]

# http://www.tcl.tk/man/tcl8.6/TclCmd/global.htm
proc global {args} {
    foreach name $args {
        uplevel 1 [list upvar #0 $name [namespace tail $name]]
    }
}

# http://www.tcl.tk/man/tcl8.6/TclCmd/variable.htm
proc variable {args} {
    # from outside a [proc] this should just do set
    if {"namespace" == [lindex [dict get [info frame 1] cmd] 0]} {
        if {[llength $args] == 1} {
            # we cannot create undefined variables, so we break the spec
            # but setting $var = {}
            uplevel 1 [list set $args {}]
        } else {
            foreach {name val} $args {
                uplevel 1 [list set $name $val]
            }
        }
    } else {
        set ns [uplevel 1 {namespace current}]
        if {[llength $args] == 1} {
            set localname [namespace tail $name]
            if [string match ::* $name] {
                set upname $name
            } else {
                set upname $ns::$name
            }
            uplevel 1 [list upvar #0 $upname $localname]
        }
        foreach {name val} $args {
            set localname [namespace tail $name]
            if [string match ::* $name] {
                set upname $name
            } else {
                set upname $ns::$name
            }
            uplevel 1 [list upvar #0 $upname $localname]
            uplevel 1 [list set $name $val]
        }
    }
}