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