Posted to tcl by kbk at Wed Jun 10 22:20:02 GMT 2009view raw
- 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