This page has some type implementations in the framework mentioned in
OO libraries.
Summary- stream
- an abstract type.
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>
- dir
- is a subtype of type stream. Provides a stream abstraction of dir. Provides open, close, read, seek, tell methods.
- tell
- gives present position.
- seek
- moves the position.
- read
- item in present position and position is advanced.
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 } {
incr myref(position)
set pres_elem [ lindex $myref(items) $myref(position) ]
}
return $pres_elem
}
seek {
set index [lindex $args 2 ]
if {$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 ;
}
}
}
}
