[[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 port]s?) 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 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

Furthermore I think that [string bytelength] is probably not what is desired.  It's rarely what is needed even with binary data.  See the manual and wiki pages for [string bytelength]. 

----
[George Peter Staplin] Jan 9, 2006 - I wrote my own solution to this problem.  It seems to work properly based on my testing.  I used patterns from [An Alternative to Namespace] for creating code that should support any namespace.  You can also of course use '''cat file.tcl | sed s/NS_/whatever/g > whatever.tcl'''

 # By George Peter Staplin
 # Revision 5

 proc NS_gets {fd timeout} {
  #
  # NS_read emulates gets when len is -1.
  #
  NS_read $fd -1 $timeout
 }
 
 proc NS_read {fd len timeout} {
  global NS_read_state
 
  set NS_read_state($fd,error) 0
  set NS_read_state($fd,remaining) $len
  set NS_read_state($fd,timeout) [after $timeout [list NS_read.abort $fd]]
  set NS_read_state($fd,pending_data) ""
  set NS_read_state($fd,data) ""
  set NS_read_state($fd,old_fileevent) [fileevent $fd readable]
  set NS_read_state($fd,old_blocking) [fconfigure $fd -blocking]
 
  fconfigure $fd -blocking 0
 
  fileevent $fd readable [list NS_read.callback $fd]
 
  vwait NS_read_state($fd,data)
 
  #
  # Copy the data object so that we can cleanup the NS_read_state array.
  #
  set data $NS_read_state($fd,data)
 
  #
  # Copy the error object for the same reason as above.
  #
  set error $NS_read_state($fd,error)
 
  #
  # Replace the fileevent with the previous fileevent handler.
  # We do this so that any fileevent handler prior to NS_read will be restored.
  #
  fileevent $fd readable $NS_read_state($fd,old_fileevent)
 
 
  #
  # Restore the original blocking mode, so that any other fileevents
  # or reads will work as before the NS_read/NS_gets.
  #
  fconfigure $fd -blocking $NS_read_state($fd,old_blocking)
 
  #
  # Cleanup the state, because we are about to return.
  #
  array unset NS_read_state $fd,*
 
  
  if {$error} {
   #
   # A timeout error occured during the read.
   #
   return -code error $data
  }
 
  return $data
 }
 
 proc NS_read.callback fd {
  global NS_read_state
 
  if {-1 == $NS_read_state($fd,remaining)} {
   #
   # We are supposed to emulate gets, so read until \n
   #
   append NS_read_state($fd,pending_data) [set c [read $fd 1]]
 
   if {"\n" eq $c} {
    # 
    # This causes the vwait in NS_read to release, so that we
    # can return a result in NS_read.
    #
    set NS_read_state($fd,data) $NS_read_state($fd,pending_data)
 
    #
    # Cancel the timeout, because we are done reading, and we don't
    # want it firing now that we have all of the data.
    #
    after cancel $NS_read_state($fd,timeout)
   }
   return
  }
 
  append NS_read_state($fd,pending_data) \
    [set chunk [read $fd $NS_read_state($fd,remaining)]]
 
  #
  # We could use incr var -[string length ...] but that results in shimmering.
  # This is a little faster normally, because it avoids shimmering.
  #
  set NS_read_state($fd,remaining) \
    [expr {$NS_read_state($fd,remaining) - [string length $chunk]}]
 
  if {$NS_read_state($fd,remaining) <= 0} {
   set NS_read_state($fd,data) $NS_read_state($fd,pending_data)
   after cancel $NS_read_state($fd,timeout)
  }
 }
 
 proc NS_read.abort fd {
  global NS_read_state
 
  #
  # The timeout was reached before enough data could be read.
  # By setting the error key, and the data in this manner the
  # NS_read will return -code error with the data as the message.
  #
  set NS_read_state($fd,error) 1
  set NS_read_state($fd,data) "NS_read timeout"
 }
 
 proc main { } {
 
  puts -nonewline "NS_read enter 4 characters followed by Return: "
  flush stdout
  puts READ10:[NS_read stdin 5 3000]
 
  puts -nonewline "NS_gets: "
  flush stdout
  puts GETS:[NS_gets stdin 3000]
 
  catch {vwait forever}
 }
 main

----
[Category File]