Posted to tcl by mjanssen at Tue Apr 20 15:15:58 GMT 2021view pretty
package require http namespace eval with { oo::class create FileCtxt { variable res method enter args { variable res [open {*}$args] return $res } method exit {} { variable res return [close $res] } } oo::class create HttpCtxt { variable res method enter args { variable res [http::geturl {*}$args] return $res } method exit {} { variable res return [http::cleanup $res] } } proc register {command contextCreator} { proc $command {varName args} [string map [list @@ $contextCreator] { if {[llength $args] < 1} { error "no block provided" } set block [lindex $args end] set ctxt [{*}@@] ; upvar 1 $varName res set res [$ctxt enter {*}[lrange $args 0 end-1]] ; set result [uplevel 1 $block] ; $ctxt exit return $result }] # Eval $block with $name s proc alias {alias target block} { set old [interp alias {} $alias] interp alias {} $alias {} $target set result [uplevel 1 $block] interp alias {} $alias {} $old return $result } } register ::with::file [list ::with::FileCtxt new] register ::with::http [list ::with::HttpCtxt new] }