Posted to tcl by aspect at Thu Sep 11 04:47:17 GMT 2014view pretty
# # for providing commands: # eg: [evalwith $obj [info object methods -all $obj] $script # will make all methods of obj available as top-level commands 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 } } # from the wiki - extend an ensemble with new commands proc extend {ens script} { namespace eval $ens [concat { proc _unknown {ens cmd args} { if {$cmd in [namespace eval ::${ens} {::info commands}]} { set map [namespace ensemble configure $ens -map] dict set map $cmd ::${ens}::$cmd namespace ensemble configure $ens -map $map } return "" ;# back to namespace ensemble dispatch } } \; $script] namespace ensemble configure $ens -unknown ${ens}::_unknown } extend dict { # dict lambda can create a lambdaexpr with the dict keys as params, defaulted to their values proc lambda {dict script} { tailcall ::lambda [lmap {k v} $dict {list $k $v}] $script } } extend array { # like [dict with], but for an array # and without leaking. So it needs a namespace argument proc with {_array script {ns ""}} { upvar 1 $_array a set prelude [lmap name [array names a] { list upvar 1 a($name) $name }] set prelude [join $prelude \n] set script $prelude\n$script if {$ns eq ""} {set ns [list $ns]} apply [list {} $script {*}$ns] } }