[Group project!]
########
#
# After at most $timeout milliseconds, return a string of at most $number_of_characters.
#
# [Hide stuff inside some namespace.]
#
########
proc read_with_timeout {channel number_of_characters timeout} {
# Preserve existing fileevent on $channel in order to restore it on return.
# Define timeout handler.
# Create character-at-a-time fileevent handler which accumulates result string.
# Restore original fileevent.
}
# Variation, from entirely different direction: Expect's timeout.
# Also note that some channels (serial lines?) already admit timeout configuration. # Is it time for a TIP to propose that Tcl do this for all platforms/devices/...?
Not sure why you only want to have a "character-at-a-time" fileevent handler, but if you care to do this more efficiently (reading in chunks), does something like the following do what you want? (forgive the verbosity and lack of testing, I just coded this up in a few minutes)- Todd Coram
namespace eval ::timed {
array set orig_event [list]
array set orig_config [list]
array set result [list]
array set error [list]
proc read {channel count timeout} {
variable orig_event
variable orig_config
variable error
variable result
set orig_event($channel) [fileevent $channel readable]
set orig_config($channel) [fconfigure $channel]
set result($channel) ""
set error($channel) ""
fconfigure $channel -blocking 0
set timer_id [after $timeout \
[namespace code [list cancel $channel "timeout"]]]
fileevent $channel readable\
[namespace code [list read_accum $channel $count ""]]
vwait ::timed::result($channel)
after cancel $timer_id
if {[llength $orig_event($channel)] > 0} {
fileevent $channel readable $orig_event($channel)
}
eval fconfigure $channel $orig_config($channel)
if {$error($channel) != ""} {
error $error($channel)
}
return $result($channel)
}
proc gets { channel timeout { line_p "" } } {
if { $line_p ne "" } {
upvar $line_p line
}
set size 0
set line ""
while { 1 } {
if { [catch {[namespace current]::read $channel 1 $timeout} char] } {
return -1
} elseif { $char eq "\n" } {
if { $line_p eq "" } {
return $line
} else {
return [string length $line]
}
} else {
append line $char
}
}
}
proc read_accum {channel count accum} {
variable result
set bytes [::read $channel $count]
if {[eof $channel]} {
cancel $channel "eof"
return
}
append accum $bytes
incr count -[string bytelength $bytes]
if {$count > 0} {
fileevent $channel readable \
[namespace code [list read_accum $channel $count $accum]]
} else {
set result($channel) $accum
}
}
proc cancel {channel reason} {
variable result
variable error
set result($channel) ""
set error($channel) "[namespace current]::read failed: $reason"
}
}EF I have modified the code above so that it also supports a gets-level. The code does no buffering, so it is not for production use.