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.

}
 namespace eval ::IOStack {variable nextid 0}
#-- Constructor
 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
    set name
 }
#-- The dispatcher is aliased to the object name
 proc IOStack::dispatch {self method args} {
    import $self stack ptr source drain
    switch -- $method {
	next {
	    incr ptr
	    if {$ptr>=[llength $stack]} {
		lappend stack [$source]
	    }
	    $drain $ptr:[lindex $stack $ptr]
	}
	back {
	    if $ptr {
		incr ptr -1
		$drain [lindex $stack $ptr]
	    }
	}
	see {puts [list $ptr $stack]}
	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]
    }
 }
#--------------------------------------- Testing
 set stack [IOStack::IOStack src drn]
 puts stack:$stack
 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}
    }
 }