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