This page has some type implementations in the framework mentioned in OO libraries.
Summary
The subtypes of this type need to provide the implementations for open, close, read, seek, tell. It presently provides foreach implementation.
foreach - foreach <obj> <picked_item> <block to act on picked item>
Usage
dir create a /tmp # object creation
> read a # reads the current item in the stream
> foreach a item { puts $item } # foreach is the iterator for the stream items.Modified proc ">"
proc > { args } {
set obj [lindex $args 1 ]
upvar $obj myobj
set handler $myobj(handler)
set myobj(level) [ expr [info level] - 1 ]
lvarpop args 1
lvarpush args myobj 1
$handler $args
}Type implementations:
Dir - type
package require Tclx
proc dir { args } {
if {! [ string equal [lindex $args 0] create ] } {
set args [lindex $args 0]
}
set ref [lindex $args 1 ]
set action [lindex $args 0]
upvar $ref myref
switch $action \
create {
array set myref [list handler dir]
array set myref [list dir [lindex $args 2 ]]
array set myref [list items [ glob $myref(dir)/* ] ]
array set myref [list position -1 ]
} \
open {
array set myref [list position -1 ]
} \
read {
set pres_elem {}
set max_position [ expr [llength $myref(items)] - 1 ]
if { $myref(position) < $max_position } {
set myref(position) [ expr $myref(position) + 1 ]
set pres_elem [ lindex $myref(items) $myref(position) ]
}
return $pres_elem
} \
seek {
set index [lindex $args 2 ]
if [ expr $index < [ llength $myref(items)] ] {
array set myref [list position [lindex $args 2] ]
}
} \
tell {
return $myref(position)
} \
close {
array set myref [list position -1 ]
} \
default {
lvarpop args 1
lvarpush args myref 1
set myargs $args
stream $myargs
}
}Stream - type
proc stream { myargs } {
set args $myargs
set ref [lindex $args 1 ]
set action [lindex $args 0]
upvar $ref myref
set handler $myref(handler)
switch $action \
foreach {
$handler {open myref}
while 1 {
set item [ $handler {read myref} ]
if { $item != {} } {
upvar $myref(level) [lindex $args 2 ] elem
set elem $item
uplevel $myref(level) [lindex $args 3 ]
} else {
break ;
}
}
}
}