[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 Tk
======

An 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}]
.b
======
Testing 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 ?

[APN] As an aside, if you are planning to use this as substitute for tclsh, note two minor issues - line continuations using backslashes are not handled correctly (meaning as in tclsh), and commands returning empty strings result in extraneous blank lines in the output. Both are simply fixed and left as an exercise for the reader.

<<categories>>Event Loop | Category Example