Posted to tcl by evilotto at Thu Sep 15 22:12:05 GMT 2011view raw

  1. # procedure to create macros that operate in caller's frame, with arguments
  2. # no default args yet
  3. proc macro {name formal_args body} {
  4. proc $name $formal_args [subst -nocommands {
  5. # locally save all formal variables, and set them in parent conext
  6. foreach _v [list $formal_args] {
  7. if {[uplevel 1 info exists \$_v]} {
  8. set __shadow__\$_v [uplevel 1 set \$_v]
  9. }
  10. uplevel 1 set \$_v [set \$_v]
  11. }
  12. uplevel 1 { $body }
  13. # undo formal variables
  14. foreach _v [list $formal_args] {
  15. if {[info exists __shadow__\$_v]} {
  16. uplevel 1 set \$_v [set __shadow__\$_v]
  17. } else {
  18. uplevel 1 unset \$_v
  19. }
  20. }
  21. }]
  22. }
  23.