Posted to tcl by kbk at Wed Jun 10 22:20:02 GMT 2009view pretty
proc cgets {chan args} { if {[llength $args] == 1} { upvar 1 [lindex $args 0] line } elseif {[llength $args] > 1} { return -code error "wrong \# args, should be \"[lindex [info level 0] 0] channel ?variable?\"" } while {1} { set blocking [fconfigure $chan -blocking] fconfigure $chan -blocking 0 set status [catch {gets $chan line} result opts] if {$status} { fconfigure $chan -blocking $blocking return -code $status -options $opts } elseif {[fblocked $chan]} { fileevent $chan readable [list [info coroutine]] yield fileevent $chan readable {} } else { fconfigure $chan -blocking $blocking if {[llength $args] == 1} { return $result } else { return $line } } } } coroutine foo apply {{} { while {[cgets stdin line] >= 0} { puts $line } set ::finished 1 }} vwait finished