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