add Tcllib's tcl::chan virtchannel packages to vendorlib

src/vendorlib/virtchannel_base/ChangeLog

@@ -0,0 +1,124 @@
+2019-03-12  Aldo Buratti
+
+    * cat.tcl - BUGFIX in event-handling . Version bumped to 1.0.3
+    * 
+2013-12-17  Andreas Kupries  <andreask@activestate.com>
+
+	* randseed.man: Fixed package name.
+
+2013-11-22  Andreas Kupries  <andreask@activestate.com>
+
+	* memchan.tcl (Events): Ticket [864a0c83e3]. Do not suppress
+	* string.tcl: readable events at end of the channel. Needed
+	* variable.tcl: to signal the eof condition. Like for regular
+	  files, always readable. Versions bumped to 1.0.3, 1.0.2, and
+	  1.0.3 respectively
+
+2013-04-03  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	* tclib_fifo2.man: Renamed more manpages, clashing with the
+	* tclib_fifo.man: Memchan package. List are the new names,
+	* tclib_memchan.man: with prefix "tcllib_".
+	* tclib_null.man:
+	* tclib_random.man:
+	* tclib_zero.man:
+
+2013-03-04  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	* string.man: Renamed, clashes with Tcl core manpage.
+	* tcllib_string.man: New name.
+
+	* variable.man: Renamed, clashes with Tcl core manpage.
+	* tcllib_variable.man: New name.
+
+2013-02-01  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.15 ========================
+	* 
+
+2012-10-05  Andreas Kupries <andreask@activestate.com>
+
+	* cat.tcl (read): Fixed bugs in the reader. Bad check of buffer
+	* pkgIndex.tcl: length, and buffer length was not taken into
+	  account for the next read after an incomplete one. Version
+	  bumped to 1.0.2.
+
+2011-12-13  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.14 ========================
+	* 
+
+2011-08-09  Andreas Kupries  <andreask@activestate.com>
+
+	* memchan.tcl: Fixed missing initialization of 'content' instance
+	  variable. Bumped to version 1.0.2.
+
+	* variable.tcl: Fixed missing invokation of superclass
+	  constructor. Fixed missing initialization of linked 'content'
+	  variable, if not existing. Fixed missing import of linked
+	  variable into the event handling. Bumped to version 1.0.2.
+
+	* cat.tcl: Removed bogus invokation of superclass constructor,
+	  there is no such. Bumped to version 1.0.1.
+
+	* facade.tcl: Added missing logger requirements, dropped bogus
+	  call to superclass constructor. Bumped to version 1.0.1.
+
+	* std.tcl: Fixed command scoping issues, and dropped bogus call to
+	  superclass constructor. Bumped to version 1.0.1.
+
+2011-05-31  Andreas Kupries  <andreask@activestate.com>
+
+	* cat.man: New base channels. Concatenation of channels,
+	* cat.tcl: standard channel combining stdin and stdout,
+	* facade.man: and a facade for wrapping around other
+	* facade.tcl: channels.
+	* std.man:
+	* std.tcl:
+	* pkgIndex.tcl:
+
+2011-02-21  Andreas Kupries  <andreask@activestate.com>
+
+	* pkgIndex.tcl: Removed the superfluous [list] command in the
+	  ifneeded script.
+
+2011-02-16  Andreas Kupries  <andreask@activestate.com>
+
+	* memchan.tcl: Fixed constructor chaining, added the missing
+	* pkgIndex.tcl: 'next'. The bug prevented proper initialization
+	* string.tcl: of the event core. All versions bumped to 1.0.1
+	* variable.tcl:
+
+2011-01-24  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.13 ========================
+	* 
+
+2010-07-29  Andreas Kupries  <andreask@activestate.com>
+
+	* fifo.man: New files, documentation for the packages in
+	* fifo2.man: this module.
+	* halfpipe.man:
+	* memchan.man:
+	* null.man:
+	* nullzero.man:
+	* random.man:
+	* randseed.man:
+	* string.man:
+	* textwindow.man:
+	* variable.man:
+	* zero.man:
+
+2009-12-07  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.12 ========================
+	* 
+
+2009-12-01  Andreas Kupries  <andreask@activestate.com>
+
+	* New module 'virtchannel_base', providing classes implementing
+	  various virtual channels aka reflected channels. TclOO based.

src/vendorlib/virtchannel_base/README.txt

@@ -0,0 +1,44 @@
+null, zero, fifo, memchan, fifo2
+
+	Re-implementations of Memchan's channel types.
+
+random
+
+	Semi re-implementation of a Memchan channel type.
+	"Random" byte generator, simple feedback register.
+	Memchan uses ISAAC (http://burtleburtle.net/bob/rand/isaacafa.html).
+
+string, variable
+
+	Variants of 'memchan', with fixed content, and the content
+	factored out to a namespaced variable, respectively.
+
+randomseed
+
+	Support to generate and combine seed lists for the
+	random channel, using semi-random sources in Tcl.
+
+halfpipe
+
+	Half channel, simpler callback API. fifo2 is build on top this
+	basic block.
+
+textwindow
+
+	Channel attaches to text widget to write data into.
+
+cat
+
+	Concatenation channel, delivering the data from 1 or more
+	channels, one after the other.
+
+facade
+
+	A wrapper around any other channel. Mainly for debugging,
+	allowing a developer to observe the activity on the wrapped
+	channel.
+
+std
+
+	Unification of stdin and stdout into a single read/write
+	channel

src/vendorlib/virtchannel_base/cat.man

@@ -0,0 +1,48 @@
+[comment {-*- tcl -*- doctools manpage}]
+[vset Version 1.0.4]
+[manpage_begin tcl::chan::cat n [vset Version]]
+[keywords {concatenation channel}]
+[keywords {reflected channel}]
+[keywords {tip 219}]
+[keywords {virtual channel}]
+[copyright {2011 Andreas Kupries <andreas_kupries@users.sourceforge.net>}]
+[moddesc   {Reflected/virtual channel support}]
+[category  Channels]
+[titledesc {Concatenation channel}]
+[require Tcl "8.5 9"]
+[require TclOO]
+[require tcl::chan::core [opt 1.1]]
+[require tcl::chan::cat [opt [vset Version]]]
+[description]
+[para]
+
+The [package tcl::chan::cat] package provides a command creating
+concatenation channels. These are non-seekable channels owning a list
+of subordinate channels whose contents they return in order, until all
+are exhausted. In this manner the channel is the concatentation of the
+contents of all the sub-ordinate channels.
+
+[para] Note that the created channels take ownership of the channels
+they were constructed with. Whenever they have exhausted one of their
+channel it will be closed. Similarly, closing the cat channel will
+close all the sub-ordinates it still has.
+
+[para] The internal [package TclOO] class implementing the channel
+handler is a sub-class of the [package tcl::chan::core] framework.
+
+[para] Event handling is delegated to the currently active sub-channel.
+
+[section API]
+
+[list_begin definitions]
+
+[call [cmd ::tcl::chan::cat] [arg chan]...]
+
+This command creates the concatenation channel using all the provided
+channels, and returns its handle.
+
+[list_end]
+
+[vset CATEGORY virtchannel]
+[include ../common-text/feedback.inc]
+[manpage_end]

src/vendorlib/virtchannel_base/cat.tcl

@@ -0,0 +1,135 @@
+# -*- tcl -*-
+# # ## ### ##### ######## #############
+# (C) 2011,2019 Andreas Kupries
+
+# Facade concatenating the contents of the channels it was constructed
+# with. Owns the sub-ordinate channels and closes them on exhaustion and/or
+# when closed itself.
+
+# @@ Meta Begin
+# Package tcl::chan::cat 1.0.4
+# Meta as::author {Andreas Kupries}
+# Meta as::copyright 2011
+# Meta as::license BSD
+# Meta description Facade concatenating the contents of the channels it
+# Meta description was constructed with. Owns the sub-ordinate channels
+# Meta description and closes them on exhaustion and/or when closed itself.
+# Meta platform tcl
+# Meta require TclOO
+# Meta require tcl::chan::core
+# Meta require {Tcl 8.5}
+# @@ Meta End
+
+# # ## ### ##### ######## #############
+
+package require Tcl 8.5 9
+package require TclOO
+package require tcl::chan::core
+
+# # ## ### ##### ######## #############
+
+namespace eval ::tcl::chan {}
+
+proc ::tcl::chan::cat {args} {
+    return [::chan create {read} [cat::implementation new {*}$args]]
+}
+
+oo::class create ::tcl::chan::cat::implementation {
+    superclass ::tcl::chan::core ; # -> initialize, finalize.
+
+    # We are not using the standard event handling class, because here
+    # it will not be timer-driven. We propagate anything related to
+    # events to catin and catout instead and let them handle things.
+
+    constructor {args} {
+	set channels $args
+	# Disable translation (and hence encoding) in the wrapped channels.
+	# This will happen in our generic layer instead.
+	foreach c $channels {
+	    fconfigure $c -translation binary
+	}
+	set delay 10
+	set watching 0
+	return
+    }
+
+    destructor {
+	foreach c $channels {
+	    ::close $c
+	}
+	return
+    }
+
+    variable channels timer delay watching
+
+    method watch {c requestmask} {
+	if {"read" in $requestmask} {
+	    # Activate event handling.  Either drive an eof home via
+	    # timers, or activate things in the foremost sub-ordinate.
+
+	    set watching 1
+	    if {![llength $channels]} {
+		set timer [after $delay [namespace code [list my Post $c]]]
+	    } else {
+		chan event [lindex $channels 0] readable [list chan postevent $c read]
+	    }
+	} else {
+	    # Stop events. Either kill timer, or disable in the
+	    # foremost sub-ordinate.
+
+	    set watching 0
+	    if {![llength $channels]} {
+		catch { after cancel $timer }
+	    } else {
+		chan event [lindex $channels 0] readable {}
+	    }
+	}
+	return
+    }
+
+    method read {c n} {
+	if {![llength $channels]} {
+	    # This signals EOF higher up.
+	    return {}
+	}
+
+	set buf {}
+	while {([string length $buf] < $n) &&
+	       [llength $channels]} {
+
+	    set in     [lindex $channels 0]
+	    set toread [expr {$n - [string length $buf]}]
+	    append buf [::read $in $toread]
+
+	    if {[eof $in]} {
+		close $in
+		set channels [lrange $channels 1 end]
+
+		# The close of the exhausted subordinate killed any
+		# fileevent handling we may have had attached to this
+		# channel. Update the settings (i.e. move to the next
+		# subordinate, or to timer-based, to drive the eof
+		# home).
+
+		if {$watching} {
+		    my watch $c read
+		}
+	    }
+	}
+
+	# When `buf` is empty, all channels have been exhausted and
+	# closed, therefore returning this empty string will cause an
+	# EOF higher up.
+	return $buf
+    }
+
+    method Post {c} {
+	set timer [after $delay [namespace code [list my Post $c]]]
+	chan postevent $c read
+	return
+    }
+}
+
+# # ## ### ##### ######## #############
+package provide tcl::chan::cat 1.0.4
+return

src/vendorlib/virtchannel_base/cat.test

@@ -0,0 +1,69 @@
+#- - -- --- ----- -------- ------------- ---------------------
+# cat.test -*- tcl -*-
+# (C) 2019 Andreas Kupries. BSD licensed.
+#- - -- --- ----- -------- ------------- ---------------------
+
+source [file join \
+	[file dirname [file dirname [file join [pwd] [info script]]]] \
+	devtools testutilities.tcl]
+
+testsNeedTcl     8.5
+testsNeedTcltest 2.0
+testsNeed        TclOO 1
+
+support {
+    use virtchannel_core/core.tcl   tcl::chan::core
+    use virtchannel_core/events.tcl tcl::chan::events
+    useLocal string.tcl tcl::chan::string
+}
+testing {
+    useLocal cat.tcl tcl::chan::cat
+}
+
+#- - -- --- ----- -------- ------------- ---------------------
+## No wrong#args, allowed to zero and up
+
+#- - -- --- ----- -------- ------------- ---------------------
+
+test tcl-chan-cat-2.0 {tell, nothing} -setup {
+    set c [tcl::chan::cat]
+} -body {
+    tell $c
+} -cleanup {
+    close $c
+    unset c
+} -result -1
+
+test tcl-chan-cat-2.1 {ticket 1975182bdd - file events} -setup {
+    # setup a cat'enated channel
+    set fa [tcl::chan::string "ABCDE..XYZ"]
+    set fb [tcl::chan::string "0123456789"]
+    set ch [tcl::chan::cat $fa $fb]
+} -body {
+    set r {}
+    chan event $ch readable {
+        if { [eof $ch] } {
+            set done .
+        } else {
+            lappend r [read $ch 4]
+        }
+    }    
+    vwait done
+    set r
+} -cleanup {
+    close $ch
+    unset ch fa fb r
+} -result {ABCD E..X YZ01 2345 6789 {}}
+
+#- - -- --- ----- -------- ------------- ---------------------
+# Explicit cleanup of loaded support classes.
+
+rename tcl::chan::events {}
+rename tcl::chan::core   {}
+testsuiteCleanup
+return
+
+# Local Variables:
+#  mode: tcl
+#  indent-tabs-mode: nil
+# End:

src/vendorlib/virtchannel_base/facade.man

@@ -0,0 +1,73 @@
+[comment {-*- tcl -*- doctools manpage}]
+[manpage_begin tcl::chan::facade n 1.1]
+[keywords {concatenation channel}]
+[keywords {reflected channel}]
+[keywords {tip 219}]
+[keywords {virtual channel}]
+[copyright {2011 Andreas Kupries <andreas_kupries@users.sourceforge.net>}]
+[moddesc   {Reflected/virtual channel support}]
+[category  Channels]
+[titledesc {Facade channel}]
+[require Tcl "8.5 9"]
+[require TclOO]
+[require logger]
+[require tcl::chan::core [opt 1.1]]
+[require tcl::chan::facade [opt 1.1]]
+[description]
+[para]
+
+The [package tcl::chan::facade] package provides a command creating
+facades to other channels. These are channels which own a single
+subordinate channel and delegate all operations to.
+
+[para] The main use for facades is the debugging of actions on a
+channel. While most of the information could be tracked by a virtual
+channel transformation it does not have access to the event-related
+operation, and furthermore they are only available in Tcl 8.6.
+
+[para] Therefore this channel, usable with Tcl 8.5, and having access
+to everything going on for a channel.
+
+[para] The intercepted actions on channel are logged through package
+[package logger].
+
+[para] Beyond that facades provide the following additional channel
+configuration options:
+
+[list_begin options]
+[opt_def -self]
+The TclOO object handling the facade.
+
+[opt_def -fd]
+The handle of the subordinate, i.e. wrapped channel.
+
+[opt_def -used]
+The last time the wrapped channel was read from or written to by
+the facade, as per [cmd {clock milliseconds}]. A value of [const 0]
+indicates that the subordinate channel was not accessed at all, yet.
+
+[opt_def -created]
+The time the facade was created, as per [cmd {clock milliseconds}].
+
+[opt_def -user]
+A free-form value identifying the user of the facade and its
+wrapped channel.
+
+[list_end]
+
+Of these only option [option -user] is writable.
+
+[section API]
+
+[list_begin definitions]
+
+[call [cmd ::tcl::chan::facade] [arg chan]]
+
+This command creates the facade channel around the provided
+channel [arg chan], and returns its handle.
+
+[list_end]
+
+[vset CATEGORY virtchannel]
+[include ../common-text/feedback.inc]
+[manpage_end]

src/vendorlib/virtchannel_base/facade.tcl

@@ -0,0 +1,234 @@
+# -*- tcl -*-
+# # ## ### ##### ######## #############
+# (C) 2011 Andreas Kupries
+
+# Facade wrapping around some other channel. All operations on the
+# facade are delegated to the wrapped channel. This makes it useful
+# for debugging of Tcl's activity on a channel. While a transform can
+# be used for that as well it does not have access to some things of
+# the base-channel, i.e. all the event managment is not visible to it,
+# whereas the facade has access to even this.
+
+# @@ Meta Begin
+# Package tcl::chan::facade 1.0.2
+# Meta as::author {Colin McCormack}
+# Meta as::author {Andreas Kupries}
+# Meta as::copyright 2011
+# Meta as::license BSD
+# Meta description Facade wrapping around some other channel. All
+# Meta description operations on the facade are delegated to the
+# Meta description wrapped channel. This makes it useful for debugging
+# Meta description of Tcl's activity on a channel. While a transform
+# Meta description can be used for that as well it does not have
+# Meta description access to some things of the base-channel, i.e. all
+# Meta description the event managment is not visible to it, whereas
+# Meta description the facade has access to even this.
+# Meta platform tcl
+# Meta require TclOO
+# Meta require tcl::chan::core
+# Meta require {Tcl 8.5}
+# @@ Meta End
+
+# # ## ### ##### ######## #############
+## TODO document the special options of the facade
+## TODO log integration.
+## TODO document that facada takes ownership of the channel.
+
+package require Tcl 8.5 9
+package require TclOO
+package require logger
+package require tcl::chan::core
+
+# # ## ### ##### ######## #############
+
+namespace eval ::tcl::chan {}
+
+logger::initNamespace ::tcl::chan::facade
+proc ::tcl::chan::facade {args} {
+    return [::chan create {read} [facade::implementation new {*}$args]]
+}
+
+# # ## ### ##### ######## #############
+
+oo::class create ::tcl::chan::facade::implementation {
+    superclass ::tcl::chan::core ; # -> initialize, finalize.
+
+    # # ## ### ##### ######## #############
+
+    # We are not using the standard event handling class, because here
+    # it will not be timer-driven. We propagate anything related to
+    # events to the wrapped channel instead and let it handle things.
+
+    constructor {thechan} {
+	# Access to the log(ger) commands.
+	namespace path [list {*}[namespace path] ::tcl::chan::facade]
+
+	set chan $thechan
+
+	# set some configuration data
+	set created [clock milliseconds]
+	set used 0
+	set user ""	;# user data - freeform
+
+	# validate args
+	if {$chan eq [self]} {
+	    return -code error "recursive chan!  No good."
+	} elseif {$chan eq ""} {
+	    return -code error "Needs a chan argument"
+	}
+
+	set blocking [::chan configure $chan -blocking]
+	return
+    }
+
+    destructor {
+	log::debug {[self] destroyed}
+	if {[catch { ::chan close $chan } e o]} {
+	    log::debug {failed to close $chan [self] because "$e" ($o)}
+	}
+	return
+    }
+
+    variable chan used user created blocking
+
+    method initialize {myself mode} {
+	log::debug {$myself initialize $chan $mode}
+	log::debug {$chan configured: ([::chan configure $chan])}
+	return [next $chan $mode]
+    }
+
+    method finalize {myself} {
+	log::debug {$myself finalize $chan}
+	catch {::chan close $chan}
+	catch {next $myself}
+	catch {my destroy}
+	return
+    }
+
+    method blocking {myself mode} {
+	if {[catch {
+	    ::chan configure $chan -blocking $mode
+	    set blocking $mode
+	} e o]} {
+	    log::debug {$myself blocking $chan $mode -> error $e ($o)}
+	} else {
+	    log::debug {$myself blocking $chan $mode -> $e}
+	}
+	return
+    }
+
+    method watch {myself requestmask} {
+	log::debug {$myself watch $chan $requestmask}
+
+	if {"read" in $requestmask} {
+	    fileevent readable $chan [my Callback Readable $myself]
+	} else {
+	    fileevent readable $chan {}
+	}
+
+	if {"write" in $requestmask} {
+	    fileevent writable $chan [my Callback Writable $myself]
+	} else {
+	    fileevent writable $chan {}
+	}
+	return
+    }
+
+    method read {myself n} {
+	log::debug {$myself read $chan begin eof: [::chan eof $chan], blocked: [::chan blocked $chan]}
+	set used [clock milliseconds]
+
+	if {[catch {
+	    set data [::chan read $chan $n]
+	} e o]} {
+	    log::error {$myself read $chan $n -> error $e ($o)}
+	} else {
+	    log::debug {$myself read $chan $n -> [string length $data] bytes: [string map {\n \\n} "'[string range $data 0 20]...[string range $data end-20 end]"]'}
+	    log::debug {$myself read $chan eof     = [::chan eof     $chan]}
+	    log::debug {$myself read $chan blocked = [::chan blocked $chan]}
+	    log::debug {$chan configured: ([::chan configure $chan])}
+
+	    set gone [catch {chan eof $chan} eof]
+	    if {
+		($data eq {}) &&
+		!$gone && !$eof && !$blocking
+	    } {
+		log::error {$myself EAGAIN}
+		return -code error EAGAIN
+	    }
+	}
+
+	log::debug {$myself read $chan result: [string length $data] bytes}
+	return $data
+    }
+
+    method write {myself data} {
+	log::debug {$myself write $chan [string length $data] / [::chan pending output $chan] / [::chan pending output $myself]}
+	set used [clock milliseconds]
+	::chan puts -nonewline $chan $data
+	return [string length $data]
+    }
+
+    method configure {myself option value} {
+	log::debug {[self] configure $myself $option -> $value}
+
+	if {$option eq "-user"} {
+	    set user $value
+	    return
+	}
+
+	::chan configure $fd $option $value
+	return
+    }
+
+    method cget {myself option} {
+	switch -- $option {
+	    -self    { return [self]   }
+	    -fd      { return $chan    }
+	    -used    { return $used    }
+	    -created { return $created }
+	    -user    { return $user    }
+	    default  {
+		return [::chan configure $chan $option]
+	    }
+	}
+    }
+
+    method cgetall {myself} {
+	set result [::chan configure $chan]
+	lappend result \
+	    -self    [self] \
+	    -fd      $chan \
+	    -used    $used \
+	    -created $created \
+	    -user $user
+
+	log::debug {[self] cgetall $myself -> $result}
+	return $result
+    }
+
+    # # ## ### ##### ######## #############
+
+    # Internals. Methods. Event generation.
+    method Readable {myself} {
+	log::debug {$myself readable $chan - [::chan pending input $chan]}
+	::chan postevent $myself read
+	return
+    }
+
+    method Writable {myself} {
+	log::debug {$myself writable $chan - [::chan pending output $chan]}
+	::chan postevent $myself write
+	return
+    }
+
+    method Callback {method args} {
+	list [uplevel 1 {namespace which my}] $method {*}$args
+    }
+
+    # # ## ### ##### ######## #############
+}
+
+# # ## ### ##### ######## #############
+package provide tcl::chan::facade 1.0.2
+return

src/vendorlib/virtchannel_base/fifo.tcl

@@ -0,0 +1,138 @@
+# -*- tcl -*-
+# # ## ### ##### ######## #############
+# (C) 2009 Andreas Kupries
+
+# @@ Meta Begin
+# Package tcl::chan::fifo 1.1
+# Meta as::author {Andreas Kupries}
+# Meta as::copyright 2009
+# Meta as::license BSD
+# Meta description Re-implementation of Memchan's fifo
+# Meta description channel. Based on Tcl 8.5's channel
+# Meta description reflection support. Exports a single
+# Meta description command for the creation of new
+# Meta description channels. No arguments. Result is the
+# Meta description handle of the new channel.
+# Meta platform tcl
+# Meta require TclOO
+# Meta require tcl::chan::events
+# Meta require {Tcl 8.5}
+# @@ Meta End
+# # ## ### ##### ######## #############
+
+package require Tcl 8.5 9
+package require TclOO
+package require tcl::chan::events
+
+# # ## ### ##### ######## #############
+
+namespace eval ::tcl::chan {}
+
+proc ::tcl::chan::fifo {} {
+    return [::chan create {read write} [fifo::implementation new]]
+}
+
+oo::class create ::tcl::chan::fifo::implementation {
+    superclass ::tcl::chan::events ; # -> initialize, finalize, watch
+
+    method initialize {args} {
+	my allow write
+	next {*}$args
+    }
+
+    method read {c n} {
+	set max  [string length $read]
+	set last [expr {$at + $n - 1}]
+	set result {}
+
+	#    last+1 <= max
+	# <=> at+n <= max
+	# <=> n <= max-at
+
+	if {$n <= ($max - $at)} {
+	    # The request is less than what we have left in the read
+	    # buffer, we take it, and move the read pointer forward.
+
+	    append result [string range $read $at $last]
+	    incr at $n
+	    incr $size -$n
+	} else {
+	    # We need the whole remaining read buffer, and more. For
+	    # the latter we shift the write buffer contents over into
+	    # the read buffer, and then read from the latter again.
+
+	    append result  [string range $read $at end]
+	    incr n -[string length $result]
+
+	    set at    0
+	    set read  $write
+	    set write {}
+	    set size  [string length $read]
+	    set max   $size
+
+	    # at == 0
+	    if {$n <= $max} {
+		# The request is less than what we have in the updated
+		# read buffer, we take it, and move the read pointer
+		# forward.
+
+		append result [string range $read 0 $last]
+		set at $n
+		incr $size -$n
+	    } else {
+		# We need the whole remaining read buffer, and
+		# more. As we took the data from write already we have
+		# nothing left, and update accordingly.
+
+		append result $read
+
+		set at   0
+		set read {}
+		set size 0
+	    }
+	}
+
+	my Readable
+
+	if {$result eq {}} {
+	    return -code error EAGAIN
+	}
+
+	return $result
+    }
+
+    method write {c bytes} {
+	append write $bytes
+	set n [string length $bytes]
+	incr size $n
+	my Readable
+	return $n
+    }
+
+    # # ## ### ##### ######## #############
+
+    variable at read write size
+
+    # # ## ### ##### ######## #############
+
+    constructor {} {
+	set at    0
+	set read  {}
+	set write {}
+	set size  0
+	next
+    }
+
+    method Readable {} {
+	if {$size} {
+	    my allow read
+	} else {
+	    my disallow read
+	}
+	return
+    }
+}
+
+# # ## ### ##### ######## #############
+package provide tcl::chan::fifo 1.1
+return

src/vendorlib/virtchannel_base/fifo2.tcl

@@ -0,0 +1,113 @@
+# -*- tcl -*-
+# # ## ### ##### ######## #############
+# (C) 2009 Andreas Kupries
+
+# @@ Meta Begin
+# Package tcl::chan::fifo2 1.1
+# Meta as::author {Andreas Kupries}
+# Meta as::copyright 2009
+# Meta as::license BSD
+# Meta as::notes   This fifo2 command does not have to
+# Meta as::notes   deal with the pesky details of
+# Meta as::notes   threading for cross-thread
+# Meta as::notes   communication. That is hidden in the
+# Meta as::notes   implementation of reflected
+# Meta as::notes   channels. It is less optimal as the
+# Meta as::notes   command provided by Memchan as this
+# Meta as::notes   fifo2 may involve three threads when
+# Meta as::notes   sending data around: The threads the
+# Meta as::notes   two endpoints are in, and the thread
+# Meta as::notes   holding this code. Memchan's C
+# Meta as::notes   implementation does not need this last
+# Meta as::notes   intermediary thread.
+# Meta description Re-implementation of Memchan's fifo2
+# Meta description channel. Based on Tcl 8.5's channel
+# Meta description reflection support. Exports a single
+# Meta description command for the creation of new
+# Meta description channels. No arguments. Result are the
+# Meta description handles of the two new channels.
+# Meta platform tcl
+# Meta require TclOO
+# Meta require tcl::chan::halfpipe
+# Meta require {Tcl 8.5}
+# @@ Meta End
+# # ## ### ##### ######## #############
+
+package require Tcl 8.5 9
+package require TclOO
+package require tcl::chan::halfpipe
+
+# # ## ### ##### ######## #############
+
+namespace eval ::tcl::chan {}
+
+proc ::tcl::chan::fifo2 {} {
+
+    set coordinator [fifo2::implementation new]
+
+    lassign [halfpipe \
+	       -write-command [list $coordinator froma] \
+	       -close-command [list $coordinator closeda]] \
+	a ha
+
+    lassign [halfpipe \
+	       -write-command [list $coordinator fromb] \
+	       -close-command [list $coordinator closedb]] \
+	b hb
+
+    $coordinator connect $a $ha $b $hb
+
+    return [list $a $b]
+}
+
+oo::class create ::tcl::chan::fifo2::implementation {
+    method connect {thea theha theb thehb} {
+	set a $thea
+	set b $theb
+	set ha $theha
+	set hb $thehb
+	return
+    }
+
+    method closeda {c} {
+	set a {}
+	if {$b ne {}} {
+	    close $b
+	    set b {}
+	} else {
+	    my destroy
+	}
+	return
+    }
+
+    method closedb {c} {
+	set b {}
+	if {$a ne {}} {
+	    close $a
+	    set a {}
+	} else {
+	    my destroy
+	}
+	return
+    }
+
+    method froma {c bytes} {
+	$hb put $bytes
+	return
+    }
+
+    method fromb {c bytes} {
+	$ha put $bytes
+	return
+    }
+
+    # # ## ### ##### ######## #############
+
+    variable a b ha hb
+
+    # # ## ### ##### ######## #############
+}
+
+# # ## ### ##### ######## #############
+package provide tcl::chan::fifo2 1.1
+return

src/vendorlib/virtchannel_base/fifo2.test

@@ -0,0 +1,82 @@
+# -------------------------------------------------------------------------
+# fifo2.test -*- tcl -*-
+# (C) 2019 Andreas Kupries. BSD licensed.
+# -------------------------------------------------------------------------
+
+source [file join \
+	[file dirname [file dirname [file join [pwd] [info script]]]] \
+	devtools testutilities.tcl]
+
+testsNeedTcl     8.5
+testsNeedTcltest 2.0
+testsNeed        TclOO 1
+
+support {
+    use virtchannel_core/core.tcl   tcl::chan::core
+    use virtchannel_core/events.tcl tcl::chan::events
+}
+testing {
+    useLocal halfpipe.tcl tcl::chan::halfpipe
+    useLocal fifo2.tcl    tcl::chan::fifo2
+}
+
+# -------------------------------------------------------------------------
+
+test tcl-chan-fifo2-1.1 {constructor wrong\#args} -body {
+    tcl::chan::fifo2 X
+} -returnCodes error \
+    -result {wrong # args: should be "tcl::chan::fifo2"}
+
+test tcl-chan-fifo2-1.2 {destructor kills both sides and coordinator} -setup {
+    lassign [tcl::chan::fifo2] a b
+} -match glob -body {
+    lappend r [lsort -dict [file channels]]
+    lappend r [info class instances ::tcl::chan::fifo2::implementation]
+    close $a
+    lappend r [lsort -dict [file channels]]
+    lappend r [info class instances ::tcl::chan::fifo2::implementation]
+} -cleanup {
+    unset a b r
+} -result {{rc4 rc5 stderr stdin stdout} ::oo::Obj* {stderr stdin stdout} {}}
+
+# -------------------------------------------------------------------------
+
+test tcl-chan-fifo2-2.0 {tell, initial, empty} -setup {
+    lassign [tcl::chan::fifo2] a b
+} -body {
+    list [tell $a] [tell $b]
+} -cleanup {
+    close $a
+    unset a b
+} -result {-1 -1}
+
+# -------------------------------------------------------------------------
+
+test tcl-chan-fifo2-tkt-3f48fd6ea2 {fixed misindexing} -setup {
+    lassign [tcl::chan::fifo2] a b
+    chan configure $a -buffersize 1
+    chan configure $b -buffering none
+    chan puts -nonewline $b foobar ;# push 6 chars
+    chan read $a 2	     	   ;# read 2
+    chan read $a 4		   ;# read 4, fifo has nothing left
+    chan puts -nonewline $b baz	   ;# push 3 more
+} -body {
+    chan read $a 1	;# read 1, the `b`
+} -cleanup {
+    close $a
+    unset a b
+} -result b
+
+# -------------------------------------------------------------------------
+# Explicit cleanup of loaded (support) classes.
+rename tcl::chan::events   {}
+rename tcl::chan::core     {}
+rename tcl::chan::halfpipe {}
+rename tcl::chan::fifo2    {}
+testsuiteCleanup
+return
+
+# Local Variables:
+#  mode: tcl
+#  indent-tabs-mode: nil
+# End:

src/vendorlib/virtchannel_base/halfpipe.man

@@ -0,0 +1,81 @@
+[vset VERSION 1.0.2]
+[comment {-*- tcl -*- doctools manpage}]
+[manpage_begin tcl::chan::halfpipe n [vset VERSION]]
+[keywords callbacks]
+[keywords fifo]
+[keywords {in-memory channel}]
+[keywords {reflected channel}]
+[keywords {tip 219}]
+[keywords {virtual channel}]
+[copyright {2009, 2019 Andreas Kupries <andreas_kupries@users.sourceforge.net>}]
+[moddesc   {Reflected/virtual channel support}]
+[category  Channels]
+[titledesc {In-memory channel, half of a fifo2}]
+[require Tcl "8.5 9"]
+[require TclOO]
+[require tcl::chan::events [opt 1.1]]
+[require tcl::chan::halfpipe [opt [vset VERSION]]]
+[description]
+[para]
+
+The [package tcl::chan::halfpipe] package provides a command creating
+one half of a [package tcl::chan::fifo2] pair. Writing into such a
+channel invokes a set of callbacks which then handle the data. This is
+similar to a channel handler, except having a much simpler API.
+
+[para] The internal [package TclOO] class implementing the channel
+handler is a sub-class of the [package tcl::chan::events] framework.
+
+[section API]
+
+[list_begin definitions]
+
+[call [cmd ::tcl::chan::halfpipe] [opt "[option -option] [arg value]..."]]
+
+This command creates a halfpipe channel and configures it with the
+callbacks to run when the channel is closed, data was written to it,
+or ran empty. See the section [sectref Options] for the list of
+options and associated semantics.
+
+The result of the command is a list containing two elements, the
+handle of the new channel, and the object command of the channel
+handler, in this order.
+
+The latter is supplied to the caller to provide her with access to the
+[method put] method for adding data to the channel.
+
+[para] Two halfpipes with a bit of glue logic in the callbacks make
+for one [package tcl::chan::fifo2].
+
+[call [arg objectCmd] [method put] [arg bytes]]
+
+This method of the channel handler object puts the data [arg bytes]
+into the channel so that it can be read from it.
+
+[list_end]
+
+[section Options]
+
+[list_begin options]
+[opt_def -close-command cmdprefix]
+
+This callback is invoked when the channel is closed.
+A single argument is supplied, the handle of the channel being closed.
+The result of the callback is ignored.
+
+[opt_def -write-command cmdprefix]
+
+This callback is invoked when data is written to the channel.
+Two arguments are supplied, the handle of the channel written to, and the data written.
+The result of the callback is ignored.
+
+[opt_def -empty-command cmdprefix]
+
+This callback is invoked when the channel has run out of data to read.
+A single argument is supplied, the handle of the channel.
+
+[list_end]
+
+[vset CATEGORY virtchannel]
+[include ../common-text/feedback.inc]
+[manpage_end]

src/vendorlib/virtchannel_base/halfpipe.tcl

@@ -0,0 +1,194 @@
+# -*- tcl -*-
+# # ## ### ##### ######## #############
+# (C) 2009, 2019 Andreas Kupries
+
+# @@ Meta Begin
+# Package tcl::chan::halfpipe 1.0.3
+# Meta as::author {Andreas Kupries}
+# Meta as::copyright 2009,2019
+# Meta as::license BSD
+# Meta description Implementation of one half of a pipe
+# Meta description channel. Based on Tcl 8.5's channel
+# Meta description reflection support. Exports a single
+# Meta description command for the creation of new
+# Meta description channels. Option arguments. Result is the
+# Meta description handle of the new channel, and the object
+# Meta description command of the handler object.
+# Meta platform tcl
+# Meta require TclOO
+# Meta require tcl::chan::events
+# Meta require {Tcl 8.5}
+# @@ Meta End
+# # ## ### ##### ######## #############
+
+package require Tcl 8.5 9
+package require TclOO
+package require tcl::chan::events
+
+# # ## ### ##### ######## #############
+
+namespace eval ::tcl::chan {}
+
+proc ::tcl::chan::halfpipe {args} {
+    set handler [halfpipe::implementation new {*}$args]
+    return [list [::chan create {read write} $handler] $handler]
+}
+
+oo::class create ::tcl::chan::halfpipe::implementation {
+    superclass ::tcl::chan::events ; # -> initialize, finalize, watch
+
+    method initialize {args} {
+	my allow write
+	set eof 0
+	next {*}$args
+    }
+
+    method finalize {c} {
+	my Call -close-command $c
+	next $c
+    }
+
+    method read {c n} {
+	set max  [string length $read]
+	set last [expr {$at + $n - 1}]
+	set result {}
+	
+	#    last+1 <= max
+	# <=> at+n <= max
+	# <=> n <= max-at
+
+	if {$n <= ($max - $at)} {
+	    # There is enough data in the buffer to fill the request, so take
+	    # it from there and move the read pointer forward.
+
+	    append result [string range $read $at $last]
+	    incr at $n
+	    incr $size -$n
+	} else {
+	    # We need the whole remaining read buffer, and more. For
+	    # the latter we make the write buffer the new read buffer,
+	    # and then read from it again.
+
+	    append result [string range $read $at end]
+	    incr n -[string length $result]
+
+	    set at    0
+            set last  [expr {$n - 1}]
+	    set read  $write
+	    set write {}
+	    set size  [string length $read]
+	    set max   $size
+
+	    # at == 0 simplifies expressions
+	    if {$n <= $max} {
+		# The request is less than what we have in the new
+		# read buffer, we take it, and move the read pointer
+		# forward.
+
+		append result [string range $read 0 $last]
+		set at $n
+		incr $size -$n
+	    } else {
+		# We need the whole remaining read buffer, and
+		# more. As we took the data from write already we have
+		# nothing left, and update accordingly.
+
+		append result $read
+
+		set at   0
+		set read {}
+		set size 0
+	    }
+	}
+	my Readable
+	if {$result eq {} && !$eof} {
+	    return -code error EAGAIN
+	}
+	return $result
+    }
+
+    method write {c bytes} {
+	my Call -write-command $c $bytes
+	return [string length $bytes]
+    }
+
+    # # ## ### ##### ######## #############
+
+    method put bytes {
+	append write $bytes
+	set n [string length $bytes]
+	if {$n == 0} {
+	    my variable eof
+	    set eof 1
+	} else {
+	    incr size $n
+	}
+	my Readable
+	return $n
+    }
+
+    # # ## ### ##### ######## #############
+
+    variable at eof read write size options
+    # at      : first location in read buffer not yet read
+    # eof     : indicates whether the end of the data has been reached 
+    # read    : read buffer
+    # write   : buffer for received data, i.e.
+    #           written into the halfpipe from
+    #           the other side.
+    # size    : combined length of receive and read buffers
+    #           == amount of stored data
+    # options : configuration array
+
+    # The halpipe uses a pointer (`at`) into the data buffer to
+    # extract the characters read by the user, while not shifting the
+    # data down in memory. Doing such a shift would cause a large
+    # performance hit (O(n**2) operation vs O(n)). This however comes
+    # with the danger of the buffer growing out of bounds as ever more
+    # data is appended by the receiver while the reader is not
+    # catching up, preventing a release. The solution to this in turn
+    # is to split the buffer into two. An append-only receive buffer
+    # (`write`) for incoming data, and a `read` buffer with the
+    # pointer. When the current read buffer is entirely consumed the
+    # current receive buffer becomes the new read buffer and a new
+    # empty receive buffer is started.
+    
+    # # ## ### ##### ######## #############
+
+    constructor {args} {
+	array set options {
+	    -write-command {}
+	    -empty-command {}
+	    -close-command {}
+	}
+	# todo: validity checking of options (legal names, legal
+	# values, etc.)
+	array set options $args
+	set at    0
+	set read  {}
+	set write {}
+	set size  0
+	next
+    }
+
+    method Readable {} {
+	if {$size || $eof} {
+	    my allow read
+	} else {
+	    my variable channel
+	    my disallow read
+	    my Call -empty-command $channel
+	}
+	return
+    }
+
+    method Call {o args} {
+	if {![llength $options($o)]} return
+	uplevel \#0 [list {*}$options($o) {*}$args]
+	return
+    }
+}
+
+# # ## ### ##### ######## #############
+package provide tcl::chan::halfpipe 1.0.3
+return

src/vendorlib/virtchannel_base/memchan.tcl

@@ -0,0 +1,169 @@
+# -*- tcl -*-
+# # ## ### ##### ######## #############
+# (C) 2009 Andreas Kupries
+
+# Variable string channel (in-memory r/w file, internal variable).
+# Seekable beyond the end of the data, implies appending of 0x00
+# bytes.
+
+# @@ Meta Begin
+# Package tcl::chan::memchan 1.0.5
+# Meta as::author {Andreas Kupries}
+# Meta as::copyright 2009
+# Meta as::license BSD
+# Meta description Re-implementation of Memchan's memchan
+# Meta description channel. Based on Tcl 8.5's channel
+# Meta description reflection support. Exports a single
+# Meta description command for the creation of new
+# Meta description channels. No arguments. Result is the
+# Meta description handle of the new channel. Essentially
+# Meta description an in-memory read/write random-access
+# Meta description file. Similar to -> tcl::chan::variable,
+# Meta description except the content variable is internal,
+# Meta description part of the channel. Further similar to
+# Meta description -> tcl::chan::string, except that the
+# Meta description content is here writable, and
+# Meta description extendable.
+# Meta platform tcl
+# Meta require TclOO
+# Meta require tcl::chan::events
+# Meta require {Tcl 8.5}
+# @@ Meta End
+
+# # ## ### ##### ######## #############
+
+package require Tcl 8.5 9
+package require TclOO
+package require tcl::chan::events
+
+# # ## ### ##### ######## #############
+
+namespace eval ::tcl::chan {}
+
+proc ::tcl::chan::memchan {} {
+    return [::chan create {read write} [memchan::implementation new]]
+}
+
+oo::class create ::tcl::chan::memchan::implementation {
+    superclass ::tcl::chan::events ; # -> initialize, finalize, watch
+
+    constructor {} {
+	set content {}
+	set at 0
+	next
+    }
+
+    method initialize {args} {
+	my allow write
+	my Events
+	next {*}$args
+    }
+
+    variable content at 
+
+    method read {c n} {
+	# First determine the location of the last byte to read,
+	# relative to the current location, and limited by the maximum
+	# location we are allowed to access per the size of the
+	# content.
+
+	set last [expr {min($at + $n,[string length $content])-1}]
+
+	# Then extract the relevant range from the content, move the
+	# seek location behind it, and return the extracted range. Not
+	# to forget, switch readable events based on the seek
+	# location.
+
+	set res [string range $content $at $last]
+	set at $last
+	incr at
+
+	my Events
+	return $res
+    }
+
+    method write {c newbytes} {
+	# Return immediately if there is nothing is to write.
+	set n [string length $newbytes]
+	if {$n == 0} {
+	    return $n
+	}
+
+	# Determine where and how to write. There are three possible cases.
+	# (1) Append at/after the end.
+	# (2) Starting in the middle, but extending beyond the end.
+	# (3) Replace in the middle.
+
+	set max [string length $content]
+	if {$at >= $max} {
+	    # Ad 1.
+	    append content $newbytes
+	    set at [string length $content]
+	} else {
+	    set last [expr {$at + $n - 1}]
+	    if {$last >= $max} {
+		# Ad 2.
+		set content [string replace $content $at end $newbytes]
+		set at [string length $content]
+	    } else {
+		# Ad 3.
+		set content [string replace $content $at $last $newbytes]
+		set at $last
+		incr at
+	    }
+	}
+
+	my Events
+	return $n
+    }
+
+    method seek {c offset base} {
+	# offset == 0 && base == current
+	# <=> Seek nothing relative to current
+	# <=> Report current location.
+
+	if {!$offset && ($base eq "current")} {
+	    return $at
+	}
+
+	# Compute the new location per the arguments.
+
+	set max [string length $content]
+	switch -exact -- $base {
+	    start   { set newloc $offset}
+	    current { set newloc [expr {$at  + $offset }] }
+	    end     { set newloc [expr {$max + $offset }] }
+	}
+
+	# Check if the new location is beyond the range given by the
+	# content.
+
+	if {$newloc < 0} {
+	    return -code error "Cannot seek before the start of the channel"
+	} elseif {$newloc > $max} {
+	    # We can seek beyond the end of the current contents, add
+	    # a block of zeros.
+	    #puts XXX.PAD.[expr {$newloc - $max}]
+	    append content [binary format @[expr {$newloc - $max}]]
+	}
+
+	# Commit to new location, switch readable events, and report.
+	set at $newloc
+
+	my Events
+	return $at
+    }
+
+    method Events {} {
+	# Always readable -- Even if the seek location is at the end
+	# (or beyond).  In that case the readable events are fired
+	# endlessly until the eof indicated by the seek location is
+	# properly processed by the event handler. Like for regular
+	# files -- Ticket [864a0c83e3].
+	my allow read
+    }
+}
+
+# # ## ### ##### ######## #############
+package provide tcl::chan::memchan 1.0.5
+return

src/vendorlib/virtchannel_base/memchan.test

@@ -0,0 +1,92 @@
+# -------------------------------------------------------------------------
+# memchan.test -*- tcl -*-
+# (C) 2017 Andreas Kupries. BSD licensed.
+# -------------------------------------------------------------------------
+
+source [file join \
+	[file dirname [file dirname [file join [pwd] [info script]]]] \
+	devtools testutilities.tcl]
+
+testsNeedTcl     8.5
+testsNeedTcltest 2.0
+testsNeed        TclOO 1
+
+support {
+    use virtchannel_core/core.tcl   tcl::chan::core
+    use virtchannel_core/events.tcl tcl::chan::events
+}
+testing {
+    useLocal memchan.tcl tcl::chan::memchan
+}
+
+# -------------------------------------------------------------------------
+
+test tcl-chan-memchan-1.0 {constructor wrong\#args} -body {
+    tcl::chan::memchan X
+} -returnCodes error \
+    -result {wrong # args: should be "tcl::chan::memchan"}
+
+# -------------------------------------------------------------------------
+
+test tcl-chan-memchan-2.0 {tell, initial, empty} -setup {
+    set c [tcl::chan::memchan]
+} -body {
+    tell $c
+} -cleanup {
+    close $c
+    unset c
+} -result 0
+
+test tcl-chan-memchan-2.1 {seek from start, expand, tell} -setup {
+    set c [tcl::chan::memchan]
+} -body {
+    seek $c 10
+    tell $c
+} -cleanup {
+    close $c
+    unset c
+} -result 10
+
+test tcl-chan-memchan-2.2 {seek from end, eof, empty, tell} -setup {
+    set c [tcl::chan::memchan]
+} -body {
+    seek $c 0 end
+    tell $c
+} -cleanup {
+    close $c
+    unset c
+} -result 0
+
+test tcl-chan-memchan-2.3 {seek from end, eof, non-empty, tell} -setup {
+    set c [tcl::chan::memchan]
+    puts $c Hello
+} -body {
+    seek $c 0 end
+    tell $c
+} -cleanup {
+    close $c
+    unset c
+} -result 6
+
+test tcl-chan-memchan-2.4 {seek from end, non-eof, non-empty, tell} -setup {
+    set c [tcl::chan::memchan]
+    puts $c Hello
+} -body {
+    seek $c -6 end
+    tell $c
+} -cleanup {
+    close $c
+    unset c
+} -result 0
+
+# -------------------------------------------------------------------------
+# Explicit cleanup of loaded support classes.
+rename tcl::chan::events {}
+rename tcl::chan::core   {}
+testsuiteCleanup
+return
+
+# Local Variables:
+#  mode: tcl
+#  indent-tabs-mode: nil
+# End:

src/vendorlib/virtchannel_base/null.tcl

@@ -0,0 +1,54 @@
+# -*- tcl -*-
+# # ## ### ##### ######## #############
+# (C) 2009 Andreas Kupries
+
+# @@ Meta Begin
+# Package tcl::chan::null 1.1
+# Meta as::author {Andreas Kupries}
+# Meta as::copyright 2009
+# Meta as::license BSD
+# Meta description Re-implementation of Memchan's null
+# Meta description channel. Based on Tcl 8.5's channel
+# Meta description reflection support. Exports a single
+# Meta description command for the creation of new
+# Meta description channels. No arguments. Result is the
+# Meta description handle of the new channel.
+# Meta platform tcl
+# Meta require TclOO
+# Meta require tcl::chan::events
+# Meta require {Tcl 8.5}
+# @@ Meta End
+
+# # ## ### ##### ######## #############
+
+package require Tcl 8.5 9
+package require TclOO
+package require tcl::chan::events
+
+# # ## ### ##### ######## #############
+
+namespace eval ::tcl::chan {}
+
+proc ::tcl::chan::null {} {
+    return [::chan create {write} [null::implementation new]]
+}
+
+oo::class create ::tcl::chan::null::implementation {
+    superclass ::tcl::chan::events ; # -> initialize, finalize, watch
+
+    method initialize {args} {
+	my allow write
+	next {*}$args
+    }
+
+    # Ignore the data in most particulars. We do count it so that we
+    # can tell the caller that everything was written. Null device.
+
+    method write {c data} {
+	return [string length $data]
+    }
+}
+
+# # ## ### ##### ######## #############
+package provide tcl::chan::null 1.1
+return

src/vendorlib/virtchannel_base/nullzero.man

@@ -0,0 +1,44 @@
+[comment {-*- tcl -*- doctools manpage}]
+[manpage_begin tcl::chan::nullzero n 1.1]
+[keywords /dev/null]
+[keywords /dev/zero]
+[keywords null]
+[keywords {reflected channel}]
+[keywords {tip 219}]
+[keywords {virtual channel}]
+[keywords zero]
+[copyright {2009 Andreas Kupries <andreas_kupries@users.sourceforge.net>}]
+[moddesc   {Reflected/virtual channel support}]
+[category  Channels]
+[titledesc {Null/Zero channel combination}]
+[require Tcl "8.5 9"]
+[require TclOO]
+[require tcl::chan::events [opt 1.1]]
+[require tcl::chan::nullzero [opt 1.1]]
+[description]
+[para]
+
+The [package tcl::chan::nullzero] package provides a command creating channels,
+which are a combination of null and zero devices. They immediately forget
+whatever is written to them, and on reading return an infinite stream of null
+characters.
+
+[para] Packages related to this are [package tcl::chan::null] and
+[package tcl::chan::zero].
+
+[para] The internal [package TclOO] class implementing the channel handler
+is a sub-class of the [package tcl::chan::events] framework.
+
+[section API]
+
+[list_begin definitions]
+
+[call [cmd ::tcl::chan::nullzero]]
+
+This command creates a new nullzero channel and returns its handle.
+
+[list_end]
+
+[vset CATEGORY virtchannel]
+[include ../common-text/feedback.inc]
+[manpage_end]

src/vendorlib/virtchannel_base/nullzero.tcl

@@ -0,0 +1,62 @@
+# -*- tcl -*-
+# # ## ### ##### ######## #############
+# (C) 2009 Andreas Kupries
+
+# @@ Meta Begin
+# Package tcl::chan::nullzero 1.1
+# Meta as::author {Andreas Kupries}
+# Meta as::copyright 2009
+# Meta as::license BSD
+# Meta description Implementation of a channel combining
+# Meta description Memchan's null and zero channels in a
+# Meta description single device. Based on Tcl 8.5's channel
+# Meta description reflection support. Exports a single
+# Meta description command for the creation of new
+# Meta description channels. No arguments. Result is the
+# Meta description handle of the new channel.
+# Meta platform tcl
+# Meta require TclOO
+# Meta require tcl::chan::events
+# Meta require {Tcl 8.5}
+# @@ Meta End
+
+# # ## ### ##### ######## #############
+
+package require Tcl 8.5 9
+package require TclOO
+package require tcl::chan::events
+
+# # ## ### ##### ######## #############
+
+namespace eval ::tcl::chan {}
+
+proc ::tcl::chan::nullzero {} {
+    return [::chan create {read write} [nullzero::implementation new]]
+}
+
+oo::class create ::tcl::chan::nullzero::implementation {
+    superclass ::tcl::chan::events ; # -> initialize, finalize, watch
+
+    method initialize {args} {
+	my allow read write
+	next {*}$args
+    }
+
+    # Ignore the data in most particulars. We do count it so that we
+    # can tell the caller that everything was written. Null device.
+
+    method write {c data} {
+	return [string length $data]
+    }
+
+    # Generate and return a block of N null bytes, as requested. Zero
+    # device.
+
+    method read {c n} {
+	return [binary format @$n]
+    }
+}
+
+# # ## ### ##### ######## #############
+package provide tcl::chan::nullzero 1.1
+return

src/vendorlib/virtchannel_base/pkgIndex.tcl

@@ -0,0 +1,17 @@
+if {![package vsatisfies [package provide Tcl] 8.5 9]} {return}
+
+package ifneeded tcl::chan::cat 1.0.4      [list source [file join $dir cat.tcl]]
+package ifneeded tcl::chan::facade 1.0.2   [list source [file join $dir facade.tcl]]
+package ifneeded tcl::chan::fifo 1.1       [list source [file join $dir fifo.tcl]]
+package ifneeded tcl::chan::fifo2 1.1      [list source [file join $dir fifo2.tcl]]
+package ifneeded tcl::chan::halfpipe 1.0.3 [list source [file join $dir halfpipe.tcl]]
+package ifneeded tcl::chan::memchan 1.0.5  [list source [file join $dir memchan.tcl]]
+package ifneeded tcl::chan::null 1.1       [list source [file join $dir null.tcl]]
+package ifneeded tcl::chan::nullzero 1.1   [list source [file join $dir nullzero.tcl]]
+package ifneeded tcl::chan::random 1.1     [list source [file join $dir random.tcl]]
+package ifneeded tcl::chan::std 1.0.2      [list source [file join $dir std.tcl]]
+package ifneeded tcl::chan::string 1.0.4   [list source [file join $dir string.tcl]]
+package ifneeded tcl::chan::textwindow 1.1 [list source [file join $dir textwindow.tcl]]
+package ifneeded tcl::chan::variable 1.0.5 [list source [file join $dir variable.tcl]]
+package ifneeded tcl::chan::zero 1.1         [list source [file join $dir zero.tcl]]
+package ifneeded tcl::randomseed 1.1         [list source [file join $dir randseed.tcl]]

src/vendorlib/virtchannel_base/random.tcl

@@ -0,0 +1,80 @@
+# -*- tcl -*-
+# # ## ### ##### ######## #############
+# (C) 2009 Andreas Kupries
+
+# @@ Meta Begin
+# Package tcl::chan::random 1.1
+# Meta as::author {Andreas Kupries}
+# Meta as::copyright 2009
+# Meta as::license BSD
+# Meta description Implementation of a channel similar to
+# Meta description Memchan's random channel. Based on Tcl
+# Meta description 8.5's channel reflection support. Exports
+# Meta description a single command for the creation of new
+# Meta description channels. One argument, a list of
+# Meta description numbers to initialize the feedback
+# Meta description register of the internal random number
+# Meta description generator. Result is the handle of the
+# Meta description new channel.
+# Meta platform tcl
+# Meta require TclOO
+# Meta require tcl::chan::events
+# Meta require {Tcl 8.5}
+# @@ Meta End
+
+# # ## ### ##### ######## #############
+
+package require tcl::chan::events
+package require Tcl 8.5 9
+package require TclOO
+
+# # ## ### ##### ######## #############
+
+namespace eval ::tcl::chan {}
+
+proc ::tcl::chan::random {seed} {
+    return [::chan create {read} [random::implementation new $seed]]
+}
+
+oo::class create ::tcl::chan::random::implementation {
+    superclass tcl::chan::events ; # -> initialize, finalize, watch
+
+    constructor {theseed} {
+	my variable seed next
+	set seed $theseed
+	set next [expr "([join $seed +]) & 0xff"]
+	next
+    }
+
+    method initialize {args} {
+	my allow read
+	next {*}$args
+    }
+
+    # Generate and return a block of N randomly selected bytes, as
+    # requested. Random device.
+
+    method read {c n} {
+	set buffer {}
+	while {$n} {
+	    append buffer [binary format c [my Next]]
+	    incr n -1
+	}
+	return $buffer
+    }
+
+    variable seed
+    variable next
+
+    method Next {} {
+	my variable seed next
+	set result $next
+	set next [expr {(2*$next - [lindex $seed 0]) & 0xff}]
+	set seed [linsert [lrange $seed 1 end] end $result]
+	return $result
+    }
+}
+
+# # ## ### ##### ######## #############
+package provide tcl::chan::random 1.1
+return

src/vendorlib/virtchannel_base/randseed.man

@@ -0,0 +1,43 @@
+[comment {-*- tcl -*- doctools manpage}]
+[manpage_begin tcl::randomseed n 1.1]
+[keywords /dev/random]
+[keywords merge]
+[keywords random]
+[keywords {reflected channel}]
+[keywords seed]
+[keywords {tip 219}]
+[keywords {virtual channel}]
+[copyright {2009 Andreas Kupries <andreas_kupries@users.sourceforge.net>}]
+[moddesc   {Reflected/virtual channel support}]
+[category  Channels]
+[titledesc {Utilities for random channels}]
+[require Tcl "8.5 9"]
+[require TclOO]
+[require tcl::randomseed [opt 1.1]]
+[description]
+[para]
+
+The [package tcl::randomseed] package provides a a few utility commands
+to help with the seeding of [package tcl::chan::random] channels.
+
+[section API]
+
+[list_begin definitions]
+
+[call [cmd ::tcl::randomseed]]
+
+This command creates returns a list of seed integers suitable as seed
+argument for random channels. The numbers are derived from the process
+id, current time, and Tcl random number generator.
+
+[call [cmd ::tcl::combine] [arg seed1] [arg seed2]]
+
+This command takes to seed lists and combines them into a single list
+by XORing them elementwise, modulo 256. If the lists are not of equial
+length the shorter of the two is padded with 0s before merging.
+
+[list_end]
+
+[vset CATEGORY virtchannel]
+[include ../common-text/feedback.inc]
+[manpage_end]

src/vendorlib/virtchannel_base/randseed.tcl

@@ -0,0 +1,58 @@
+# -*- tcl -*-
+# # ## ### ##### ######## #############
+# (C) 2009 Andreas Kupries
+
+# @@ Meta Begin
+# Package tcl::randomseed 1.1
+# Meta as::author {Andreas Kupries}
+# Meta as::copyright 2009
+# Meta as::license BSD
+# Meta description Generate and combine seed lists for the
+# Meta description random number generator inside of the
+# Meta description tcl::chan::random channel. Sources of
+# Meta description randomness are process id, time in two
+# Meta description granularities, and Tcl's random number
+# Meta description generator.
+# Meta platform tcl
+# Meta require {Tcl 8.5}
+# @@ Meta End
+
+# # ## ### ##### ######## #############
+
+package require Tcl 8.5 9
+
+# # ## ### ##### ######## #############
+
+namespace eval ::tcl {}
+
+proc ::tcl::randomseed {} {
+    set result {}
+    foreach v [list \
+		   [pid] \
+		   [clock seconds] \
+		   [expr {int(256*rand())}] \
+		   [clock clicks -milliseconds]] \
+	{
+	    lappend result [expr {$v % 256}]
+	}
+    return $result
+}
+
+proc ::tcl::combine {a b} {
+    while {[llength $a] < [llength $b]} {
+	lappend a 0
+    }
+    while {[llength $b] < [llength $a]} {
+	lappend b 0
+    }
+
+    set result {}
+    foreach x $a y $b {
+	lappend result [expr {($x ^ $y) % 256}]
+    }
+    return $result
+}
+
+# # ## ### ##### ######## #############
+package provide tcl::randomseed 1.1
+return

src/vendorlib/virtchannel_base/std.man

@@ -0,0 +1,43 @@
+[comment {-*- tcl -*- doctools manpage}]
+[manpage_begin tcl::chan::std n 1.1]
+[keywords {reflected channel}]
+[keywords {standard io}]
+[keywords stdin]
+[keywords stdout]
+[keywords {tip 219}]
+[keywords {virtual channel}]
+[copyright {2011 Andreas Kupries <andreas_kupries@users.sourceforge.net>}]
+[moddesc   {Reflected/virtual channel support}]
+[category  Channels]
+[titledesc {Standard I/O, unification of stdin and stdout}]
+[require Tcl "8.5 9"]
+[require TclOO]
+[require tcl::chan::core [opt 1.1]]
+[require tcl::chan::std [opt 1.1]]
+[description]
+[para]
+
+The [package tcl::chan::std] package provides a command creating
+a standard channel which unifies stdin and stdout into a single
+read- and writable channel. The result is not seek-able, like
+the original standard channels.
+
+[para] The internal [package TclOO] class implementing the channel
+handler is a sub-class of the [package tcl::chan::core] framework.
+
+[section API]
+
+[list_begin definitions]
+
+[call [cmd ::tcl::chan::std]]
+
+This command creates the std channel and returns its handle.
+
+[para] The channel is created only once, on the first call, and all
+future calls simply return this handle.
+
+[list_end]
+
+[vset CATEGORY virtchannel]
+[include ../common-text/feedback.inc]
+[manpage_end]

src/vendorlib/virtchannel_base/std.tcl

@@ -0,0 +1,97 @@
+# -*- tcl -*-
+# # ## ### ##### ######## #############
+# (C) 2011 Andreas Kupries
+
+# Facade wrapping the separate channels for stdin and stdout into a
+# single read/write channel for all regular standard i/o. Not
+# seekable. Fileevent handling is propagated to the regular channels
+# the facade wrapped about. Only one instance of the class is
+# ever created.
+
+# @@ Meta Begin
+# Package tcl::chan::std 1.0.2
+# Meta as::author {Andreas Kupries}
+# Meta as::copyright 2011
+# Meta as::license BSD
+# Meta description Facade wrapping the separate channels for stdin
+# Meta description and stdout into a single read/write channel for
+# Meta description all regular standard i/o. Not seekable. Only one
+# Meta description instance of the class is ever created.
+# Meta platform tcl
+# Meta require TclOO
+# Meta require tcl::chan::core
+# Meta require {Tcl 8.5}
+# @@ Meta End
+
+# # ## ### ##### ######## #############
+
+package require Tcl 8.5 9
+package require TclOO
+package require tcl::chan::core
+
+# # ## ### ##### ######## #############
+
+namespace eval ::tcl::chan {}
+
+proc ::tcl::chan::std {} {
+    ::variable std
+    if {$std eq {}} {
+	set std [::chan create {read write} [std::implementation new]]
+    }
+    return $std
+}
+
+oo::class create ::tcl::chan::std::implementation {
+    superclass ::tcl::chan::core ; # -> initialize, finalize.
+
+    # We are not using the standard event handling class, because here
+    # it will not be timer-driven. We propagate anything related to
+    # events to stdin and stdout instead and let them handle things.
+
+    constructor {} {
+	# Disable encoding and translation processing in the wrapped channels.
+	# This will happen in our generic layer instead.
+	fconfigure stdin  -translation binary
+	fconfigure stdout -translation binary
+	return
+    }
+
+    method watch {c requestmask} {
+
+	if {"read" in $requestmask} {
+	    fileevent readable stdin [list chan postevent $c read]
+	} else {
+	    fileevent readable stdin {}
+	}
+
+	if {"write" in $requestmask} {
+	    fileevent readable stdin [list chan postevent $c write]
+	} else {
+	    fileevent readable stdout {}
+	}
+
+	return
+    }
+
+    method read {c n} {
+	# Read is redirected to stdin.
+	return [::read stdin $n]
+    }
+
+    method write {c newbytes} {
+	# Write is redirected to stdout.
+	puts -nonewline stdout $newbytes
+	flush stdout
+	return [string length $newbytes]
+    }
+}
+
+# # ## ### ##### ######## #############
+
+namespace eval ::tcl::chan {
+    ::variable std {}
+}
+
+# # ## ### ##### ######## #############
+package provide tcl::chan::std 1.0.2
+return

src/vendorlib/virtchannel_base/string.tcl

@@ -0,0 +1,124 @@
+# -*- tcl -*-
+# # ## ### ##### ######## #############
+# (C) 2009 Andreas Kupries
+
+# @@ Meta Begin
+# Package tcl::chan::string 1.0.4
+# Meta as::author {Andreas Kupries}
+# Meta as::copyright 2009
+# Meta as::license BSD
+# Meta description Implementation of a channel representing
+# Meta description an in-memory read-only random-access
+# Meta description file. Based on using Tcl 8.5's channel
+# Meta description reflection support. Exports a single
+# Meta description command for the creation of new channels.
+# Meta description One argument, the contents of the file.
+# Meta description Result is the  handle of the new channel.
+# Meta description Similar to -> tcl::chan::memchan, except
+# Meta description that the content is read-only. Seekable
+# Meta description only within the bounds of the content.
+# Meta platform tcl
+# Meta require TclOO
+# Meta require tcl::chan::events
+# Meta require {Tcl 8.5}
+# @@ Meta End
+
+# # ## ### ##### ######## #############
+
+package require Tcl 8.5 9
+package require TclOO
+package require tcl::chan::events
+
+# # ## ### ##### ######## #############
+
+namespace eval ::tcl::chan {}
+
+proc ::tcl::chan::string {content} {
+    return [::chan create {read} [string::implementation new $content]]
+}
+
+oo::class create ::tcl::chan::string::implementation {
+    superclass ::tcl::chan::events ; # -> initialize, finalize, watch
+
+    constructor {thecontent} {
+	set content $thecontent
+	set at 0
+	next
+    }
+
+    method initialize {args} {
+	my Events
+	next {*}$args
+    }
+
+    variable content at 
+
+    method read {c n} {
+
+	# First determine the location of the last byte to read,
+	# relative to the current location, and limited by the maximum
+	# location we are allowed to access per the size of the
+	# content.
+
+	set last [expr {min($at + $n,[string length $content])-1}]
+
+	# Then extract the relevant range from the content, move the
+	# seek location behind it, and return the extracted range. Not
+	# to forget, switch readable events based on the seek
+	# location.
+
+	set res [string range $content $at $last]
+	set at $last
+	incr at
+
+	my Events
+	return $res
+    }
+
+    method seek {c offset base} {
+	# offset == 0 && base == current
+	# <=> Seek nothing relative to current
+	# <=> Report current location.
+
+	if {!$offset && ($base eq "current")} {
+	    return $at
+	}
+
+	# Compute the new location per the arguments.
+
+	set max [string length $content]
+	switch -exact -- $base {
+	    start   { set newloc $offset}
+	    current { set newloc [expr {$at  + $offset }] }
+	    end     { set newloc [expr {$max + $offset }] }
+	}
+
+	# Check if the new location is beyond the range given by the
+	# content.
+
+	if {$newloc < 0} {
+	    return -code error "Cannot seek before the start of the channel"
+	} elseif {$newloc > $max} {
+	    return -code error "Cannot seek after the end of the channel"
+	}
+
+	# Commit to new location, switch readable events, and report.
+	set at $newloc
+
+	my Events
+	return $at
+    }
+
+    method Events {} {
+	# Always readable -- Even if the seek location is at the end
+	# (or beyond).  In that case the readable events are fired
+	# endlessly until the eof indicated by the seek location is
+	# properly processed by the event handler. Like for regular
+	# files -- Ticket [864a0c83e3].
+	my allow read
+    }
+}
+
+# # ## ### ##### ######## #############
+package provide tcl::chan::string 1.0.4
+return

src/vendorlib/virtchannel_base/string.test

@@ -0,0 +1,94 @@
+# -------------------------------------------------------------------------
+# string.test -*- tcl -*-
+# (C) 2017 Andreas Kupries. BSD licensed.
+# -------------------------------------------------------------------------
+
+source [file join \
+	[file dirname [file dirname [file join [pwd] [info script]]]] \
+	devtools testutilities.tcl]
+
+testsNeedTcl     8.5
+testsNeedTcltest 2.0
+testsNeed        TclOO 1
+
+support {
+    use virtchannel_core/core.tcl   tcl::chan::core
+    use virtchannel_core/events.tcl tcl::chan::events
+}
+testing {
+    useLocal string.tcl tcl::chan::string
+}
+
+# -------------------------------------------------------------------------
+
+test tcl-chan-string-1.0 {constructor wrong\#args} -body {
+    tcl::chan::string
+} -returnCodes error \
+    -result {wrong # args: should be "tcl::chan::string content"}
+
+test tcl-chan-string-1.1 {constructor wrong\#args} -body {
+    tcl::chan::string C X
+} -returnCodes error \
+    -result {wrong # args: should be "tcl::chan::string content"}
+
+# -------------------------------------------------------------------------
+
+test tcl-chan-string-2.0 {tell, initial, empty} -setup {
+    set c [tcl::chan::string ""]
+} -body {
+    tell $c
+} -cleanup {
+    close $c
+    unset c
+} -result 0
+
+test tcl-chan-string-2.1 {seek from start beyond eof is error} -setup {
+    set c [tcl::chan::string ""]
+} -body {
+    seek $c 10
+} -cleanup {
+    close $c
+    unset c
+} -returnCodes error -result {Cannot seek after the end of the channel}
+
+test tcl-chan-string-2.2 {seek from end, eof, empty, tell} -setup {
+    set c [tcl::chan::string ""]
+} -body {
+    seek $c 0 end
+    tell $c
+} -cleanup {
+    close $c
+    unset c
+} -result 0
+
+test tcl-chan-string-2.3 {seek from end, eof, non-empty, tell} -setup {
+    set c [tcl::chan::string Hello\n]
+} -body {
+    seek $c 0 end
+    tell $c
+} -cleanup {
+    close $c
+    unset c
+} -result 6
+
+test tcl-chan-string-2.4 {seek from end, non-eof, non-empty, tell} -setup {
+    set c [tcl::chan::string Hello\n]
+} -body {
+    seek $c -6 end
+    tell $c
+} -cleanup {
+    close $c
+    unset c
+} -result 0
+
+# -------------------------------------------------------------------------
+# Explicit cleanup of loaded support classes.
+rename tcl::chan::events {}
+rename tcl::chan::core   {}
+testsuiteCleanup
+return
+
+# Local Variables:
+#  mode: tcl
+#  indent-tabs-mode: nil
+# End:

src/vendorlib/virtchannel_base/tcllib_fifo.man

@@ -0,0 +1,43 @@
+[comment {-*- tcl -*- doctools manpage}]
+[manpage_begin tcl::chan::fifo n 1.1]
+[keywords fifo]
+[keywords {in-memory channel}]
+[keywords {reflected channel}]
+[keywords {tip 219}]
+[keywords {virtual channel}]
+[copyright {2009 Andreas Kupries <andreas_kupries@users.sourceforge.net>}]
+[moddesc   {Reflected/virtual channel support}]
+[category  Channels]
+[titledesc {In-memory fifo channel}]
+[require Tcl "8.5 9"]
+[require TclOO]
+[require tcl::chan::events [opt 1.1]]
+[require tcl::chan::fifo [opt 1.1]]
+[description]
+[para]
+
+The [package tcl::chan::fifo] package provides a command creating
+channels which live purely in memory. Access is fifo-like, i.e. things
+are read out of the channel in the order they were written to it.
+
+This is equivalent to the fifo channels provided by the package
+[package Memchan], except that this is written in pure Tcl, not C. On
+the other hand, [package Memchan] is usable with Tcl 8.4 and before,
+whereas this package requires Tcl 8.5 or higher, and [package TclOO].
+
+[para] The internal [package TclOO] class implementing the channel
+handler is a sub-class of the [package tcl::chan::events] framework.
+
+[section API]
+
+[list_begin definitions]
+
+[call [cmd ::tcl::chan::fifo]]
+
+This command creates a new fifo channel and returns its handle.
+
+[list_end]
+
+[vset CATEGORY virtchannel]
+[include ../common-text/feedback.inc]
+[manpage_end]

src/vendorlib/virtchannel_base/tcllib_fifo2.man

@@ -0,0 +1,50 @@
+[comment {-*- tcl -*- doctools manpage}]
+[manpage_begin tcl::chan::fifo2 n 1.1]
+[keywords {connected fifos}]
+[keywords fifo]
+[keywords {in-memory channel}]
+[keywords {inter-thread communication}]
+[keywords {reflected channel}]
+[keywords {tip 219}]
+[keywords {virtual channel}]
+[copyright {2009 Andreas Kupries <andreas_kupries@users.sourceforge.net>}]
+[moddesc   {Reflected/virtual channel support}]
+[category  Channels]
+[titledesc {In-memory interconnected fifo channels}]
+[require Tcl "8.5 9"]
+[require TclOO]
+[require tcl::chan::events [opt 1.1]]
+[require tcl::chan::halfpipe [opt 1.1]]
+[require tcl::chan::fifo2 [opt 1.1]]
+[description]
+[para]
+
+The [package tcl::chan::fifo2] package provides a command creating
+pairs of channels which live purely in memory and are connected to
+each other in a fifo manner. What is written to one half of the pair
+can be read from the other half, in the same order. One particular
+application for this is communication between threads, with one half
+of the pair moved to the thread to talk to.
+
+This is equivalent to the fifo2 channels provided by the package
+[package Memchan], except that this is written in pure Tcl, not C. On
+the other hand, [package Memchan] is usable with Tcl 8.4 and before,
+whereas this package requires Tcl 8.5 or higher, and [package TclOO].
+
+[para] The internal [package TclOO] class implementing the channel
+handler is a sub-class of the [package tcl::chan::events] framework.
+
+[section API]
+
+[list_begin definitions]
+
+[call [cmd ::tcl::chan::fifo2]]
+
+This command creates a new connected pair of fifo channels and returns
+their handles, as a list containing two elements.
+
+[list_end]
+
+[vset CATEGORY virtchannel]
+[include ../common-text/feedback.inc]
+[manpage_end]

src/vendorlib/virtchannel_base/tcllib_memchan.man

@@ -0,0 +1,45 @@
+[vset VERSION 1.0.5]
+[comment {-*- tcl -*- doctools manpage}]
+[manpage_begin tcl::chan::memchan n [vset VERSION]]
+[keywords {in-memory channel}]
+[keywords {reflected channel}]
+[keywords {tip 219}]
+[keywords {virtual channel}]
+[copyright {2009-2017 Andreas Kupries <andreas_kupries@users.sourceforge.net>}]
+[moddesc   {Reflected/virtual channel support}]
+[category  Channels]
+[titledesc {In-memory channel}]
+[require Tcl "8.5 9"]
+[require TclOO]
+[require tcl::chan::events [opt 1.1]]
+[require tcl::chan::memchan [opt [vset VERSION]]]
+[description]
+[para]
+
+The [package tcl::chan::memchan] package provides a command creating
+channels which live purely in memory. They provide random-access,
+i.e. are seekable. This is equivalent to the memchan channels provided by
+the package [package Memchan], except that this is written in pure Tcl,
+not C. On the other hand, [package Memchan] is usable with Tcl 8.4 and
+before, whereas this package requires Tcl 8.5 or higher, and
+[package TclOO].
+
+[para] Packages related to this are [package tcl::chan::string] and
+[package tcl::chan::variable].
+
+[para] The internal [package TclOO] class implementing the channel
+handler is a sub-class of the [package tcl::chan::events] framework.
+
+[section API]
+
+[list_begin definitions]
+
+[call [cmd ::tcl::chan::memchan]]
+
+This command creates a new memchan channel and returns its handle.
+
+[list_end]
+
+[vset CATEGORY virtchannel]
+[include ../common-text/feedback.inc]
+[manpage_end]

src/vendorlib/virtchannel_base/tcllib_null.man

@@ -0,0 +1,45 @@
+[comment {-*- tcl -*- doctools manpage}]
+[manpage_begin tcl::chan::null n 1.1]
+[keywords /dev/null]
+[keywords null]
+[keywords {reflected channel}]
+[keywords {tip 219}]
+[keywords {virtual channel}]
+[copyright {2009 Andreas Kupries <andreas_kupries@users.sourceforge.net>}]
+[moddesc   {Reflected/virtual channel support}]
+[category  Channels]
+[titledesc {Null channel}]
+[require Tcl "8.5 9"]
+[require TclOO]
+[require tcl::chan::events [opt 1.1]]
+[require tcl::chan::null [opt 1.1]]
+[description]
+[para]
+
+The [package tcl::chan::null] package provides a command creating null
+channels, i.e. write-only channels which immediately forget whatever
+is written to them. This is equivalent to the null channels provided by
+the package [package Memchan], except that this is written in pure Tcl,
+not C. On the other hand, [package Memchan] is usable with Tcl 8.4 and
+before, whereas this package requires Tcl 8.5 or higher, and
+[package TclOO].
+
+[para] Packages related to this are [package tcl::chan::zero] and
+[package tcl::chan::nullzero].
+
+[para] The internal [package TclOO] class implementing the channel
+handler is a sub-class of the [package tcl::chan::events] framework.
+
+[section API]
+
+[list_begin definitions]
+
+[call [cmd ::tcl::chan::null]]
+
+This command creates a new null channel and returns its handle.
+
+[list_end]
+
+[vset CATEGORY virtchannel]
+[include ../common-text/feedback.inc]
+[manpage_end]

src/vendorlib/virtchannel_base/tcllib_random.man

@@ -0,0 +1,46 @@
+[comment {-*- tcl -*- doctools manpage}]
+[manpage_begin tcl::chan::random n 1.1]
+[keywords /dev/random]
+[keywords random]
+[keywords {reflected channel}]
+[keywords {tip 219}]
+[keywords {virtual channel}]
+[copyright {2009 Andreas Kupries <andreas_kupries@users.sourceforge.net>}]
+[moddesc   {Reflected/virtual channel support}]
+[category  Channels]
+[titledesc {Random channel}]
+[require Tcl "8.5 9"]
+[require TclOO]
+[require tcl::chan::events [opt 1.1]]
+[require tcl::chan::random [opt 1.1]]
+[description]
+[para]
+
+The [package tcl::chan::random] package provides a command creating
+random channels, i.e. read-only channels which return an infinite
+stream of pseudo-random characters upon reading. This is similar to
+the random channels provided by the package [package Memchan], except
+that this is written in pure Tcl, not C, and uses a much simpler
+generator as well. On the other hand, [package Memchan] is usable with
+Tcl 8.4 and before, whereas this package requires Tcl 8.5 or higher,
+and TclOO.
+
+[para] The internal [package TclOO] class implementing the channel
+handler is a sub-class of the [package tcl::chan::events] framework.
+
+[section API]
+
+[list_begin definitions]
+
+[call [cmd ::tcl::chan::random] [arg seed]]
+
+This command creates a new random channel and returns its handle.
+
+The seed is a list of integer numbers used to initialize the
+internal feedback shift register of the generator.
+
+[list_end]
+
+[vset CATEGORY virtchannel]
+[include ../common-text/feedback.inc]
+[manpage_end]

src/vendorlib/virtchannel_base/tcllib_string.man

@@ -0,0 +1,46 @@
+[vset VERSION 1.0.4]
+[comment {-*- tcl -*- doctools manpage}]
+[manpage_begin tcl::chan::string n [vset VERSION]]
+[keywords {in-memory channel}]
+[keywords {reflected channel}]
+[keywords {tip 219}]
+[keywords {virtual channel}]
+[copyright {2009 Andreas Kupries <andreas_kupries@users.sourceforge.net>}]
+[moddesc   {Reflected/virtual channel support}]
+[category  Channels]
+[titledesc {Read-only in-memory channel}]
+[require Tcl "8.5 9"]
+[require TclOO]
+[require tcl::chan::events [opt 1.1]]
+[require tcl::chan::string [opt [vset VERSION]]]
+[description]
+[para]
+
+The [package tcl::chan::string] package provides a command creating
+channels which live purely in memory. They provide random-access,
+i.e. are seekable.
+
+In contrast to the channels created by [package tcl::chan::memchan]
+they are read-only however, their content is provided at the time of
+construction and immutable afterward.
+
+[para] Packages related to this are [package tcl::chan::memchan] and
+[package tcl::chan::variable].
+
+[para] The internal [package TclOO] class implementing the channel
+handler is a sub-class of the [package tcl::chan::events] framework.
+
+[section API]
+
+[list_begin definitions]
+
+[call [cmd ::tcl::chan::string] [arg content]]
+
+This command creates a new string channel and returns its handle. The
+channel provides random read-only access to the [arg content] string.
+
+[list_end]
+
+[vset CATEGORY virtchannel]
+[include ../common-text/feedback.inc]
+[manpage_end]

src/vendorlib/virtchannel_base/tcllib_variable.man

@@ -0,0 +1,47 @@
+[vset VERSION 1.0.5]
+[comment {-*- tcl -*- doctools manpage}]
+[manpage_begin tcl::chan::variable n [vset VERSION]]
+[keywords {in-memory channel}]
+[keywords {reflected channel}]
+[keywords {tip 219}]
+[keywords {virtual channel}]
+[copyright {2009 Andreas Kupries <andreas_kupries@users.sourceforge.net>}]
+[moddesc   {Reflected/virtual channel support}]
+[category  Channels]
+[titledesc {In-memory channel using variable for storage}]
+[require Tcl "8.5 9"]
+[require TclOO]
+[require tcl::chan::events [opt 1.1]]
+[require tcl::chan::variable [opt [vset VERSION]]]
+[description]
+[para]
+
+The [package tcl::chan::variable] package provides a command creating
+channels which live purely in memory. They provide random-access,
+i.e. are seekable.
+
+In contrast to the channels created by [package tcl::chan::memchan]
+the data is not hidden in the channel however, but stored in an
+associated variable, specified at the time of construction.
+
+[para] Packages related to this are [package tcl::chan::memchan] and
+[package tcl::chan::string].
+
+[para] The internal [package TclOO] class implementing the channel
+handler is a sub-class of the [package tcl::chan::events] framework.
+
+[section API]
+
+[list_begin definitions]
+
+[call [cmd ::tcl::chan::variable] [arg varname]]
+
+This command creates a new variable channel and returns its handle.
+The content of the channel is stored in the associated namespace
+variable [arg varname].
+
+[list_end]
+
+[vset CATEGORY virtchannel]
+[include ../common-text/feedback.inc]
+[manpage_end]

src/vendorlib/virtchannel_base/tcllib_zero.man

@@ -0,0 +1,45 @@
+[comment {-*- tcl -*- doctools manpage}]
+[manpage_begin tcl::chan::zero n 1.1]
+[keywords /dev/zero]
+[keywords {reflected channel}]
+[keywords {tip 219}]
+[keywords {virtual channel}]
+[keywords zero]
+[copyright {2009 Andreas Kupries <andreas_kupries@users.sourceforge.net>}]
+[moddesc   {Reflected/virtual channel support}]
+[category  Channels]
+[titledesc {Zero channel}]
+[require Tcl "8.5 9"]
+[require TclOO]
+[require tcl::chan::events [opt 1.1]]
+[require tcl::chan::zero [opt 1.1]]
+[description]
+[para]
+
+The [package tcl::chan::zero] package provides a command creating zero
+channels, i.e. read-only channels which return an infinite stream of null
+characters upon reading. This is equivalent to the zero channels
+provided by the package [package Memchan], except that this is written
+in pure Tcl, not C. On the other hand, [package Memchan] is usable with
+Tcl 8.4 and before, whereas this package requires Tcl 8.5 or higher,
+and TclOO.
+
+[para] Packages related to this are [package tcl::chan::null] and
+[package tcl::chan::nullzero].
+
+[para] The internal [package TclOO] class implementing the channel
+handler is a sub-class of the [package tcl::chan::events] framework.
+
+[section API]
+
+[list_begin definitions]
+
+[call [cmd ::tcl::chan::zero]]
+
+This command creates a new zero channel and returns its handle.
+
+[list_end]
+
+[vset CATEGORY virtchannel]
+[include ../common-text/feedback.inc]
+[manpage_end]

src/vendorlib/virtchannel_base/textwindow.man

@@ -0,0 +1,39 @@
+[comment {-*- tcl -*- doctools manpage}]
+[manpage_begin tcl::chan::textwindow n 1.1]
+[keywords {reflected channel}]
+[keywords {text widget}]
+[keywords {tip 219}]
+[keywords Tk]
+[keywords {virtual channel}]
+[copyright {2009 Andreas Kupries <andreas_kupries@users.sourceforge.net>}]
+[moddesc   {Reflected/virtual channel support}]
+[category  Channels]
+[titledesc {Textwindow channel}]
+[require Tcl "8.5 9"]
+[require TclOO]
+[require tcl::chan::events [opt 1.1]]
+[require tcl::chan::textwindow [opt 1.1]]
+[description]
+[para]
+
+The [package tcl::chan::textwindow] package provides a command creating
+write-only channels connected to text widgets. Anything written to the
+channel is printed into the associated widget.
+
+[para] The internal [package TclOO] class implementing the channel
+handler is a sub-class of the [package tcl::chan::events] framework.
+
+[section API]
+
+[list_begin definitions]
+
+[call [cmd ::tcl::chan::textwindow] [arg widget]]
+
+This command creates a new textwindow channel and returns its handle.
+Data written to this channel will appear in the associated [arg widget].
+
+[list_end]
+
+[vset CATEGORY virtchannel]
+[include ../common-text/feedback.inc]
+[manpage_end]

src/vendorlib/virtchannel_base/textwindow.tcl

@@ -0,0 +1,74 @@
+# -*- tcl -*-
+# # ## ### ##### ######## #############
+# (C) 2009 Andreas Kupries
+
+# @@ Meta Begin
+# Package tcl::chan::textwindow 1.1
+# Meta as::author {Andreas Kupries}
+# Meta as::copyright 2009
+# Meta as::license BSD
+# Meta as::credit  To Bryan Oakley for rotext, see
+# Meta as::credit  http://wiki.tcl.tk/22036. His code was
+# Meta as::credit  used here as template for the text
+# Meta as::credit  widget portions of the channel.
+# Meta description Implementation of a text window
+# Meta description channel, using Tcl 8.5's channel
+# Meta description reflection support. Exports a single
+# Meta description command for the creation of new
+# Meta description channels. No arguments. Result is the
+# Meta description handle of the new channel.
+# Meta platform tcl
+# Meta require TclOO
+# Meta require tcl::chan::events
+# Meta require {Tcl 8.5}
+# @@ Meta End
+
+# # ## ### ##### ######## #############
+
+package require Tcl 8.5 9
+package require TclOO
+package require tcl::chan::events
+
+# # ## ### ##### ######## #############
+
+namespace eval ::tcl::chan {}
+
+proc ::tcl::chan::textwindow {w} {
+    set chan [::chan create {write} [textwindow::implementation new $w]]
+    fconfigure $chan -encoding utf-8 -buffering none
+    return $chan
+}
+
+oo::class create ::tcl::chan::textwindow::implementation {
+    superclass ::tcl::chan::events ; # -> initialize, finalize, watch
+
+    constructor {w} {
+	set widget $w
+	next
+    }
+
+    # # ## ### ##### ######## #############
+
+    variable widget
+
+    # # ## ### ##### ######## #############
+
+    method initialize {args} {
+	my allow write
+	next {*}$args
+    }
+
+    method write {c data} {
+	# NOTE: How is encoding convertfrom dealing with a partial
+	# utf-8 character at the end of the buffer ? Should be saved
+	# up for the next buffer. No idea if we can.
+
+	$widget insert end [encoding convertfrom utf-8 $data]
+	$widget see end
+	return [string length $data]
+    }
+}
+
+# # ## ### ##### ######## #############
+package provide tcl::chan::textwindow 1.1
+return

src/vendorlib/virtchannel_base/variable.tcl

@@ -0,0 +1,181 @@
+# -*- tcl -*-
+# # ## ### ##### ######## #############
+# (C) 2009 Andreas Kupries
+
+# @@ Meta Begin
+# Package tcl::chan::variable 1.0.5
+# Meta as::author {Andreas Kupries}
+# Meta as::copyright 2009
+# Meta as::license BSD
+# Meta description Implementation of a channel representing
+# Meta description an in-memory read-write random-access
+# Meta description file. Based on Tcl 8.5's channel reflection
+# Meta description support. Exports a single command for the
+# Meta description creation of new channels. No arguments.
+# Meta description Result is the handle of the new channel.
+# Meta description Similar to -> tcl::chan::memchan, except
+# Meta description that the variable holding the content
+# Meta description exists outside of the channel itself, in
+# Meta description some namespace, and as such is not a part
+# Meta description of the channel. Seekable beyond the end
+# Meta description of the data, implies appending of 0x00
+# Meta description bytes.
+# Meta platform tcl
+# Meta require TclOO
+# Meta require tcl::chan::events
+# Meta require {Tcl 8.5}
+# @@ Meta End
+
+# # ## ### ##### ######## #############
+
+package require Tcl 8.5 9
+package require TclOO
+package require tcl::chan::events
+
+# # ## ### ##### ######## #############
+
+namespace eval ::tcl::chan {}
+
+proc ::tcl::chan::variable {varname} {
+    return [::chan create {read write} [variable::implementation new $varname]]
+}
+
+oo::class create ::tcl::chan::variable::implementation {
+    superclass ::tcl::chan::events ; # -> initialize, finalize, watch
+
+    constructor {thevarname} {
+	set varname $thevarname
+	set at 0
+
+	upvar #0 $varname content
+	if {![info exists content]} {
+	    set content {}
+	}
+	next
+    }
+
+    method initialize {args} {
+	my allow write
+	my Events
+	next {*}$args
+    }
+
+    variable varname at 
+
+    method read {c n} {
+	# Bring connected variable for content into scope.
+
+	upvar #0 $varname content
+
+	# First determine the location of the last byte to read,
+	# relative to the current location, and limited by the maximum
+	# location we are allowed to access per the size of the
+	# content.
+
+	set last [expr {min($at + $n,[string length $content])-1}]
+
+	# Then extract the relevant range from the content, move the
+	# seek location behind it, and return the extracted range. Not
+	# to forget, switch readable events based on the seek
+	# location.
+
+	set res [string range $content $at $last]
+	set at $last
+	incr at
+
+	my Events
+	return $res
+    }
+
+    method write {c newbytes} {
+	# Bring connected variable for content into scope.
+
+	upvar #0 $varname content
+
+	# Return immediately if there is nothing is to write.
+	set n [string length $newbytes]
+	if {$n == 0} {
+	    return $n
+	}
+
+	# Determine where and how to write. There are three possible cases.
+	# (1) Append at/after the end.
+	# (2) Starting in the middle, but extending beyond the end.
+	# (3) Replace in the middle.
+
+	set max [string length $content]
+	if {$at >= $max} {
+	    # Ad 1.
+	    append content $newbytes
+	    set at [string length $content]
+	} else {
+	    set last [expr {$at + $n - 1}]
+	    if {$last >= $max} {
+		# Ad 2.
+		set content [string replace $content $at end $newbytes]
+		set at [string length $content]
+	    } else {
+		# Ad 3.
+		set content [string replace $content $at $last $newbytes]
+		set at $last
+		incr at
+	    }
+	}
+
+	my Events
+	return $n
+    }
+
+    method seek {c offset base} {
+	# offset == 0 && base == current
+	# <=> Seek nothing relative to current
+	# <=> Report current location.
+
+	if {!$offset && ($base eq "current")} {
+	    return $at
+	}
+
+	# Bring connected variable for content into scope.
+
+	upvar #0 $varname content
+
+	# Compute the new location per the arguments.
+
+	set max [string length $content]
+	switch -exact -- $base {
+	    start   { set newloc $offset}
+	    current { set newloc [expr {$at  + $offset }] }
+	    end     { set newloc [expr {$max + $offset }] }
+	}
+
+	# Check if the new location is beyond the range given by the
+	# content.
+
+	if {$newloc < 0} {
+	    return -code error "Cannot seek before the start of the channel"
+	} elseif {$newloc > $max} {
+	    # We can seek beyond the end of the current contents, add
+	    # a block of zeros.
+	    append content [binary format @[expr {$newloc - $max}]]
+	}
+
+	# Commit to new location, switch readable events, and report.
+	set at $newloc
+
+	my Events
+	return $at
+    }
+
+    method Events {} {
+	# Always readable -- Even if the seek location is at the end
+	# (or beyond).  In that case the readable events are fired
+	# endlessly until the eof indicated by the seek location is
+	# properly processed by the event handler. Like for regular
+	# files -- Ticket [864a0c83e3].
+	my allow read
+    }
+}
+
+# # ## ### ##### ######## #############
+package provide tcl::chan::variable 1.0.5
+return

src/vendorlib/virtchannel_base/variable.test

@@ -0,0 +1,102 @@
+# -------------------------------------------------------------------------
+# variable.test -*- tcl -*-
+# (C) 2017 Andreas Kupries. BSD licensed.
+# -------------------------------------------------------------------------
+
+source [file join \
+	[file dirname [file dirname [file join [pwd] [info script]]]] \
+	devtools testutilities.tcl]
+
+testsNeedTcl     8.5
+testsNeedTcltest 2.0
+testsNeed        TclOO 1
+
+support {
+    use virtchannel_core/core.tcl   tcl::chan::core
+    use virtchannel_core/events.tcl tcl::chan::events
+}
+testing {
+    useLocal variable.tcl tcl::chan::variable
+}
+
+# -------------------------------------------------------------------------
+
+test tcl-chan-variable-1.0 {constructor wrong\#args} -body {
+    tcl::chan::variable
+} -returnCodes error \
+    -result {wrong # args: should be "tcl::chan::variable varname"}
+
+test tcl-chan-variable-1.1 {constructor wrong\#args} -body {
+    tcl::chan::variable V X
+} -returnCodes error \
+    -result {wrong # args: should be "tcl::chan::variable varname"}
+
+# -------------------------------------------------------------------------
+
+test tcl-chan-variable-2.0 {tell, initial, empty} -setup {
+    set content ""
+    set c [tcl::chan::variable content]
+} -body {
+    tell $c
+} -cleanup {
+    close $c
+    unset c content
+} -result 0
+
+test tcl-chan-variable-2.1 {seek from start, expand, tell} -setup {
+    set content ""
+    set c [tcl::chan::variable content]
+} -body {
+    seek $c 10
+    tell $c
+} -cleanup {
+    close $c
+    unset c content
+} -result 10
+
+test tcl-chan-variable-2.2 {seek from end, eof, empty, tell} -setup {
+    set content ""
+    set c [tcl::chan::variable content]
+} -body {
+    seek $c 0 end
+    tell $c
+} -cleanup {
+    close $c
+    unset c content
+} -result 0
+
+test tcl-chan-variable-2.3 {seek from end, eof, non-empty, tell} -setup {
+    set content ""
+    set c [tcl::chan::variable content]
+    puts $c Hello
+} -body {
+    seek $c 0 end
+    tell $c
+} -cleanup {
+    close $c
+    unset c content
+} -result 6
+
+test tcl-chan-variable-2.4 {seek from end, non-eof, non-empty, tell} -setup {
+    set content ""
+    set c [tcl::chan::variable content]
+    puts $c Hello
+} -body {
+    seek $c -6 end
+    tell $c
+} -cleanup {
+    close $c
+    unset c content
+} -result 0
+
+# -------------------------------------------------------------------------
+# Explicit cleanup of loaded support classes.
+rename tcl::chan::events {}
+rename tcl::chan::core   {}
+testsuiteCleanup
+return
+
+# Local Variables:
+#  mode: tcl
+#  indent-tabs-mode: nil
+# End:

src/vendorlib/virtchannel_base/zero.tcl

@@ -0,0 +1,54 @@
+# -*- tcl -*-
+# # ## ### ##### ######## #############
+# (C) 2009 Andreas Kupries
+
+# @@ Meta Begin
+# Package tcl::chan::zero 1.1
+# Meta as::author {Andreas Kupries}
+# Meta as::copyright 2009
+# Meta as::license BSD
+# Meta description Re-implementation of Memchan's zero
+# Meta description channel. Based on Tcl 8.5's channel
+# Meta description reflection support. Exports a single
+# Meta description command for the creation of new
+# Meta description channels. No arguments. Result is the
+# Meta description handle of the new channel.
+# Meta platform tcl
+# Meta require TclOO
+# Meta require tcl::chan::events
+# Meta require {Tcl 8.5}
+# @@ Meta End
+
+# # ## ### ##### ######## #############
+
+package require Tcl 8.5 9
+package require TclOO
+package require tcl::chan::events
+
+# # ## ### ##### ######## #############
+
+namespace eval ::tcl::chan {}
+
+proc ::tcl::chan::zero {} {
+    return [::chan create {read} [zero::implementation new]]
+}
+
+oo::class create ::tcl::chan::zero::implementation {
+    superclass tcl::chan::events ; # -> initialize, finalize, watch
+
+    method initialize {args} {
+	my allow read
+	next {*}$args
+    }
+
+    # Generate and return a block of N null bytes, as requested.
+    # Zero device.
+
+    method read {c n} {
+	return [binary format @$n]
+    }
+}
+
+# # ## ### ##### ######## #############
+package provide tcl::chan::zero 1.1
+return

src/vendorlib/virtchannel_core/ChangeLog

@@ -0,0 +1,39 @@
+2013-02-01  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.15 ========================
+	* 
+
+2011-12-13  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.14 ========================
+	* 
+
+2011-02-21  Andreas Kupries  <andreask@activestate.com>
+
+	* pkgIndex.tcl: Removed the superfluous [list] command in the
+	  ifneeded script.
+
+2011-01-24  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.13 ========================
+	* 
+
+2010-07-28  Andreas Kupries  <andreask@activestate.com>
+
+	* core.man: New files, documentation for the packages in
+	* events.man: this module.
+	* transformcore.man:
+
+2009-12-07  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.12 ========================
+	* 
+
+2009-12-01  Andreas Kupries  <andreask@activestate.com>
+
+	* New module 'virtchannel_core', with core classes for virtual
+	  channels aka reflected channels. TclOO based.

src/vendorlib/virtchannel_core/README.txt

@@ -0,0 +1,5 @@
+
+core, events
+
+	Support packages for initialization, finalization, and
+	timer-driven event support.

src/vendorlib/virtchannel_core/core.man

@@ -0,0 +1,72 @@
+[comment {-*- tcl -*- doctools manpage}]
+[manpage_begin tcl::chan::core n 1.1]
+[keywords {reflected channel}]
+[keywords {tip 219}]
+[keywords {virtual channel}]
+[copyright {2009 Andreas Kupries <andreas_kupries@users.sourceforge.net>}]
+[moddesc   {Reflected/virtual channel support}]
+[category  Channels]
+[titledesc {Basic reflected/virtual channel support}]
+[require Tcl "8.5 9"]
+[require TclOO]
+[require tcl::chan::core [opt 1.1]]
+[description]
+[para]
+
+The [package tcl::chan::core] package provides a [package TclOO]
+class implementing common behaviour needed by virtually every
+reflected or virtual channel (initialization, finalization).
+
+[para] This class expects to be used as either superclass of a concrete
+channel class, or to be mixed into such a class.
+
+[section {Class API}]
+
+[list_begin definitions]
+
+[call [cmd ::tcl::chan::core] [arg objectName]]
+
+This command creates a new channel core object with an associated
+global Tcl command whose name is [emph objectName]. This command may
+be used to invoke various operations on the object, as described in
+the section for the [sectref {Instance API}].
+
+[list_end]
+
+[section {Instance API}]
+
+The API of channel core instances provides only two methods, both
+corresponding to channel handler commands (For reference see
+[uri http:/tip.tcl.tk/219 {TIP 219}]). They expect to be called
+from whichever object instance the channel core was made a part of.
+
+[list_begin definitions]
+
+[call [arg objectName] [method initialize] [arg thechannel] [arg mode]]
+
+This method implements standard behaviour for the [method initialize]
+method of channel handlers. Using introspection it finds the handler
+methods supported by the instance and returns a list containing their
+names, as expected by the support for reflected channels in the Tcl
+core.
+
+[para] It further remembers the channel handle in an instance variable
+for access by sub-classes.
+
+[call [arg objectName] [method finalize] [arg thechannel]]
+
+This method implements standard behaviour for the [method finalize]
+method of channel handlers. It simply destroys itself.
+
+[call [arg objectName] [method destroy]]
+
+Destroying the channel core instance closes the channel it was
+initialized for, see the method [method initialize]. When destroyed
+from within a call of [method finalize] this does not happen, under
+the assumption that the channel is being destroyed by Tcl.
+
+[list_end]
+
+[vset CATEGORY virtchannel]
+[include ../common-text/feedback.inc]
+[manpage_end]

src/vendorlib/virtchannel_core/core.tcl

@@ -0,0 +1,73 @@
+# -*- tcl -*-
+# # ## ### ##### ######## #############
+# (C) 2009 Andreas Kupries
+
+# @@ Meta Begin
+# Package tcl::chan::core 1.1
+# Meta as::author {Andreas Kupries}
+# Meta as::copyright 2009
+# Meta as::license BSD
+# Meta description Support package handling a core
+# Meta description aspect of reflected base channels
+# Meta description (initialization, finalization).
+# Meta description It is expected that this class
+# Meta description is used as either one superclass of the
+# Meta description class C for a specific channel, or is
+# Meta description mixed into C.
+# Meta platform tcl
+# Meta require TclOO
+# Meta require {Tcl 8.5}
+# @@ Meta End
+
+# # ## ### ##### ######## #############
+
+package require Tcl 8.5 9
+package require TclOO
+
+# # ## ### ##### ######## #############
+
+oo::class create ::tcl::chan::core {
+    destructor {
+	if {$channel eq {}} return
+	close $channel
+	return
+    }
+
+    # # ## ### ##### ######## #############
+
+    method initialize {thechannel mode} {
+	set methods [info object methods [self] -all]
+
+	# Note: Checking of the mode against the supported methods is
+	#       done by the caller.
+
+	set channel $thechannel
+	set supported {}
+	foreach m {
+	    initialize finalize watch read write seek configure cget
+	    cgetall blocking
+	} {
+	    if {$m in $methods} {
+		lappend supported $m
+	    }
+	}
+	return $supported
+    }
+
+    method finalize {c} {
+	set channel {} ; # Prevent destroctor from calling close.
+	my destroy
+	return
+    }
+
+    # # ## ### ##### ######## #############
+
+    variable channel
+
+    # channel The channel the handler belongs to.
+    # # ## ### ##### ######## #############
+}
+
+# # ## ### #####
+package provide tcl::chan::core 1.1
+return

src/vendorlib/virtchannel_core/events.man

@@ -0,0 +1,79 @@
+[comment {-*- tcl -*- doctools manpage}]
+[manpage_begin tcl::chan::events n 1.1]
+[keywords {event management}]
+[keywords {reflected channel}]
+[keywords {tip 219}]
+[keywords {virtual channel}]
+[copyright {2009 Andreas Kupries <andreas_kupries@users.sourceforge.net>}]
+[moddesc   {Reflected/virtual channel support}]
+[category  Channels]
+[titledesc {Event support for reflected/virtual channels}]
+[require Tcl "8.5 9"]
+[require TclOO]
+[require tcl::chan::core [opt 1.1]]
+[require tcl::chan::events [opt 1.1]]
+[description]
+[para]
+
+The [package tcl::chan::events] package provides a [package TclOO]
+class implementing common behaviour needed by virtually every
+reflected or virtual channel supporting event driven IO. It is a
+sub-class of [package tcl::chan::core], inheriting all of its behaviour.
+
+[para] This class expects to be used as either superclass of a concrete
+channel class, or to be mixed into such a class.
+
+[section {Class API}]
+
+[list_begin definitions]
+
+[call [cmd ::tcl::chan::events] [arg objectName]]
+
+This command creates a new channel event core object with an associated
+global Tcl command whose name is [emph objectName]. This command may
+be used to invoke various operations on the object, as described in
+the section for the [sectref {Instance API}].
+
+[list_end]
+
+[section {Instance API}]
+
+The API of channel event core instances provides only four methods, two
+corresponding to channel handler commands (For reference see
+[uri http:/tip.tcl.tk/219 {TIP 219}]), and the other two for use by
+sub-classes to control event generation. They former expect to be called
+from whichever object instance the channel event core was made a part of.
+
+[list_begin definitions]
+
+[call [arg objectName] [method finalize] [arg thechannel]]
+
+This method implements standard behaviour for the [method finalize]
+method of channel handlers. It overrides the behaviour inherited from
+[package tcl::chan::core] and additionally disables any and all event
+generation before destroying itself.
+
+[call [arg objectName] [method watch] [arg thechannel] [arg eventmask]]
+
+This method implements standard behaviour for the [method watch]
+method of channel handlers. Called by the IO system whenever the
+interest in event changes it updates the instance state to activate
+and/or suppress the generation of the events of (non-)interest.
+
+[call [arg objectName] [method allow] [arg eventname]...]
+[call [arg objectName] [method disallow] [arg eventname]...]
+
+These two methods are exported to sub-classes, so that their instances
+can notify their event core of the events the channel they implement
+can (allow) or cannot (disallow) generate.
+
+Together with the information about the events requested by Tcl's IO
+system coming in through the [method watch] method the event core is
+able to determine which events it should (not) generate and act
+accordingly.
+
+[list_end]
+
+[vset CATEGORY virtchannel]
+[include ../common-text/feedback.inc]
+[manpage_end]

src/vendorlib/virtchannel_core/events.tcl

@@ -0,0 +1,154 @@
+# -*- tcl -*-
+# # ## ### ##### ######## #############
+# (C) 2009 Andreas Kupries
+
+# @@ Meta Begin
+# Package tcl::chan::events 1.1
+# Meta as::author {Andreas Kupries}
+# Meta as::copyright 2009
+# Meta as::license BSD
+# Meta description Support package handling a core
+# Meta description aspect of reflected base channels
+# Meta description (timer
+# Meta description driven file event support). Controls a
+# Meta description timer generating the expected read/write
+# Meta description events. It is expected that this class
+# Meta description is used as either one superclass of the
+# Meta description class C for a specific channel, or is
+# Meta description mixed into C.
+# Meta platform tcl
+# Meta require tcl::chan::core
+# Meta require TclOO
+# Meta require {Tcl 8.5}
+# @@ Meta End
+
+# TODO :: set/get accessor methods for the timer delay
+
+# # ## ### ##### ######## #############
+
+package require Tcl 8.5 9
+package require TclOO
+package require tcl::chan::core
+
+# # ## ### ##### ######## #############
+
+oo::class create ::tcl::chan::events {
+    superclass ::tcl::chan::core ; # -> initialize, finalize, destructor
+
+    constructor {} {
+	array set allowed {
+	    read  0
+	    write 0
+	}
+	set requested {}
+	set delay     10
+	return
+    }
+
+    # # ## ### ##### ######## #############
+
+    method finalize {c} {
+	my disallow read write
+	next $c
+    }
+
+    # Allow/disallow the posting of events based on the
+    # events requested by Tcl's IO system, and the mask of
+    # events the instance's channel can handle, per all
+    # preceding calls of allow and disallow.
+
+    method watch {c requestmask} {
+	if {$requestmask eq $requested} return
+	set requested $requestmask
+	my Update
+	return
+    }
+
+    # # ## ### ##### ######## #############
+
+    # Declare that the named events are handled by the
+    # channel. This may start a timer to periodically post
+    # these events to the instance's channel.
+
+    method allow {args} {
+	my Allowance $args yes
+	return
+    }
+
+    # Declare that the named events are not handled by the
+    # channel. This may stop the periodic posting of events
+    # to the instance's channel.
+
+    method disallow {args} {
+	my Allowance $args no
+	return
+    }
+
+    # # ## ### ##### ######## #############
+
+    # Event System State - Timer driven
+
+    variable timer allowed requested posting delay    
+
+    # channel   = The channel to post events to - provided by superclass
+    # timer     = Timer controlling the posting.
+    # allowed   = Set of events allowed to post.
+    # requested = Set of events requested by core.
+    # posting   = Set of events we are posting.
+    # delay     = Millisec interval between posts.
+
+    # 'allowed' is an Array (event name -> boolean). The
+    # value is true if the named event is allowed to be
+    # posted.
+
+    # Common code used by both allow and disallow to enter
+    # the state change.
+
+    method Allowance {events enable} {
+	set changed no
+	foreach event $events {
+	    if {$allowed($event) == $enable} continue
+	    set allowed($event) $enable
+	    set changed yes
+	}
+	if {!$changed} return
+	my Update
+	return
+    }
+
+    # Merge the current event allowance and the set of
+    # requested events into one datum, the set of events to
+    # post. From that then derive whether we need a timer or
+    # not and act accordingly.
+
+    method Update {} {
+	catch { after cancel $timer }
+	set posting {}
+	foreach event $requested {
+	    if {!$allowed($event)} continue
+	    lappend posting $event
+	}
+	if {[llength $posting]} {
+	    set timer [after $delay \
+			   [namespace code [list my Post]]]
+	} else {
+	    catch { unset timer }
+	}
+	return
+    }
+
+    # Post the current set of events, then reschedule to
+    # make this periodic.
+
+    method Post {} {
+	my variable channel
+	set timer [after $delay \
+		       [namespace code [list my Post]]]
+	chan postevent $channel $posting
+	return
+    }
+}
+
+# # ## ### #####
+package provide tcl::chan::events 1.1
+return

src/vendorlib/virtchannel_core/pkgIndex.tcl

@@ -0,0 +1,8 @@
+if {![package vsatisfies [package provide Tcl] 8.5 9]} {return}
+
+package ifneeded tcl::chan::core 1.1   [list source [file join $dir core.tcl]]
+package ifneeded tcl::chan::events 1.1 [list source [file join $dir events.tcl]]
+
+if {![package vsatisfies [package provide Tcl] 8.6 9]} {return}
+
+package ifneeded tcl::transform::core 1.1 [list source [file join $dir transformcore.tcl]]

src/vendorlib/virtchannel_core/transformcore.man

@@ -0,0 +1,72 @@
+[comment {-*- tcl -*- doctools manpage}]
+[manpage_begin tcl::transform::core n 1.1]
+[keywords {reflected channel}]
+[keywords {tip 219}]
+[keywords {virtual channel}]
+[copyright {2009 Andreas Kupries <andreas_kupries@users.sourceforge.net>}]
+[moddesc   {Reflected/virtual channel support}]
+[category  Channels]
+[titledesc {Basic reflected/virtual channel transform support}]
+[require Tcl "8.5 9"]
+[require TclOO]
+[require tcl::transform::core [opt 1.1]]
+[description]
+[para]
+
+The [package tcl::transform::core] package provides a [package TclOO]
+class implementing common behaviour needed by virtually every
+reflected or virtual channel transformation (initialization, finalization).
+
+[para] This class expects to be used as either superclass of a concrete
+channel class, or to be mixed into such a class.
+
+[section {Class API}]
+
+[list_begin definitions]
+
+[call [cmd ::tcl::transform::core] [arg objectName]]
+
+This command creates a new transform core object with an associated
+global Tcl command whose name is [emph objectName]. This command may
+be used to invoke various operations on the object, as described in
+the section for the [sectref {Instance API}].
+
+[list_end]
+
+[section {Instance API}]
+
+The API of transform core instances provides only two methods, both
+corresponding to transform handler commands (For reference see
+[uri http:/tip.tcl.tk/230 {TIP 230}]). They expect to be called
+from whichever object instance the transform core was made a part of.
+
+[list_begin definitions]
+
+[call [arg objectName] [method initialize] [arg thechannel] [arg mode]]
+
+This method implements standard behaviour for the [method initialize]
+method of transform handlers. Using introspection it finds the handler
+methods supported by the instance and returns a list containing their
+names, as expected by the support for reflected transformation in the
+Tcl core.
+
+[para] It further remembers the channel handle in an instance variable
+for access by sub-classes.
+
+[call [arg objectName] [method finalize] [arg thechannel]]
+
+This method implements standard behaviour for the [method finalize]
+method of channel handlers. It simply destroys itself.
+
+[call [arg objectName] [method destroy]]
+
+Destroying the transform core instance closes the channel and transform
+it was initialized for, see the method [method initialize]. When destroyed
+from within a call of [method finalize] this does not happen, under
+the assumption that the channel and transform are being destroyed by Tcl.
+
+[list_end]
+
+[vset CATEGORY virtchannel]
+[include ../common-text/feedback.inc]
+[manpage_end]

src/vendorlib/virtchannel_core/transformcore.tcl

@@ -0,0 +1,71 @@
+# -*- tcl -*-
+# # ## ### ##### ######## #############
+# (C) 2009 Andreas Kupries
+
+# @@ Meta Begin
+# Package tcl::transform::core 1.1
+# Meta as::author {Andreas Kupries}
+# Meta as::copyright 2009
+# Meta as::license BSD
+# Meta description Support package handling a core
+# Meta description aspect of reflected transform channels
+# Meta description (initialization, finalization).
+# Meta description It is expected that this class
+# Meta description is used as either one superclass of the
+# Meta description class C for a specific channel, or is
+# Meta description mixed into C.
+# Meta platform tcl
+# Meta require TclOO
+# Meta require {Tcl 8.6}
+# @@ Meta End
+
+# # ## ### ##### ######## #############
+
+package require Tcl 8.6 9
+
+# # ## ### ##### ######## #############
+
+oo::class create ::tcl::transform::core {
+    destructor {
+	if {$channel eq {}} return
+	close $channel
+	return
+    }
+
+    # # ## ### ##### ######## #############
+
+    method initialize {thechannel mode} {
+	set methods [info object methods [self] -all]
+
+	# Note: Checking of the mode against the supported methods is
+	#       done by the caller.
+
+	set channel $thechannel
+	set supported {}
+	foreach m {
+	    initialize finalize read write drain flush limit?
+	} {
+	    if {$m in $methods} {
+		lappend supported $m
+	    }
+	}
+	return $supported
+    }
+
+    method finalize {c} {
+	set channel {} ; # Prevent destroctor from calling close.
+	my destroy
+	return
+    }
+
+    # # ## ### ##### ######## #############
+
+    variable channel
+
+    # channel The channel the handler belongs to.
+    # # ## ### ##### ######## #############
+}
+
+# # ## ### #####
+package provide tcl::transform::core 1.1
+return

src/vendorlib/virtchannel_transform/ChangeLog

@@ -0,0 +1,53 @@
+2013-03-04  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	* zlib.man: Renamed, clashes with Tcl core manpage.
+	* tcllib_zlib.man: New name.
+
+2013-02-01  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.15 ========================
+	* 
+
+2011-12-13  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.14 ========================
+	* 
+
+2011-02-21  Andreas Kupries  <andreask@activestate.com>
+
+	* pkgIndex.tcl: Removed the superfluous [list] command in the
+	  ifneeded script.
+
+2011-01-24  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.13 ========================
+	* 
+
+2010-08-04  Andreas Kupries  <andreask@activestate.com>
+
+	* adler32.man: New files, documentation for the packages in
+	* base64.man: this module.
+	* counter.man:
+	* crc32.man:
+	* hex.man:
+	* identity.man:
+	* limitsize.man:
+	* observe.man:
+	* otp.man:
+	* rot.man:
+	* spacer.man:
+	* zlib.man:
+
+2009-12-07  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.12 ========================
+	* 
+
+2009-12-01  Andreas Kupries  <andreask@activestate.com>
+
+	* New module 'virtchannel_transform, providing classes implementing
+	  various channel transformation. TclOO based.

src/vendorlib/virtchannel_transform/README.txt

@@ -0,0 +1,38 @@
+base64, hex
+
+	Base64 and hex de- and encoding of data flowing
+	through a channel.
+
+	Encodes on write, decodes on read.
+
+identity
+
+	No transformation
+
+counter
+
+	Identity, counting bytes.
+
+adler32, adler32pure, crc32
+
+	Compute checksums and write to external variables.
+
+observe
+
+	Divert copy of the data to additional channels.
+
+limitsize
+
+	Force EOF after reading N bytes, N configurable.
+
+spacer
+
+	Inserts separator string every n bytes.
+
+otp
+
+	One-Time-Pad encryption.
+
+zlib
+
+	zlib (de)compression (deflate, inflate).

src/vendorlib/virtchannel_transform/adler32.man

@@ -0,0 +1,70 @@
+[comment {-*- tcl -*- doctools manpage}]
+[manpage_begin tcl::transform::adler32 n 1.1]
+[keywords adler32]
+[keywords {channel transformation}]
+[keywords checksum]
+[keywords {reflected channel}]
+[keywords {tip 230}]
+[keywords transformation]
+[keywords {virtual channel}]
+[copyright {2009 Andreas Kupries <andreas_kupries@users.sourceforge.net>}]
+[moddesc   {Reflected/virtual channel support}]
+[category  Channels]
+[titledesc {Adler32 transformation}]
+[require Tcl "8.6 9"]
+[require tcl::transform::core [opt 1.1]]
+[require tcl::transform::adler32 [opt 1.1]]
+[description]
+[para]
+
+The [package tcl::transform::adler32] package provides a command
+creating a channel transformation which passes the read and written
+bytes through unchanged (like [package tcl::transform::identity]), but
+additionally continuously computes the adler32 checksums of the data
+it has seen for each direction and stores them in Tcl variables
+specified at construction time.
+
+[para] Related transformations in this module are
+[package tcl::transform::counter],
+[package tcl::transform::crc32],
+[package tcl::transform::identity], and
+[package tcl::transform::observe].
+
+[para] The internal [package TclOO] class implementing the transform
+handler is a sub-class of the [package tcl::transform::core]
+framework.
+
+[section API]
+
+[list_begin definitions]
+
+[call [cmd ::tcl::transform::adler32] [arg chan] [option -option] [arg value]...]
+
+This command creates an adler32 checksumming transformation on top of
+the channel [arg chan] and returns its handle. The accepted options are
+
+[list_begin options]
+[opt_def -read-variable varname]
+
+The value of the option is the name of a global or namespaced
+variable, the location where the transformation has to store the
+adler32 checksum of the data read from the channel.
+
+[para] If not specified, or the empty string, the checksum of the read
+direction is not saved.
+
+[opt_def -write-variable varname]
+
+The value of the option is the name of a global or namespaced
+variable, the location where the transformation has to store the
+adler32 checksum of the data written to the channel.
+
+[para] If not specified, or the empty string, the checksum of the
+write direction is not saved.
+
+[list_end]
+[list_end]
+
+[vset CATEGORY virtchannel]
+[include ../common-text/feedback.inc]
+[manpage_end]

src/vendorlib/virtchannel_transform/adler32.tcl

@@ -0,0 +1,103 @@
+# -*- tcl -*-
+# # ## ### ##### ######## #############
+# (C) 2009 Andreas Kupries
+
+# @@ Meta Begin
+# Package tcl::transform::adler32 1.1
+# Meta as::author {Andreas Kupries}
+# Meta as::copyright 2009
+# Meta as::license BSD
+# Meta as::notes   For other observers see crc32, counter,
+# Meta as::notes   identity, and observer (stream copy).
+# Meta description Implementation of an adler32 checksum
+# Meta description transformation. Based on Tcl 8.6's
+# Meta description transformation reflection support (TIP
+# Meta description 230), and its zlib support (TIP 234) for
+# Meta description the adler32 functionality. An observer
+# Meta description instead of a transformation. For details
+# Meta description on the adler checksum see
+# Meta description http://en.wikipedia.org/wiki/Adler-32 .
+# Meta description The observer saves the checksums into two
+# Meta description namespaced external variables specified
+# Meta description at construction time. Exports a single
+# Meta description command adding a new transformation of
+# Meta description this type to a channel. One argument,
+# Meta description the channel to extend, plus options to
+# Meta description specify the variables for the checksums.
+# Meta description No result.
+# Meta platform tcl
+# Meta require tcl::transform::core
+# Meta require {Tcl 8.6}
+# @@ Meta End
+
+# # ## ### ##### ######## #############
+
+package require Tcl 8.6 9
+package require tcl::transform::core
+
+# # ## ### ##### ######## #############
+
+namespace eval ::tcl::transform {}
+
+proc ::tcl::transform::adler32 {chan args} {
+    ::chan push $chan [adler32::implementation new {*}$args]
+}
+
+oo::class create ::tcl::transform::adler32::implementation {
+    superclass tcl::transform::core ;# -> initialize, finalize, destructor
+
+    # This transformation continuously computes a checksum from the
+    # data it sees. This data may be arbitrary parts of the input or
+    # output if the channel is seeked while the transform is
+    # active. This may not be what is wanted and the desired behaviour
+    # may require the destruction of the transform before seeking.
+
+    method write {c data} {
+	my Adler32 -write-variable $data
+	return $data
+    }
+
+    method read {c data} {
+	my Adler32 -read-variable $data
+	return $data
+    }
+
+    # # ## ### ##### ######## #############
+
+    constructor {args} {
+	array set options {
+	    -read-variable  {}
+	    -write-variable {}
+	}
+	# todo: validity checking of options (legal names, legal
+	# values, etc.)
+	array set options $args
+	my Init -read-variable
+	my Init -write-variable
+	return
+    }
+
+    # # ## ### ##### ######## #############
+
+    variable options
+
+    # # ## ### ##### ######## #############
+
+    method Init {o} {
+	if {$options($o) eq ""} return
+	upvar #0 $options($o) adler
+	set adler 1
+	return
+    }
+
+    method Adler32 {o data} {
+	if {$options($o) eq ""} return
+	upvar #0 $options($o) adler
+	set adler [zlib adler32 $data $adler]
+	return
+    }
+}
+
+# # ## ### ##### ######## #############
+package provide tcl::transform::adler32 1.1
+return

src/vendorlib/virtchannel_transform/base64.tcl

@@ -0,0 +1,111 @@
+# -*- tcl -*-
+# # ## ### ##### ######## #############
+# (C) 2009 Andreas Kupries
+
+# @@ Meta Begin
+# Package tcl::transform::base64 1.1
+# Meta as::author {Andreas Kupries}
+# Meta as::copyright 2009
+# Meta as::license BSD
+# Meta as::notes   Possibilities for extension: Currently
+# Meta as::notes   the mapping between read/write and
+# Meta as::notes   decode/encode is fixed. Allow it to be
+# Meta as::notes   configured at construction time.
+# Meta description Implementation of a base64
+# Meta description transformation (RFC 4648). Based on Tcl
+# Meta description 8.6's transformation reflection support
+# Meta description (TIP 230) and binary en/decode (TIP 317).
+# Meta description Exports a single command adding a new
+# Meta description transformation of this type to a channel.
+# Meta description One argument, the channel to extend. No
+# Meta description result.
+# Meta platform tcl
+# Meta require tcl::transform::core
+# Meta require {Tcl 8.6}
+# @@ Meta End
+
+# # ## ### ##### ######## #############
+
+package require Tcl 8.6 9
+package require tcl::transform::core
+
+# # ## ### ##### ######## #############
+
+namespace eval ::tcl::transform {}
+
+proc ::tcl::transform::base64 {chan} {
+    ::chan push $chan [base64::implementation new]
+    return
+}
+
+oo::class create ::tcl::transform::base64::implementation {
+    superclass tcl::transform::core ;# -> initialize, finalize, destructor
+
+    method write {c data} {
+	my Code encodebuf encode $data 3
+    }
+
+    method read {c data} {
+	my Code decodebuf decode $data 4
+    }
+
+    method flush {c} {
+	set data [binary encode base64 $encodebuf]
+	set encodebuf {}
+	return $data
+    }
+
+    method drain {c} {
+	set data [binary decode base64 $decodebuf]
+	set decodebuf {}
+	return $data
+    }
+
+    method clear {c} {
+	set decodebuf {}
+	return
+    }
+
+    # # ## ### ##### ######## #############
+
+    constructor {} {
+	set encodebuf {}
+	set decodebuf {}
+	return
+    }
+
+    # # ## ### ##### ######## #############
+
+    variable encodebuf decodebuf
+
+    # # ## ### ##### ######## #############
+
+    method Code {bufvar op data n} {
+	upvar 1 $bufvar buffer
+
+	append buffer $data
+
+	set n [my Complete $buffer $n]
+	if {$n < 0} {
+	    return {}
+	}
+
+	set result \
+	    [binary $op base64 \
+		 [string range $buffer 0 $n]]
+	incr n
+	set buffer \
+	    [string range $buffer $n end]
+
+	return $result
+    }
+
+    method Complete {buffer n} {
+	set len [string length $buffer]
+	return [expr {(($len / $n) * $n)-1}]
+    }
+}
+
+# # ## ### ##### ######## #############
+package provide tcl::transform::base64 1.1
+return

src/vendorlib/virtchannel_transform/counter.tcl

@@ -0,0 +1,94 @@
+# -*- tcl -*-
+# # ## ### ##### ######## #############
+# (C) 2009 Andreas Kupries
+
+# @@ Meta Begin
+# Package tcl::transform::counter 1.1
+# Meta as::author {Andreas Kupries}
+# Meta as::copyright 2009
+# Meta as::license BSD
+# Meta as::notes   For other observers see adler32, crc32,
+# Meta as::notes   identity, and observer (stream copy).
+# Meta as::notes   Possibilities for extension: Separate
+# Meta as::notes   counters per byte value. Count over
+# Meta as::notes   fixed time-intervals = channel speed.
+# Meta as::notes   Use callbacks or traces to save changes
+# Meta as::notes   in the counters, etc. as time-series.
+# Meta as::notes   Compute statistics over the time-series.
+# Meta description Implementation of a counter
+# Meta description transformation. Based on Tcl 8.6's
+# Meta description transformation reflection support (TIP
+# Meta description 230). An observer instead of a
+# Meta description transformation, it counts the number of
+# Meta description bytes read and written. The observer
+# Meta description saves the counts into two external
+# Meta description namespaced variables specified at
+# Meta description construction time. Exports a single
+# Meta description command adding a new transformation of
+# Meta description this type to a channel. One argument,
+# Meta description the channel to extend, plus options to
+# Meta description specify the variables for the counters.
+# Meta description No result.
+# Meta platform tcl
+# Meta require tcl::transform::core
+# Meta require {Tcl 8.6}
+# @@ Meta End
+
+# # ## ### ##### ######## #############
+
+package require Tcl 8.6 9
+package require tcl::transform::core
+
+# # ## ### ##### ######## #############
+
+namespace eval ::tcl::transform {}
+
+proc ::tcl::transform::counter {chan args} {
+    ::chan push $chan [counter::implementation new {*}$args]
+}
+
+oo::class create ::tcl::transform::counter::implementation {
+    superclass tcl::transform::core ;# -> initialize, finalize, destructor
+
+    method write {c data} {
+	my Count -write-variable $data
+	return $data
+    }
+
+    method read {c data} {
+	my Count -read-variable $data
+	return $data
+    }
+
+    # No partial data, nor state => no flush, drain, nor clear needed.
+
+    # # ## ### ##### ######## #############
+
+    constructor {args} {
+	array set options {
+	    -read-variable  {}
+	    -write-variable {}
+	}
+	# todo: validity checking of options (legal names, legal
+	# values, etc.)
+	array set options $args
+	return
+    }
+
+    # # ## ### ##### ######## #############
+
+    variable options
+
+    # # ## ### ##### ######## #############
+
+    method Count {o data} {
+	if {$options($o) eq ""} return
+	upvar #0 $options($o) counter
+	incr counter [string length $data]
+	return
+    }
+}
+
+# # ## ### ##### ######## #############
+package provide tcl::transform::counter 1.1
+return

src/vendorlib/virtchannel_transform/crc32.tcl

@@ -0,0 +1,103 @@
+# -*- tcl -*-
+# # ## ### ##### ######## #############
+# (C) 2009 Andreas Kupries
+
+# @@ Meta Begin
+# Package tcl::transform::crc32 1.1
+# Meta as::author {Andreas Kupries}
+# Meta as::copyright 2009
+# Meta as::license BSD
+# Meta as::notes   For other observers see adler32, counter,
+# Meta as::notes   identity, and observer (stream copy).
+# Meta description Implementation of a crc32 checksum
+# Meta description transformation. Based on Tcl 8.6's
+# Meta description transformation reflection support (TIP
+# Meta description 230), and its zlib support (TIP 234) for
+# Meta description the crc32 functionality. An observer
+# Meta description instead of a transformation. For details
+# Meta description on the crc checksum see
+# Meta description http://en.wikipedia.org/wiki/Cyclic_redundancy_check#Commonly_used_and_standardised_CRCs .
+# Meta description The observer saves the checksums into two
+# Meta description namespaced external variables specified
+# Meta description at construction time. Exports a single
+# Meta description command adding a new transformation of
+# Meta description this type to a channel. One argument,
+# Meta description the channel to extend, plus options to
+# Meta description specify the variables for the checksums.
+# Meta description No result.
+# Meta platform tcl
+# Meta require tcl::transform::core
+# Meta require {Tcl 8.6}
+# @@ Meta End
+
+# # ## ### ##### ######## #############
+
+package require Tcl 8.6 9
+package require tcl::transform::core
+
+# # ## ### ##### ######## #############
+
+namespace eval ::tcl::transform {}
+
+proc ::tcl::transform::crc32 {chan args} {
+    ::chan push $chan [crc32::implementation new {*}$args]
+}
+
+oo::class create ::tcl::transform::crc32::implementation {
+    superclass tcl::transform::core ;# -> initialize, finalize, destructor
+
+    # This transformation continuously computes a checksum from the
+    # data it sees. This data may be arbitrary parts of the input or
+    # output if the channel is seeked while the transform is
+    # active. This may not be what is wanted and the desired behaviour
+    # may require the destruction of the transform before seeking.
+
+    method write {c data} {
+	my Crc32 -write-variable $data
+	return $data
+    }
+
+    method read {c data} {
+	my Crc32 -read-variable $data
+	return $data
+    }
+
+    # # ## ### ##### ######## #############
+
+    constructor {args} {
+	array set options {
+	    -read-variable  {}
+	    -write-variable {}
+	}
+	# todo: validity checking of options (legal names, legal
+	# values, etc.)
+	array set options $args
+	my Init -read-variable
+	my Init -write-variable
+	return
+    }
+
+    # # ## ### ##### ######## #############
+
+    variable options
+
+    # # ## ### ##### ######## #############
+
+    method Init {o} {
+	if {$options($o) eq ""} return
+	upvar #0 $options($o) crc
+	set crc 0
+	return
+    }
+
+    method Crc32 {o data} {
+	if {$options($o) eq ""} return
+	upvar #0 $options($o) crc
+	set crc [zlib crc32 $data $crc]
+	return
+    }
+}
+
+# # ## ### ##### ######## #############
+package provide tcl::transform::crc32 1.1
+return

src/vendorlib/virtchannel_transform/hex.man

@@ -0,0 +1,43 @@
+[comment {-*- tcl -*- doctools manpage}]
+[manpage_begin tcl::transform::hex n 1.1]
+[keywords {channel transformation}]
+[keywords hexadecimal]
+[keywords {reflected channel}]
+[keywords {tip 230}]
+[keywords transformation]
+[keywords {virtual channel}]
+[copyright {2009 Andreas Kupries <andreas_kupries@users.sourceforge.net>}]
+[moddesc   {Reflected/virtual channel support}]
+[category  Channels]
+[titledesc {Hexadecimal encoding transformation}]
+[require Tcl "8.6 9"]
+[require tcl::transform::core [opt 1.1]]
+[require tcl::transform::hex [opt 1.1]]
+[description]
+[para]
+
+The [package tcl::transform::hex] package provides a command creating
+a channel transformation which hex encodes data written to it, and
+decodes the data read from it.
+
+[para] A related transformations in this module is
+[package tcl::transform::base64].
+
+[para] The internal [package TclOO] class implementing the transform
+handler is a sub-class of the [package tcl::transform::core]
+framework.
+
+[section API]
+
+[list_begin definitions]
+
+[call [cmd ::tcl::transform::hex] [arg chan]]
+
+This command creates a hex transformation on top of the channel
+[arg chan] and returns its handle.
+
+[list_end]
+
+[vset CATEGORY virtchannel]
+[include ../common-text/feedback.inc]
+[manpage_end]

src/vendorlib/virtchannel_transform/hex.tcl

@@ -0,0 +1,58 @@
+# -*- tcl -*-
+# # ## ### ##### ######## #############
+# (C) 2009 Andreas Kupries
+
+# @@ Meta Begin
+# Package tcl::transform::hex 1.1
+# Meta as::author {Andreas Kupries}
+# Meta as::copyright 2009
+# Meta as::license BSD
+# Meta description Implementation of a hex transformation,
+# Meta description using Tcl 8.6's transformation
+# Meta description reflection support. Uses the binary
+# Meta description command to implement the transformation.
+# Meta description Exports a single command adding a new
+# Meta description transform of this type to a channel. One
+# Meta description argument, the channel to extend. No
+# Meta description result.
+# Meta platform tcl
+# Meta require tcl::transform::core
+# Meta require {Tcl 8.6}
+# @@ Meta End
+
+# # ## ### ##### ######## #############
+
+package require Tcl 8.6 9
+package require tcl::transform::core
+
+# # ## ### ##### ######## #############
+
+namespace eval ::tcl::transform {}
+
+proc ::tcl::transform::hex {chan} {
+    ::chan push $chan [hex::implementation new]
+    return
+}
+
+oo::class create ::tcl::transform::hex::implementation {
+    superclass tcl::transform::core ;# -> initialize, finalize, destructor
+
+    method write {c data} {
+	# bytes -> hex
+	binary scan $data H* hex
+	return $hex
+    }
+
+    method read {c data} {
+	# hex -> bytes
+	return [binary format H* $data]
+    }
+
+    # No partial data, nor state => no flush, drain, nor clear needed.
+
+    # # ## ### ##### ######## #############
+}
+
+# # ## ### ##### ######## #############
+package provide tcl::transform::hex 1.1
+return

src/vendorlib/virtchannel_transform/identity.man

@@ -0,0 +1,50 @@
+[comment {-*- tcl -*- doctools manpage}]
+[manpage_begin tcl::transform::identity n 1.1]
+[keywords {channel transformation}]
+[keywords identity]
+[keywords {reflected channel}]
+[keywords {tip 230}]
+[keywords transformation]
+[keywords {virtual channel}]
+[copyright {2009 Andreas Kupries <andreas_kupries@users.sourceforge.net>}]
+[moddesc   {Reflected/virtual channel support}]
+[category  Channels]
+[titledesc {Identity transformation}]
+[require Tcl "8.6 9"]
+[require tcl::transform::core [opt 1.1]]
+[require tcl::transform::identity [opt 1.1]]
+[description]
+[para]
+
+The [package tcl::transform::identity] package provides a command
+creating an identity channel transformation, which does nothing but
+pass the read and written bytes through it unchanged. Not really
+useful in an application, however as the prototypical observer
+transformation its code is a useful starting point for any other
+observers people may wish to write.
+
+[para] The transformations in this module which derived from
+identity's code are
+[package tcl::transform::adler32],
+[package tcl::transform::counter],
+[package tcl::transform::crc32], and
+[package tcl::transform::observe].
+
+[para] The internal [package TclOO] class implementing the transform
+handler is a sub-class of the [package tcl::transform::core]
+framework.
+
+[section API]
+
+[list_begin definitions]
+
+[call [cmd ::tcl::transform::identity] [arg chan]]
+
+This command creates an identity transformation on top of the channel
+[arg chan] and returns its handle.
+
+[list_end]
+
+[vset CATEGORY virtchannel]
+[include ../common-text/feedback.inc]
+[manpage_end]

src/vendorlib/virtchannel_transform/identity.tcl

@@ -0,0 +1,59 @@
+# -*- tcl -*-
+# # ## ### ##### ######## #############
+# (C) 2009 Andreas Kupries
+
+# @@ Meta Begin
+# Package tcl::transform::identity 1.1
+# Meta as::author {Andreas Kupries}
+# Meta as::copyright 2009
+# Meta as::license BSD
+# Meta as::notes   The prototypical observer transformation.
+# Meta as::notes   To observers what null is to reflected
+# Meta as::notes   base channels. For other observers see
+# Meta as::notes   adler32, crc32, counter, and observer
+# Meta as::notes   (stream copy).
+# Meta description Implementation of an identity
+# Meta description transformation, i.e one which does not
+# Meta description change the data in any way, shape, or
+# Meta description form. Based on Tcl 8.6's transformation
+# Meta description reflection support. Exports a single
+# Meta description command adding a new transform of this
+# Meta description type to a channel. One argument, the
+# Meta description channel to extend. No result.
+# Meta platform tcl
+# Meta require tcl::transform::core
+# Meta require {Tcl 8.6}
+# @@ Meta End
+
+# # ## ### ##### ######## #############
+
+package require Tcl 8.6 9
+package require tcl::transform::core
+
+# # ## ### ##### ######## #############
+
+namespace eval ::tcl::transform {}
+
+proc ::tcl::transform::identity {chan} {
+    ::chan push $chan [identity::implementation new]
+}
+
+oo::class create ::tcl::transform::identity::implementation {
+    superclass tcl::transform::core ;# -> initialize, finalize, destructor
+
+    method write {c data} {
+	return $data
+    }
+
+    method read {c data} {
+	return $data
+    }
+
+    # No partial data, nor state => no flush, drain, nor clear needed.
+
+    # # ## ### ##### ######## #############
+}
+
+# # ## ### ##### ######## #############
+package provide tcl::transform::identity 1.1
+return

src/vendorlib/virtchannel_transform/limitsize.man

@@ -0,0 +1,46 @@
+[comment {-*- tcl -*- doctools manpage}]
+[manpage_begin tcl::transform::limitsize n 1.1]
+[keywords {channel transformation}]
+[keywords limitsize]
+[keywords {reflected channel}]
+[keywords {size limit}]
+[keywords {tip 230}]
+[keywords transformation]
+[keywords {virtual channel}]
+[copyright {2009 Andreas Kupries <andreas_kupries@users.sourceforge.net>}]
+[moddesc   {Reflected/virtual channel support}]
+[category  Channels]
+[titledesc {limiting input}]
+[require Tcl "8.6 9"]
+[require tcl::transform::core [opt 1.1]]
+[require tcl::transform::limitsize [opt 1.1]]
+[description]
+[para]
+
+The [package tcl::transform::limitsize] package provides a command
+creating a channel transformation which limits the number of
+characters which can be read from the channel. A generator for an
+artificial EOF.
+
+[para] The internal [package TclOO] class implementing the transform
+handler is a sub-class of the [package tcl::transform::core]
+framework.
+
+[section API]
+
+[list_begin definitions]
+
+[call [cmd ::tcl::transform::limitsize] [arg chan] [arg max]]
+
+This command creates a size limiting transformation on top of the
+channel [arg chan] and returns its handle.
+
+[para] [arg max] is the number of bytes which can be read from the
+channel before EOF is signaled by the transformation. Note that
+popping the transformation clears the EOF it generated as well.
+
+[list_end]
+
+[vset CATEGORY virtchannel]
+[include ../common-text/feedback.inc]
+[manpage_end]

src/vendorlib/virtchannel_transform/limitsize.tcl

@@ -0,0 +1,88 @@
+# -*- tcl -*-
+# # ## ### ##### ######## #############
+# (C) 2009 Andreas Kupries
+
+# @@ Meta Begin
+# Package tcl::transform::limitsize 1.1
+# Meta as::author {Andreas Kupries}
+# Meta as::copyright 2009
+# Meta as::license BSD
+# Meta as::notes   Possibilities for extension: Trigger the
+# Meta as::notes   EOF when finding specific patterns in
+# Meta as::notes   the input. Trigger the EOF based on some
+# Meta as::notes   external signal routed into the limiter.
+# Meta as::notes   Make the limit reconfigurable.
+# Meta description Implementation of a transformation
+# Meta description limiting the number of bytes read
+# Meta description from its channel. An observer instead of
+# Meta description a transformation, forcing an artificial
+# Meta description EOF marker. Based on Tcl 8.6's
+# Meta description transformation reflection support.
+# Meta description Exports a single command adding a new
+# Meta description transform of this type to a channel. One
+# Meta description argument, the channel to extend, and the
+# Meta description number of bytes to allowed to be read.
+# Meta description No result.
+# Meta platform tcl
+# Meta require tcl::transform::core
+# Meta require {Tcl 8.6}
+# @@ Meta End
+
+# This may help with things like zlib compression of messages. Have
+# the message format a length at the front, followed by a payload of
+# that size. Now we may compress messages. On the read side we can use
+# the limiter to EOF on a message, then reset the limit for the
+# next. This is a half-baked idea.
+
+# # ## ### ##### ######## #############
+
+package require Tcl 8.6 9
+package require tcl::transform::core
+
+# # ## ### ##### ######## #############
+
+namespace eval ::tcl::transform {}
+
+proc ::tcl::transform::limitsize {chan max} {
+    ::chan push $chan [limitsize::implementation new $max]
+}
+
+oo::class create ::tcl::transform::limitsize::implementation {
+    superclass tcl::transform::core ;# -> initialize, finalize, destructor
+
+    method write {c data} {
+	return $data
+    }
+
+    method read {c data} {
+	# Reduce the limit of bytes allowed in the future according to
+	# the number of bytes we have seen already.
+
+	if {$max > 0} {
+	    incr max -[string length $data]
+	    if {$max < 0} {
+		set max 0
+	    }
+	}
+	return $data
+    }
+
+    method limit? {c} {
+	return $max
+    }
+
+    # # ## ### ##### ######## #############
+
+    constructor {themax} {
+	set max $themax
+	return
+    }
+
+    variable max
+
+    # # ## ### ##### ######## #############
+}
+
+# # ## ### ##### ######## #############
+package provide tcl::transform::limitsize 1.1
+return

src/vendorlib/virtchannel_transform/observe.man

@@ -0,0 +1,50 @@
+[comment {-*- tcl -*- doctools manpage}]
+[manpage_begin tcl::transform::observe n 1.1]
+[keywords {channel transformation}]
+[keywords observer]
+[keywords {reflected channel}]
+[keywords {stream copy}]
+[keywords {tip 230}]
+[keywords transformation]
+[keywords {virtual channel}]
+[copyright {2009 Andreas Kupries <andreas_kupries@users.sourceforge.net>}]
+[moddesc   {Reflected/virtual channel support}]
+[category  Channels]
+[titledesc {Observer transformation, stream copy}]
+[require Tcl "8.6 9"]
+[require tcl::transform::core [opt 1.1]]
+[require tcl::transform::observe [opt 1.1]]
+[description]
+[para]
+
+The [package tcl::transform::observer] package provides a command
+creating a channel transformation which passes the read and written
+bytes through unchanged (like [package tcl::transform::identity]), but
+additionally copies the data it has seen for each direction into
+channels specified at construction time.
+
+[para] Related transformations in this module are
+[package tcl::transform::adler32],
+[package tcl::transform::counter],
+[package tcl::transform::crc32], and
+[package tcl::transform::identity].
+
+[para] The internal [package TclOO] class implementing the transform
+handler is a sub-class of the [package tcl::transform::core]
+framework.
+
+[section API]
+
+[list_begin definitions]
+
+[call [cmd ::tcl::transform::observe] [arg chan] [arg logw] [arg logr]]
+
+This command creates an observer transformation on top of the channel
+[arg chan] and returns its handle. The channel handles [arg logr] and
+[arg logw] are there the data is copied to.
+
+[list_end]
+
+[vset CATEGORY virtchannel]
+[include ../common-text/feedback.inc]
+[manpage_end]

src/vendorlib/virtchannel_transform/observe.tcl

@@ -0,0 +1,80 @@
+# -*- tcl -*-
+# # ## ### ##### ######## #############
+# (C) 2009 Andreas Kupries
+
+# @@ Meta Begin
+# Package tcl::transform::observe 1.1
+# Meta as::author {Andreas Kupries}
+# Meta as::copyright 2009
+# Meta as::license BSD
+# Meta as::notes   For other observers see adler32, crc32,
+# Meta as::notes   identity, and counter.
+# Meta as::notes   Possibilities for extension: Save the
+# Meta as::notes   observed bytes to variables instead of
+# Meta as::notes   channels. Use callbacks to save the
+# Meta as::notes   observed bytes.
+# Meta description Implementation of an observer
+# Meta description transformation copying the bytes going
+# Meta description through it into two channels configured
+# Meta description at construction time. Based on Tcl 8.6's
+# Meta description transformation reflection support.
+# Meta description Exports a single command adding a new
+# Meta description transformation of this type to a channel.
+# Meta description Three arguments, the channel to extend,
+# Meta description plus the channels to write the bytes to.
+# Meta description No result.
+# Meta platform tcl
+# Meta require tcl::transform::core
+# Meta require {Tcl 8.6}
+# @@ Meta End
+
+# # ## ### ##### ######## #############
+
+package require Tcl 8.6 9
+package require tcl::transform::core
+
+# # ## ### ##### ######## #############
+
+namespace eval ::tcl::transform {}
+
+proc ::tcl::transform::observe {chan logw logr} {
+    ::chan push $chan [observe::implementation new $logw $logr]
+}
+
+oo::class create ::tcl::transform::observe::implementation {
+    superclass tcl::transform::core ;# -> initialize, finalize, destructor
+
+    method write {c data} {
+	if {$logw ne {}} {
+	    puts -nonewline $logw $data
+	}
+	return $data
+    }
+
+    method read {c data} {
+	if {$logr ne {}} {
+	    puts -nonewline $logr $data
+	}
+	return $data
+    }
+
+    # No partial data, nor state => no flush, drain, nor clear needed.
+
+    # # ## ### ##### ######## #############
+
+    constructor {lw lr} {
+	set logr $lr
+	set logw $lw
+	return
+    }
+
+    # # ## ### ##### ######## #############
+
+    variable logr logw
+
+    # # ## ### ##### ######## #############
+}
+
+# # ## ### ##### ######## #############
+package provide tcl::transform::observe 1.1
+return

src/vendorlib/virtchannel_transform/otp.tcl

@@ -0,0 +1,98 @@
+# -*- tcl -*-
+# # ## ### ##### ######## #############
+# (C) 2009 Andreas Kupries
+
+# @@ Meta Begin
+# Package tcl::transform::otp 1.1
+# Meta as::author {Andreas Kupries}
+# Meta as::copyright 2009
+# Meta as::license BSD
+# Meta description Implementation of an onetimepad
+# Meta description encryption transformation. Based on Tcl
+# Meta description 8.6's transformation reflection support.
+# Meta description The key bytes are read from two channels
+# Meta description configured at construction time. Exports
+# Meta description a single command adding a new
+# Meta description transformation of this type to a channel.
+# Meta description Three arguments, the channel to extend,
+# Meta description plus the channels to read the keys from.
+# Meta description No result.
+# Meta platform tcl
+# Meta require tcl::transform::core
+# Meta require {Tcl 8.6}
+# @@ Meta End
+
+# # ## ### ##### ######## #############
+
+package require Tcl 8.6 9
+package require tcl::transform::core
+
+# # ## ### ##### ######## #############
+
+namespace eval ::tcl::transform {}
+
+proc ::tcl::transform::otp {chan keychanw keychanr} {
+    ::chan push $chan [otp::implementation new $keychanw $keychanr]
+}
+
+oo::class create ::tcl::transform::otp::implementation {
+    superclass tcl::transform::core ;# -> initialize, finalize, destructor
+
+    # This transformation is intended for streaming operation. Seeking
+    # the channel while it is active may cause undesirable
+    # output. Proper behaviour may require the destruction of the
+    # transform before seeking.
+
+    method write {c data} {
+	return [my Xor $data $keychanw]
+    }
+
+    method read {c data} {
+	return [my Xor $data $keychanr]
+    }
+
+    # # ## ### ##### ######## #############
+
+    constructor {keyw keyr} {
+	set keychanr $keyr
+	set keychanw $keyw
+	return
+    }
+
+    # # ## ### ##### ######## #############
+
+    variable keychanr keychanw
+
+    # # ## ### ##### ######## #############
+
+    # A very convoluted way to perform the XOR would be to use TIP
+    # #317's hex encoding to convert the bytes into strings, then zip
+    # key and data into an interleaved string (nibble wise), then
+    # perform the xor as a 'string map' of the whole thing, and at
+    # last 'binary decode hex' the string back into bytes. Even so
+    # most ops would run on the whole message at C level. Except for
+    # the interleave. :(
+
+    method Xor {data keychan} {
+	# xor is done byte-wise. to keep IO down we read the key bytes
+	# once, before the loop handling the bytes. Note that we are
+	# having binary data at this point, making it necessary to
+	# convert into numbers (scan), and back (binary format).
+
+	set keys [read $keychan [string length $data]]
+	set result {}
+	foreach d [split $data {}] k [split $keys {}] {
+	    append result \
+		[binary format c \
+		     [expr {
+			    [scan $d %c] ^
+			    [scan $k %c]
+			}]]
+	}
+	return $result
+    }
+}
+
+# # ## ### ##### ######## #############
+package provide tcl::transform::otp 1.1
+return

src/vendorlib/virtchannel_transform/pkgIndex.tcl

@@ -0,0 +1,14 @@
+if {![package vsatisfies [package provide Tcl] 8.6 9]} {return}
+
+package ifneeded tcl::transform::adler32 1.1     [list source [file join $dir adler32.tcl]]
+package ifneeded tcl::transform::base64 1.1      [list source [file join $dir base64.tcl]]
+package ifneeded tcl::transform::counter 1.1     [list source [file join $dir counter.tcl]]
+package ifneeded tcl::transform::crc32 1.1       [list source [file join $dir crc32.tcl]]
+package ifneeded tcl::transform::hex 1.1         [list source [file join $dir hex.tcl]]
+package ifneeded tcl::transform::identity 1.1    [list source [file join $dir identity.tcl]]
+package ifneeded tcl::transform::limitsize 1.1   [list source [file join $dir limitsize.tcl]]
+package ifneeded tcl::transform::observe 1.1     [list source [file join $dir observe.tcl]]
+package ifneeded tcl::transform::otp 1.1         [list source [file join $dir otp.tcl]]
+package ifneeded tcl::transform::rot 1.1         [list source [file join $dir rot.tcl]]
+package ifneeded tcl::transform::spacer 1.1      [list source [file join $dir spacer.tcl]]
+package ifneeded tcl::transform::zlib 1.0.2      [list source [file join $dir zlib.tcl]]

src/vendorlib/virtchannel_transform/rot.man

@@ -0,0 +1,57 @@
+[comment {-*- tcl -*- doctools manpage}]
+[manpage_begin tcl::transform::rot n 1.1]
+[keywords {caesar cipher}]
+[keywords {channel transformation}]
+[keywords cipher]
+[keywords decryption]
+[keywords encryption]
+[keywords {reflected channel}]
+[keywords rot]
+[keywords rot13]
+[keywords {tip 230}]
+[keywords transformation]
+[keywords {virtual channel}]
+[copyright {2009 Andreas Kupries <andreas_kupries@users.sourceforge.net>}]
+[moddesc   {Reflected/virtual channel support}]
+[category  Channels]
+[titledesc {rot-encryption}]
+[require Tcl "8.6 9"]
+[require tcl::transform::core [opt 1.1]]
+[require tcl::transform::rot [opt 1.1]]
+[description]
+[para]
+
+The [package tcl::transform::rot] package provides a command creating
+a channel transformation which performs primitive encryption (on
+writing) and decryption (on reading) on the alphabetic characters. The
+algorithm is the Caesar-cipher, a specific variant of which is rot13.
+
+[para] A related transformations in this module is
+[package tcl::transform::otp].
+
+[para] The internal [package TclOO] class implementing the transform
+handler is a sub-class of the [package tcl::transform::core]
+framework.
+
+[section API]
+
+[list_begin definitions]
+
+[call [cmd ::tcl::transform::rot] [arg chan] [arg key]]
+
+This command creates a rot encryption transformation on top of the
+channel [arg chan] and returns its handle.
+
+[para] The "[arg key]" specifies how far characters are rotated in the
+alphabet, and is wrapped to the range "0...25".
+
+[para] Note that this transformation affects only bytes in the ranges
+ASCII 65...90, and 97...122, i.e. the upper- and lower-case alphabetic
+characters, i.e. "A...Z" and "a...z". All other bytes are passed
+through unchanged.
+
+[list_end]
+
+[vset CATEGORY virtchannel]
+[include ../common-text/feedback.inc]
+[manpage_end]

src/vendorlib/virtchannel_transform/rot.tcl

@@ -0,0 +1,95 @@
+# -*- tcl -*-
+# # ## ### ##### ######## #############
+# (C) 2009 Andreas Kupries
+
+# @@ Meta Begin
+# Package tcl::transform::rot 1.1
+# Meta as::author {Andreas Kupries}
+# Meta as::copyright 2009
+# Meta as::license BSD
+# Meta description Implementation of a rot
+# Meta description encryption transformation. Based on Tcl
+# Meta description 8.6's transformation reflection support.
+# Meta description The key byte is
+# Meta description configured at construction time. Exports
+# Meta description a single command adding a new
+# Meta description transformation of this type to a channel.
+# Meta description Two arguments, the channel to extend,
+# Meta description plus the key byte.
+# Meta description No result.
+# Meta platform tcl
+# Meta require tcl::transform::core
+# Meta require {Tcl 8.6}
+# @@ Meta End
+
+# # ## ### ##### ######## #############
+
+package require Tcl 8.6 9
+package require tcl::transform::core
+
+# # ## ### ##### ######## #############
+
+namespace eval ::tcl::transform {}
+
+proc ::tcl::transform::rot {chan key} {
+    ::chan push $chan [rot::implementation new $key]
+}
+
+oo::class create ::tcl::transform::rot::implementation {
+    superclass tcl::transform::core ;# -> initialize, finalize, destructor
+
+    # This transformation is intended for streaming operation. Seeking
+    # the channel while it is active may cause undesirable
+    # output. Proper behaviour may require the destruction of the
+    # transform before seeking.
+
+    method write {c data} {
+	return [my Rot $data $key]
+    }
+
+    method read {c data} {
+	return [my Rot $data $ikey]
+    }
+
+    # # ## ### ##### ######## #############
+
+    constructor {thekey} {
+	set key [expr {$thekey % 26}]
+	set ikey [expr {26 - $key}]
+	return
+    }
+
+    # # ## ### ##### ######## #############
+
+    variable key ikey
+
+    # # ## ### ##### ######## #############
+
+    method Rot {data key} {
+	# rot'ation is done byte-wise. Note that we are having binary
+	# data at this point, making it necessary to convert into
+	# numbers (scan), and back (binary format).
+
+	set result {}
+	foreach d [split $data {}] {
+	    set dx [scan $d %c]
+	    if {(65 <= $dx)  && ($dx <= 90)} {
+		set n [binary format c \
+			   [expr { (($dx - 65 + $key) % 26) + 65 }]]
+	    } elseif {(97 <= $dx) && ($dx <= 122)} {
+		set n [binary format c \
+			   [expr { (($dx - 97 + $key) % 26) + 97 }]]
+	    } else {
+		set n $d
+	    }
+
+	    append result $n
+		
+	}
+	return $result
+    }
+}
+
+# # ## ### ##### ######## #############
+package provide tcl::transform::rot 1.1
+return

src/vendorlib/virtchannel_transform/spacer.man

@@ -0,0 +1,45 @@
+[comment {-*- tcl -*- doctools manpage}]
+[manpage_begin tcl::transform::spacer n 1.1]
+[keywords {channel transformation}]
+[keywords {reflected channel}]
+[keywords spacing]
+[keywords {tip 230}]
+[keywords transformation]
+[keywords {virtual channel}]
+[copyright {2009 Andreas Kupries <andreas_kupries@users.sourceforge.net>}]
+[moddesc   {Reflected/virtual channel support}]
+[category  Channels]
+[titledesc {Space insertation and removal}]
+[require Tcl "8.6 9"]
+[require tcl::transform::core [opt 1.1]]
+[require tcl::transform::spacer [opt 1.1]]
+[description]
+[para]
+
+The [package tcl::transform::spacer] package provides a command
+creating a channel transformation which adds spacing to the data
+written to it, and removes such spacing from the data read from it.
+
+[para] The internal [package TclOO] class implementing the transform
+handler is a sub-class of the [package tcl::transform::core]
+framework.
+
+[section API]
+
+[list_begin definitions]
+
+[call [cmd ::tcl::transform::spacer] [arg chan] [arg n] [opt [arg space]]]
+
+This command creates a spacer transformation on top of the channel
+[arg chan] and returns its handle.
+
+[para] The [arg space] character sequence will be added every [arg n]
+bytes of data written, and on the read side the same is done in
+reverse, removing the spacing. If [arg space] is not specified it
+defaults to a single space character (ASCII 32).
+
+[list_end]
+
+[vset CATEGORY virtchannel]
+[include ../common-text/feedback.inc]
+[manpage_end]

src/vendorlib/virtchannel_transform/spacer.tcl

@@ -0,0 +1,151 @@
+# -*- tcl -*-
+# # ## ### ##### ######## #############
+# (C) 2009 Andreas Kupries
+
+# @@ Meta Begin
+# Package tcl::transform::spacer 1.1
+# Meta as::author {Andreas Kupries}
+# Meta as::copyright 2009
+# Meta as::license BSD
+# Meta description Implementation of a spacer
+# Meta description transformation, using Tcl 8.6's
+# Meta description transformation reflection support. Uses
+# Meta description counters to implement the transformation,
+# Meta description i.e. decide where to insert the spacing.
+# Meta description Exports a single command adding a new
+# Meta description transform of this type to a channel. One
+# Meta description argument, the channel to extend. No
+# Meta description result.
+# Meta platform tcl
+# Meta require tcl::transform::core
+# Meta require {Tcl 8.6}
+# @@ Meta End
+
+# # ## ### ##### ######## #############
+
+package require Tcl 8.6 9
+package require tcl::transform::core
+
+# # ## ### ##### ######## #############
+
+namespace eval ::tcl::transform {}
+
+proc ::tcl::transform::spacer {chan n {space { }}} {
+    ::chan push $chan [spacer::implementation new $n $space]
+    return
+}
+
+oo::class create ::tcl::transform::spacer::implementation {
+    superclass tcl::transform::core ;# -> initialize, finalize, destructor
+
+    # This transformation is intended for streaming operation. Seeking
+    # the channel while it is active may cause undesirable
+    # output. Proper behaviour may require the destruction of the
+    # transform before seeking.
+
+    method write {c data} {
+	# add spacing, data is split into groups of delta chars.
+	set result {}
+	set len [string length $data]
+
+	if {$woffset} {
+	    # The beginning of the buffer is the remainder of the
+	    # partial group found at the end of the buffer in the last
+	    # call.  It may still be partial, if the current buffer is
+	    # short enough.
+
+	    if {($woffset + $len) < $delta} {
+		# Yes, the group is still not fully covered.
+		# Move the offset forward, and return the whole
+		# buffer. spacing is not needed yet.
+		incr woffset $len
+		return $data
+	    }
+
+	    # The buffer completes the group. Add it and the following
+	    # spacing, then fix the offset to start the processing of
+	    # the groups coming after at the proper location.
+
+	    set stop [expr {$delta - $woffset - 1}]
+
+	    append result [string range $data 0 $stop]
+	    append result $spacing
+
+	    set  woffset $stop
+	    incr woffset
+	}
+
+	# Process full groups in the middle of the incoming buffer.
+
+	set at   $woffset
+	set stop [expr {$at + $delta - 1}]
+	while {$stop < $len} {
+	    append result [string range $data $at $stop]
+	    append result $spacing
+	    incr at   $delta
+	    incr stop $delta
+	}
+
+	# Process partial group at the end of the buffer and remember
+	# the offset, for the processing of the group remainder in the
+	# next call.
+
+	if {($at < $len) && ($stop >= $len)} {
+	    append result [string range $data $at end]
+	}
+	set woffset [expr {$len - $at}]
+	return $result
+    }
+
+    method read {c data} {
+	# remove spacing from groups of delta+sdelta chars, keeping
+	# the first delta in each group.
+	set result {}
+	set iter [expr {$delta + $sdelta}]
+	set at 0
+	if {$roffset} {
+	    if {$roffset < $delta} {
+		append result [string range $data 0 ${roffset}-1]
+	    }
+	    incr at [expr {$iter - $roffset}]
+	}
+	set len  [string length $data]
+	set end  [expr {$at + $delta - 1}]
+	set stop [expr {$at + $iter - 1}]
+	while {$stop < $len} {
+	    append result [string range $data $at $end]
+	    incr at   $iter
+	    incr end  $iter
+	    incr stop $iter
+	}
+	if {$end < $len} {
+	    append result [string range $data $at $end]
+	    set roffset [expr {$len - $end + 1}]
+	} elseif {$at < $len} {
+	    append result [string range $data $at end]
+	    set roffset [expr {$len - $at}]
+	}
+	return [list $result $roffset]
+    }
+
+    # # ## ### ##### ######## #############
+
+    constructor {n space} {
+	set roffset 0
+	set woffset 0
+	set delta   $n
+	set spacing $space
+	set sdelta [string length $spacing]
+	return
+    }
+
+    # # ## ### ##### ######## #############
+
+    variable roffset woffset delta spacing sdelta
+
+    # # ## ### ##### ######## #############
+}
+
+# # ## ### ##### ######## #############
+package provide tcl::transform::spacer 1.1
+return

src/vendorlib/virtchannel_transform/tcllib_zlib.man

@@ -0,0 +1,46 @@
+[comment {-*- tcl -*- doctools manpage}]
+[manpage_begin tcl::transform::zlib n 1.1]
+[keywords {channel transformation}]
+[keywords compression]
+[keywords decompression]
+[keywords {reflected channel}]
+[keywords {tip 230}]
+[keywords {tip 234}]
+[keywords transformation]
+[keywords {virtual channel}]
+[keywords zlib]
+[copyright {2009 Andreas Kupries <andreas_kupries@users.sourceforge.net>}]
+[moddesc   {Reflected/virtual channel support}]
+[category  Channels]
+[titledesc {zlib (de)compression}]
+[require Tcl "8.6 9"]
+[require tcl::transform::core [opt 1.1]]
+[require tcl::transform::zlib [opt 1.1]]
+[description]
+[para]
+
+The [package tcl::transform::zlib] package provides a command creating
+a channel transformation which zlib compresses the written data, and
+decompresses on reading.
+
+[para] The internal [package TclOO] class implementing the transform
+handler is a sub-class of the [package tcl::transform::core]
+framework.
+
+[section API]
+
+[list_begin definitions]
+
+[call [cmd ::tcl::transform::zlib] [arg chan] [opt [arg level]]]
+
+This command creates a zlib compressor transformation on top of the
+channel [arg chan] and returns its handle.
+
+[para] The [arg level] specifies how much effort is put into the
+compression, from [const 0] to [const 9], and defaults to [const 4].
+
+[list_end]
+
+[vset CATEGORY virtchannel]
+[include ../common-text/feedback.inc]
+[manpage_end]

src/vendorlib/virtchannel_transform/vt_base64.man

@@ -0,0 +1,44 @@
+[comment {-*- tcl -*- doctools manpage}]
+[manpage_begin tcl::transform::base64 n 1.1]
+[keywords base64]
+[keywords {channel transformation}]
+[keywords {reflected channel}]
+[keywords {tip 230}]
+[keywords {tip 317}]
+[keywords transformation]
+[keywords {virtual channel}]
+[copyright {2009 Andreas Kupries <andreas_kupries@users.sourceforge.net>}]
+[moddesc   {Reflected/virtual channel support}]
+[category  Channels]
+[titledesc {Base64 encoding transformation}]
+[require Tcl "8.6 9"]
+[require tcl::transform::core [opt 1.1]]
+[require tcl::transform::base64 [opt 1.1]]
+[description]
+[para]
+
+The [package tcl::transform::base64] package provides a command
+creating a channel transformation which base64 encodes data written to
+it, and decodes the data read from it.
+
+[para] A related transformations in this module is
+[package tcl::transform::hex].
+
+[para] The internal [package TclOO] class implementing the transform
+handler is a sub-class of the [package tcl::transform::core]
+framework.
+
+[section API]
+
+[list_begin definitions]
+
+[call [cmd ::tcl::transform::base64] [arg chan]]
+
+This command creates a base64 transformation on top of the channel
+[arg chan] and returns its handle.
+
+[list_end]
+
+[vset CATEGORY virtchannel]
+[include ../common-text/feedback.inc]
+[manpage_end]

src/vendorlib/virtchannel_transform/vt_counter.man

@@ -0,0 +1,68 @@
+[comment {-*- tcl -*- doctools manpage}]
+[manpage_begin tcl::transform::counter n 1.1]
+[keywords {channel transformation}]
+[keywords counter]
+[keywords {reflected channel}]
+[keywords {tip 230}]
+[keywords transformation]
+[keywords {virtual channel}]
+[copyright {2009 Andreas Kupries <andreas_kupries@users.sourceforge.net>}]
+[moddesc   {Reflected/virtual channel support}]
+[category  Channels]
+[titledesc {Counter transformation}]
+[require Tcl "8.6 9"]
+[require tcl::transform::core [opt 1.1]]
+[require tcl::transform::counter [opt 1.1]]
+[description]
+[para]
+
+The [package tcl::transform::counterr] package provides a command
+creating a channel transformation which passes the read and written
+bytes through unchanged (like [package tcl::transform::identity]), but
+additionally counts the bytes it has seen for each direction and
+stores these counts in Tcl variables specified at construction time.
+
+[para] Related transformations in this module are
+[package tcl::transform::adler32],
+[package tcl::transform::crc32],
+[package tcl::transform::identity], and
+[package tcl::transform::observe].
+
+[para] The internal [package TclOO] class implementing the transform
+handler is a sub-class of the [package tcl::transform::core]
+framework.
+
+[section API]
+
+[list_begin definitions]
+
+[call [cmd ::tcl::transform::counter] [arg chan] [option -option] [arg value]...]
+
+This command creates a counter transformation on top of the channel
+[arg chan] and returns its handle. The accepted options are
+
+[list_begin options]
+[opt_def -read-variable varname]
+
+The value of the option is the name of a global or namespaced
+variable, the location where the transformation has to store the
+byte count of the data read from the channel.
+
+[para] If not specified, or the empty string, the counter of the read
+direction is not saved.
+
+[opt_def -write-variable varname]
+
+The value of the option is the name of a global or namespaced
+variable, the location where the transformation has to store the
+byte count of the data written to the channel.
+
+[para] If not specified, or the empty string, the counter of the
+write direction is not saved.
+
+[list_end]
+[list_end]
+
+[vset CATEGORY virtchannel]
+[include ../common-text/feedback.inc]
+[manpage_end]

src/vendorlib/virtchannel_transform/vt_crc32.man

@@ -0,0 +1,70 @@
+[comment {-*- tcl -*- doctools manpage}]
+[manpage_begin tcl::transform::crc32 n 1.1]
+[keywords {channel transformation}]
+[keywords checksum]
+[keywords crc32]
+[keywords {reflected channel}]
+[keywords {tip 230}]
+[keywords transformation]
+[keywords {virtual channel}]
+[copyright {2009 Andreas Kupries <andreas_kupries@users.sourceforge.net>}]
+[moddesc   {Reflected/virtual channel support}]
+[category  Channels]
+[titledesc {Crc32 transformation}]
+[require Tcl "8.6 9"]
+[require tcl::transform::core [opt 1.1]]
+[require tcl::transform::crc32 [opt 1.1]]
+[description]
+[para]
+
+The [package tcl::transform::crc32] package provides a command
+creating a channel transformation which passes the read and written
+bytes through unchanged (like [package tcl::transform::identity]), but
+additionally continuously computes the crc32 checksums of the data it
+has seen for each direction and stores them in Tcl variables specified
+at construction time. The checksum in question is zlib's crc32.
+
+[para] Related transformations in this module are
+[package tcl::transform::adler32],
+[package tcl::transform::counter],
+[package tcl::transform::identity], and
+[package tcl::transform::observe].
+
+[para] The internal [package TclOO] class implementing the transform
+handler is a sub-class of the [package tcl::transform::core]
+framework.
+
+[section API]
+
+[list_begin definitions]
+
+[call [cmd ::tcl::transform::crc32] [arg chan] [option -option] [arg value]...]
+
+This command creates a crc32 checksumming transformation on top of
+the channel [arg chan] and returns its handle. The accepted options are
+
+[list_begin options]
+[opt_def -read-variable varname]
+
+The value of the option is the name of a global or namespaced
+variable, the location where the transformation has to store the
+crc32 checksum of the data read from the channel.
+
+[para] If not specified, or the empty string, the checksum of the read
+direction is not saved.
+
+[opt_def -write-variable varname]
+
+The value of the option is the name of a global or namespaced
+variable, the location where the transformation has to store the
+crc32 checksum of the data written to the channel.
+
+[para] If not specified, or the empty string, the checksum of the
+write direction is not saved.
+
+[list_end]
+[list_end]
+
+[vset CATEGORY virtchannel]
+[include ../common-text/feedback.inc]
+[manpage_end]

src/vendorlib/virtchannel_transform/vt_otp.man

@@ -0,0 +1,53 @@
+[comment {-*- tcl -*- doctools manpage}]
+[manpage_begin tcl::transform::otp n 1.1]
+[keywords {channel transformation}]
+[keywords cipher]
+[keywords decryption]
+[keywords encryption]
+[keywords {one time pad}]
+[keywords otp]
+[keywords {reflected channel}]
+[keywords {tip 230}]
+[keywords transformation]
+[keywords {virtual channel}]
+[keywords xor]
+[copyright {2009 Andreas Kupries <andreas_kupries@users.sourceforge.net>}]
+[moddesc   {Reflected/virtual channel support}]
+[category  Channels]
+[titledesc {Encryption via one-time pad}]
+[require Tcl "8.6 9"]
+[require tcl::transform::core [opt 1.1]]
+[require tcl::transform::otp [opt 1.1]]
+[description]
+[para]
+
+The [package tcl::transform::otp] package provides a command creating
+a channel transformation which uses externally provided one-time pads
+to perform encryption (on writing) and decryption (on reading).
+
+[para] A related transformations in this module is
+[package tcl::transform::rot].
+
+[para] The internal [package TclOO] class implementing the transform
+handler is a sub-class of the [package tcl::transform::core]
+framework.
+
+[section API]
+
+[list_begin definitions]
+
+[call [cmd ::tcl::transform::otp] [arg chan] [arg keychanw] [arg keychanr]]
+
+This command creates a one-time pad based encryption transformation on
+top of the channel [arg chan] and returns its handle.
+
+[para] The two channels [arg keychanw] and [arg keychanr] contain the
+one-time pads for the write and read directions, respectively. Their
+contents are reads and xored with the bytes written to and read from
+the channel.
+
+[list_end]
+
+[vset CATEGORY virtchannel]
+[include ../common-text/feedback.inc]
+[manpage_end]

src/vendorlib/virtchannel_transform/zlib.tcl

@@ -0,0 +1,100 @@
+# -*- tcl -*-
+# # ## ### ##### ######## #############
+# (C) 2009 Andreas Kupries
+
+# @@ Meta Begin
+# Package tcl::transform::zlib 1.0.2
+# Meta as::author {Andreas Kupries}
+# Meta as::copyright 2009
+# Meta as::license BSD
+# Meta as::notes   Possibilities for extension: Currently
+# Meta as::notes   the mapping between read/write and
+# Meta as::notes   de/compression is fixed. Allow it to be
+# Meta as::notes   configured at construction time.
+# Meta description Implementation of a zlib (de)compressor.
+# Meta description Based on Tcl 8.6's transformation
+# Meta description reflection support (TIP 230) and zlib
+# Meta description support (TIP 234). Compresses on write.
+# Meta description Exports a single command adding a new
+# Meta description transformation of this type to a channel.
+# Meta description Two arguments, the channel to extend,
+# Meta description and the compression level. No result.
+# Meta platform tcl
+# Meta require tcl::transform::core
+# Meta require {Tcl 8.6}
+# @@ Meta End
+
+# # ## ### ##### ######## #############
+
+package require Tcl 8.6 9
+package require tcl::transform::core
+
+# # ## ### ##### ######## #############
+
+namespace eval ::tcl::transform {}
+
+proc ::tcl::transform::zlib {chan {level 4}} {
+    ::chan push $chan [zlib::implementation new $level]
+    return
+}
+
+oo::class create ::tcl::transform::zlib::implementation {
+    superclass tcl::transform::core ;# -> initialize, finalize, destructor
+
+    # This transformation is intended for streaming operation. Seeking
+    # the channel while it is active may cause undesirable
+    # output. Proper behaviour may require the destruction of the
+    # transform before seeking.
+
+    method initialize {c mode} {
+	set compressor   [zlib stream deflate -level $level]
+	set decompressor [zlib stream inflate]
+
+	next $c $mode
+    }
+
+    method finalize {c} {
+	$compressor   close
+	$decompressor close
+
+	next $c
+    }
+
+    method write {c data} {
+	$compressor put $data
+	return [$compressor get]
+    }
+
+    method read {c data} {
+	$decompressor put $data
+	return [$decompressor get]
+    }
+
+    method flush {c} {
+	$compressor flush
+	return [$compressor get]
+    }
+
+    method drain {c} {
+	$decompressor flush
+	return [$decompressor get]
+    }
+
+    # # ## ### ##### ######## #############
+
+    constructor {thelevel} {
+	# Should validate input (level in (0 ...9))
+	set level $thelevel
+	return
+    }
+
+    # # ## ### ##### ######## #############
+
+    variable level compressor decompressor
+
+    # # ## ### ##### ######## #############
+}
+
+# # ## ### ##### ######## #############
+package provide tcl::transform::zlib 1.0.2
+return