Posted to tcl by evilotto at Fri Mar 14 17:50:15 GMT 2014view pretty

proc locals {args} {
    foreach vn $args {
        uplevel upvar 0 __locals($vn) $vn
    }
}

proc nonlocals {args} {
    foreach vn $args {
        if {[string match __* $vn]} continue
        uplevel upvar 2 $vn $vn
    }
}

proc scope {script} {
    set v [uplevel info vars]
    set vb "nonlocals $v\n"
    apply [list {} $vb$script]
}

proc scoped {cmd args} {
    switch $cmd {
        if {
            lassign $args expr body
            uplevel if $expr [list [list scope $body]]
        }
        while {
            lassign $args test body
            uplevel while $test [list [list scope $body]]
        }
        foreach {
            set body [lindex $args end]
            set cmd [lreplace $args end end [list [list scope $body]]]
            uplevel foreach {*}$cmd
        }
        default {error "$cmd unsupported"}
    }
}

set a 1
if {true} {
   set b 1
}
puts "b=$b"
scoped if {true} {
   nonlocals b c d
   set c 1
   set b 2
   puts "c=$c b=$b"
}
puts "b=$b"
puts "c=$c b=$b"
puts "d=$d"


set l {1 2 3}
foreach x $l {
   puts $x
   set a $l
}
puts $a
unset a