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]
}