[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 ports?) 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 {
variable orig_event
variable orig_config
variable result
variable error
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. Also, I changed the behaviour of read_accum so that it only sets the result once all data asked for has been read, which should better comply to what the regular read command does.
George Peter Staplin: I corrected the namespace usage with variable, because the namespace resolution rules outside outside of procedures are less than ideal. This may be fixed in the core for Tcl 9.0. For example:
$ tclsh8.4
% set g "I'm global"
I'm global
% namespace eval ::Timed { set g "I'm in ::Timed -- I think" }
I'm in ::Timed -- I think
% set g
I'm in ::Timed -- I think