Posted to tcl by aspect at Mon Sep 08 02:51:01 GMT 2014view raw

  1. proc evalwith {eval commands script} {
  2. set eval [uplevel 1 namespace which -command [list $eval]]
  3. set ns [newns]
  4. set path [uplevel 1 {linsert [namespace path] 0 [namespace current]}]
  5. namespace eval $ns [list namespace path $path]
  6. foreach cmd $commands {
  7. interp alias {} ${ns}::$cmd {} $eval $cmd
  8. }
  9. interp alias {} ${ns}::self {} ::uplevel 1 self
  10. try {
  11. uplevel 1 [list namespace eval $ns $script]
  12. } finally {
  13. namespace delete $ns
  14. }
  15. }
  16.  
  17. if 0 {
  18. oo::class create Test {
  19. method foo {args} {
  20. debug log {[self] foo $args}
  21. }
  22. method bar {args} {
  23. debug log {[self] bar $args}
  24. }
  25. method block {name script} {
  26. debug log {[self] block-enter $name}
  27. uplevel 1 $script
  28. debug log {[self] block-leave $name}
  29. }
  30. }
  31. Test create t
  32. evalwith t {foo bar block} {
  33. foo one
  34. foreach x {1 2 3} {
  35. bar $x
  36. }
  37. block "what's a now" {
  38. foo $x
  39. bar [incr x]
  40. }
  41. }
  42.  
  43. # common constructor pattern:
  44. # constructor {... script} {
  45. # ...
  46. # tailcall evalwith [self] [info object methods -all [self]]
  47. # }
  48. }
  49.  
  50.