Posted to tcl by pooryorick at Wed Nov 13 19:39:52 GMT 2013view pretty
#! /bin/env tclsh proc invoke {command handler} { lassign [chan pipe] stderr stderrin lappend command 2>@$stderrin set stdout [open |$command] set handler1 [namespace current]::[info cmdcount] coroutine $handler1 {*}$handler fileevent $stderrin writable [list apply {{stdout stderrin} { if {[chan names $stdout] eq {} || [eof $stdout]} { close $stderrin } }} $stdout $stderrin] fileevent $stdout readable [list $handler1 [list stdout $stdout]] fileevent $stderr readable [list $handler1 [list stderr $stderr]] } proc handler {onstdout onstderr onexit} { set done {} lassign [yield [info level 0]] mode chan while 1 { if {[set data [gets $chan]] eq {}} { if {[eof $chan]} { lappend done $mode if {[catch {close $chan} cres e]} { dict with e {} lassign [set -errorcode] sysmsg pid exit if {$sysmsg == "NONE"} { #output to stderr caused [close] to fail. Do nothing } elseif {$sysmsg eq "CHILDSTATUS"} { {*}$onexit $exit } else { return -options $e $stderr } } if {[llength $done] == 2} { return } else { lassign [yield] mode chan } } else { lassign [yield] mode chan } } else { {*}[set on$mode] $data lassign [yield] mode chan } } } set command { puts stdout {hi to stdout} puts stderr {hi to stderr} exit 42 } invoke [list tclsh <<$command] [list handler [list apply {{data} { puts -nonewline "here comes some stdout: " puts $data }}] [list apply {{data} { puts -nonewline "here comes some stderr: " return -code error "an error!" puts $data }}] [list apply {{code} { set ::exit 1 puts $code }}]] vwait exit