#! /bin/env tclsh
package require {ycl coro object}
package require {ycl math rand}
namespace import [yclprefix]::math::rand::randprint_256
package require {ycl shelf shelf}
namespace import [yclprefix]::proc::checkargs
package require {ycl format tcl}
namespace import [yclprefix]::format::tcl
rename tcl formattcl
[yclprefix] shelf shelf .spawn [namespace current]
#namespace eval [::info coroutine] [list formatter init chan {*}$chan]
#interp alias {} [::info coroutine]::append {} [namespace which append_unstarted]
#interp alias {} [::info coroutine]::command {} [::info coroutine]::formatter command
#interp alias {} [::info coroutine]::word {} [::info coroutine]::formatter word
proc finalize _ {
namespace upvar $_ chan chan endinfo endinfo sentinel sentinel
$_ formatter command {*}$endinfo $sentinel
$_ formatter chan flush
}
[namespace current] .method finalize
variable doc::init {
description {
}
args {
_ {
description {
}
}
chan {
description {
The channel to operate on .
}
}
}
}
proc init {_ args} {
namespace upvar $_ endinfo endinfo info info started started
checkargs $doc::init {*}$args
[formattcl .spawn ${_}::formatter] init chan $chan
$_ .method puts puts_unstarted
$_ .routine formatter
$_ .routine word $_ formatter word
$_ .routine command $_ formatter command
set started 0
set endinfo {}
set info {}
return $_
}
[namespace current] .method init
variable doc::put {
description {
write one record in the table to $chan .
}
}
proc puts_started {_ data} {
namespace upvar $_ chan chan info info sentinel sentinel started started
if {!$started} {
$_ startoutput
}
$_ formatter puts $data
}
proc puts_unstarted {_ args} {
$_ startoutput
$_ .method puts puts_started
tailcall $_ puts {*}$args
}
proc startoutput _ {
namespace upvar $_ info info sentinel sentinel started started
set sentinel [randprint_256]
$_ formatter command $sentinel {*}$info
set started 1
}
[namespace current] .method startoutput