Posted to tcl by evilotto at Fri Mar 14 17:50:15 GMT 2014view raw
- 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