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 
            }
        }
    }]
}