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

proc evalwith {eval commands script} {
    set eval [uplevel 1 namespace which -command [list $eval]]
    set ns [newns]
    set path [uplevel 1 {linsert [namespace path] 0 [namespace current]}]
    namespace eval $ns [list namespace path $path]
    foreach cmd $commands {
        interp alias {} ${ns}::$cmd {} $eval $cmd
    }
    interp alias {} ${ns}::self {} ::uplevel 1 self
    try {
        uplevel 1 [list namespace eval $ns $script]
    } finally {
        namespace delete $ns
    }
}

if 0 {
    oo::class create Test {
        method foo {args} {
            debug log {[self] foo $args}
        }
        method bar {args} {
            debug log {[self] bar $args}
        }
        method block {name script} {
            debug log {[self] block-enter $name}
            uplevel 1 $script
            debug log {[self] block-leave $name}
        }
    }
    Test create t
    evalwith t {foo bar block} {
        foo one
        foreach x {1 2 3} {
            bar $x
        }
        block "what's a now" {
            foo $x
            bar [incr x]
        }
    }

# common constructor pattern:
#   constructor {... script} {
#       ...
#       tailcall evalwith [self] [info object methods -all [self]]
#   }
}