Posted to tcl by evilotto at Thu Sep 15 22:12:05 GMT 2011view raw
- # 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
- }
- }
- }]
- }