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
set 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]}
}#---------------- 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}
}
}