Artifact
70317d0e8c830a528faae4bfbedee46abec0ebfb:
Attachment "mychan.tcl" to
ticket [2936225fff]
added by
ferrieux
2010-03-09 06:17:41.
set fast [open /dev/zero r]
fconfigure $fast -translation binary
set slow stdout;#[lindex [chan pipe] 1]
fconfigure $slow -translation binary
proc d {} {puts stderr MYCHAN:[info level -1]}
namespace eval mychan {
proc blocking {mychan mode} {d;fconfigure $::slow -blocking $mode}
proc watch {mychan eventspec} {d
if {[regexp {write} $eventspec]} {
fileevent $::slow writable [list chan postevent $mychan write]
} else {
fileevent $::slow writable {}
}
}
proc readable {mychan} {d;chan postevent $mychan read}
proc writable {mychan} {d;chan postevent $mychan write}
proc read {mychan n} {d
set result [chan read $::slow $n]
if {![string length $result] &&
![chan configure $chan -blocking] &&
![chan eof $chan]} {
return -code error EAGAIN
}
return $result
}
proc write {mychan data} {d
flush $::slow
if {[chan pending output $::slow]>0} {
error EAGAIN
}
puts -nonewline $::slow $data
return [string length $data]
}
proc initialize {mychan mode} {d;return [list initialize finalize blocking watch read write cget cgetall configure]}
proc configure {mychan option value} {d}
proc finalize {mychan} {d}
proc cget {mychan option} {d}
proc cgetall {mychan} {d}
namespace export *
namespace ensemble create
}
proc finish args {
set ::done 1
}
set ref [chan create write mychan]
fconfigure $ref -blocking 0
fcopy $fast $ref -command finish -size 1000000
vwait done
