NEM 2009-07-31: Here's a simple interactive tclsh-style application, with the difference that it runs inside a coroutine. This allows you to have complex event-driven interactions appear as if they are happening in a blocking, non-event-driven manner. For example, you can have Tk GUI applications responding to events while you are apparently in a blocking HTTP request.
# corotcl --
#
# A coroutine-enabled tclsh
#
package require Tk
proc lambda {params body args} {
list ::apply [list $params $body] {*}$args
}
proc prompt p {
puts -nonewline "$p "
flush stdout
fileevent stdin readable [lambda return {
$return [gets stdin]
} [info coroutine]]
yield
}
proc get-command {} {
set cmd [prompt %]
while {![info complete $cmd]} {
append cmd \n [prompt >]
}
return $cmd
}
proc repl {} {
while 1 {
set cmd [get-command]
set code [catch { uplevel #0 $cmd } result opts]
if {$code == 1} {
puts [dict get $opts -errorinfo]
} else { puts $result }
}
}
coroutine main repl
#vwait forever ;# if no TkAn example of use. First, we bring up a simple Tk interface to check that everything keeps running in the background:
% pack [button .b -text Test -command {puts Test}]
.bTesting this will show that it does print "Test" in the console when clicked. So far, so normal. Now, we create a coroutine-enabled version of http::geturl:
% package require http
2.7.2
% proc fetch url {
> http::geturl $url -command [info coroutine]
> yield
> }We can now use this to fetch data from the web, just like the usual geturl. The difference is that this works in the background: you can still click on the Tk button and it will still print to the console even while the fetch is still in progress:
% set t [fetch http://wiki.tcl.tk/4] Test Test Test ::http::1
There we go: an interactive Tcl interpreter that is fully coroutine enabled.
Next step? Futures?
CMcC - 2009-07-31 11:36:54
Very cool.
Here's a variant which uses a TclOO object called Shell so one can have multiple of these constructed with different chans as i/o. If you construct it with a 'port' argument, it'll listen on localhost.
# Shell -- a coroutine enabled tcl evaluator
#
# From Neil Madden's corotcl http://wiki.tcl.tk/24060
#
# Usage:
#
# [Shell new] - create a shell listening on stdio
# [Shell new in $chan out $chan] - shell connected to chan
# [Shell new port $port] - shell server on localhost port $port
package require TclOO
namespace import oo::*
package provide Shell
class create Shell {
variable interp
constructor {args} {
# prompt for input, collect it and return
proc prompt {in out p} {
puts -nonewline $out "$p "
chan flush $out
chan event $in readable [list ::apply {{return in} {
$return [gets $in]
}} [info coroutine] $in]
return [yield]
}
# read-eval-print loop - prompt, gets input, evaluate it, print result
proc repl {self in out} {
variable interp
while {1} {
set cmd [prompt $in $out %]
while {![info complete $cmd]} {
append cmd \n [prompt $in $out >]
}
try {
{*}$interp $cmd
} on error {result eo} {
puts $out [dict get $eo -errorinfo]
} on return {result} {
break
} on ok {result} {
puts $out $result
}
}
# close the i/o unless it's stdio
if {$in ne "stdin"} {
chan close $in read
} else {
chan event $in readable {} ;# stop listening to stdin
}
if {![string match std* $out]} {
chan close $out write
}
return $result
}
set interp {uplevel #0}
set in stdin; set out "";# default - use stdio
set host localhost ;# default - listen only to localhost
dict with args {
if {[info exists port]} {
# what is wanted is a listener
socket -server [list ::apply {{sock addr port} {
set shell [Shell new in $sock]
}}] -myaddr $host $port
} else {
# we have a chan (or a couple of chans)
if {$out eq ""} {
if {$in eq "stdin"} {
set out stdout
} else {
set out $in
}
}
chan configure $out -buffering line
coroutine [self]_CORO repl [self] $in $out
}
}
}
}
if {[info exists argv0] && ($argv0 eq [info script])} {
puts "Shell on stdio"
Shell new
puts "Shell on localhost port 8082"
Shell new port 8082 interp {uplevel #1}
vwait forever
}CMcC - 2009-07-31 22:31:19
Further development of Shell has been moved into Wub. For the latest version (including a login facility) please consult: http://code.google.com/p/wub/source/browse/trunk/Utilities/Shell.tcl
APN Could someone explain the following two points - how come the channel does not need to be set to non-blocking mode? Couldn't the [gets] block preventing the coroutine from yielding and effectively blocking the gui as well ? Secondly, without coroutines, I could see doing something like this using a combination of async reads and update. Do the caveats regarding use of update also apply to using coroutines? If not, why not. If yes, then what advantage do coroutines afford over async i/o and update in such scenarios ?