Posted to tcl by evilotto at Thu Sep 15 22:12:05 GMT 2011view pretty
# procedure to create macros that operate in caller's frame, with arguments # no default args yet proc macro {name formal_args body} { proc $name $formal_args [subst -nocommands { # locally save all formal variables, and set them in parent conext foreach _v [list $formal_args] { if {[uplevel 1 info exists \$_v]} { set __shadow__\$_v [uplevel 1 set \$_v] } uplevel 1 set \$_v [set \$_v] } uplevel 1 { $body } # undo formal variables foreach _v [list $formal_args] { if {[info exists __shadow__\$_v]} { uplevel 1 set \$_v [set __shadow__\$_v] } else { uplevel 1 unset \$_v } } }] }