Updated 2015-03-02 02:23:01 by RLE

if 0 {Richard Suchenwirth 2005-03-23 - I needed this thing to be able to backtrack a display tool, which receives instructions from a pipe on stdin. So I thought up a stack object (framework-less OO :^) with a next and a back method to walk up and down the stack, and callbacks for a data source (to extend the stack from) and "drain" (it doesn't really drain anything, it just displays it). The stack only grows over time. }
 namespace eval ::IOStack {variable nextid 0}
#-- The constructor takes the names of the two callbacks, and creates a namespace for the object:
 proc IOStack::IOStack {source drain} {
    variable nextid
    set name [namespace current]::[incr nextid]
    set vars [list variable stack {} ptr -1 source $source drain $drain]
    namespace eval $name $vars
    interp alias {} $name {} [namespace current]::dispatch $name
    # returns the name
#-- The dispatcher contains the methods, and is aliased to the object name
 proc IOStack::dispatch {self method args} {
    import $self stack ptr source drain
    switch -- $method {
        next {
            if {[incr ptr]>=[llength $stack]} {lappend stack [$source]}
            $drain $ptr:[lindex $stack $ptr]
        back    {if $ptr {$drain [lindex $stack [incr ptr -1]]}}
        see     {puts [list $ptr $stack] ;#-- for debugging}
        default {error "bad method $method, must be 'next' or 'back'"}
#-- Utility for linking variables from a namespace
 proc import {ns args} {
    foreach name $args {uplevel 1 [list upvar #0 ${ns}::$name $name]}

if 0 {The last command is the only thing here that resembles vaguely an OO "framework", except in size - if you can live without "class", "method" sugar, Tcl's namespace facility (for giving an object's instance variables a safe home) and interp alias (to redirect the popular
 $object method arg...

way of calling to the generic dispatcher) are perfectly sufficient for rapid OO without any dependencies.

There is no explicit destructor - delete all traces of your stack with
 namespace delete $stack

Now testing:}
 set stack [IOStack::IOStack src drn]
#-- Callbacks for "source" and "drain":
 proc src {} {
    puts -nonewline "new data: "
    flush stdout
    gets stdin
 proc drn item {
    puts "draining $item"
#-- "keyboard event loop"
 while 1 {
    puts -nonewline "> "
    flush stdout
    gets stdin cmd
    switch -- $cmd {
        q {break}
        + {$stack next}
        - {$stack back}
        . {$stack see}

See also Skeleton OO for a variant where methods are implemented as procs.