[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 $in 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
    }

<<categories>>Event Loop