ansi and repl fixes - and support libraries

src/bootsupport/include_modules.config

@@ -6,6 +6,10 @@ set bootsupport_modules [list\
     src/vendormodules overtype\
     src/vendormodules oolib\
     src/vendormodules http\
+    src/vendormodules dictutils\
+    src/vendormodules fileutil\
+    src/vendormodules textutil::tabify\
+    src/vendormodules textutil::split\
     modules punkcheck\
     modules punk::ansi\
     modules punk::args\

src/bootsupport/modules/dictutils-0.2.1.tm

@@ -0,0 +1,145 @@
+# dictutils.tcl --
+ #
+ #       Various dictionary utilities.
+ #
+ # Copyright (c) 2007 Neil Madden (nem@cs.nott.ac.uk).
+ #
+ # License: http://www.cs.nott.ac.uk/~nem/license.terms (Tcl-style).
+ #
+
+ #2023 0.2.1 - changed "package require Tcl 8.6" to "package require Tcl 8.6-"
+ 
+ package require Tcl         8.6-
+ package provide dictutils   0.2.1
+ 
+ namespace eval dictutils {
+     namespace export equal apply capture witharray nlappend
+     namespace ensemble create
+
+     # dictutils witharray dictVar arrayVar script --
+     #
+     #       Unpacks the elements of the dictionary in dictVar into the array
+     #       variable arrayVar and then evaluates the script. If the script
+     #       completes with an ok, return or continue status, then the result is copied
+     #       back into the dictionary variable, otherwise it is discarded. A
+     #       [break] can be used to explicitly abort the transaction.
+     #
+     proc witharray {dictVar arrayVar script} {
+         upvar 1 $dictVar dict $arrayVar array
+         array set array $dict
+         try { uplevel 1 $script
+         } on break    {}     { # Discard the result
+         } on continue result - on ok result {
+             set dict [array get array] ;# commit changes
+             return $result
+         } on return   {result opts} {
+             set dict [array get array] ;# commit changes
+             dict incr opts -level ;# remove this proc from level
+             return -options $opts $result
+         }
+         # All other cases will discard the changes and propagage
+     }
+ 
+     # dictutils equal equalp d1 d2 --
+     #
+     #       Compare two dictionaries for equality. Two dictionaries are equal
+     #       if they (a) have the same keys, (b) the corresponding values for
+     #       each key in the two dictionaries are equal when compared using the
+     #       equality predicate, equalp (passed as an argument). The equality
+     #       predicate is invoked with the key and the two values from each
+     #       dictionary as arguments.
+     #
+     proc equal {equalp d1 d2} {
+         if {[dict size $d1] != [dict size $d2]} { return 0 }
+         dict for {k v} $d1 {
+             if {![dict exists $d2 $k]} { return 0 }
+             if {![invoke $equalp $k $v [dict get $d2 $k]]} { return 0 }
+         }
+         return 1
+     }
+ 
+     # apply dictVar lambdaExpr ?arg1 arg2 ...? --
+     #
+     #       A combination of *dict with* and *apply*, this procedure creates a
+     #       new procedure scope populated with the values in the dictionary
+     #       variable. It then applies the lambdaTerm (anonymous procedure) in
+     #       this new scope. If the procedure completes normally, then any
+     #       changes made to variables in the dictionary are reflected back to
+     #       the dictionary variable, otherwise they are ignored. This provides
+     #       a transaction-style semantics whereby atomic updates to a
+     #       dictionary can be performed. This procedure can also be useful for
+     #       implementing a variety of control constructs, such as mutable
+     #       closures.
+     #
+     proc apply {dictVar lambdaExpr args} {
+         upvar 1 $dictVar dict
+         set env $dict ;# copy
+         lassign $lambdaExpr params body ns
+         if {$ns eq ""} { set ns "::" }
+         set body [format {
+             upvar 1 env __env__
+             dict with __env__ %s
+         } [list $body]]
+         set lambdaExpr [list $params $body $ns]
+         set rc [catch { ::apply $lambdaExpr {*}$args } ret opts]
+         if {$rc == 0} {
+             # Copy back any updates
+             set dict $env
+         }
+         return -options $opts $ret
+     }
+ 
+     # capture ?level? ?exclude? ?include? --
+     #
+     #       Captures a snapshot of the current (scalar) variable bindings at
+     #       $level on the stack into a dictionary environment. This dictionary
+     #       can later be used with *dictutils apply* to partially restore the
+     #       scope, creating a first approximation of closures. The *level*
+     #       argument should be of the forms accepted by *uplevel* and
+     #       designates which level to capture. It defaults to 1 as in uplevel.
+     #       The *exclude* argument specifies an optional list of literal
+     #       variable names to avoid when performing the capture. No variables
+     #       matching any item in this list will be captured. The *include*
+     #       argument can be used to specify a list of glob patterns of
+     #       variables to capture. Only variables matching one of these
+     #       patterns are captured. The default is a single pattern "*", for
+     #       capturing all visible variables (as determined by *info vars*).
+     #
+     proc capture {{level 1} {exclude {}} {include {*}}} {
+         if {[string is integer $level]} { incr level }
+         set env [dict create]
+         foreach pattern $include {
+             foreach name [uplevel $level [list info vars $pattern]] {
+                 if {[lsearch -exact -index 0 $exclude $name] >= 0} { continue }
+                 upvar $level $name value
+                 catch { dict set env $name $value } ;# no arrays
+             }
+         }
+         return $env
+     }
+ 
+     # nlappend dictVar keyList ?value ...?
+     #
+     #       Append zero or more elements to the list value stored in the given
+     #       dictionary at the path of keys specified in $keyList.  If $keyList
+     #       specifies a non-existent path of keys, nlappend will behave as if
+     #       the path mapped to an empty list.
+     #
+     proc nlappend {dictvar keylist args} {
+         upvar 1 $dictvar dict
+         if {[info exists dict] && [dict exists $dict {*}$keylist]} {
+             set list [dict get $dict {*}$keylist]
+         }
+         lappend list {*}$args
+         dict set dict {*}$keylist $list
+     }
+
+     # invoke cmd args... --
+     #
+     #       Helper procedure to invoke a callback command with arguments at
+     #       the global scope. The helper ensures that proper quotation is
+     #       used. The command is expected to be a list, e.g. {string equal}.
+     #
+     proc invoke {cmd args} { uplevel #0 $cmd $args }
+
+ }

src/bootsupport/modules/overtype-1.5.6.tm

@@ -0,0 +1,928 @@
+# -*- tcl -*-
+# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from <pkg>-buildversion.txt
+#
+# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem.
+# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository.
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+# (C) Julian Noble 2003-2023
+#
+# @@ Meta Begin
+# Application overtype 1.5.6
+# Meta platform     tcl
+# Meta license      BSD 
+# @@ Meta End
+
+
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+# doctools header
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+#*** !doctools
+#[manpage_begin overtype_module_overtype 0 1.5.6]
+#[copyright "2024"]
+#[titledesc {overtype text layout - ansi aware}]  [comment {-- Name section and table of contents description --}]
+#[moddesc {overtype text layout}]             [comment {-- Description at end of page heading --}] 
+#[require overtype]
+#[keywords module text ansi]
+#[description]
+#[para] -
+
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+
+#*** !doctools
+#[section Overview]
+#[para] overview of overtype 
+#[subsection Concepts]
+#[para] -
+
+
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+##  Requirements
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+
+#*** !doctools
+#[subsection dependencies]
+#[para] packages used by overtype 
+#[list_begin itemized]
+
+package require Tcl 8.6
+package require textutil
+package require punk::lib   ;#required for lines_as_list
+package require punk::ansi  ;#required to detect, split, strip and calculate lengths
+package require punk::char  ;#box drawing - and also unicode character width determination for proper layout of text with double-column-width chars
+#*** !doctools
+#[item] [package {Tcl 8.6}]
+#[item] [package textutil]
+#[item] [package punk::ansi]
+#[para] - required to detect, split, strip and calculate lengths of text possibly containing ansi codes
+#[item] [package punk::char]
+#[para] - box drawing - and also unicode character width determination for proper layout of text with double-column-width chars
+
+# #package require frobz
+# #*** !doctools
+# #[item] [package {frobz}]
+
+#*** !doctools
+#[list_end]
+
+
+
+
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+#*** !doctools
+#[section API]
+
+
+#Julian Noble <julian@precisium.com.au> - 2003 
+#Released under standard 'BSD license' conditions.
+#
+#todo - ellipsis truncation indicator for center,right
+
+#v1.4 2023-07 - naive ansi color handling - todo - fix string range 
+# - need to extract and replace ansi codes?
+
+namespace eval overtype {
+	namespace export *
+    variable default_ellipsis_horizontal "..." ;#fallback 
+    variable default_ellipsis_vertical "..." 
+    namespace eval priv {
+        proc _init {} {
+            upvar ::overtype::default_ellipsis_horizontal e_h
+            upvar ::overtype::default_ellipsis_vertical e_v
+            set e_h [format %c 0x2026] ;#Unicode Horizontal Ellipsis
+            set e_v [format %c 0x22EE]
+            #The unicode ellipsis looks more natural than triple-dash which is centred vertically whereas ellipsis is at floorline of text
+            #Also - unicode ellipsis has semantic meaning that other processors can interpret
+            #unicode does also provide a midline horizontal ellipsis 0x22EF
+
+            #set e [format %c 0x2504] ;#punk::char::charshort boxd_ltdshhz  - Box Drawings Light Triple Dash Horizontal
+            #if {![catch {package require punk::char}]} {
+            #    set e [punk::char::charshort boxd_ltdshhz] 
+            #}
+        }
+    }
+    priv::_init
+}
+proc overtype::about {} {
+	return "Simple text formatting. Author JMN. BSD-License"
+}
+
+namespace eval overtype {
+    variable escape_terminals
+    #single "final byte" in the range 0x40–0x7E (ASCII @A–Z[\]^_`a–z{|}~).
+    dict set escape_terminals CSI [list @ \\ ^ _ ` | ~ a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z "\{" "\}"]
+    #dict set escape_terminals CSI [list J K m n A B C D E F G s u] ;#basic 
+    dict set escape_terminals OSC [list \007 \033\\] ;#note mix of 1 and 2-byte terminals 
+
+    #self-contained 2 byte ansi escape sequences - review more?
+    variable ansi_2byte_codes_dict
+    set  ansi_2byte_codes_dict [dict create\
+        "reset_terminal"            "\u001bc"\
+        "save_cursor_posn"          "\u001b7"\
+        "restore_cursor_posn"       "\u001b8"\
+        "cursor_up_one"             "\u001bM"\
+        "NEL - Next Line"           "\u001bE"\
+        "IND - Down one line"       "\u001bD"\
+        "HTS - Set Tab Stop"        "\u001bH"\
+        ]
+
+        #debatable whether strip should reveal the somethinghidden - some terminals don't hide it anyway.
+        #  "PM - Privacy Message"      "\u001b^somethinghidden\033\\"\
+}
+
+
+#proc overtype::stripansi {text} {
+#    variable escape_terminals  ;#dict
+#    variable ansi_2byte_codes_dict
+#    #important that we don't spend too much time on this for plain text that doesn't contain any escapes anyway
+#    if {[string first \033 $text] <0 && [string first \009c $text] <0} {
+#        #\033 same as \x1b
+#        return $text
+#    }
+#
+#    set text [convert_g0 $text] 
+#
+#    #we process char by char - line-endings whether \r\n or \n should be processed as per any other character.
+#    #line endings can theoretically occur within an ansi escape sequence (review e.g title?)
+#    set inputlist [split $text ""]
+#    set outputlist [list] 
+#
+#    set 2bytecodes [dict values $ansi_2byte_codes_dict]
+#
+#    set in_escapesequence 0
+#    #assumption - undertext already 'rendered' - ie no backspaces or carriagereturns or other cursor movement controls
+#    set i 0
+#    foreach u $inputlist {
+#        set v [lindex $inputlist $i+1]
+#        set uv ${u}${v}
+#        if {$in_escapesequence eq "2b"} {
+#            #2nd byte - done.
+#            set in_escapesequence 0
+#        } elseif {$in_escapesequence != 0} {
+#            set escseq [dict get $escape_terminals $in_escapesequence]
+#            if {$u in $escseq} {
+#                set in_escapesequence 0
+#            } elseif {$uv in $escseq} {
+#                set in_escapseequence 2b ;#flag next byte as last in sequence
+#            }
+#        } else {
+#            #handle both 7-bit and 8-bit CSI and OSC
+#            if {[regexp {^(?:\033\[|\u009b)} $uv]} {
+#                set in_escapesequence CSI
+#            } elseif {[regexp {^(?:\033\]|\u009c)} $uv]} {
+#                set in_escapesequence OSC
+#            } elseif {$uv in $2bytecodes} {
+#                #self-contained e.g terminal reset - don't pass through.
+#                set in_escapesequence 2b
+#            } else {
+#                lappend outputlist $u
+#            }
+#        }
+#        incr i
+#    }
+#    return [join $outputlist ""]
+#}
+
+
+
+
+
+proc overtype::string_columns {text} {
+    if {[punk::ansi::ta::detect $text]} {
+        #error "error string_columns is for calculating character length of string - ansi codes must be stripped/rendered first e.g with punk::ansi::stripansi. Alternatively try punk::ansi::printing_length"
+        set text [punk::ansi::stripansi $text]
+    }
+    return [punk::char::string_width $text]
+}
+
+
+#string range should generally be avoided for both undertext and overtext which contain ansi escapes and other cursor affecting chars such as \b and \r
+proc overtype::left {args} {
+	# @c overtype starting at left (overstrike) 
+	# @c can/should we use something like this?: 'format "%-*s" $len $overtext 
+    variable default_ellipsis_horizontal
+
+	if {[llength $args] < 2} {
+		error {usage: ?-transparent [0|1]? ?-overflow [1|0]? ?-ellipsis [1|0]? ?-ellipsistext ...? undertext overtext}
+	}
+    lassign [lrange $args end-1 end] underblock overblock
+    set defaults [dict create\
+        -bias       ignored\
+        -ellipsis   0\
+        -ellipsistext   $default_ellipsis_horizontal\
+        -ellipsiswhitespace 0\
+        -overflow   0\
+        -transparent 0\
+        -exposed1 \uFFFD\
+        -exposed2 \uFFFD\
+    ]
+    set known_opts [dict keys $defaults]
+    set argsflags [lrange $args 0 end-2]
+    dict for {k v} $argsflags {
+        if {$k ni $known_opts} {
+            error "overtype::left unknown option '$k'. Known options: $known_opts"
+        }
+    }
+    set opts [dict merge $defaults $argsflags]
+    # -- --- --- --- --- ---
+    set opt_transparent     [dict get $opts -transparent]
+    set opt_ellipsistext    [dict get $opts -ellipsistext]
+    set opt_ellipsiswhitespace [dict get $opts -ellipsiswhitespace]
+    set opt_exposed1        [dict get $opts -exposed1] ;#widechar_exposed_left  - todo
+    set opt_exposed2        [dict get $opts -exposed2] ;#widechar_exposed_right - todo
+    # -- --- --- --- --- ---
+
+    set norm [list \r\n \n]
+    set underblock [string map $norm $underblock]
+    set overblock  [string map $norm $overblock]
+
+    set underlines [split $underblock \n]
+    #set colwidth [tcl::mathfunc::max {*}[lmap v $underlines {punk::ansi::printing_length $v}]]
+    lassign [blocksize $underblock] _w colwidth _h colheight
+    set overlines  [split $overblock \n]
+    #set overblock_width [tcl::mathfunc::max {*}[lmap v $overlines {punk::ansi::printing_length $v}]]
+    lassign [blocksize $overblock] _w overblock_width _h overblock_height
+    set under_exposed_max [expr {$colwidth - $overblock_width}]
+    set right_exposed $under_exposed_max 
+
+    set outputlines [list]
+    foreach undertext $underlines overtext $overlines {    
+        set undertext_printlen [punk::ansi::printing_length $undertext]
+        if {$undertext_printlen < $colwidth} {
+            set udiff [expr {$colwidth - $undertext_printlen}]
+            set undertext "$undertext[string repeat { } $udiff]"
+        }
+        set overtext_printlen [punk::ansi::printing_length $overtext]
+        set overflowlength [expr {$overtext_printlen - $colwidth}]
+
+        #review
+        #append overtext "\033\[0m"
+
+
+        if {$overflowlength > 0} {
+            #background line is narrower than data in line
+            set rendered [renderline -transparent $opt_transparent -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 -overflow [dict get $opts -overflow] $undertext $overtext]
+            if {![dict get $opts -overflow]} {
+                #set overtext [string range $overtext 0 $colwidth-1] ;#string range won't be correct e.g if contains ansi codes or leading \r or \b etc
+                if {[dict get $opts -ellipsis]} {
+                    set show_ellipsis 1
+                    if {!$opt_ellipsiswhitespace} {
+                        #we don't want ellipsis if only whitespace was lost
+                        set lostdata [string range $overtext end-[expr {$overflowlength-1}] end]
+                        if {[string trim $lostdata] eq ""} {
+                            set show_ellipsis 0
+                        }
+                    }
+                    if {$show_ellipsis} {
+                        set rendered [overtype::right $rendered $opt_ellipsistext]
+                    }
+                }
+            }
+            lappend outputlines $rendered
+        } else {
+            #we know overtext data is shorter or equal (for this line)
+            lappend outputlines [renderline -transparent $opt_transparent -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 $undertext $overtext]
+        }
+    }
+    return [join $outputlines \n]
+
+}
+
+namespace eval overtype::piper {
+    proc overcentre {args} {
+        if {[llength $args] < 2} {
+            error {usage: ?-bias left|right? ?-transparent [0|1|<regexp>]? ?-exposed1 <char>? ?-exposed2 <char>?  ?-overflow [1|0]? overtext pipelinedata}
+        }
+        lassign [lrange $args end-1 end] over under
+        set argsflags [lrange $args 0 end-2]
+        tailcall overtype::centre {*}$argsflags $under $over
+    }
+    proc overleft {args} {
+        if {[llength $args] < 2} {
+            error {usage: ?-start <column>? ?-transparent [0|1|<regexp>]? ?-exposed1 <char>? ?-exposed2 <char>?  ?-overflow [1|0]? overtext pipelinedata}
+        }
+        lassign [lrange $args end-1 end] over under
+        set argsflags [lrange $args 0 end-2]
+        tailcall overtype::left {*}$argsflags $under $over
+    }
+}
+#todo - left-right ellipsis ?
+proc overtype::centre {args} {
+    variable default_ellipsis_horizontal
+	if {[llength $args] < 2} {
+		error {usage: ?-transparent [0|1]? ?-bias [left|right]?  ?-overflow [1|0]? undertext overtext}
+	}
+	
+    foreach {underblock overblock} [lrange $args end-1 end] break
+
+    #todo - vertical vs horizontal overflow for blocks
+    set defaults [dict create\
+        -bias       left\
+        -ellipsis   0\
+        -ellipsistext   $default_ellipsis_horizontal\
+        -ellipsiswhitespace 0\
+        -overflow   0\
+        -transparent 0\
+        -exposed1 \uFFFD\
+        -exposed2 \uFFFD\
+    ]
+    set known_opts [dict keys $defaults]
+    set argsflags [lrange $args 0 end-2]
+    dict for {k v} $argsflags {
+        if {$k ni $known_opts} {
+            error "overtype::centre unknown option '$k'. Known options: $known_opts"
+        }
+    }
+    set opts [dict merge $defaults $argsflags]
+    # -- --- --- --- --- ---
+    set opt_transparent     [dict get $opts -transparent]
+    set opt_ellipsis        [dict get $opts -ellipsis]
+    set opt_ellipsistext    [dict get $opts -ellipsistext]
+    set opt_ellipsiswhitespace [dict get $opts -ellipsiswhitespace]
+    set opt_exposed1        [dict get $opts -exposed1]
+    set opt_exposed2        [dict get $opts -exposed2]
+    # -- --- --- --- --- ---
+
+
+    set norm [list \r\n \n]
+    set underblock [string map $norm $underblock]
+    set overblock  [string map $norm $overblock]
+
+    set underlines [split $underblock \n]
+    #set colwidth [tcl::mathfunc::max {*}[lmap v $underlines {punk::ansi::printing_length $v}]]
+    lassign [blocksize $underblock] _w colwidth _h colheight
+    set overlines  [split $overblock \n]
+    #set overblock_width [tcl::mathfunc::max {*}[lmap v $overlines {punk::ansi::printing_length $v}]]
+    lassign [blocksize $overblock] _w overblock_width _h overblock_height 
+    set under_exposed_max [expr {$colwidth - $overblock_width}]
+    if {$under_exposed_max > 0} {
+        #background block is wider
+        if {$under_exposed_max % 2 == 0} {
+            #even left/right exposure
+            set left_exposed [expr {$under_exposed_max / 2}]
+        } else {
+            set beforehalf [expr {$under_exposed_max / 2}] ;#1 less than half due to integer division
+            if {[string tolower [dict get $opts -bias]] eq "left"} {
+                set left_exposed $beforehalf
+            } else {
+                #bias to the right
+                set left_exposed [expr {$beforehalf + 1}]
+            }
+        }
+    } else {
+        set left_exposed 0
+    }
+
+    set outputlines [list]
+    foreach undertext $underlines overtext $overlines {    
+        set overtext_datalen [punk::ansi::printing_length $overtext]
+        set ulen [punk::ansi::printing_length $undertext]
+        if {$ulen < $colwidth} {
+            set udiff [expr {$colwidth - $ulen}]
+            set undertext "$undertext[string repeat { } $udiff]"
+        }
+
+        set overflowlength [expr {$overtext_datalen - $colwidth}]
+        #review - right-to-left langs should elide on left! - extra option required
+
+        if {$overflowlength > 0} {
+            #overlay line wider or equal
+            set rendered [renderline -transparent $opt_transparent -overflow [dict get $opts -overflow] -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 $undertext $overtext]
+            #overlay line data is wider - trim if overflow not specified in opts - and overtype an ellipsis at right if it was specified
+            if {![dict get $opts -overflow]} {
+                #lappend outputlines [string range $overtext 0 [expr {$colwidth - 1}]]
+                #set overtext [string range $overtext 0 $colwidth-1 ]
+                if {$opt_ellipsis} {
+                    set show_ellipsis 1
+                    if {!$opt_ellipsiswhitespace} {
+                        #we don't want ellipsis if only whitespace was lost
+                        set lostdata [string range $overtext end-[expr {$overflowlength-1}] end]
+                        if {[string trim $lostdata] eq ""} {
+                            set show_ellipsis 0
+                        }
+                    }
+                    if {$show_ellipsis} {
+                        set rendered [overtype::right $rendered $opt_ellipsistext]
+                    }
+                }
+            }
+            lappend outputlines $rendered
+            #lappend outputlines [renderline -transparent $opt_transparent $undertext $overtext]
+        } else {
+            #background block is wider than or equal to data for this line
+            lappend outputlines [renderline -start $left_exposed -transparent $opt_transparent -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 $undertext $overtext]
+        }
+    }
+    return [join $outputlines \n]
+}
+
+proc overtype::right {args} {
+    #NOT the same as align-right - which should be done to the overblock first if required
+    variable default_ellipsis_horizontal
+	# @d !todo - implement overflow, length checks etc
+
+	if {[llength $args] < 2} {
+		error {usage: ?-overflow [1|0]? undertext overtext}
+	}
+    foreach {underblock overblock} [lrange $args end-1 end] break
+
+    set defaults [dict create\
+        -bias       ignored\
+        -ellipsis   0\
+        -ellipsistext   $default_ellipsis_horizontal\
+        -ellipsiswhitespace 0\
+        -overflow   0\
+        -transparent 0\
+        -exposed1 \uFFFD\
+        -exposed2 \uFFFD\
+    ]
+    set known_opts [dict keys $defaults]
+    set argsflags [lrange $args 0 end-2]
+    dict for {k v} $argsflags {
+        if {$k ni $known_opts} {
+            error "overtype::centre unknown option '$k'. Known options: $known_opts"
+        }
+    }
+    set opts [dict merge $defaults $argsflags]
+    # -- --- --- --- --- ---
+    set opt_transparent     [dict get $opts -transparent]
+    set opt_ellipsis         [dict get $opts -ellipsis]
+    set opt_ellipsistext    [dict get $opts -ellipsistext]
+    set opt_ellipsiswhitespace [dict get $opts -ellipsiswhitespace]
+    set opt_overflow        [dict get $opts -overflow]
+    set opt_exposed1        [dict get $opts -exposed1]
+    set opt_exposed2        [dict get $opts -exposed2]
+    # -- --- --- --- --- ---
+    
+    set norm [list \r\n \n]
+    set underblock [string map $norm $underblock]
+    set overblock  [string map $norm $overblock]
+
+    set underlines [split $underblock \n]
+    #set colwidth [tcl::mathfunc::max {*}[lmap v $underlines {punk::ansi::printing_length $v}]]
+    lassign [blocksize $underblock] _w colwidth _h colheight
+    set overlines  [split $overblock \n]
+    #set overblock_width [tcl::mathfunc::max {*}[lmap v $overlines {punk::ansi::printing_length $v}]]
+    lassign [blocksize $overblock] _w overblock_width _h overblock_height 
+    set under_exposed_max [expr {$colwidth - $overblock_width}]
+    set left_exposed $under_exposed_max 
+
+    set outputlines [list]
+    foreach undertext $underlines overtext $overlines {    
+        set overtext_datalen [punk::ansi::printing_length $overtext]
+        set ulen [punk::ansi::printing_length $undertext]
+        if {$ulen < $colwidth} {
+            set udiff [expr {$colwidth - $ulen}]
+            puts xxx
+            set undertext "$undertext[string repeat { } $udiff]"
+        }
+        if {$overtext_datalen < $overblock_width} {
+            set odiff [expr {$overblock_width - $overtext_datalen}]
+            #padding always on right - if alignment is required it should be done to block beforehand - not here
+            set overtextpadding "$overtext[string repeat { } $odiff]"
+        }
+
+        set overflowlength [expr {$overtext_datalen - $colwidth}]
+        if {$overflowlength > 0} {	
+            #raw overtext wider than undertext column
+            set rendered [renderline -transparent $opt_transparent -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 -overflow $opt_overflow -start 0 $undertext $overtext]
+            if {!$opt_overflow} {
+                if {$opt_ellipsis} {
+                    set show_ellipsis 1
+                    if {!$opt_ellipsiswhitespace} {
+                        #we don't want ellipsis if only whitespace was lost
+                        set lostdata [string range $overtext end-[expr {$overflowlength-1}] end]
+                        if {[string trim $lostdata] eq ""} {
+                            set show_ellipsis 0
+                        }
+                    }
+                    if {$show_ellipsis} {
+                        set rendered [overtype::right $rendered $opt_ellipsistext]
+                    }
+                }
+            }
+            lappend outputlines $rendered
+        } else {
+            #padded overtext 
+            lappend outputlines [renderline -transparent $opt_transparent -start $left_exposed $undertext $overtext]
+        }
+    }
+
+    return [join $outputlines \n]
+}
+
+# -- --- --- --- --- --- --- --- --- --- ---
+proc overtype::transparentline {args} {
+    foreach {under over} [lrange $args end-1 end] break
+    set argsflags [lrange $args 0 end-2]
+    set defaults [dict create\
+        -transparent 1\
+        -exposed 1 " "\
+        -exposed 2 " "\
+    ]
+    set newargs [dict merge $defaults $argsflags]
+    tailcall overtype::renderline {*}$newargs $under $over
+}
+#renderline may not make sense as it is in the long run for blocks of text - but is handy in the single-line-handling form anyway.
+# We are trying to handle ansi codes in a block of text which is acting like a mini-terminal in some sense.
+#We can process standard cursor moves such as \b \r - but no way to respond to other cursor movements e.g moving to other lines.
+#
+namespace eval overtype::piper {
+    proc renderline {args} {
+        if {[llength $args] < 2} {
+            error {usage: ?-start <int>? ?-transparent [0|1|<regexp>]?  ?-overflow [1|0]? overtext pipelinedata}
+        }
+        foreach {over under} [lrange $args end-1 end] break
+        set argsflags [lrange $args 0 end-2]
+        tailcall overtype::renderline {*}$argsflags $under $over
+    }
+}
+interp alias "" piper_renderline "" overtype::piper::renderline 
+
+#-returnextra to enable returning of overflow and length
+# todo - use punk::ansi::ta::detect to short-circuit processing and do simple string calcs as an optimisation?
+#review - DECSWL/DECDWL double width line codes - very difficult/impossible to align and compose with other elements
+#todo - review transparency issues with single/double width characters!
+proc overtype::renderline {args} {
+	if {[llength $args] < 2} {
+		error {usage: ?-start <int>? ?-transparent [0|1|<regexp>]?  ?-overflow [1|0]? undertext overtext}
+	}
+    lassign [lrange $args end-1 end] under over
+    #should also rule out \v
+    if {[string first \n $over] >=0 || [string first \n $under] >= 0} {
+        error "overtype::renderline not allowed to contain newlines"
+    }
+    set defaults [dict create\
+        -overflow   0\
+        -transparent 0\
+        -start 0\
+        -returnextra 0\
+        -exposed1 \uFFFD\
+        -exposed2 \uFFFD\
+    ]
+    #exposed1 and exposed2 for first and second col of underying 2wide char which is truncated by transparency or overflow
+
+    set known_opts [dict keys $defaults]
+    set argsflags [lrange $args 0 end-2]
+    dict for {k v} $argsflags {
+        if {$k ni $known_opts} {
+            error "overtype::renderline unknown option '$k'. Known options: $known_opts"
+        }
+    }
+    set opts [dict merge $defaults $argsflags]
+    # -- --- --- --- --- --- --- --- --- --- --- ---
+    set opt_overflow            [dict get $opts -overflow]
+    set opt_colstart            [dict get $opts -start]
+    # -- --- --- --- --- --- --- --- --- --- --- ---
+    set opt_transparent         [dict get $opts -transparent]  
+    if {$opt_transparent eq "0"} {
+        set do_transparency 0
+    } else {
+        set do_transparency 1
+        if {$opt_transparent eq "1"} {
+            set opt_transparent {[\s]}
+        }
+    }
+    # -- --- --- --- --- --- --- --- --- --- --- ---
+    set opt_returnextra         [dict get $opts -returnextra]
+    # -- --- --- --- --- --- --- --- --- --- --- ---
+    set opt_exposed1            [dict get $opts -exposed1]
+    set opt_exposed2            [dict get $opts -exposed2]
+    # -- --- --- --- --- --- --- --- --- --- --- ---
+
+    #-----
+    #
+    if {[string first \t $under] >= 0} {
+        #set under [textutil::tabify::untabify2 $under]
+        set under [textutil::tabify::untabifyLine $under 8] ;#8 is default for untabify2 - review
+    }
+    set overdata $over
+    if {[string first \t $over] >= 0} {
+        #set overdata [textutil::tabify::untabify2 $over]
+        set overdata [textutil::tabify::untabifyLine $over 8]
+    }
+    #-------
+
+    #ta_detect ansi and do simpler processing?
+
+
+    # -- --- --- --- --- --- --- ---
+    set undermap [punk::ansi::ta::split_codes_single $under]
+    set understacks [dict create]
+
+    set i_u -1
+    set i_o 0 
+    set out [list] 
+    set u_codestack [list]
+    set pt_underchars "" ;#for string_columns length calculation for overflow 0 truncation
+    set remainder [list] ;#for returnextra
+    foreach {pt code} $undermap {
+        #pt = plain text
+        append pt_underchars $pt
+        foreach grapheme [punk::char::grapheme_split $pt] {
+            set width [punk::char::string_width $grapheme]
+            incr i_u
+            dict set understacks $i_u $u_codestack 
+            lappend out $grapheme
+            if {$width > 1} {
+                incr i_u
+                #presumably there are no triple-column or wider unicode chars.. until the aliens arrive.(?)
+                #but what about emoji combinations etc - can they be wider than 2?
+                dict set understacks $i_u $u_codestack 
+                lappend out ""
+            }
+        }
+
+        #underlay should already have been rendered and not have non-sgr codes - but let's retain the check for them and not stack them if other codes are here
+
+        #only stack SGR (graphics rendition) codes - not title sets, cursor moves etc 
+        #order of if-else based on assumptions:
+        # that pure resets are fairly common - more so than leading resets with other info
+        # that non-sgr codes are not that common, so ok to check for resets before verifying it is actually SGR at all.
+        if {[punk::ansi::codetype::is_sgr_reset $code]} {
+            set u_codestack [list]
+        } elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} {
+            set u_codestack [list $code]
+        } elseif {[punk::ansi::codetype::is_sgr $code]} {
+            lappend u_codestack $code
+        }
+        #consider also if there are other codes that should be stacked..?
+    }
+    #trailing codes in effect for underlay
+    if {[llength $undermap]} {
+        dict set understacks [expr {$i_u + 1}] $u_codestack
+    }
+
+
+    # -- --- --- --- --- --- --- ---
+    ####
+    #if opt_colstart - we need to build a space (or any singlewidth char really) padding on the left of the right number of columns.
+    #this will be processed as transparent - and handle doublewidth underlay characters appropriately
+    set startpad [string repeat " " $opt_colstart]
+    append startpad $overdata ;#overdata with left padding spaces based on col-start under will show through for left-padding portion regardless of -transparency
+    set overmap  [punk::ansi::ta::split_codes_single $startpad]
+    ####
+
+    #set re_diacritics {[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+} 
+    #as at 2024-02 punk::char::grapheme_split uses these - not aware of more complex graphemes
+
+
+    set overstacks [dict create]
+    set o_codestack [list]
+    set pt_overchars ""
+    foreach {pt code} $overmap {
+        append pt_overchars $pt
+        foreach grapheme [punk::char::grapheme_split $pt] {
+           dict set overstacks $i_o $o_codestack 
+           incr i_o 
+        }
+
+        if {[punk::ansi::codetype::is_sgr $code]} {
+            if {[punk::ansi::codetype::has_sgr_leadingreset $code]} {
+                #m code which has sgr reset at start - no need to replay prior sgr codes 
+                set o_codestack [list $code]
+            } else {
+                lappend o_codestack $code
+            }
+        }
+
+        #only stack SGR (graphics rendition) codes - not title sets, cursor moves etc 
+        #order of if-else based on assumptions:
+        # that pure resets are fairly common - more so than leading resets with other info
+        # that non-sgr codes are not that common, so ok to check for resets before verifying it is actually SGR at all.
+        if {[punk::ansi::codetype::is_sgr_reset $code]} {
+            set o_codestack [list]
+        } elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} {
+            set o_codestack [list $code]
+        } elseif {[punk::ansi::codetype::is_sgr $code]} {
+            lappend o_codestack $code
+        }
+
+    }
+    # -- --- --- --- --- --- --- ---
+
+
+    #potential problem - combinining diacritics directly following control chars like \r \b
+
+    set bs [format %c 0x08]
+    set idx 0 ;# line index  (cursor - 1)
+    set idx_over -1
+    foreach {pt code} $overmap {
+        #set ptchars [split $pt ""] ;#for lookahead
+        set graphemes [punk::char::grapheme_split $pt]
+        #emit plaintext chars first using existing SGR codes from under/over stack as appropriate
+        #then check if the following code is a cursor movement within the line and adjust index if so
+        foreach ch $graphemes {
+            incr idx_over
+            if {$ch eq "\r"} {
+                set idx $opt_colstart
+            } elseif {$ch eq "\b"} {
+                #review - backspace effect on double-width chars
+                if {$idx > $opt_colstart} {
+                    incr idx -1
+                }
+            } elseif {($idx < $opt_colstart)} {
+                incr idx
+            } elseif {($do_transparency && [regexp $opt_transparent $ch])} {    
+                #pre opt_colstart is effectively transparent (we have applied padding of required number of columns to left of overlay)
+                set owidth [punk::char::string_width $ch]
+                if {$idx > [llength $out]-1} {
+                    lappend out " "
+                    dict set understacks $idx [list] ;#review - use idx-1 codestack?
+                    incr idx
+                } else {
+                    set uwidth [punk::char::string_width [lindex $out $idx]]
+                    if {[lindex $out $idx] eq ""} {
+                        #2nd col of 2-wide char in underlay 
+                        incr idx
+                    } elseif {$uwidth == 0} {
+                        #e.g control char  ? combining diacritic ?
+                        incr idx
+                    } elseif {$uwidth == 1} {
+                        incr idx
+                        if {$owidth > 1} {
+                            incr idx
+                        } 
+                    } elseif {$uwidth > 1} {
+                        if {[punk::char::string_width $ch] == 1} {
+                            #normal singlewide transparency 
+                            set next_pt_overchar [string index $pt_overchars $idx_over+1] ;#lookahead of next plain-text char in overlay
+                            if {$next_pt_overchar eq ""} {
+                                #special-case trailing transparent - no next_pt_overchar
+                                incr idx
+                            } else {
+                                if {[regexp $opt_transparent $next_pt_overchar]} {
+                                    incr idx
+                                } else {
+                                    #next overlay char is not transparent.. first-half of underlying 2wide char is exposed 
+                                    priv::render_addchar $idx $opt_exposed1 [dict get $overstacks $idx_over]
+                                    incr idx
+                                }
+                            }
+                        } else {
+                            #2wide transparency over 2wide in underlay
+                            incr idx
+                        }
+                    }
+                }
+            } else {
+                #non-transparent char in overlay
+                set owidth [punk::char::string_width $ch]
+                set uwidth [punk::char::string_width [lindex $out $idx]]
+                if {[lindex $out $idx] eq ""} {
+                    #2nd col of 2wide char in underlay
+                    priv::render_addchar $idx $ch [dict get $overstacks $idx_over]
+                    incr idx
+                } elseif {$uwidth == 0} {
+                    #e.g combining diacritic - increment before over char  REVIEW
+                    #arguably the previous overchar should have done this - ie lookahead for combiners?
+                    priv::render_addchar $idx "" [dict get $overstacks $idx_over]
+                    incr idx
+                    priv::render_addchar $idx $ch [dict get $overstacks $idx_over]
+                    incr idx
+
+                } elseif {$uwidth == 1} {
+                    if {$owidth == 1} {
+                        priv::render_addchar $idx $ch [dict get $overstacks $idx_over]
+                        incr idx
+                    } else {
+                        priv::render_addchar $idx $ch [dict get $overstacks $idx_over]
+                        incr idx
+                        priv::render_addchar $idx ""  [dict get $overstacks $idx_over]
+                    }
+                } elseif {$uwidth > 1} {
+                    if {$owidth == 1} {
+                        priv::render_addchar $idx $ch [dict get $overstacks $idx_over]
+                        incr idx
+                        priv::render_addchar $idx $opt_exposed2 [dict get $overstacks $idx_over]
+                        #don't incr idx - we are just putting a broken-indication in the underlay - which may get overwritten by next overlay char
+                    } else {
+                        #2wide over 2wide
+                        priv::render_addchar $idx $ch [dict get $overstacks $idx_over]
+                        incr idx 
+                    }
+                }
+            }
+        } 
+
+        #cursor movement?
+        #if {![punk::ansi::codetype::is_sgr $code]} {
+        #
+        #}
+    }
+
+    if {$opt_overflow == 0} {
+        #need to truncate to the width of the original undertext
+        #review - string_width vs printing_length here. undertext requirement to be already rendered therefore punk::char::string_width ok?
+        set num_under_columns [punk::char::string_width $pt_underchars] ;#plaintext underchars
+    }
+
+    #coalesce and replay codestacks for out char list
+    set outstring ""    
+    set remstring "" ;#remainder after overflow point reached
+    set i 0
+    set cstack [list]
+    set prevstack [list]
+    set out_rawchars ""; #for overflow counting 
+    set output_to "outstring" ;#var in effect depending on overflow
+    set in_overflow 0 ;#used to stop char-width scanning once in overflow
+    foreach ch $out {
+        append out_rawchars $ch
+        if {$opt_overflow == 0 && !$in_overflow} {
+            if {[set nextvisualwidth [punk::char::string_width $out_rawchars]] < $num_under_columns} {
+            } else {
+                #todo - check if we overflowed with a double-width char ? 
+                #store visualwidth which may be short
+                set in_overflow 1
+            }
+        }
+        set cstack [dict get $understacks $i]
+        if {$cstack ne $prevstack} {
+            if {[llength $prevstack]} {
+                append $output_to \033\[m
+            }
+            foreach code $cstack {
+                append $output_to $code
+            }
+        }
+        append $output_to $ch
+        set prevstack $cstack
+        incr i
+        if {$in_overflow} {
+            set output_to "remstring"
+        }
+    }
+    if {[dict size $understacks] > 0} {
+        append $output_to [join [dict get $understacks [expr {[dict size $understacks]-1}]] ""] ;#tail codes
+    }
+    if {[string length $remstring]} {
+        #puts stderr "remainder:$remstring"
+    }
+    #pdict $understacks
+    if {$opt_returnextra} {
+        return [list $outstring $visualwidth [string length $outstring] $remstring]
+    } else {
+        return $outstring
+    }
+    #return [join $out ""]
+}
+proc overtype::test_renderline {} {
+    set t \uFF5E ;#2-wide tilde
+    set u \uFF3F ;#2-wide underscore
+    set missing \uFFFD
+    return [list $t $u A${t}B]
+}
+
+#same as textblock::size - but we don't want that circular dependency
+proc overtype::blocksize {textblock} {
+    if {$textblock eq ""} {
+        return [dict create width 0 height 1] ;#no such thing as zero-height block - for consistency with non-empty strings having no line-endings
+    }
+    set textblock [textutil::tabify::untabify2 $textblock]
+    #stripansi on entire block in one go rather than line by line - result should be the same - review - make tests
+    set textblock [punk::ansi::stripansi $textblock]
+    if {[string first \n $textblock] >= 0} {
+        set width [tcl::mathfunc::max {*}[lmap v [punk::lib::lines_as_list -- $textblock] {::punk::char::string_width $v}]]
+    } else {
+        set width [punk::char::string_width $textblock] 
+    }
+    set num_le [expr {[string length $textblock]-[string length [string map [list \n {}] $textblock]]}] ;#faster than splitting into single-char list
+    #our concept of block-height is likely to be different to other line-counting mechanisms
+    set height [expr {$num_le + 1}] ;# one line if no le - 2 if there is one trailing le even if no data follows le
+
+    return [dict create width $width height $height] ;#maintain order in 'image processing' standard width then height - caller may use lassign [dict values [blocksize <data>]] width height
+}
+
+namespace eval overtype::priv {
+
+    #is actually addgrapheme?
+    proc render_addchar {i c stack} {
+        upvar out o
+        upvar understacks ustacks
+        set nxt [llength $o] 
+        if {$i < $nxt} {
+            lset o $i $c
+        } else {
+            lappend o $c
+        }
+        dict set ustacks $i $stack
+    }
+
+}
+
+
+
+# -- --- --- --- --- --- --- --- --- --- ---
+namespace eval overtype {
+	interp alias {} ::overtype::center {} ::overtype::centre
+}
+
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+##  Ready   
+package provide overtype [namespace eval overtype {
+    variable version
+    set version 1.5.6 
+}]
+return
+
+#*** !doctools
+#[manpage_end]

src/bootsupport/modules/overtype-1.5.7.tm

@@ -0,0 +1,998 @@
+# -*- tcl -*-
+# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from <pkg>-buildversion.txt
+#
+# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem.
+# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository.
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+# (C) Julian Noble 2003-2023
+#
+# @@ Meta Begin
+# Application overtype 1.5.7
+# Meta platform     tcl
+# Meta license      BSD 
+# @@ Meta End
+
+
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+# doctools header
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+#*** !doctools
+#[manpage_begin overtype_module_overtype 0 1.5.7]
+#[copyright "2024"]
+#[titledesc {overtype text layout - ansi aware}]  [comment {-- Name section and table of contents description --}]
+#[moddesc {overtype text layout}]             [comment {-- Description at end of page heading --}] 
+#[require overtype]
+#[keywords module text ansi]
+#[description]
+#[para] -
+
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+
+#*** !doctools
+#[section Overview]
+#[para] overview of overtype 
+#[subsection Concepts]
+#[para] -
+
+
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+##  Requirements
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+
+#*** !doctools
+#[subsection dependencies]
+#[para] packages used by overtype 
+#[list_begin itemized]
+
+package require Tcl 8.6
+package require textutil
+package require punk::lib   ;#required for lines_as_list
+package require punk::ansi  ;#required to detect, split, strip and calculate lengths
+package require punk::char  ;#box drawing - and also unicode character width determination for proper layout of text with double-column-width chars
+#*** !doctools
+#[item] [package {Tcl 8.6}]
+#[item] [package textutil]
+#[item] [package punk::ansi]
+#[para] - required to detect, split, strip and calculate lengths of text possibly containing ansi codes
+#[item] [package punk::char]
+#[para] - box drawing - and also unicode character width determination for proper layout of text with double-column-width chars
+
+# #package require frobz
+# #*** !doctools
+# #[item] [package {frobz}]
+
+#*** !doctools
+#[list_end]
+
+
+
+
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+#*** !doctools
+#[section API]
+
+
+#Julian Noble <julian@precisium.com.au> - 2003 
+#Released under standard 'BSD license' conditions.
+#
+#todo - ellipsis truncation indicator for center,right
+
+#v1.4 2023-07 - naive ansi color handling - todo - fix string range 
+# - need to extract and replace ansi codes?
+
+namespace eval overtype {
+	namespace export *
+    variable default_ellipsis_horizontal "..." ;#fallback 
+    variable default_ellipsis_vertical "..." 
+    namespace eval priv {
+        proc _init {} {
+            upvar ::overtype::default_ellipsis_horizontal e_h
+            upvar ::overtype::default_ellipsis_vertical e_v
+            set e_h [format %c 0x2026] ;#Unicode Horizontal Ellipsis
+            set e_v [format %c 0x22EE]
+            #The unicode ellipsis looks more natural than triple-dash which is centred vertically whereas ellipsis is at floorline of text
+            #Also - unicode ellipsis has semantic meaning that other processors can interpret
+            #unicode does also provide a midline horizontal ellipsis 0x22EF
+
+            #set e [format %c 0x2504] ;#punk::char::charshort boxd_ltdshhz  - Box Drawings Light Triple Dash Horizontal
+            #if {![catch {package require punk::char}]} {
+            #    set e [punk::char::charshort boxd_ltdshhz] 
+            #}
+        }
+    }
+    priv::_init
+}
+proc overtype::about {} {
+	return "Simple text formatting. Author JMN. BSD-License"
+}
+
+namespace eval overtype {
+    variable escape_terminals
+    #single "final byte" in the range 0x40–0x7E (ASCII @A–Z[\]^_`a–z{|}~).
+    dict set escape_terminals CSI [list @ \\ ^ _ ` | ~ a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z "\{" "\}"]
+    #dict set escape_terminals CSI [list J K m n A B C D E F G s u] ;#basic 
+    dict set escape_terminals OSC [list \007 \033\\] ;#note mix of 1 and 2-byte terminals 
+
+    #self-contained 2 byte ansi escape sequences - review more?
+    variable ansi_2byte_codes_dict
+    set  ansi_2byte_codes_dict [dict create\
+        "reset_terminal"            "\u001bc"\
+        "save_cursor_posn"          "\u001b7"\
+        "restore_cursor_posn"       "\u001b8"\
+        "cursor_up_one"             "\u001bM"\
+        "NEL - Next Line"           "\u001bE"\
+        "IND - Down one line"       "\u001bD"\
+        "HTS - Set Tab Stop"        "\u001bH"\
+        ]
+
+        #debatable whether strip should reveal the somethinghidden - some terminals don't hide it anyway.
+        #  "PM - Privacy Message"      "\u001b^somethinghidden\033\\"\
+}
+
+
+#proc overtype::stripansi {text} {
+#    variable escape_terminals  ;#dict
+#    variable ansi_2byte_codes_dict
+#    #important that we don't spend too much time on this for plain text that doesn't contain any escapes anyway
+#    if {[string first \033 $text] <0 && [string first \009c $text] <0} {
+#        #\033 same as \x1b
+#        return $text
+#    }
+#
+#    set text [convert_g0 $text] 
+#
+#    #we process char by char - line-endings whether \r\n or \n should be processed as per any other character.
+#    #line endings can theoretically occur within an ansi escape sequence (review e.g title?)
+#    set inputlist [split $text ""]
+#    set outputlist [list] 
+#
+#    set 2bytecodes [dict values $ansi_2byte_codes_dict]
+#
+#    set in_escapesequence 0
+#    #assumption - undertext already 'rendered' - ie no backspaces or carriagereturns or other cursor movement controls
+#    set i 0
+#    foreach u $inputlist {
+#        set v [lindex $inputlist $i+1]
+#        set uv ${u}${v}
+#        if {$in_escapesequence eq "2b"} {
+#            #2nd byte - done.
+#            set in_escapesequence 0
+#        } elseif {$in_escapesequence != 0} {
+#            set escseq [dict get $escape_terminals $in_escapesequence]
+#            if {$u in $escseq} {
+#                set in_escapesequence 0
+#            } elseif {$uv in $escseq} {
+#                set in_escapseequence 2b ;#flag next byte as last in sequence
+#            }
+#        } else {
+#            #handle both 7-bit and 8-bit CSI and OSC
+#            if {[regexp {^(?:\033\[|\u009b)} $uv]} {
+#                set in_escapesequence CSI
+#            } elseif {[regexp {^(?:\033\]|\u009c)} $uv]} {
+#                set in_escapesequence OSC
+#            } elseif {$uv in $2bytecodes} {
+#                #self-contained e.g terminal reset - don't pass through.
+#                set in_escapesequence 2b
+#            } else {
+#                lappend outputlist $u
+#            }
+#        }
+#        incr i
+#    }
+#    return [join $outputlist ""]
+#}
+
+
+
+
+
+proc overtype::string_columns {text} {
+    if {[punk::ansi::ta::detect $text]} {
+        #error "error string_columns is for calculating character length of string - ansi codes must be stripped/rendered first e.g with punk::ansi::stripansi. Alternatively try punk::ansi::printing_length"
+        set text [punk::ansi::stripansi $text]
+    }
+    return [punk::char::string_width $text]
+}
+
+
+#string range should generally be avoided for both undertext and overtext which contain ansi escapes and other cursor affecting chars such as \b and \r
+proc overtype::left {args} {
+	# @c overtype starting at left (overstrike) 
+	# @c can/should we use something like this?: 'format "%-*s" $len $overtext 
+    variable default_ellipsis_horizontal
+
+	if {[llength $args] < 2} {
+		error {usage: ?-transparent [0|1]? ?-overflow [1|0]? ?-ellipsis [1|0]? ?-ellipsistext ...? undertext overtext}
+	}
+    lassign [lrange $args end-1 end] underblock overblock
+    set defaults [dict create\
+        -bias       ignored\
+        -ellipsis   0\
+        -ellipsistext   $default_ellipsis_horizontal\
+        -ellipsiswhitespace 0\
+        -overflow   0\
+        -transparent 0\
+        -exposed1 \uFFFD\
+        -exposed2 \uFFFD\
+    ]
+    set known_opts [dict keys $defaults]
+    set argsflags [lrange $args 0 end-2]
+    dict for {k v} $argsflags {
+        if {$k ni $known_opts} {
+            error "overtype::left unknown option '$k'. Known options: $known_opts"
+        }
+    }
+    set opts [dict merge $defaults $argsflags]
+    # -- --- --- --- --- ---
+    set opt_transparent     [dict get $opts -transparent]
+    set opt_ellipsistext    [dict get $opts -ellipsistext]
+    set opt_ellipsiswhitespace [dict get $opts -ellipsiswhitespace]
+    set opt_exposed1        [dict get $opts -exposed1] ;#widechar_exposed_left  - todo
+    set opt_exposed2        [dict get $opts -exposed2] ;#widechar_exposed_right - todo
+    # -- --- --- --- --- ---
+
+    set norm [list \r\n \n]
+    set underblock [string map $norm $underblock]
+    set overblock  [string map $norm $overblock]
+
+    set underlines [split $underblock \n]
+    #set colwidth [tcl::mathfunc::max {*}[lmap v $underlines {punk::ansi::printing_length $v}]]
+    lassign [blocksize $underblock] _w colwidth _h colheight
+    set overlines  [split $overblock \n]
+    #set overblock_width [tcl::mathfunc::max {*}[lmap v $overlines {punk::ansi::printing_length $v}]]
+    lassign [blocksize $overblock] _w overblock_width _h overblock_height
+    set under_exposed_max [expr {$colwidth - $overblock_width}]
+    set right_exposed $under_exposed_max 
+
+    set outputlines [list]
+    foreach undertext $underlines overtext $overlines {    
+        set undertext_printlen [punk::ansi::printing_length $undertext]
+        if {$undertext_printlen < $colwidth} {
+            set udiff [expr {$colwidth - $undertext_printlen}]
+            set undertext "$undertext[string repeat { } $udiff]"
+        }
+        set overtext_printlen [punk::ansi::printing_length $overtext]
+        set overflowlength [expr {$overtext_printlen - $colwidth}]
+
+        #review
+        #append overtext "\033\[0m"
+
+
+        if {$overflowlength > 0} {
+            #background line is narrower than data in line
+            set rendered [renderline -transparent $opt_transparent -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 -overflow [dict get $opts -overflow] $undertext $overtext]
+            if {![dict get $opts -overflow]} {
+                #set overtext [string range $overtext 0 $colwidth-1] ;#string range won't be correct e.g if contains ansi codes or leading \r or \b etc
+                if {[dict get $opts -ellipsis]} {
+                    set show_ellipsis 1
+                    if {!$opt_ellipsiswhitespace} {
+                        #we don't want ellipsis if only whitespace was lost
+                        set lostdata [string range $overtext end-[expr {$overflowlength-1}] end]
+                        if {[string trim $lostdata] eq ""} {
+                            set show_ellipsis 0
+                        }
+                    }
+                    if {$show_ellipsis} {
+                        set rendered [overtype::right $rendered $opt_ellipsistext]
+                    }
+                }
+            }
+            lappend outputlines $rendered
+        } else {
+            #we know overtext data is shorter or equal (for this line)
+            lappend outputlines [renderline -transparent $opt_transparent -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 $undertext $overtext]
+        }
+    }
+    return [join $outputlines \n]
+
+}
+
+namespace eval overtype::piper {
+    proc overcentre {args} {
+        if {[llength $args] < 2} {
+            error {usage: ?-bias left|right? ?-transparent [0|1|<regexp>]? ?-exposed1 <char>? ?-exposed2 <char>?  ?-overflow [1|0]? overtext pipelinedata}
+        }
+        lassign [lrange $args end-1 end] over under
+        set argsflags [lrange $args 0 end-2]
+        tailcall overtype::centre {*}$argsflags $under $over
+    }
+    proc overleft {args} {
+        if {[llength $args] < 2} {
+            error {usage: ?-startcolumn <column>? ?-transparent [0|1|<regexp>]? ?-exposed1 <char>? ?-exposed2 <char>?  ?-overflow [1|0]? overtext pipelinedata}
+        }
+        lassign [lrange $args end-1 end] over under
+        set argsflags [lrange $args 0 end-2]
+        tailcall overtype::left {*}$argsflags $under $over
+    }
+}
+#todo - left-right ellipsis ?
+proc overtype::centre {args} {
+    variable default_ellipsis_horizontal
+	if {[llength $args] < 2} {
+		error {usage: ?-transparent [0|1]? ?-bias [left|right]?  ?-overflow [1|0]? undertext overtext}
+	}
+	
+    foreach {underblock overblock} [lrange $args end-1 end] break
+
+    #todo - vertical vs horizontal overflow for blocks
+    set defaults [dict create\
+        -bias       left\
+        -ellipsis   0\
+        -ellipsistext   $default_ellipsis_horizontal\
+        -ellipsiswhitespace 0\
+        -overflow   0\
+        -transparent 0\
+        -exposed1 \uFFFD\
+        -exposed2 \uFFFD\
+    ]
+    set known_opts [dict keys $defaults]
+    set argsflags [lrange $args 0 end-2]
+    dict for {k v} $argsflags {
+        if {$k ni $known_opts} {
+            error "overtype::centre unknown option '$k'. Known options: $known_opts"
+        }
+    }
+    set opts [dict merge $defaults $argsflags]
+    # -- --- --- --- --- ---
+    set opt_transparent     [dict get $opts -transparent]
+    set opt_ellipsis        [dict get $opts -ellipsis]
+    set opt_ellipsistext    [dict get $opts -ellipsistext]
+    set opt_ellipsiswhitespace [dict get $opts -ellipsiswhitespace]
+    set opt_exposed1        [dict get $opts -exposed1]
+    set opt_exposed2        [dict get $opts -exposed2]
+    # -- --- --- --- --- ---
+
+
+    set norm [list \r\n \n]
+    set underblock [string map $norm $underblock]
+    set overblock  [string map $norm $overblock]
+
+    set underlines [split $underblock \n]
+    #set colwidth [tcl::mathfunc::max {*}[lmap v $underlines {punk::ansi::printing_length $v}]]
+    lassign [blocksize $underblock] _w colwidth _h colheight
+    set overlines  [split $overblock \n]
+    #set overblock_width [tcl::mathfunc::max {*}[lmap v $overlines {punk::ansi::printing_length $v}]]
+    lassign [blocksize $overblock] _w overblock_width _h overblock_height 
+    set under_exposed_max [expr {$colwidth - $overblock_width}]
+    if {$under_exposed_max > 0} {
+        #background block is wider
+        if {$under_exposed_max % 2 == 0} {
+            #even left/right exposure
+            set left_exposed [expr {$under_exposed_max / 2}]
+        } else {
+            set beforehalf [expr {$under_exposed_max / 2}] ;#1 less than half due to integer division
+            if {[string tolower [dict get $opts -bias]] eq "left"} {
+                set left_exposed $beforehalf
+            } else {
+                #bias to the right
+                set left_exposed [expr {$beforehalf + 1}]
+            }
+        }
+    } else {
+        set left_exposed 0
+    }
+
+    set outputlines [list]
+    foreach undertext $underlines overtext $overlines {    
+        set overtext_datalen [punk::ansi::printing_length $overtext]
+        set ulen [punk::ansi::printing_length $undertext]
+        if {$ulen < $colwidth} {
+            set udiff [expr {$colwidth - $ulen}]
+            set undertext "$undertext[string repeat { } $udiff]"
+        }
+
+        set overflowlength [expr {$overtext_datalen - $colwidth}]
+        #review - right-to-left langs should elide on left! - extra option required
+
+        if {$overflowlength > 0} {
+            #overlay line wider or equal
+            set rendered [renderline -transparent $opt_transparent -overflow [dict get $opts -overflow] -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 $undertext $overtext]
+            #overlay line data is wider - trim if overflow not specified in opts - and overtype an ellipsis at right if it was specified
+            if {![dict get $opts -overflow]} {
+                #lappend outputlines [string range $overtext 0 [expr {$colwidth - 1}]]
+                #set overtext [string range $overtext 0 $colwidth-1 ]
+                if {$opt_ellipsis} {
+                    set show_ellipsis 1
+                    if {!$opt_ellipsiswhitespace} {
+                        #we don't want ellipsis if only whitespace was lost
+                        set lostdata [string range $overtext end-[expr {$overflowlength-1}] end]
+                        if {[string trim $lostdata] eq ""} {
+                            set show_ellipsis 0
+                        }
+                    }
+                    if {$show_ellipsis} {
+                        set rendered [overtype::right $rendered $opt_ellipsistext]
+                    }
+                }
+            }
+            lappend outputlines $rendered
+            #lappend outputlines [renderline -transparent $opt_transparent $undertext $overtext]
+        } else {
+            #background block is wider than or equal to data for this line
+            lappend outputlines [renderline -startcolumn [expr {$left_exposed + 1}] -transparent $opt_transparent -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 $undertext $overtext]
+        }
+    }
+    return [join $outputlines \n]
+}
+
+proc overtype::right {args} {
+    #NOT the same as align-right - which should be done to the overblock first if required
+    variable default_ellipsis_horizontal
+	# @d !todo - implement overflow, length checks etc
+
+	if {[llength $args] < 2} {
+		error {usage: ?-overflow [1|0]? undertext overtext}
+	}
+    foreach {underblock overblock} [lrange $args end-1 end] break
+
+    set defaults [dict create\
+        -bias       ignored\
+        -ellipsis   0\
+        -ellipsistext   $default_ellipsis_horizontal\
+        -ellipsiswhitespace 0\
+        -overflow   0\
+        -transparent 0\
+        -exposed1 \uFFFD\
+        -exposed2 \uFFFD\
+    ]
+    set known_opts [dict keys $defaults]
+    set argsflags [lrange $args 0 end-2]
+    dict for {k v} $argsflags {
+        if {$k ni $known_opts} {
+            error "overtype::centre unknown option '$k'. Known options: $known_opts"
+        }
+    }
+    set opts [dict merge $defaults $argsflags]
+    # -- --- --- --- --- ---
+    set opt_transparent     [dict get $opts -transparent]
+    set opt_ellipsis         [dict get $opts -ellipsis]
+    set opt_ellipsistext    [dict get $opts -ellipsistext]
+    set opt_ellipsiswhitespace [dict get $opts -ellipsiswhitespace]
+    set opt_overflow        [dict get $opts -overflow]
+    set opt_exposed1        [dict get $opts -exposed1]
+    set opt_exposed2        [dict get $opts -exposed2]
+    # -- --- --- --- --- ---
+    
+    set norm [list \r\n \n]
+    set underblock [string map $norm $underblock]
+    set overblock  [string map $norm $overblock]
+
+    set underlines [split $underblock \n]
+    #set colwidth [tcl::mathfunc::max {*}[lmap v $underlines {punk::ansi::printing_length $v}]]
+    lassign [blocksize $underblock] _w colwidth _h colheight
+    set overlines  [split $overblock \n]
+    #set overblock_width [tcl::mathfunc::max {*}[lmap v $overlines {punk::ansi::printing_length $v}]]
+    lassign [blocksize $overblock] _w overblock_width _h overblock_height 
+    set under_exposed_max [expr {$colwidth - $overblock_width}]
+    set left_exposed $under_exposed_max 
+
+    set outputlines [list]
+    foreach undertext $underlines overtext $overlines {    
+        set overtext_datalen [punk::ansi::printing_length $overtext]
+        set ulen [punk::ansi::printing_length $undertext]
+        if {$ulen < $colwidth} {
+            set udiff [expr {$colwidth - $ulen}]
+            puts xxx
+            set undertext "$undertext[string repeat { } $udiff]"
+        }
+        if {$overtext_datalen < $overblock_width} {
+            set odiff [expr {$overblock_width - $overtext_datalen}]
+            #padding always on right - if alignment is required it should be done to block beforehand - not here
+            set overtextpadding "$overtext[string repeat { } $odiff]"
+        }
+
+        set overflowlength [expr {$overtext_datalen - $colwidth}]
+        if {$overflowlength > 0} {	
+            #raw overtext wider than undertext column
+            set rendered [renderline -transparent $opt_transparent -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 -overflow $opt_overflow -startcolumn 1 $undertext $overtext]
+            if {!$opt_overflow} {
+                if {$opt_ellipsis} {
+                    set show_ellipsis 1
+                    if {!$opt_ellipsiswhitespace} {
+                        #we don't want ellipsis if only whitespace was lost
+                        set lostdata [string range $overtext end-[expr {$overflowlength-1}] end]
+                        if {[string trim $lostdata] eq ""} {
+                            set show_ellipsis 0
+                        }
+                    }
+                    if {$show_ellipsis} {
+                        set rendered [overtype::right $rendered $opt_ellipsistext]
+                    }
+                }
+            }
+            lappend outputlines $rendered
+        } else {
+            #padded overtext 
+            lappend outputlines [renderline -transparent $opt_transparent -startcolumn [expr {$left_exposed + 1}] $undertext $overtext]
+        }
+    }
+
+    return [join $outputlines \n]
+}
+
+# -- --- --- --- --- --- --- --- --- --- ---
+proc overtype::transparentline {args} {
+    foreach {under over} [lrange $args end-1 end] break
+    set argsflags [lrange $args 0 end-2]
+    set defaults [dict create\
+        -transparent 1\
+        -exposed 1 " "\
+        -exposed 2 " "\
+    ]
+    set newargs [dict merge $defaults $argsflags]
+    tailcall overtype::renderline {*}$newargs $under $over
+}
+#renderline may not make sense as it is in the long run for blocks of text - but is handy in the single-line-handling form anyway.
+# We are trying to handle ansi codes in a block of text which is acting like a mini-terminal in some sense.
+#We can process standard cursor moves such as \b \r - but no way to respond to other cursor movements e.g moving to other lines.
+#
+namespace eval overtype::piper {
+    proc renderline {args} {
+        if {[llength $args] < 2} {
+            error {usage: ?-start <int>? ?-transparent [0|1|<regexp>]?  ?-overflow [1|0]? overtext pipelinedata}
+        }
+        foreach {over under} [lrange $args end-1 end] break
+        set argsflags [lrange $args 0 end-2]
+        tailcall overtype::renderline {*}$argsflags $under $over
+    }
+}
+interp alias "" piper_renderline "" overtype::piper::renderline 
+
+#-returnextra to enable returning of overflow and length
+# todo - use punk::ansi::ta::detect to short-circuit processing and do simple string calcs as an optimisation?
+#review - DECSWL/DECDWL double width line codes - very difficult/impossible to align and compose with other elements
+#todo - review transparency issues with single/double width characters!
+#bidi - need a base direction and concept of directional runs for RTL vs LTR - may be best handled at another layer?
+proc overtype::renderline {args} {
+	if {[llength $args] < 2} {
+		error {usage: ?-info 0|1? ?-startcolumn <int>? ?-transparent [0|1|<regexp>]?  ?-overflow [1|0]? undertext overtext}
+	}
+    lassign [lrange $args end-1 end] under over
+    #should also rule out \v
+    if {[string first \n $over] >=0 || [string first \n $under] >= 0} {
+        error "overtype::renderline not allowed to contain newlines"
+    }
+    set defaults [dict create\
+        -overflow   0\
+        -transparent 0\
+        -startcolumn 1\
+        -info 0\
+        -exposed1 \uFFFD\
+        -exposed2 \uFFFD\
+    ]
+    #exposed1 and exposed2 for first and second col of underying 2wide char which is truncated by transparency or overflow
+
+    set known_opts [dict keys $defaults]
+    set argsflags [lrange $args 0 end-2]
+    dict for {k v} $argsflags {
+        if {$k ni $known_opts} {
+            error "overtype::renderline unknown option '$k'. Known options: $known_opts"
+        }
+    }
+    set opts [dict merge $defaults $argsflags]
+    # -- --- --- --- --- --- --- --- --- --- --- ---
+    set opt_overflow            [dict get $opts -overflow]
+    set opt_colstart            [dict get $opts -startcolumn] ;#start cursor column
+    # -- --- --- --- --- --- --- --- --- --- --- ---
+    set opt_transparent         [dict get $opts -transparent]  
+    if {$opt_transparent eq "0"} {
+        set do_transparency 0
+    } else {
+        set do_transparency 1
+        if {$opt_transparent eq "1"} {
+            set opt_transparent {[\s]}
+        }
+    }
+    # -- --- --- --- --- --- --- --- --- --- --- ---
+    set opt_returnextra         [dict get $opts -info]
+    # -- --- --- --- --- --- --- --- --- --- --- ---
+    set opt_exposed1            [dict get $opts -exposed1]
+    set opt_exposed2            [dict get $opts -exposed2]
+    # -- --- --- --- --- --- --- --- --- --- --- ---
+
+    #-----
+    #
+    if {[string first \t $under] >= 0} {
+        #set under [textutil::tabify::untabify2 $under]
+        set under [textutil::tabify::untabifyLine $under 8] ;#8 is default for untabify2 - review
+    }
+    set overdata $over
+    if {[string first \t $over] >= 0} {
+        #set overdata [textutil::tabify::untabify2 $over]
+        set overdata [textutil::tabify::untabifyLine $over 8]
+    }
+    #-------
+
+    #ta_detect ansi and do simpler processing?
+
+
+    # -- --- --- --- --- --- --- ---
+    set undermap [punk::ansi::ta::split_codes_single $under]
+    set understacks [dict create]
+
+    set i_u -1
+    set i_o 0 
+    set outcols [list] 
+    set u_codestack [list]
+    set pt_underchars "" ;#for string_columns length calculation for overflow 0 truncation
+    set remainder [list] ;#for returnextra
+    foreach {pt code} $undermap {
+        #pt = plain text
+        append pt_underchars $pt
+        foreach grapheme [punk::char::grapheme_split $pt] {
+            set width [punk::char::string_width $grapheme]
+            incr i_u
+            dict set understacks $i_u $u_codestack 
+            lappend outcols $grapheme
+            if {$width > 1} {
+                incr i_u
+                #presumably there are no triple-column or wider unicode chars.. until the aliens arrive.(?)
+                #but what about emoji combinations etc - can they be wider than 2?
+                dict set understacks $i_u $u_codestack 
+                lappend outcols ""
+            }
+        }
+
+        #underlay should already have been rendered and not have non-sgr codes - but let's retain the check for them and not stack them if other codes are here
+
+        #only stack SGR (graphics rendition) codes - not title sets, cursor moves etc 
+        #order of if-else based on assumptions:
+        # that pure resets are fairly common - more so than leading resets with other info
+        # that non-sgr codes are not that common, so ok to check for resets before verifying it is actually SGR at all.
+        if {[punk::ansi::codetype::is_sgr_reset $code]} {
+            set u_codestack [list]
+        } elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} {
+            set u_codestack [list $code]
+        } elseif {[punk::ansi::codetype::is_sgr $code]} {
+            lappend u_codestack $code
+        }
+        #consider also if there are other codes that should be stacked..?
+    }
+    #trailing codes in effect for underlay
+    if {[llength $undermap]} {
+        dict set understacks [expr {$i_u + 1}] $u_codestack
+    }
+
+
+    # -- --- --- --- --- --- --- ---
+    ####
+    #if opt_colstart - we need to build a space (or any singlewidth char really) padding on the left of the right number of columns.
+    #this will be processed as transparent - and handle doublewidth underlay characters appropriately
+    set startpad [string repeat " " [expr {$opt_colstart -1}]]
+    append startpad $overdata ;#overdata with left padding spaces based on col-start under will show through for left-padding portion regardless of -transparency
+    set overmap  [punk::ansi::ta::split_codes_single $startpad]
+    ####
+    set colcursor $opt_colstart
+
+    #set re_diacritics {[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+} 
+    #as at 2024-02 punk::char::grapheme_split uses these - not aware of more complex graphemes
+
+
+    set overstacks [dict create]
+    set o_codestack [list]
+    set pt_overchars ""
+    foreach {pt code} $overmap {
+        append pt_overchars $pt
+        foreach grapheme [punk::char::grapheme_split $pt] {
+           dict set overstacks $i_o $o_codestack 
+           incr i_o 
+        }
+
+        if {[punk::ansi::codetype::is_sgr $code]} {
+            if {[punk::ansi::codetype::has_sgr_leadingreset $code]} {
+                #m code which has sgr reset at start - no need to replay prior sgr codes 
+                set o_codestack [list $code]
+            } else {
+                lappend o_codestack $code
+            }
+        }
+
+        #only stack SGR (graphics rendition) codes - not title sets, cursor moves etc 
+        #order of if-else based on assumptions:
+        # that pure resets are fairly common - more so than leading resets with other info
+        # that non-sgr codes are not that common, so ok to check for resets before verifying it is actually SGR at all.
+        if {[punk::ansi::codetype::is_sgr_reset $code]} {
+            set o_codestack [list]
+        } elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} {
+            set o_codestack [list $code]
+        } elseif {[punk::ansi::codetype::is_sgr $code]} {
+            lappend o_codestack $code
+        }
+
+    }
+    # -- --- --- --- --- --- --- ---
+
+
+    #potential problem - combinining diacritics directly following control chars like \r \b
+
+    set bs [format %c 0x08]
+    set idx 0 ;# line index  (cursor - 1)
+    set idx_over -1
+    foreach {pt code} $overmap {
+        #set ptchars [split $pt ""] ;#for lookahead
+        set overlay_graphemes [punk::char::grapheme_split $pt]
+        #emit plaintext chars first using existing SGR codes from under/over stack as appropriate
+        #then check if the following code is a cursor movement within the line and adjust index if so
+        foreach ch $overlay_graphemes {
+            set within_undercols [expr {$idx <= [llength $outcols]-1}]
+            incr idx_over
+            if {$ch eq "\r"} {
+                set idx [expr {$opt_colstart -1}]
+            } elseif {$ch eq "\b"} {
+                #review - backspace effect on double-width chars
+                if {$idx > ($opt_colstart -1)} {
+                    incr idx -1
+                }
+            } elseif {($idx < ($opt_colstart -1))} {
+                incr idx
+            } elseif {($do_transparency && [regexp $opt_transparent $ch])} {    
+                #pre opt_colstart is effectively transparent (we have applied padding of required number of columns to left of overlay)
+                if {$idx > [llength $outcols]-1} {
+                    lappend outcols " "
+                    dict set understacks $idx [list] ;#review - use idx-1 codestack?
+                    incr idx
+                } else {
+                    set uwidth [punk::char::string_width [lindex $outcols $idx]]
+                    if {[lindex $outcols $idx] eq ""} {
+                        #2nd col of 2-wide char in underlay 
+                        incr idx
+                    } elseif {$uwidth == 0} {
+                        #e.g control char  ? combining diacritic ?
+                        incr idx
+                    } elseif {$uwidth == 1} {
+                        set owidth [punk::char::string_width $ch]
+                        incr idx
+                        if {$owidth > 1} {
+                            incr idx
+                        } 
+                    } elseif {$uwidth > 1} {
+                        if {[punk::char::string_width $ch] == 1} {
+                            #normal singlewide transparency 
+                            set next_pt_overchar [string index $pt_overchars $idx_over+1] ;#lookahead of next plain-text char in overlay
+                            if {$next_pt_overchar eq ""} {
+                                #special-case trailing transparent - no next_pt_overchar
+                                incr idx
+                            } else {
+                                if {[regexp $opt_transparent $next_pt_overchar]} {
+                                    incr idx
+                                } else {
+                                    #next overlay char is not transparent.. first-half of underlying 2wide char is exposed 
+                                    priv::render_addchar $idx $opt_exposed1 [dict get $overstacks $idx_over]
+                                    incr idx
+                                }
+                            }
+                        } else {
+                            #2wide transparency over 2wide in underlay
+                            incr idx
+                        }
+                    }
+                }
+            } else {
+                #non-transparent char in overlay
+                set uwidth [punk::char::string_width [lindex $outcols $idx]]
+                    
+                if {$within_undercols && [lindex $outcols $idx] eq ""} {
+                    #2nd col of 2wide char in underlay
+                    priv::render_addchar $idx $ch [dict get $overstacks $idx_over]
+                    #JMN - this has to expose if our startposn chopped an underlay - but not if we already overwrote the first half of the widechar underlay grapheme 
+                    #e.g renderline \uFF21\uFF21---  a\uFF23\uFF23
+                    #vs
+                    #    renderline -startcolumn 2 \uFF21---- \uFF23
+                    if {[lindex $outcols $idx-1] != ""} {
+                        #verified it's an empty following a filled - so it's a legit underlay remnant 
+                        #reset previous to an exposed 1st-half - but leave understacks code as is
+                        priv::render_addchar [expr {$idx-1}] $opt_exposed1 [dict get $understacks [expr {$idx-1}]]
+                    }
+                    incr idx
+                    
+                } elseif {$uwidth == 0} {
+                    if {$within_undercols} {
+                        #e.g combining diacritic - increment before over char  REVIEW
+                        #arguably the previous overchar should have done this - ie lookahead for combiners?
+                        priv::render_addchar $idx "" [dict get $overstacks $idx_over]
+                        incr idx
+                        priv::render_addchar $idx $ch [dict get $overstacks $idx_over]
+                        incr idx
+                    } else {
+                        #overflow
+                        priv::render_addchar $idx $ch [dict get $overstacks $idx_over]
+                        incr idx
+                    }
+                } elseif {$uwidth == 1} {
+                    set owidth [punk::char::string_width $ch]
+                    if {$owidth == 1} {
+                        priv::render_addchar $idx $ch [dict get $overstacks $idx_over]
+                        incr idx
+                    } else {
+                        priv::render_addchar $idx $ch [dict get $overstacks $idx_over]
+                        incr idx
+                        priv::render_addchar $idx ""  [dict get $overstacks $idx_over]
+                        #if next column in underlay empty - we've overwritten first half of underlying 2wide grapheme
+                        #replace with rhs exposure in case there are no more overlay graphemes coming - use underlay's stack
+                        if {[llength $outcols] >= [expr {$idx +2}] && [lindex $outcols $idx+1] eq ""} {
+                            priv::render_addchar [expr {$idx+1}] $opt_exposed2 [dict get $understacks [expr {$idx+1}]]
+                        }
+                        incr idx
+                    }
+                } elseif {$uwidth > 1} {
+                    set owidth [punk::char::string_width $ch]
+                    if {$owidth == 1} {
+                        priv::render_addchar $idx $ch [dict get $overstacks $idx_over]
+                        incr idx
+                        priv::render_addchar $idx $opt_exposed2 [dict get $overstacks $idx_over]
+                        #don't incr idx - we are just putting a broken-indication in the underlay - which may get overwritten by next overlay char
+                    } else {
+                        #2wide over 2wide
+                        priv::render_addchar $idx $ch [dict get $overstacks $idx_over]
+                        incr idx 2 
+                    }
+                }
+            }
+        } 
+
+        #cursor movement?
+        #if {![punk::ansi::codetype::is_sgr $code]} {
+        #
+        #}
+        if {[punk::ansi::codetype::is_cursor_move_in_line $code]} {
+        }
+        set re_col_move {\x1b\[([0-9]*)(C|D|G)}
+        if {[regexp $re_col_move $code _match num type]} {
+            if {$type eq "C"} {
+                #left-arrow/move-back
+                if {$num eq ""} {set num 1}
+                incr idx -$num
+                if {$idx < $opt_colstart} {
+                    set idx $opt_colstart
+                }
+            } elseif {$type eq "D"} {
+                #right-arrow/move forward
+                if {$num eq ""} {set num 1}
+                if {!$opt_overflow || ($idx + $num) <= [llength $outcols]-1} {
+                    incr idx $num
+                    if {$idx > [llength $outcols]-1} {
+                        set idx [llength $outcols] -1
+                    }
+                } else {
+                    set idxstart $idx
+                    set idxend [expr {[llength $outcols]-1}]
+                    set moveend [expr {$idxend - $idxstart}] 
+                    incr idx $moveend
+                    set stackinfo [dict get $understacks $idx] ;#use understack at end - which may or may not have already been replaced by stack from overtext
+                    #pad outcols
+                    set movemore [expr {$num - $moveend}] 
+                    #assert movemore always at least 1 or we wouldn't be in this branch
+                    for {set m 1} {$m <= $movemore} {incr m} {
+                        incr idx
+                        priv::render_addchar $idx " " $stackinfo
+                    }
+                }
+            } elseif {$type eq "G"} {
+                #move absolute column
+                #adjust to colstart - as column 1 is within overlay
+                #ie 
+                set num [expr {$num + $opt_colstart}]
+                error "renderline absolute col move ESC G unimplemented"
+            }
+
+        }
+    }
+
+    if {$opt_overflow == 0} {
+        #need to truncate to the width of the original undertext
+        #review - string_width vs printing_length here. undertext requirement to be already rendered therefore punk::char::string_width ok?
+        set num_under_columns [punk::char::string_width $pt_underchars] ;#plaintext underchars
+    }
+
+    #coalesce and replay codestacks for outcols grapheme list
+    set outstring ""    
+    set remstring "" ;#remainder after overflow point reached
+    set i 0
+    set cstack [list]
+    set prevstack [list]
+    set out_rawchars ""; #for overflow counting 
+    set output_to "outstring" ;#var in effect depending on overflow
+    set in_overflow 0 ;#used to stop char-width scanning once in overflow
+    foreach ch $outcols {
+        append out_rawchars $ch
+        if {$opt_overflow == 0 && !$in_overflow} {
+            if {[set nextvisualwidth [punk::char::string_width $out_rawchars]] > $num_under_columns} {
+                #todo - check if we overflowed with a double-width char ? 
+                #store visualwidth which may be short
+                set in_overflow 1
+            }
+        }
+        if {$in_overflow} {
+            set output_to "remstring"
+        }
+        set cstack [dict get $understacks $i]
+        if {$cstack ne $prevstack} {
+            if {[llength $prevstack]} {
+                append $output_to \033\[m
+            }
+            foreach code $cstack {
+                append $output_to $code
+            }
+        }
+        append $output_to $ch
+        set prevstack $cstack
+        incr i
+    }
+    if {[dict size $understacks] > 0} {
+        append $output_to [join [dict get $understacks [expr {[dict size $understacks]-1}]] ""] ;#tail codes
+    }
+    if {[string length $remstring]} {
+        #puts stderr "remainder:$remstring"
+    }
+    #pdict $understacks
+    if {$opt_returnextra} {
+        set cursorinfo ""
+        return [list result $outstring visualwidth - stringlen [string length $outstring] remainder $remstring cursor [expr {$idx + 1}]]
+    } else {
+        return $outstring
+    }
+    #return [join $out ""]
+}
+proc overtype::test_renderline {} {
+    set t \uFF5E ;#2-wide tilde
+    set u \uFF3F ;#2-wide underscore
+    set missing \uFFFD
+    return [list $t $u A${t}B]
+}
+
+#maintenance warning
+#same as textblock::size - but we don't want that circular dependency
+#block width and height can be tricky. e.g \v handled differently on different terminal emulators and can affect both
+proc overtype::blocksize {textblock} {
+    if {$textblock eq ""} {
+        return [dict create width 0 height 1] ;#no such thing as zero-height block - for consistency with non-empty strings having no line-endings
+    }
+    set textblock [textutil::tabify::untabify2 $textblock]
+    #stripansi on entire block in one go rather than line by line - result should be the same - review - make tests
+    set textblock [punk::ansi::stripansi $textblock]
+    if {[string first \n $textblock] >= 0} {
+        set width [tcl::mathfunc::max {*}[lmap v [punk::lib::lines_as_list -- $textblock] {::punk::char::string_width $v}]]
+    } else {
+        set width [punk::char::string_width $textblock] 
+    }
+    set num_le [expr {[string length $textblock]-[string length [string map [list \n {}] $textblock]]}] ;#faster than splitting into single-char list
+    #our concept of block-height is likely to be different to other line-counting mechanisms
+    set height [expr {$num_le + 1}] ;# one line if no le - 2 if there is one trailing le even if no data follows le
+
+    return [dict create width $width height $height] ;#maintain order in 'image processing' standard width then height - caller may use lassign [dict values [blocksize <data>]] width height
+}
+
+namespace eval overtype::priv {
+
+    #is actually addgrapheme?
+    proc render_addchar {i c stack} {
+        upvar outcols o
+        upvar understacks ustacks
+        set nxt [llength $o] 
+        if {$i < $nxt} {
+            lset o $i $c
+        } else {
+            lappend o $c
+        }
+        dict set ustacks $i $stack
+    }
+
+}
+
+
+
+# -- --- --- --- --- --- --- --- --- --- ---
+namespace eval overtype {
+	interp alias {} ::overtype::center {} ::overtype::centre
+}
+
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+##  Ready   
+package provide overtype [namespace eval overtype {
+    variable version
+    set version 1.5.7 
+}]
+return
+
+#*** !doctools
+#[manpage_end]

src/bootsupport/modules/punk/ansi-0.1.1.tm

@@ -167,6 +167,9 @@ namespace eval punk::ansi {
     proc controlstring_APC8 {text} {
         return "\x9f${text}\x9c"
     }
+    #there is also the SGR hide code (8) which has intermittent terminal support
+    #This doesn't change the output length - so support is tricky to detec. (terminal checksum report?)
+
 
     #candidate for zig/c implementation?
     proc stripansi {text} {
@@ -199,7 +202,8 @@ namespace eval punk::ansi {
         set outputlist [list] 
 
         set in_escapesequence 0
-        #assumption - undertext already 'rendered' - ie no backspaces or carriagereturns or other cursor movement controls
+        #assumption - text already 'rendered' - ie no cursor movement controls . (what about backspace and lone carriage returns - they are horizontal cursor movements)
+        
         set i 0
         foreach u $inputlist {
             set v [lindex $inputlist $i+1]
@@ -598,12 +602,13 @@ namespace eval punk::ansi {
     proc move_column {col} {
         #*** !doctools
         #[call [fun move_column] [arg col]]
-        return \x1b\[${col}g
+        return \x1b\[${col}G
     }
     proc move_row {row} {
         #*** !doctools
         #[call [fun move_row] [arg row]]
-        return \x1b\[${row}G
+        #[para]VPA - Vertical Line Position Absolute
+        return \x1b\[${row}d
     }
     # -- ---  --- --- ---
 
@@ -686,6 +691,22 @@ namespace eval punk::ansi {
         return \033\[6n 
     }
 
+    proc request_cursor_information {} {
+        #*** !doctools
+        #[call [fun request_cursor_information]]
+        #[para]DECRQPSR (DEC Request Presentation State Report) for DECCCIR Cursor Information report
+        #[para]When written to the terminal, this sequence causes the terminal to emit cursor information to stdin
+        #[para]A stdin readloop will need to be in place to read this information
+        return \x1b\[1\$w
+    }
+    proc request_tabstops {} {
+        #*** !doctools
+        #[call [fun request_tabstops]]
+        #[para]DECRQPSR (DEC Request Presentation State Report) for DECTABSR Tab stop report
+        #[para]When written to the terminal, this sequence causes the terminal to emit tabstop information to stdin
+        return \x1b\[2\$w
+    }
+
 
     #alternative to string terminator is \007 - 
     proc titleset {windowtitle} {
@@ -811,7 +832,7 @@ namespace eval punk::ansi {
         }
         proc is_cursor_move_in_line {code} {
             #review - what about CSI n : m H where row n happens to be current line?
-            regexp {\033\[[0-9]*(:?C|D|G)$}
+            regexp {\033\[[0-9]*(:?C|D|G)$} $code
         }
         #pure SGR reset with no other functions
         proc is_sgr_reset {code} {
@@ -1254,7 +1275,7 @@ namespace eval punk::ansi::ansistring {
             APC [list \x9f \ue03f]\
         ]
         #it turns out we need pretty much everything for debugging
-        set visuals [dict create\
+        set visuals_c0 [dict create\
             NUL [list \x00 \u2400]\
             SOH [list \x01 \u2401]\
             STX [list \x02 \u2402]\
@@ -1282,41 +1303,71 @@ namespace eval punk::ansi::ansistring {
             RS  [list \x1e \u241e]\
             US  [list \x1f \u241f]\
             DEL [list \x7f \u2421]\
+        ]
+        set visuals_c1 [dict create\
+            BPH [list \x82 \ue022]\
+            NBH [list \x83 \ue023]\
+            IND [list \x84 \ue024]\
+            NEL [list \x85 \ue025]\
+            SSA [list \x86 \ue026]\
+            ESA [list \x87 \ue027]\
+            HTS [list \x88 \ue028]\
+            HTJ [list \x89 \ue029]\
+            VTS [list \x8a \ue02a]\
+            PLD [list \x8b \ue02a]\
+            PLU [list \x8c \ue02c]\
+            RI  [list \x8d \ue02d]\
+            SS2 [list \x8e \ue02e]\
+            SS3 [list \x8f \ue02f]\
+            DCS [list \x90 \ue030]\
+            PU1 [list \x91 \ue031]\
+            PU2 [list \x92 \ue032]\
+            STS [list \x93 \ue033]\
+            CCH [list \x94 \ue034]\
+            MW  [list \x95 \ue035]\
+            SPA [list \x96 \ue036]\
+            EPA [list \x97 \ue037]\
             SOS [list \x98 \ue038]\
+            SCI [list \x9a \ue03a]\
             CSI [list \x9b \ue03b]\
             ST  [list \x9c \ue03c]\
+            OSC [list \x9d \ue03d]\
             PM  [list \x9e \ue03e]\
             APC [list \x9f \ue03f]\
         ]
+
+        set visuals_opt [dict create]
         if {$opt_esc} {
-            dict set visuals VT [list \x1b \u241b]
+            dict set visuals_opt ESC [list \x1b \u241b]
         }
         if {$opt_cr} {
-            dict set visuals CR [list \x0d \u240d]
+            dict set visuals_opt CR [list \x0d \u240d]
         }
         if {$opt_lf} {
-            dict set visuals LF [list \x0a \u240a]
+            dict set visuals_opt LF [list \x0a \u240a]
         }
         if {$opt_vt} {
-            dict set visuals VT [list \x0b \u240b]
+            dict set visuals_opt VT [list \x0b \u240b]
         }
         if {$opt_ht} {
-            dict set visuals HT [list \x09 \u2409]
+            dict set visuals_opt HT [list \x09 \u2409]
         }
         if {$opt_bs} {
-            dict set visuals BS [list \x08 \u2408]
+            dict set visuals_opt BS [list \x08 \u2408]
         }
         if {$opt_sp} {
-            dict set visuals SP [list \x20 \u2420]
+            dict set visuals_opt SP [list \x20 \u2420]
         }
 
+        set visuals [dict merge $visuals_opt $visuals_c0 $visuals_c1]
         set  charmap [list]
         dict for {nm chars} $visuals {
             lappend charmap {*}$chars
         }
         return [string map $charmap $string]
 
-        #ISO2047 - 7bit - limited set, limited support
+
+        #test of ISO2047 - 7bit - limited set, limited support, somewhat obscure glyphs
         #return [string map [list \033 \U2296 \007 \U237E] $string]
     }
 
@@ -1326,7 +1377,7 @@ namespace eval punk::ansi::ansistring {
         #[para]Returns the length of the string without ansi codes
         #[para]This will not count strings hidden inside a 'privacy message' or other ansi codes which may have content between their opening escape and their termination sequence.
         #[para]This is equivalent to calling string length on the result of stripansi $string 
-        #[para]Note that this returns the number of characters in the payload, and is not always the same as the width of the string as rendered on a terminal.
+        #[para]Note that this returns the number of characters in the payload (after applying combiners), and is not always the same as the width of the string as rendered on a terminal.
         #[para]To get the width, use punk::ansi::printing_length instead, which is also ansi aware.
         string length [stripansi $string]
     }

src/bootsupport/modules/punk/char-0.1.0.tm

@@ -1796,12 +1796,21 @@ namespace eval punk::char {
     #review - what about \r \t \b ?
     proc string_width {text} {
         #review is detecting \033 enough? what about 8-bit escapes?
+
         if {[string first \n $text] >= 0} {
             error "string_width accepts only a single line"
         }
-        if {[string first \033 $text] >= 0} {
-            error "string_width doesn't accept ansi escape sequences. Use punk::ansi::stripansi first"
-        }
+
+
+        #we can c0 control characters after or while processing ansi escapes.
+        #we need to map remaining control characters to zero-width (under assumption we're not using a font/codepage that displays them - review!) 
+        #anyway - we must allow things like raw ESC,DEL, NUL etc to pass through without error
+        #if {[string first \033 $text] >= 0} {
+        #    error "string_width doesn't accept ansi escape sequences. Use punk::ansi::stripansi first"
+        #}
+        set re_ascii_c0 {[\U0000-\U001F]}
+        set text [regsub -all $re_ascii_c0 $text ""]
+
         #todo - check double-width chars in unicode blocks.. try to do reasonably quicky 
         #short-circuit basic cases
         if {![regexp {[\uFF-\U10FFFF]} $text]} {
@@ -1822,9 +1831,16 @@ namespace eval punk::char {
         #
         # initial simplistic approach is just to strip these ... todo REVIEW
 
+        #experiment to detect leading diacritics - but this isn't necessary - it's still zero-width
+        #(leading combiners may display in terminal as mark on rightmost prompt char which is usually a space - but won't add width even then)
+        #set re_leading_diacritic {^(?:[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+)} 
+        #if {[regexp $re_leading_diacritic $text]} {
+        #    set text " $text" 
+        #}
         set re_diacritics {[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+} 
         set text [regsub -all $re_diacritics $text ""]
 
+
         set re_ascii_fullwidth {[\uFF01-\uFF5e]} 
 
         set doublewidth_char_count 0
@@ -1858,13 +1874,13 @@ namespace eval punk::char {
 
     #This shouldn't be called on text containing ansi codes!
     proc strip_nonprinting_ascii {str} {
-        #review - some single-byte 'control' chars have visual representations e.g ETX as heart
+        #review - some single-byte 'control' chars have visual representations e.g ETX as heart depending on font/codepage
         #It is currently used for screen display width calculations
         #equivalent for various unicode combining chars etc?
         set map [list\
-            \007 ""\
-            [format %c 0] ""\
-            [format %c 0x7f] ""\
+            \x00 ""\
+            \x07 ""\
+            \x7f ""\
         ]
         return [string map $map $str]
     }
@@ -1877,6 +1893,55 @@ namespace eval punk::char {
         error "char_uc_width unimplemented"
     }
 
+
+    #split into plaintext and runs of combiners 
+    proc combiner_split {text} {
+        #split into odd numbered list (or zero) in a similar way to punk::ansi::ta::_perlish_split
+        #
+        set re_diacritics {[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+} 
+        set graphemes [list]
+        set g ""
+        if {[string length $text] == 0} {
+            return {}
+        }
+        set list [list]
+        set start 0
+        set strlen [string length $text]
+        #make sure our regexes aren't non-greedy - or we may not have exit condition for loop 
+        #review
+        while {$start < $strlen && [regexp -start $start -indices -- $re_diacritics $text match]} {
+            lassign $match      matchStart matchEnd
+            #puts "->start $start ->match $matchStart $matchEnd"
+            lappend list [string range $text $start $matchStart-1] [string range $text $matchStart $matchEnd] 
+            set start [expr {$matchEnd+1}]
+
+            #if {$start >= [string length $text]} {
+            #    break
+            #}
+        }
+        lappend list [string range $text $start end]
+
+        return $list 
+    }
+
+    #1st shot - basic diacritics
+    #todo - become aware of unicode grapheme cluster boundaries
+    #
+    proc grapheme_split {text} {
+        set graphemes [list]
+        set csplits [combiner_split $text]
+        foreach {pt combiners} [lrange $csplits 0 end-1] {
+            set clist [split $pt ""]
+            lappend graphemes {*}[lrange $clist 0 end-1]
+            lappend graphemes [string cat [lindex $clist end] $combiners]
+        } 
+        #last csplit never has a combiner (_perlish_split style) - and may be empty - in which case we don't append it as a grapheme
+        if {[lindex $csplits end] ne ""} {
+            lappend graphemes {*}[split [lindex $csplits end] ""]
+        }
+        return $graphemes
+    }
+
     # -- --- --- --- ---
     #will accept a single char or a string - test using console cursor position reporting
     proc char_info_testwidth {ch {emit 0}} {

src/bootsupport/modules/punk/console-0.1.1.tm

@@ -80,6 +80,12 @@ namespace eval punk::console {
             internal::abort_if_loop
             tailcall enableVirtualTerminal
         }
+        proc disableVirtualTerminal {} {
+            #loopavoidancetoken (don't remove) 
+            internal::define_windows_procs
+            internal::abort_if_loop
+            tailcall disableVirtualTerminal
+        }
     } else {
         proc enableAnsi {} {
             #todo?
@@ -105,12 +111,19 @@ namespace eval punk::console {
             if {[set previous_stty_state_$channel] ne ""} {
                 exec {*}$sttycmd [set previous_stty_state_$channel]
                 set previous_stty_state_$channel ""
+                set is_raw 0
                 return restored
             }
             exec {*}$sttycmd -raw echo <@$channel
             set is_raw 0
             return done
         }
+        proc enableVirtualTerminal {} {
+
+        }
+        proc disableVirtualTerminal {} {
+
+        }
     }
 
     proc enable_mouse {} {
@@ -142,6 +155,27 @@ namespace eval punk::console {
         enable_bracketed_paste
         
     }
+    proc mode {{raw_or_line query}} {
+        variable is_raw
+        set raw_or_line [string tolower $raw_or_line]
+        if {$raw_or_line eq "query"} {
+            if {$is_raw} {
+                return "raw"
+            } else {
+                return "line"
+            }
+        } elseif {$raw_or_line eq "raw"} {
+            punk::console::enableRaw
+            punk::console::enableVirtualTerminal both
+        } elseif {$raw_or_line eq "line"} {
+            #review -order. disableRaw has memory from enableRaw.. but but for line mode we want vt disabled - so call it after disableRaw (?) 
+            punk::console::disableRaw
+            punk::console::disableVirtualTerminal input ;#default readline arrow behaviour etc
+            punk::console::enableVirtualTerminal output ;#display/use ansi codes
+        } else {
+            error "punk::console::mode expected 'raw' or 'line' or default value 'query'
+        }
+    }
 
     namespace eval internal {
         proc abort_if_loop {{failmsg ""}} {
@@ -162,6 +196,10 @@ namespace eval punk::console {
         proc define_windows_procs {} {
             package require zzzload
             set loadstate [zzzload::pkg_require twapi]
+
+            #loadstate could also be stuck on loading? - review - zzzload not very ripe
+            #Twapi is relatively slow to load - can be 1s plus in normal cases - and much longer if there are disk performance issues.
+
             if {$loadstate ni [list failed]} {
                 #review zzzload usage
                 #puts stdout "=========== console loading twapi ============="
@@ -220,17 +258,88 @@ namespace eval punk::console {
                     return [list stdout [list from $oldmode_out to $newmode_out] stdin [list from $oldmode_in to $newmode_in]]
                 }
 
-                proc [namespace parent]::enableVirtualTerminal {} {
-                    set h_out [twapi::get_console_handle stdout] 
-                    set oldmode_out [twapi::GetConsoleMode $h_out]
-                    set newmode_out [expr {$oldmode_out | 4}] 
-                    twapi::SetConsoleMode $h_out $newmode_out
+                #
+                proc [namespace parent]::enableVirtualTerminal {{channels {input output}}} {
+                    set ins [list in input stdin]
+                    set outs [list out output stdout stderr]
+                    set known [concat $ins $outs both]
+                    set directions [list]
+                    foreach v $channels {
+                        if {$v in $ins} {
+                            lappend directions input
+                        } elseif {$v in $outs} {
+                            lappend directions output
+                        } elseif {$v eq "both"} {
+                            lappend directions input output
+                        }
+                        if {$v ni $known} {
+                            error "enableVirtualTerminal expected channel values to be one of '$known'. (all values mapped to input and/or output)"
+                        }
+                    }
+                    set channels $directions ;#don't worry about dups.
+                    if {"both" in $channels} {
+                        lappend channels input output
+                    }
+                    set result [dict create]
+                    if {"output" in $channels} {
+                        #note setting stdout makes stderr have the same settings - ie there is really only one output to configure
+                        set h_out [twapi::get_console_handle stdout] 
+                        set oldmode [twapi::GetConsoleMode $h_out]
+                        set newmode [expr {$oldmode | 4}] 
+                        twapi::SetConsoleMode $h_out $newmode
+                        dict set result output [list from $oldmode to $newmode]
+                    }
 
-                    set h_in [twapi::get_console_handle stdin]
-                    set oldmode_in [twapi::GetConsoleMode $h_in]
-                    set newmode_in [expr {$oldmode_in | 0x200}]
-                    twapi::SetConsoleMode $h_in $newmode_in
-                    return [list stdout [list from $oldmode_out to $newmode_out] stdin [list from $oldmode_in to $newmode_in]]
+                    if {"input" in $channels} {
+                        set h_in [twapi::get_console_handle stdin]
+                        set oldmode_in [twapi::GetConsoleMode $h_in]
+                        set newmode_in [expr {$oldmode_in | 0x200}]
+                        twapi::SetConsoleMode $h_in $newmode_in
+                        dict set result input [list from $oldmode_in to $newmode_in]
+                    }
+
+                    return $result
+                }
+                proc [namespace parent]::disableVirtualTerminal {{channels {input output}}} {
+                    set ins [list in input stdin]
+                    set outs [list out output stdout stderr]
+                    set known [concat $ins $outs both]
+                    set directions [list]
+                    foreach v $channels {
+                        if {$v in $ins} {
+                            lappend directions input
+                        } elseif {$v in $outs} {
+                            lappend directions output
+                        } elseif {$v eq "both"} {
+                            lappend directions input output
+                        }
+                        if {$v ni $known} {
+                            error "disableVirtualTerminal expected channel values to be one of '$known'. (all values mapped to input and/or output)"
+                        }
+                    }
+                    set channels $directions ;#don't worry about dups.
+                    if {"both" in $channels} {
+                        lappend channels input output
+                    }
+                    set result [dict create]
+                    if {"output" in $channels} {
+                        #as above - configuring stdout does stderr too
+                        set h_out [twapi::get_console_handle stdout] 
+                        set oldmode [twapi::GetConsoleMode $h_out]
+                        set newmode [expr {$oldmode & ~4}] 
+                        twapi::SetConsoleMode $h_out $newmode
+                        dict set result output [list from $oldmode to $newmode]
+                    }
+                    if {"input" in $channels} {
+                        set h_in [twapi::get_console_handle stdin]
+                        set oldmode_in [twapi::GetConsoleMode $h_in]
+                        set newmode_in [expr {$oldmode_in & ~0x200}]
+                        twapi::SetConsoleMode $h_in $newmode_in
+                        dict set result input [list from $oldmode_in to $newmode_in]
+                    }
+
+                    #return [list stdout [list from $oldmode_out to $newmode_out] stdin [list from $oldmode_in to $newmode_in]]
+                    return $result
                 }
 
                 proc [namespace parent]::enableProcessedInput {} {
@@ -249,47 +358,94 @@ namespace eval punk::console {
                 }
 
 
-                proc [namespace parent]::enableRaw {{channel stdin}} {
-                    variable is_raw
-                    #review - change to modify_console_input_mode
-                    set console_handle [twapi::GetStdHandle -10]
-                    set oldmode [twapi::GetConsoleMode $console_handle]
-                    set newmode [expr {$oldmode & ~6}] ;# Turn off the echo and line-editing bits
-                    twapi::SetConsoleMode $console_handle $newmode
-                    set is_raw 1
-                    #don't disable handler - it will detect is_raw
-                    ###    twapi::set_console_control_handler {}
-                    return [list stdin [list from $oldmode to $newmode]]
+
+            } else {
+            
+                puts stderr "punk::console falling back to stty because twapi load failed"
+                proc [namespace parent]::enableAnsi {} {
+                    puts stderr "punk::console::enableAnsi todo"
                 }
-                proc [namespace parent]::disableRaw {{channel stdin}} {
-                    variable is_raw
-                    set console_handle [twapi::GetStdHandle -10]
-                    set oldmode [twapi::GetConsoleMode $console_handle]
-                    set newmode [expr {$oldmode | 6}] ;# Turn on the echo and line-editing bits
-                    twapi::SetConsoleMode $console_handle $newmode
-                    set is_raw 0
-                    return [list stdin [list from $oldmode to $newmode]]
+                proc [namespace parent]::disableAnsi {} {
+                }
+                #?
+                proc [namespace parent]::enableVirtualTerminal {{channels {input output}}} {
+                }
+                proc [namespace parent]::disableVirtualTerminal {{channels {input output}}} {
                 }
 
-            } else {
-                if {$loadstate eq "failed"} {
-                    puts stderr "punk::console falling back to stty because twapi load failed"
-                    proc [namespace parent]::enableAnsi {} {
-                        puts stderr "punk::console::enableAnsi todo"
-                    }
-                    proc [namespace parent]::enableRaw {{channel stdin}} {
-                        set sttycmd [auto_execok stty]
+            }
+
+                proc [namespace parent]::enableRaw {{channel stdin}} {
+                    variable is_raw
+                    variable previous_stty_state_$channel
+
+                    if {[package provide twapi] ne ""} {
+                        set console_handle [twapi::get_console_handle stdin]
+                        #returns dictionary
+                        #e.g -processedinput 1 -lineinput 1 -echoinput 1 -windowinput 0 -mouseinput 0 -insertmode 1 -quickeditmode 1 -extendedmode 1 -autoposition 0
+                        set oldmode [twapi::get_console_input_mode]
+                        twapi::modify_console_input_mode $console_handle -lineinput 0 -echoinput 0
+                        # Turn off the echo and line-editing bits
+                        #set newmode [dict merge $oldmode [dict create -lineinput 0 -echoinput 0]]
+                        set newmode [twapi::get_console_input_mode]
+
+                        set is_raw 1
+                        #don't disable handler - it will detect is_raw
+                        ###    twapi::set_console_control_handler {}
+                        return [list stdin [list from $oldmode to $newmode]]
+                    } elseif {[set sttycmd [auto_execok stty]] ne ""} {
+                        if {[set previous_stty_state_$channel] eq ""} {
+                            set previous_stty_state_$channel [exec {*}$sttycmd -g <@$channel]
+                        }
+
                         exec {*}$sttycmd raw -echo <@$channel
+                        set is_raw 1
+                        #review - inconsistent return dict
+                        return [dict create stdin [list from [set previous_stty_state_$channel] to "" note "fixme - to state not shown"]]
+                    } else {
+                        error "punk::console::enableRaw Unable to use twapi or stty to set raw mode - aborting"
                     }
-                    proc [namespace parent]::disableRaw {{channel stdin}} {
+                }
+
+                #note: twapi GetStdHandle & GetConsoleMode & SetConsoleCombo unreliable - fails with invalid handle (somewhat intermittent.. after stdin reopened?)
+                #could be we were missing a step in reopening stdin and console configuration?
+
+                proc [namespace parent]::disableRaw {{channel stdin}} {
+                    variable is_raw
+                    variable previous_stty_state_$channel
+
+                    if {[package provide twapi] ne ""} {
+                        set console_handle [twapi::get_console_handle stdin]
+                        set oldmode [twapi::get_console_input_mode]
+                        # Turn on the echo and line-editing bits
+                        twapi::modify_console_input_mode $console_handle -lineinput 1 -echoinput 1
+                        set newmode [twapi::get_console_input_mode]
+                        set is_raw 0
+                        return [list stdin [list from $oldmode to $newmode]]
+                    } elseif {[set sttycmd [auto_execok stty]] ne ""} {
                         set sttycmd [auto_execok stty]
-                        exec {*}$sttycmd raw echo <@$channel
+                        if {[set previous_stty_state_$channel] ne ""} {
+                            exec {*}$sttycmd [set previous_stty_state_$channel]
+                            set previous_stty_state_$channel ""
+                            return restored
+                        }
+                        exec {*}$sttycmd -raw echo <@$channel
+                        set is_raw 0
+                        #do we really want to exec stty yet again to show final 'to' state? 
+                        #probably not. We should work out how to read the stty result flags and set a result.. or just limit from,to to showing echo and lineedit states.
+                        return [list stdin  [list from "[set previous_stty_state_$channel]" to "" note "fixme - to state not shown"]]
+                    } else {
+                        error "punk::console::disableRaw Unable to use twapi or stty to unset raw mode - aborting"
                     }
                 }
-            }
+
+
         }
 
-        #review - 1 byte at a time seems inefficient..
+        #review - 1 byte at a time seems inefficient... but we don't have a way to peek or put back chars (?)
+        #todo - timeout - what if terminal doesn't put data on stdin?
+        #review - what if we slurp in data meant for main loop? Main loop probably needs to detect these responses and store them for lookup *instead* of this handler
+        #we may still need this handler if such a loop doesn't exist.
         proc ansi_response_handler {chan accumulatorvar waitvar} {
             set status [catch {read $chan 1} bytes]
             if { $status != 0 } {
@@ -457,9 +613,14 @@ namespace eval punk::console {
         
         set accumulator ::punk::console::chunk
         set waitvar     ::punk::console::chunkdone
-        set existing_handler [fileevent stdin readable]
+        set existing_handler [fileevent stdin readable] ;#review!
         set $waitvar ""
-        #todo - test and save rawstate so we don't disableRaw if terminal was already raw
+
+        set stdin_state [fconfigure stdin]
+
+        #todo - only use own handler if an existing stdin handler not present.. (or console is in line mode) 
+
+        #todo - test and save rawstate so we don't disableRaw if console was already raw
         if {!$::punk::console::is_raw} {
             set was_raw 0
             enableRaw
@@ -467,8 +628,7 @@ namespace eval punk::console {
             set was_raw 1
         }
         fconfigure stdin -blocking 0
-        #review
-        #fconfigure stdin -blocking 0 -inputmode raw
+        #
         fileevent stdin readable [list ::punk::console::internal::ansi_response_handler stdin $accumulator $waitvar]
 
         # - stderr vs stdout
@@ -478,32 +638,47 @@ namespace eval punk::console {
         #review - Are there disadvantages to using stdout vs stderr?
 
         puts -nonewline stdout \033\[6n ;flush stdout 
-        after 0 {update idletasks}
+
+
+        #response from terminal
         #e.g  \033\[46;1R
-        #todo - reset
+
+        #todo - make timeout configurable?
+        set cancel_timeout_id [after 2000 [list set $waitvar timedout]]
+        after 0 {update idletasks}
+
         set info ""
         if {[set $waitvar] eq ""} {
             vwait   $waitvar
         }
+        if {$waitvar ne "timedout"} {
+            after cancel $cancel_timeout_id
+        } else {
+            return ""
+        }
+
         if {$was_raw == 0} {
             disableRaw
         }
-        #fconfigure stdin -inputmode normal
+        #restore stdin state
+        fconfigure stdin -blocking [dict get $stdin_state -blocking]
         if {[string length $existing_handler]} {
             fileevent stdin readable $existing_handler
         }
         #response handler automatically removes it's own fileevent
 
+
         set info [set $accumulator]
         set start [string first \x1b $info]
         if {$start > 0} {
             set other [string range $info 0 $start-1]
             #!!!!! TODO
-            # Log this somehwere? Work out how to stop it happening?
+            # Log this somewhere? Work out how to stop it happening?
             #puts stderr "Warning - get_cursor_pos read extra data at start - '$other'"
             set info [string range $info $start end]
         }
 
+
         #set punk::console::chunk ""
         set data [string range $info 2 end-1]
         return $data
@@ -520,15 +695,29 @@ namespace eval punk::console {
         if {!$emit} {
             puts -nonewline stdout \033\[2K\033\[1G ;#2K erase line 1G cursor at col1
         }
+        set response ""
         if {[catch {
-            lassign [split [punk::console::get_cursor_pos] ";"] _row1 col1
+            set response [punk::console::get_cursor_pos]
         } errM]} {
-            puts stderr "Cannot test_char_width - may be no console? Error message from get_cursor_pos: $errM"
+            puts stderr "Cannot test_char_width for '[punk::ansi::ansistring VIEW $char_or_string]' - may be no console? Error message from get_cursor_pos: $errM"
+            return
+        }
+        lassign [split $response ";"] _row1 col1
+        if {![string length $response] || ![string is integer -strict $col1]} {
+            puts stderr "test_char_width Could not interpret response from get_cursor_pos for initial cursor pos. Response: '[punk::ansi::ansistring VIEW $response]'"
+            flush stderr
             return
         }
 
         puts -nonewline stdout $char_or_string
-        lassign [split [punk::console::get_cursor_pos] ";"] _row2 col2
+        set response [punk::console::get_cursor_pos]
+        lassign [split $response ";"] _row2 col2
+        if {![string is integer -strict $col2]} {
+            puts stderr "test_char_width could not interpret response from get_cursor_pos for post-emit cursor pos. Response:'[punk::ansi::ansistring VIEW $response]'"
+            flush stderr
+            return
+        }
+
         if {!$emit} {
             puts -nonewline stdout \033\[2K\033\[1G
         }
@@ -654,19 +843,25 @@ namespace eval punk::console {
             }
             move  $orig_row $orig_col
         }
-        proc save_cursor {} {
-            puts -nonewline stdout [punk::ansi::save_cursor]
-        }
-        proc restore_cursor {} {
-            puts -nonewline stdout [punk::ansi::restore_cursor]
-        }
         proc scroll_up {n} {
             puts -nonewline stdout [punk::ansi::scroll_up]
         }
         proc scroll_down {n} {
             puts -nonewline stdout [punk::ansi::scroll_down]
         }
-        #review - worth the extra microseconds to inline? might be
+
+        #review - worth the extra microseconds to inline? might be if used in for example prompt on every keypress.
+        #caller should build as much as possible using the punk::ansi versions to avoid extra puts calls
+        proc save_cursor {} {
+            #*** !doctools
+            #[call [fun save_cursor]]
+            puts -nonewline \x1b\[s
+        }
+        proc restore_cursor {} {
+            #*** !doctools
+            #[call [fun restore_cursor]]
+            puts -nonewline \x1b\[u
+        }
         proc insert_spaces {count} {
             puts -nonewline stdout \x1b\[${count}@
         }
@@ -712,7 +907,8 @@ namespace eval punk::console {
         #puts -nonewline [punk::ansi::erase_eol]$blanks;move_emit_return this $col $text
         #puts -nonewline  [move_emit_return this $col [punk::ansi::insert_spaces 150]$text]
         save_cursor
-        move_emit_return this $col [punk::ansi::move_forward 50][punk::ansi::insert_spaces 150][punk::ansi::move_back 50][punk::ansi::move_forward $col]$text
+        #move_emit_return this $col [punk::ansi::move_forward 50][punk::ansi::insert_spaces 150][punk::ansi::move_back 50][punk::ansi::move_forward $col]$text
+        puts -nonewline [punk::ansi::insert_spaces 150][punk::ansi::move_column $col]$text
         restore_cursor
     }
     proc move_emit_return {row col data args} {

src/bootsupport/modules/punk/du-0.1.0.tm

@@ -18,6 +18,7 @@
 ##  Requirements
 ##e.g package require frobz
 package require punk::mix::base
+package require struct::set
 
 
 namespace eval punk::du {
@@ -65,7 +66,6 @@ namespace eval punk::du {
     #breadth-first with sort can be quite fast .. but memory usage can easily get out of control
     proc du { args } {
         variable has_twapi
-        package require struct::set
 
 
         if 0 {

src/bootsupport/modules/punk/lib-0.1.0.tm

@@ -488,9 +488,11 @@ namespace eval punk::lib {
     proc askuser {question} {
         #*** !doctools
         #[call [fun askuser] [arg question]]
-        #[para]A very basic utility to read an answer from stdin
+        #[para]A basic utility to read an answer from stdin
         #[para]The prompt is written to the terminal and then it waits for a user to type something
         #[para]stdin is temporarily configured to blocking and then put back in its original state in case it wasn't already so. 
+        #[para]If the terminal is using punk::console and is in raw mode - the terminal will temporarily be put in line mode.
+        #[para](Generic terminal raw vs linemode detection not yet present)
         #[para]The user must hit enter to submit the response
         #[para]The return value is the string if any that was typed prior to hitting enter.
         #[para]The question argument can be manually colourised using the various punk::ansi funcitons
@@ -505,9 +507,22 @@ namespace eval punk::lib {
         puts stdout $question
         flush stdout
         set stdin_state [fconfigure stdin]
+        if {[catch {
+            package require punk::console
+            set console_raw [set ::punk::console::is_raw]
+        } err_console]} {
+            #assume normal line mode
+            set console_raw 0
+        }
         try {
             fconfigure stdin -blocking 1
-            set answer [gets stdin]
+            if {$console_raw} {
+                punk::console::disableRaw
+                set answer [gets stdin]
+                punk::console::enableRaw
+            } else {
+                set answer [gets stdin]
+            }
         } finally {
             fconfigure stdin -blocking [dict get $stdin_state -blocking]
         }

src/bootsupport/modules/punk/mix/commandset/loadedlib-0.1.0.tm

@@ -18,6 +18,7 @@
 ##  Requirements
 ##e.g package require frobz
 package require punk::ns
+package require punk::lib
 
 
 
@@ -463,11 +464,8 @@ namespace eval punk::mix::commandset::loadedlib {
             puts stdout "---"
             puts stdout "$loadinfo"
             puts stdout "---"
-            puts stdout "Proceed to create ${pkgtail}-${ver}.tm module? Y|N" 
-            set stdin_state [fconfigure stdin]
-            fconfigure stdin -blocking 1 
-            set answer [string tolower [gets stdin]]
-            fconfigure stdin -blocking [dict get $stdin_state -blocking]
+            set question "Proceed to create ${pkgtail}-${ver}.tm module? Y|N" 
+            set answer [punk::lib::askuser $question] ;#takes account of previous stdin state and terminal raw vs line state
             if {$answer ne "y"} {
                 puts stderr "mix libcopy.asmodule aborting due to user response '$answer' (required Y|y to proceed)  use -askme 0 to avoid prompts."
                 return
@@ -486,11 +484,8 @@ namespace eval punk::mix::commandset::loadedlib {
         if {[file exists $target_path]} {
             puts stdout "WARNING - module already exists at $target_path"
             if {$opt_askme} {
-                puts stdout "Copy anyway? Y|N" 
-                set stdin_state [fconfigure stdin]
-                fconfigure stdin -blocking 1 
-                set answer [string tolower [gets stdin]]
-                fconfigure stdin -blocking [dict get $stdin_state -blocking]
+                set question "Copy anyway? Y|N" 
+                set answer [punk::lib::askuser $question]
                 if {$answer ne "y"} {
                     puts stderr "mix libcopy.asmodule aborting due to user response '$answer' (required Y|y to proceed)  use -askme 0 to avoid prompts."
                     return

src/bootsupport/modules/punk/mix/util-0.1.0.tm

@@ -182,6 +182,9 @@ namespace eval punk::mix::util {
     }
 
     proc askuser {question} {
+        if {![catch {package require punk::lib}]} {
+            return [punk::lib::askuser $question] ;#takes account of terminal mode raw vs line (if punk::console used)
+        }
         puts stdout $question
         flush stdout
         set stdin_state [fconfigure stdin]
@@ -191,6 +194,7 @@ namespace eval punk::mix::util {
         return $answer
     }
 
+    #review - can be surprising if caller unaware it uses try
     proc do_in_path {path script} {
         #from ::kettle::path::in
         set here [pwd]

src/bootsupport/modules/punk/repo-0.1.1.tm

@@ -139,6 +139,9 @@ namespace eval punk::repo {
     }
 
     proc askuser {question} {
+        if {![catch {package require punk::lib}]} {
+            return [punk::lib::askuser $question] ;#takes account of punk::console raw vs line
+        }
         puts stdout $question
         flush stdout
         set stdin_state [fconfigure stdin]

src/modules/patternpunk-1.1.tm

@@ -100,7 +100,7 @@ set ::punk::bannerTemplate [string trim {
  |_\ /_| 
    / \   
  _-   -_ 
-} /n]
+} \n]
 >punk .. Property rhs [string trim {
    \\\_  
    \@  > 
@@ -168,18 +168,18 @@ _+   +_
 } \n]
 
 >punk .. Property lhs_hips [string trim {
-   _///  
-  <  @/  
-   ~ |   
+  _///   
+ <  @/   
+  ~ |    
  _-   -_ 
  \ | | / 
    / \   
  _+   +_ 
 } \n]
 >punk .. Property rhs_hips [string trim {
-  \\\_   
-  \@  >  
-   | ~   
+   \\\_  
+   \@  > 
+    | ~  
  _-   -_ 
  \ | | / 
    / \   
@@ -200,13 +200,50 @@ _+   +_
 >punk .. Property poop [string trim {
  _///    
 <  @/    
- ^ |     
-_-   -_  
+ ~ |     
+ _-  -_  
  \ \\ /  
    //. ~ 
  _+_+ @  
 } \n]
 
+>punk .. Property lhs_bend [string trim {
+  _///   
+ <  @/   
+  ~ |    
+  _-  -_ 
+  \ \\ / 
+    //   
+  _+_+   
+} \n]
+>punk .. Property lhs_thrust [string trim {
+  _///   
+ <  @/   
+  ~ |    
+ _-  -_  
+ \ // /  
+   \\    
+  _+_+   
+} \n]
+>punk .. Property rhs_bend [string trim {
+   \\\_  
+   \@  > 
+    | ~  
+ _-  -_  
+ \ // /  
+   \\    
+  _+_+   
+} \n]
+>punk .. Property rhs_thrust [string trim {
+   \\\_  
+   \@  > 
+    | ~  
+  _-  -_ 
+  \ \\ / 
+    //   
+  _+_+   
+} \n]
+
 >punk .. Property fossil [string trim {
   ..       
  > <       

src/modules/punk-0.1.tm

@@ -78,6 +78,7 @@ namespace eval ::repl {
 package require punk::lib
 package require punk::config
 package require punk::ansi
+#package require textblock
 namespace import punk::ansi::ansistring
 package require punk::console
 package require punk::ns
@@ -5994,6 +5995,7 @@ namespace eval punk {
                 lappend chunklist [list result $result]
                 set ::punk::last_run_display $chunklist
             }
+           #puts stdout "-->[ansistring VIEW $result]"
            return $result
         } else {
             set atail [lassign $args a1]
@@ -6122,7 +6124,6 @@ namespace eval punk {
             if {$::repl::running} {
                 set ::punk::last_run_display $chunklist
             }
-
             return $result
         }
     }
@@ -6771,6 +6772,7 @@ namespace eval punk {
 
         if {$count > 1} {
             #val is a list
+            set llen [llength $val]
             if {$limit > 0 && ($limit < $llen)} {
                 set displayval [lrange $val 0 $limit-1]
                 if {$llen > $limit} {
@@ -6969,18 +6971,9 @@ namespace eval punk {
             puts -nonewline $chan $text
         }
     }
-    proc mode {raw_or_line} {
-        set raw_or_line [string tolower $raw_or_line]
-        if {$raw_or_line eq "raw"} {
-            punk::console::enableRaw
-            punk::console::enableVirtualTerminal
-        } elseif {$raw_or_line eq "line"} {
-            #review -order. disableRaw has memory from enableRaw.. but but for line mode we want vt disabled - so call it after disableRaw (?) 
-            punk::console::disableRaw
-            punk::console::disableVirtualTerminal
-        } else {
-            error "punk::mode expected 'raw' or 'line'
-        }
+    proc mode {{raw_or_line query}} {
+        package require punk::console
+        tailcall ::punk::console::mode $raw_or_line
     }
 
     #this hides cmds mode command - probably no big deal - anyone who needs it will know how to exec it.
@@ -7109,11 +7102,12 @@ namespace eval punk {
 
 
     interp alias {} colour    {} punk::console::colour
+    interp alias {} ansi      {} punk::console::ansi
     interp alias {} color     {} punk::console::colour
-    interp alias {} a+      {} punk::console::get_ansi+
-    interp alias {} a=      {} punk::console::get_ansi
-    interp alias {} a      {} punk::console::get_ansi
-    interp alias {} a?      {} punk::console::get_ansi?
+    interp alias {} a+        {} punk::console::code_a+
+    interp alias {} a=        {} punk::console::code_a
+    interp alias {} a         {} punk::console::code_a
+    interp alias {} a?        {} punk::console::code_a?
 
 
     proc dict_getdef {dictValue args} {

src/modules/punk/ansi-999999.0a1.0.tm

@@ -48,9 +48,9 @@
 #[para] packages used by punk::ansi 
 #[list_begin itemized]
 
-package require Tcl 8.6
+package require Tcl 8.6-
 #*** !doctools
-#[item] [package {Tcl 8.6}]
+#[item] [package {Tcl 8.6-}]
 
 # #package require frobz
 # #*** !doctools
@@ -65,6 +65,55 @@ package require Tcl 8.6
 #[section API]
 
 
+namespace eval punk::ansi::class {
+    if {![llength [info commands class_ansi]]} {
+        oo::class create class_ansi {
+            variable o_raw
+
+            variable o_render_dimensions ;#last dimensions at which we rendered
+            variable o_rendered
+            variable o_rendered_what
+            constructor {ansitext {dimensions 80x25}} {
+                if {![regexp {^([0-9]+)[xX]([0-9]+)$} $dimensions _m w h]} {
+                    error "class_ansi::render dimensions must be of the form <width>x<height>"
+                }
+                set o_rendered_what ""
+                set o_render_dimensions $dimensions
+                set o_raw $ansitext
+            }
+            method rawdata {} {
+                return $o_raw
+            }
+            method render {{dimensions ""}} {
+                if {$dimensions eq ""} {
+                    set dimensions $o_render_dimensions
+                }
+                if {![regexp {^([0-9]+)[xX]([0-9]+)$} $dimensions _m w h]} {
+                    error "class_ansi::render dimensions must be of the form <width>x<height>"
+                }
+                if {$o_rendered_what ne $o_raw || $dimensions ne $o_render_dimensions} { 
+                    set b [textblock::block $w $h " "]
+                    set o_rendered [overtype::left $b $o_raw]
+                    set o_rendered_what $o_raw
+                    set o_render_dimensions $dimensions
+                }
+
+                #todo - store rendered and allow partial rendering of new data lines?
+                return $o_rendered
+            }
+            method viewlines {} {
+                return [ansistring VIEW $o_raw]
+            }
+            method viewcodes {} {
+                return [ansistring VIEWCODES $o_raw]
+            }
+            method viewchars {} {
+                return [punk::ansi::stripansiraw $o_raw]
+            }
+
+        }
+    }
+}
 
 
 # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
@@ -79,7 +128,6 @@ namespace eval punk::ansi {
 
     variable test "blah\033\[1;33mETC\033\[0;mOK"
 
-
     #Note that a? is actually a pattern. We can't explicitly match it without also matcing a+ ab etc.  Presumably this won't matter here.
     namespace export\
         {a?} {a+} a \
@@ -106,8 +154,6 @@ namespace eval punk::ansi {
     #NOTE - we are assuming an OSC or DCS started with one type of sequence (7 or 8bit) can be terminated by either 7 or 8 bit ST (or BEL e.g wezterm ) 
     #This using a different type of ST to that of the opening sequence is presumably unlikely in the wild - but who knows?
 
-    variable standalone_codes
-    set standalone_codes [list \x1bc "" \x1b7 "" \x1b8 "" \x1bM "" \x1bE "" \x1bD "" \x1bH "" \x1b= "" \x1b> "" \x1b#3 "" \x1b#4 "" \x1b#5 "" \x1b#6 "" \x1b#8 ""]
     #review - there doesn't seem to be an \x1b#7 
     # https://espterm.github.io/docs/VT100%20escape%20codes.html
 
@@ -124,6 +170,42 @@ namespace eval punk::ansi {
         "DECPNM norm keypad"        "\x1b>"\
         ]
 
+
+    #review - We have file possibly encoded directly in another codepage such as 437 - or utf8,utf16 etc, but then still needing post conversion to e.g cp437? 
+    proc readfile {fname} {
+        #todo 
+        #1- look for BOM - read according to format given by BOM
+        #2- assume utf-8 
+        #3- if errors - assume cp437?
+
+        set data [fcat $fname]
+        if {[file extension $fname] eq ".ans"} {
+            set ansidata [encoding convertfrom cp437 $data]
+        } else {
+            set ansidata $data
+        }
+        set obj [punk::ansi::class::class_ansi new $ansidata]
+        return $obj
+    }
+    proc is_utf8_char {char} {
+        regexp {(?x)   # Expanded regexp syntax, so I can put in comments :-)
+        [\x00-\x7F] |                # Single-byte chars (ASCII range)
+        [\xC0-\xDF] [\x80-\xBF] |    # Two-byte chars (\u0080-\u07FF)
+        [\xE0-\xEF] [\x80-\xBF]{2} | # Three-byte chars (\u0800-\uFFFF)
+        [\xF0-\xF4] [\x80-\xBF]{3}   # Four-byte chars (U+10000-U+10FFFF, not supported by Tcl 8.5)
+        } $char
+    }
+    proc get_utf8 {text} {
+        regexp {(?x)   # Expanded regexp syntax, so I can put in comments :-)
+            \A (
+            [\x00-\x7F] |                # Single-byte chars (ASCII range)
+            [\xC0-\xDF] [\x80-\xBF] |    # Two-byte chars (\u0080-\u07FF)
+            [\xE0-\xEF] [\x80-\xBF]{2} | # Three-byte chars (\u0800-\uFFFF)
+            [\xF0-\xF4] [\x80-\xBF]{3}   # Four-byte chars (U+10000-U+10FFFF, not supported by Tcl 8.5)
+            ) +
+        } $text completeChars
+        return $completeChars        
+    }
     #control strings
     #https://www.ecma-international.org/wp-content/uploads/ECMA-48_5th_edition_june_1991.pdf
     #<excerpt>
@@ -167,39 +249,65 @@ namespace eval punk::ansi {
     proc controlstring_APC8 {text} {
         return "\x9f${text}\x9c"
     }
+    #there is also the SGR hide code (8) which has intermittent terminal support
+    #This doesn't change the output length - so support is tricky to detec. (terminal checksum report?)
 
     #candidate for zig/c implementation?
     proc stripansi {text} {
+        #*** !doctools
+        #[call [fun stripansi] [arg text] ]
+        #[para]Return a string with ansi codes stripped out
+        #[para]Alternate graphics chars are replaced with modern unicode equivalents (e.g boxdrawing glyphs)
+
+        #using detect costs us a couple of uS - but saves time on plain text 
+        #we should probably leave this for caller  - otherwise it ends up being called more than necessary
+        #if {![::punk::ansi::ta::detect $text]} { 
+        #    return $text
+        #}
+
+        set text [convert_g0 $text];#Convert ansi borders to unicode line drawing instead of ascii letters 
+        join [::punk::ansi::ta::split_at_codes $text] ""
+    }
+    proc stripansiraw {text} {
         #*** !doctools
         #[call [fun stripansi] [arg text] ]
         #[para]Return a string with ansi codes stripped out 
+        #[para]Alternate graphics modes will be stripped - exposing the raw characters as they appear without graphics mode.
+        #[para]ie instead of a horizontal line you may see: qqqqqq  
+
+
+        join [::punk::ansi::ta::split_at_codes $text] ""
+    }
+    proc stripansi1 {text} {
 
         #todo - character set selection - SS2 SS3 - how are they terminated?  REVIEW
 
         variable escape_terminals  ;#dict
-        variable standalone_codes  ;#map to empty string
+        variable ::punk::ansi::ta::standalone_code_map ;#map to empty string
 
         set text [convert_g0 $text] 
 
 
-        #we should just map away the 2-byte sequences too
-        #standalone 3 byte  VT100 sequences - some of these work in wezterm 
+        set text [string map $standalone_code_map $text]
+        #e.g standalone 2 byte and 3 byte  VT100(?) sequences - some of these work in wezterm 
         #\x1b#3 double-height letters top half
         #\x1b#4 double-height letters bottom half
         #\x1b#5 single-width line
         #\x1b#6 double-width line
         #\x1b#8  dec test fill screen
 
-        set text [string map $standalone_codes $text]
 
         #we process char by char - line-endings whether \r\n or \n should be processed as per any other character.
-        #line endings can theoretically occur within an ansi escape sequence payload (review e.g title?)
+
+        #Theoretically line endings can occur within an ST payload (review e.g title?)
+        #ecma standard says: The character string following may consist of any bit combination, except those representing SOS or STRING TERMINATOR (ST)
         
         set inputlist [split $text ""]
         set outputlist [list] 
 
         set in_escapesequence 0
-        #assumption - undertext already 'rendered' - ie no backspaces or carriagereturns or other cursor movement controls
+        #assumption - text already 'rendered' - ie no cursor movement controls . (what about backspace and lone carriage returns - they are horizontal cursor movements)
+        
         set i 0
         foreach u $inputlist {
             set v [lindex $inputlist $i+1]
@@ -236,39 +344,92 @@ namespace eval punk::ansi {
 
     #review - what happens when no terminator?
     #todo - map other chars  to unicode equivs
+    # convert esc(0 -> esc(B graphics sequences to single char unicode equivalents e.g box drawing set
+    # esc) ??
     proc convert_g0 {text} {
         #using not \033 inside to stop greediness - review how does it compare to ".*?"
+        #variable re_altg0_group {(?:\x1b\(0)(?:(?!\x1b\(B).)*\x1b\(B}
+        #set re {\033\(0[^\033]*\033\(B} 
+        #set re {(?:\x1b\(0)(?:(?!\x1b\(B).)*\x1b\(B}
+
+
+        set re2 {\033\(0(.*)\033\(B} ;#capturing
+
+        #puts --$g--
+        #box sample
+        #lqk
+        #x x
+        #mqj
+        #m = boxd_lur
+        #set map [list l \u250f k \u2513] ;#heavy
+        set map [list l \u250c q \u2500 k \u2510 x \u2502 m \u2514 j \u2518] ;#light box drawing lines
+        #todo - map the rest https://vt100.net/docs/vt220-rm/chapter2.html
+
+        set re_g0_open_or_close {\x1b\(0|\x1b\(B} 
+        set parts [::punk::ansi::ta::_perlish_split $re_g0_open_or_close $text]
+        set out ""
+        set g0_on 0
+        foreach {pt g} $parts {
+            if {$g0_on} {
+                #split for non graphics-set codes
+                set othersplits [punk::ansi::ta::split_codes $pt] ;#we don't need single codes here
+                foreach {innerpt innercodes} $othersplits {
+                    append out [string map $map $innerpt]
+                    append out $innercodes ;#Simplifying assumption - ST codes, titlesets etc don't require/use g0 content
+                }
+            } else {
+                append out $pt ;#may include other codes - put it all through.
+            }
+            if {$g ne ""} {
+                if {[punk::ansi::codetype::is_gx_open $g]} {
+                    set g0_on 1
+                } elseif {[punk::ansi::codetype::is_gx_close $g]} {
+                    set g0_on 0
+                }
+            }
+        }
+        return $out
+    }
+    proc convert_g0_wrong {text} {
+        #Attempting to split on a group is wrong - because there could be other ansi codes while inside a g0 section
+        #That will either stop us matching - so no conversion - or risk converting parts of the ansi codes
+        #using not \033 inside to stop greediness - review how does it compare to ".*?"
+        #variable re_altg0_group {(?:\x1b\(0)(?:(?!\x1b\(B).)*\x1b\(B}
         set re {\033\(0[^\033]*\033\(B} 
         set re2 {\033\(0(.*)\033\(B} ;#capturing
+
+        #box sample
+        #lqk
+        #x x
+        #mqj
+        #m = boxd_lur
+        #set map [list l \u250f k \u2513] ;#heavy
+        set map [list l \u250c q \u2500 k \u2510 x \u2502 m \u2514 j \u2518] ;#light box drawing lines
+        #todo - map the rest https://vt100.net/docs/vt220-rm/chapter2.html
+
         set parts [::punk::ansi::ta::_perlish_split $re $text]
         set out ""
         foreach {pt g} $parts {
             append out $pt
             if {$g ne ""} {
                 #puts --$g--
-                #box sample
-                #lqk
-                #x x
-                #mqj
-                #m = boxd_lur
-                #set map [list l \u250f k \u2513] ;#heavy
-                set map [list l \u250c q \u2500 k \u2510 x \u2502 m \u2514 j \u2518] ;#light
-
                 regexp $re2 $g _match contents
                 append out [string map $map $contents]
             }
         }
         return $out
     }
-
-    #todo - convert esc(0 graphics sequences to single char unicode equivalents e.g box drawing set
-    # esc) ??
+    proc g0 {text} {
+        return \x1b(0$text\x1b(B
+    }
     proc stripansi_gx {text} {
             #e.g "\033(0" - select VT100 graphics for character set G0
             #e.g "\033(B" - reset 
             #e.g "\033)0" - select VT100 graphics for character set G1
             #e.g "\033)X" - where X is any char other than 0 to reset ??
-            return [convert_g0 $text]
+            
+            #return [convert_g0 $text]
+            return [string map [list "\x1b(0" "" \x1b(B" "" "\x1b)0" "" "\x1b)X" ""] $text]
     }
 
 
@@ -608,16 +769,30 @@ namespace eval punk::ansi {
     }
     # -- ---  --- --- ---
 
-    proc save_cursor {} {
+    proc cursor_save {} {
         #*** !doctools
-        #[call [fun save_cursor]]
+        #[call [fun cursor_save]]
+        #[para] equivalent  term::ansi::code::ctrl::sc
         return \x1b\[s
     }
-    proc restore_cursor {} {
+    proc cursor_restore {} {
         #*** !doctools
-        #[call [fun restore_cursor]]
+        #[call [fun cursor_restore]]
+        #[para] equivalent  term::ansi::code::ctrl::rc
         return \x1b\[u
     }
+    proc cursor_save_attributes {} {
+        #*** !doctools
+        #[call [fun cursor_save_attributes]]
+        #[para] equivalent  term::ansi::code::ctrl::sca
+        return \x1b7
+    }
+    proc cursor_restore_attributes {} {
+        #*** !doctools
+        #[call [fun cursor_restore_attributes]]
+        #[para] equivalent  term::ansi::code::ctrl::rca
+        return \x1b8
+    }
 
     # -- ---  --- --- ---
     proc erase_line {} {
@@ -686,6 +861,31 @@ namespace eval punk::ansi {
         #[para]The punk::ansi::cursor_pos function is used by punk::console::get_cursor_pos and punk::console::get_cursor_pos_list
         return \033\[6n 
     }
+    
+    proc cursor_pos_extended {} {
+        #includes page e.g ^[[47;3;1R
+        return \033\[?6n 
+    }
+
+
+    #DECFRA - Fill rectangular area
+    #REVIEW - vt100 accepts decimal values 132-126 and 160-255 ("in the current GL or GR in-use table")
+    #some modern terminals accept and display characters outside this range - but this needs investigation.
+    #in a modern unicode era - the restricted range doesn't make a lot of sense - but we need to see what terminal emulators actually do.
+    #e.g what happens with double-width? 
+    #this wrapper accepts a char rather than a decimal value
+    proc fill_rect {char t l b r} {
+        set dec [scan $char %c]
+        return \x1b\[$dec\;$t\;$l\;$b\;$r\$x
+    }
+    #DECFRA with decimal char value
+    proc fill_rect_dec {decimal t l b r} {
+        return \x1b\[$decimal\;$t\;$l\;$b\;$r\$x
+    }
+
+    proc checksum_rect {id page t l b r} {
+        return "\x1b\[${id}\;${page}\;$t\;$l\;$b\;$r*y"
+    }
 
     proc request_cursor_information {} {
         #*** !doctools
@@ -734,8 +934,13 @@ namespace eval punk::ansi {
         }
         #what if line has \v (vertical tab) ie more than one logical screen line?
 
-        #review - 
+        #review - detect ansi moves and warn/error? They would invalidate this algorithm 
+        #for a string with ansi moves - we would need to use the overtype::renderline function (which is a bit heavier)
+        #arguably - \b and \r are cursor move operations too - so processing them here is not very symmetrical - review
+        #the purpose of backspace (or line cr) in embedded text is unclear. Should it allow some sort of character combining/overstrike as it has sometimes done historically (nroff/less)?  e.g a\b` as an alternative combiner or bolding if same char
+        #This should presumably only be done if the over_strike (os) capability is enabled in the terminal. Either way - it presumably won't affect printing width?
         set line [punk::ansi::stripansi $line]
+        #we can't use simple \b processing if we get ansi codes and aren't actually processing them (e.g moves)
 
         set line [punk::char::strip_nonprinting_ascii $line] ;#only strip nonprinting after stripansi - some like BEL are part of ansi
         #backspace 0x08 only erases* printing characters anyway - so presumably order of processing doesn't matter
@@ -752,31 +957,48 @@ namespace eval punk::ansi {
         #*todo - handle terminal/context where tabwidth != the default 8 spaces
         set line [textutil::tabify::untabify2 $line]
 
+        #NOTE - this is non-destructive backspace as it occurs in text blocks - and is likely different to the sequence coming from a terminal or editor which generally does a destructive backspace
+        #e.g 
+        #This means for example that abc\b  has a length of 3. Trailing or leading backslashes have no effect
+
         set bs [format %c 0x08]
-        #set line [string map [list "\r${bs}" "\r"] $line] ;#backsp following a \r will have no effect
-        set line [string trim $line $bs]
+        #set line [string map [list "\r\b" "\r"] $line] ;#backsp following a \r will have no effect
+        set line [string trim $line \b] ;#take off at start and tail only
+
         #counterintuitively "x\b" still shows the x ie length is still one. The backspace just moves the position. There must be a char following \b for it to affect the length.
+        #(we are not interested in the destructive backspace case present in editors,terminals etc - that is a different context)
         set n 0
 
-        set chars [split $line ""] 
+        #set chars [split $line ""] ; #review - graphemes vs chars? Terminals differ in how they treat this.
+        set chars [punk::char::grapheme_split $line]
+        #mintty seems more 'correct'. It will backspace over an entire grapheme (char+combiners) whereas windows terminal/wezterm etc remove a combiner
         #build an output 
         set idx 0
         set outchars [list]
         set outsizes [list]
         foreach c $chars {
-            if {$c eq $bs} {
+            if {$c eq "\b"} {
                 if {$idx > 0} {
                     incr idx -1
                 }
             } elseif {$c eq "\r"} {
                 set idx 0
             } else {
-                punk::ansi::internal::printing_length_addchar $idx $c
+                set nxt [llength $outchars] 
+                if {$idx < $nxt} {
+                    #overstrike? - should usually have no impact on width - width taken as last grapheme in that column
+                    #e.g nroff would organise text such that underline written first, then backspace, then the character - so that terminals without overstrike would display something useful if no overstriking is done 
+                    #Conceivably double_wide_char then backspace then underscore would underreport the length if overstriking were intended.
+                    lset outchars $idx $c
+                } else {
+                    lappend outchars $c
+                }
+                #punk::ansi::internal::printing_length_addchar $idx $c
                 incr idx
             }
         }
         set line2 [join $outchars ""]
-        return [punk::char::string_width $line2]
+        return [punk::char::ansifreestring_width $line2]
     }
 
 
@@ -819,39 +1041,84 @@ namespace eval punk::ansi {
         return "\u0090+q$payload\u009c"
     }
     namespace eval codetype {
-        #Functions that operate on a single ansi code sequence - not a sequence, and not codes embedded in another string
+        #Functions that are primarily intended to operate on a single ansi code sequence - rather than a sequence, or codes embedded in another string
+        #in some cases multiple sequences or leading trailing strings are ok - but the proc docs should note where the function is looking
+        #review - separate namespace for functions that operate on multiple or embedded?
         proc is_sgr {code} {
             #SGR (Select Graphic Rendition) - codes ending in 'm' - e.g colour/underline 
             #we will accept and pass through the less common colon separator (ITU Open Document Architecture) 
             #Terminals should generally ignore it if they don't use it
             regexp {\033\[[0-9;:]*m$} $code
         }
-        proc is_cursor_move_in_line {code} {
-            #review - what about CSI n : m H where row n happens to be current line?
-            regexp {\033\[[0-9]*(:?C|D|G)$}
+
+        #review - has_cursor_move_in_line? Are we wanting to allow strings/sequences and detect that there are no moves that *aren't* within line?
+        proc is_cursor_move_in_line {code {knownline ""}} {
+            if {[regexp {\033\[[0-9]*(:?C|D|G)$} $code]} {
+                return 1
+            }
+            if {[string is integer -strict $knownline]} {
+                #CSI n : m H where row n happens to be current line - review/test
+                set re [string map [list %n% $knownline] {\x1b\[%n%:[0-9]*H$}]
+                if {[regexp $re $code]} {
+                    return 1
+                }
+            }
+            return 0 
         }
         #pure SGR reset with no other functions
         proc is_sgr_reset {code} {
+            #*** !doctools
+            #[call [fun is_sgr_reset] [arg code]]
+            #[para]Return a boolean indicating whether this string has a trailing pure SGR reset
+            #[para]Note that if the reset is not the very last item in the string - it will not be detected.
+            #[para]This is primarily intended for testing a single ansi code sequence, but code can be any string where the trailing SGR code is to be tested. 
+            
             #todo 8-bit csi
-            regexp {\033\[0*m$} $code
+            regexp {\x1b\[0*m$} $code
         }
+
+
         #whether this code has 0 (or equivalently empty) parameter (but may set others)
         #if an SGR code has a reset in it - we don't need to carry forward any previous SGR codes
-        #it generally only makes sense for the reset to be the first entry - otherwise the code has ineffective portions
+        #it generally only makes sense for the reset to be the first parameter - otherwise the code has ineffective portions
         #However - detecting zero or empty parameter in other positions requires knowing all other codes that may allow zero or empty params.
-        #We will only look at initial parameter as this is the well-formed normal case.  
+        #We only look at the initial parameter within the trailing SGR code as this is the well-formed normal case.  
+
         #Review - consider normalizing sgr codes to remove other redundancies such as setting fg or bg color twice in same code
         proc has_sgr_leadingreset {code} {
+            #*** !doctools
+            #[call [fun has_sgr_leadingreset] [arg code]]
+            #[para]The reset must be the very first item in code to be detected. Trailing strings/codes ignored.
             set params ""
-            regexp {\033\[(.*)m} $code _match params
-            set plist [split $params ";"]
-            if {[string trim [lindex $plist 0] 0] eq ""} {
-                #e.g \033\[m  \033\[0\;...m  \033\[0000...m
-                return 1
+            #we need non-greedy 
+            if {[regexp {^\033\[([^m]*)m} $code _match params]} {
+                #must match trailing m to be the type of reset we're looking for
+                set plist [split $params ";"]
+                if {[string trim [lindex $plist 0] 0] eq ""} {
+                    #e.g \033\[m  \033\[0\;...m  \033\[0000...m
+                    return 1
+                } else {
+                    return 0
+                }
             } else {
                 return 0
             }
         }
+        proc is_gx {code} {
+            #g0 {(?:\x1b\(0)(?:(?!\x1b\(B).)*\x1b\(B}
+            #g1 {(?:\x1b\)0)(?:(?!\x1b\)B).)*\x1b\)B}
+            regexp {\x1b(?:\(0(?:(?:(?!\x1b\(B).)*\x1b\(B)|\)0(?:(?:(?!\x1b\)B).)*\x1b\)B))} $code
+        }
+        proc is_gx_open {code} {
+            #todo g2,g3?
+            #pin to start and end with ^ and $ ?
+            #regexp {\x1b\(0|\x1b\)0} $code
+            regexp {\x1b(?:\(0|\)0)} $code
+        }
+        proc is_gx_close {code} {
+            #regexp {\x1b\(B|\x1b\)B} $code
+            regexp {\x1b(?:\(B|\)B)} $code
+        }
 
         #has_sgr_reset  - rather than support this function - create an sgr normalize function that removes dead params and brings reset to front of param list?
 
@@ -895,45 +1162,70 @@ namespace eval punk::ansi::ta {
 
     #CSI
     #variable re_csi_open {(?:\033\[|\u009b)[0-9;]+} ;#too specific - doesn't detect \033\[m
-    variable re_csi_open {(?:\033\[|\u009b)}
+    variable re_csi_open {(?:\x1b\[|\u009b)}
+    #variable re_csi_code  {(?:\033\[|\u009b)[0-9;]*[a-zA-Z\\@\^_\{|\}\[\]~`]}
+    variable re_csi_code  {(?:\x1b\[|\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]}
 
-    #colour and style
-    variable re_csi_colour {(?:\033\[|\u009b)[0-9;]*m} ;#e.g \033\[31m  \033\[m  \033\[0m \033\[m0000m
+    #intermediate bytes range 0x20-0x2F (ascii space and !"#$%&'()*+,-./)
+    #parameter bytes range 0x30-0x3F (ascii 0-9:;<=>?)
     #single "final byte" in the range 0x40–0x7E (ASCII @A–Z[\]^_`a–z{|}~).
-    variable re_csi_code  {(?:\033\[|\u009b)[0-9;]*[a-zA-Z\\@^_|~`]}
 
-    #OSC - termnate with BEL (\a \007) or ST (string terminator \033\\)
-    # 8-byte string terminator is \x9c (\u009c)
+    #colour and style
+    variable re_sgr {(?:\033\[|\u009b)[0-9;]*m} ;#e.g \033\[31m  \033\[m  \033\[0m \033\[m0000m
 
-    #non-greedy via "*?" doesn't seem to work like this..
-    #variable re_esc_osc1 {(?:\033\]).*?\007}
-    #variable re_esc_osc2 {(?:\033\]).*?\033\\}
-    #variable re_esc_osc3 {(?:\u009d).*?\u009c}
+    #OSC - termnate with BEL (\a \007) or ST (string terminator \x1b\\)
+    # 8-byte string terminator is \x9c (\u009c)
 
     #non-greedy by excluding ST terminators
-    #TODO - FIX? see re_ST below
-    variable re_esc_osc1 {(?:\033\])(?:[^\007]*)\007}
-    variable re_esc_osc2 {(?:\033\])(?:[^\033]*)\033\\}
+    variable re_esc_osc1 {(?:\x1b\])(?:[^\007]*)\007}
+    #variable re_esc_osc2 {(?:\033\])(?:[^\033]*)\033\\} ;#somewhat wrong - we want to exclude the ST - not other esc sequences
+    variable re_esc_osc2 {(?:\x1b\])(?:(?!\x1b\\).)*\x1b\\} 
     variable re_esc_osc3 {(?:\u009d)(?:[^\u009c]*)?\u009c}
+    variable re_osc_open {(?:\x1b\]|\u009d).*}
 
-    variable re_osc_open {(?:\033\]|\u009d).*}
 
-    #standalone_codes [list \x1bc "" \x1b7 "" \x1b8 "" \x1bM "" \x1bE "" \x1bD "" \x1bH "" \x1b= "" \x1b> "" \x1b#3 "" \x1b#4 "" \x1b#5 "" \x1b#5 "" \x1b#6 "" \x1b#8 ""]
+    variable standalone_code_map [list \x1bc "" \x1b7 "" \x1b8 "" \x1bM "" \x1bE "" \x1bD "" \x1bH "" \x1b= "" \x1b> "" \x1b#3 "" \x1b#4 "" \x1b#5 "" \x1b#6 "" \x1b#8 ""]
     variable re_standalones {(?:\x1bc|\x1b7|\x1b8|\x1bM|\x1bE|\x1bD|\x1bD|\x1bH|\x1b=|\x1b>|\x1b#3|\x1b#4|\x1b#5|\x1b#6|\x1b#8)}
 
-    #see stripansi
-    set re_start_ST {^(?:\033X|\u0098|\033\^|\u009e|\033_|\u009f)} 
+    #if we don't split on altgraphics too and separate them out - it's easy to get into a horrible mess
+    variable re_altg0_group {(?:\x1b\(0)(?:(?!\x1b\(B).)*\x1b\(B}
+    variable re_altg0_open  {(?:\x1b\(0)}
+    variable re_altg0_close {(?:\x1b\(B)}
+
+    # DCS "ESC P" or "0x90" is also terminated by ST
+    set re_ST_open {(?:\033P|\u0090|\033X|\u0098|\033\^|\u009e|\033_|\u009f)} 
     #ST terminators [list \007 \033\\ \u009c]
 
     #regex to capture the start of string/privacy message/application command block including the contents and string terminator (ST)
     #non-greedy by exclusion of ST terminators in body
-    #!!!
-    #TODO - fix. we need to match \033\\ not just \033 ! could be colour codes nested in a privacy msg/string
-    #This will currently terminate the code too early in this case
+    #we need to match \x1b\\ not just \x1b  There could be colour codes nested in a privacy msg/string
+    #even if terminals generally don't support that - it's quite possible for an ansi code to get nested this way - and we'd prefer it not to break our splits
+    #Just checking for \x1b will terminate the match too early
     #we also need to track the start of ST terminated code and not add it for replay (in the ansistring functions)
-    variable re_ST  {(?:\033X|\u0098|\033\^|\u009E|\033_|\u009F)(?:[^\033\007\u009c]*)(?:\033\\|\007|\u009c)}
+    #variable re_ST  {(?:\x1bX|\u0098|\x1b\^|\u009E|\x1b_|\u009F)(?:[^\x1b\007\u009c]*)(?:\x1b\\|\007|\u009c)} ;#downsides: early terminating with nests, mixes 7bit 8bit start/ends (does that exist in the wild?)   
+    #keep our 8bit/7bit start-end codes separate
+    variable re_ST      {(?:\x1bP|\x1bX|\x1b\^|\x1b_)(?:(?!\x1b\\|007).)*(?:\x1b\\|\007)|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)}
+
+
+
+    #consider standalones as self-opening/self-closing - therefore included in both ansi_detect and ansi_detect_open
+
+    #default for regexes is non-newline-sensitive matching - ie matches can span lines
+    # -- --- --- ---
+    variable re_ansi_detect1 "${re_csi_code}|${re_esc_osc1}|${re_esc_osc2}|${re_esc_osc3}|${re_standalones}|${re_ST}|${re_altg0_open}|${re_altg0_close}"
+    # -- --- --- ---
+    #handrafted TRIE version of above. Somewhat difficult to construct and maintain. TODO - find a regext TRIE generator that works with Tcl regexes
+    #This does make things quicker - but it's too early to finalise the detect/split regexes (e.g missing \U0090 ) - will need to be redone.
+    variable re_ansi_detect {(?:\x1b(?:\((?:0|B)|\[(?:[\x20-\x2f\x30-\x3f]*[\x40-\x7e])|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|007).)*(?:\x1b\\|\007))|c|7|8|M|E|D|H|=|>|(?:#(?:3|4|5|6|8))))|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)|(?:\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]|(?:\u009d)(?:[^\u009c]*)?\u009c}
+    # -- --- --- ---
 
-    variable re_ansi_detect "${re_csi_open}|${re_esc_osc1}|${re_esc_osc2}|${re_standalones}|${re_start_ST}"
+
+
+    variable re_ansi_detect_open "${re_csi_open}|${re_osc_open}|${re_standalones}|${re_ST_open}|${re_altg0_open}" 
+    
+    #may be same as detect - kept in case detect needs to diverge
+    #variable re_ansi_split "${re_csi_code}|${re_esc_osc1}|${re_esc_osc2}|${re_esc_osc3}|${re_standalones}|${re_ST}|${re_altg0_open}|${re_altg0_close}"
+    set re_ansi_split $re_ansi_detect
 
     #detect any ansi escapes
     #review - only detect 'complete' codes - or just use the opening escapes for performance?
@@ -944,13 +1236,19 @@ namespace eval punk::ansi::ta {
         #[para]
 
         variable re_ansi_detect
-        #variable re_csi_open
-        #variable re_esc_osc1
-        #variable re_esc_osc2
-        #todo - other escape sequences
-        #expr {[regexp $re_csi_open $text] || [regexp $re_esc_osc1 $text] || [regexp $re_esc_osc2 $text]} 
         expr {[regexp $re_ansi_detect $text]}
     }
+    proc detect2 {text} {
+        variable re_ansi_detect2
+        expr {[regexp $re_ansi_detect2 $text]}
+    }
+    
+
+    proc detect_open {text} {
+        variable re_ansi_detect_open
+        expr {[regexp $re_ansi_detect_open $text]}
+    }
+
     #not in perl ta
     proc detect_csi {text} {
         #*** !doctools
@@ -972,8 +1270,8 @@ namespace eval punk::ansi::ta {
         #[para]This is most commonly an Ansi colour code - but also things such as underline and italics
         #[para]An SGR with empty or a single zero argument is a reset of the SGR features - this is also detected.
         #[para](This function is not in perl ta)
-        variable re_csi_colour
-        expr {[regexp $re_csi_colour $text]}
+        variable re_sgr
+        expr {[regexp $re_sgr $text]}
     }
     proc strip {text} {
         #*** !doctools
@@ -1001,12 +1299,8 @@ namespace eval punk::ansi::ta {
     #not in perl ta
     #returns just the plaintext portions in a list
     proc split_at_codes {text} {
-        variable re_esc_osc1
-        variable re_esc_osc2
-        variable re_csi_code
-        variable re_standalones
-        variable re_ST
-        punk::ansi::internal::splitx $text "${re_csi_code}|${re_esc_osc1}|${re_esc_osc2}|${re_standalones}|${re_ST}"
+        variable re_ansi_split
+        punk::ansi::internal::splitx $text ${re_ansi_split}
     }
     
     # -- --- --- --- --- --- 
@@ -1023,23 +1317,14 @@ namespace eval punk::ansi::ta {
     #ta_split_codes "\e[31m\e[0mb"  # => {""    "\e[31m\e[0m"  "b"}
     #
     proc split_codes {text} {
-        variable re_esc_osc1
-        variable re_esc_osc2
-        variable re_csi_code
-        variable re_standalones
-        variable re_ST
-        set re "(?:${re_csi_code}|${re_standalones}|${re_ST}|${re_esc_osc1}|${re_esc_osc2})+"
+        variable re_ansi_split
+        set re "(?:${re_ansi_split})+"
         return [_perlish_split $re $text]
     }
     #like split_codes - but each ansi-escape is split out separately (with empty string of plaintext between codes so odd/even plain ansi still holds)
     proc split_codes_single {text} {
-        variable re_esc_osc1
-        variable re_esc_osc2
-        variable re_csi_code
-        variable re_standalones
-        variable re_ST
-        set re "${re_csi_code}|${re_standalones}|${re_ST}|${re_esc_osc1}|${re_esc_osc2}"
-        return [_perlish_split $re $text]
+        variable re_ansi_split
+        return [_perlish_split $re_ansi_split $text]
     }
 
     #review - tcl greedy expressions may match multiple in one element
@@ -1093,7 +1378,7 @@ namespace eval punk::ansi::ansistring {
 
     namespace path [list ::punk::ansi ::punk::ansi::ta]
     namespace ensemble create
-    namespace export length trim trimleft trimright index VIEW
+    namespace export length trim trimleft trimright index VIEW VIEWCODES
     #todo - expose _splits_ methods so caller can work efficiently with the splits themselves
     #we need to consider whether these can be agnostic towards splits from split_codes vs split_codes_single 
 
@@ -1366,6 +1651,35 @@ namespace eval punk::ansi::ansistring {
         #test of ISO2047 - 7bit - limited set, limited support, somewhat obscure glyphs
         #return [string map [list \033 \U2296 \007 \U237E] $string]
     }
+    proc VIEWCODES {string} {
+        if {![llength $string]} {
+            return ""
+        }
+        set redb [a+ red bold]
+        set greenb [a+ green bold]
+        set GX [a+ black White bold]
+        set unk [a+ yellow bold]
+        set RST [a]
+
+        #don't split into lines first - \n is valid within ST sections
+        set output ""
+        set splits [punk::ansi::ta::split_codes_single $string]
+        foreach {pt code} $splits {
+            append output "$pt"
+            if {[punk::ansi::codetype::is_sgr_reset $code]} {
+                append output  ${greenb}RST$RST
+            } elseif {[punk::ansi::codetype::is_gx_open $code]} {
+                append output ${GX}GX+$RST
+            } elseif {[punk::ansi::codetype::is_gx_close $code]} { 
+                append output ${GX}GX-$RST
+            } elseif {[punk::ansi::codetype::is_sgr $code]} {
+                append output ${greenb}[ansistring VIEW $code]$RST
+            } else {
+                append output ${unk}[ansistring VIEW $code]$RST
+            }
+        }
+        return $output
+    }
 
     proc length {string} {
         #*** !doctools
@@ -1373,8 +1687,14 @@ namespace eval punk::ansi::ansistring {
         #[para]Returns the length of the string without ansi codes
         #[para]This will not count strings hidden inside a 'privacy message' or other ansi codes which may have content between their opening escape and their termination sequence.
         #[para]This is equivalent to calling string length on the result of stripansi $string 
-        #[para]Note that this returns the number of characters in the payload, and is not always the same as the width of the string as rendered on a terminal.
+        #[para]Note that this returns the number of characters in the payload (after applying combiners), and is not always the same as the width of the string as rendered on a terminal.
         #[para]To get the width, use punk::ansi::printing_length instead, which is also ansi aware.
+
+        #todo - combiners/diacritics? just map them away here?
+        set re_diacritics {[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+} 
+        set string [regsub -all $re_diacritics $string ""]
+
+        #we want length to return number of glyphs.. not screen width. Has to be consistent with index function  
         string length [stripansi $string]
     }
     
@@ -1429,7 +1749,7 @@ namespace eval punk::ansi::ansistring {
         #[para]Some sort of generator that parses more of the string as required might be more efficient for large chunks.
         #[para]For end-x operations we have to pre-calculate the content-length by stripping the ansi - which is also potentially sub-optimal
 
-        set splits [split_codes_single $string]; #we get empty pt(plaintext) between each ansi code that is in a run
+        set ansisplits [split_codes_single $string]; #we get empty pt(plaintext) between each ansi code that is in a run
 
         #todo - end-x  +/-x+/-x etc
         set original_index $index
@@ -1502,16 +1822,21 @@ namespace eval punk::ansi::ansistring {
         set codes_in_effect "" 
         #we can't only apply leading sequence from previous code - as there may be codes in effect from earlier, so we have to track as we go
         #(this would apply even if we used split_codes - but then we would need to do further splitting of each codeset anyway)
-        foreach {pt code} $splits {
+        foreach {pt code} $ansisplits {
             incr pt_index 2
+            #we want an index per grapheme - whether it is doublewide or single
+
             if {$pt ne ""} {
+                set graphemes [punk::char::grapheme_split $pt]
                 set low [expr {$high + 1}] ;#last high 
-                incr high [string length $pt] 
+                #incr high [string length $pt] 
+                incr high [llength $graphemes]
             }
 
             if {$pt ne "" && ($index >= $low && $index <= $high)} {
                 set pt_found $pt_index
-                set char [string index $pt $index-$low]
+                #set char [string index $pt $index-$low]
+                set char [lindex $graphemes $index-$low]
                 break
             }
             

src/modules/punk/args-999999.0a1.0.tm

@@ -81,9 +81,9 @@
 #[para] packages used by punk::args
 #[list_begin itemized]
 
-package require Tcl 8.6
+package require Tcl 8.6-
 #*** !doctools
-#[item] [package {Tcl 8.6}]
+#[item] [package {Tcl 8.6-}]
 
 # #package require frobz
 # #*** !doctools

src/modules/punk/char-999999.0a1.0.tm

@@ -55,7 +55,7 @@
 #[item] [package console]
 #[para] - 
 
-package require Tcl 8.6
+package require Tcl 8.6-
 
 #*** !doctools
 #[list_end]
@@ -525,7 +525,7 @@ namespace eval punk::char {
     # e.g encoding convertto dingbats <somethingpretty>  will output something that doesn't look dingbatty on screen.
     #-- --- --- --- --- --- --- --- 
     #must use Tcl instead of tcl (at least for 8.6)
-    if {![package vsatisfies [package present Tcl] 8.7]} {
+    if {![package vsatisfies [package present Tcl] 8.7-]} {
         proc encodable "s {enc [encoding system]}" {
             set encname [encname $enc]
             if {($encname eq "ascii")} {
@@ -1651,7 +1651,7 @@ namespace eval punk::char {
                     set twidth [dict get $charinfo $dec testwidth]
                 }
                 if {$twidth eq ""} {
-                    set width [string_width $ch] ;#based on unicode props
+                    set width [ansifreestring_width $ch] ;#based on unicode props
                 } else {
                     set width $twidth
                 }
@@ -1792,14 +1792,23 @@ namespace eval punk::char {
         puts stdout "\ncalibration done - results cached in charinfo dictionary"
         return [dict create charcount $charcount widths $width_results]
     }
-    #prerequisites - no ansi escapes -  no newlines 
-    #review - what about \r \t \b ?
+    #todo - provide a char_width equivalent that is optimised for speed
     proc string_width {text} {
-        #review is detecting \033 enough? what about 8-bit escapes?
-
+        #burn approx 2uS (2024) checking for ansi codes - not just SGR
+        if {[punk::ansi::ta::detect $text]} {
+            puts stderr "string_width detected ANSI!"
+        }
         if {[string first \n $text] >= 0} {
             error "string_width accepts only a single line"
         }
+        tailcall ansifreestring_width $text
+    }
+    #prerequisites - no ansi escapes -  no newlines 
+    #review - what about \r \t \b ?
+    #NO processing of \b - already handled in ansi::printing_length which then calls this
+    proc ansifreestring_width {text} {
+        #caller responsible for calling ansistrip first if text may have ansi codes - and for ensuring no newlines
+
 
 
         #we can c0 control characters after or while processing ansi escapes.
@@ -1808,15 +1817,6 @@ namespace eval punk::char {
         #if {[string first \033 $text] >= 0} {
         #    error "string_width doesn't accept ansi escape sequences. Use punk::ansi::stripansi first"
         #}
-        set re_ascii_c0 {[\U0000-\U001F]}
-        set text [regsub -all $re_ascii_c0 $text ""]
-
-        #todo - check double-width chars in unicode blocks.. try to do reasonably quicky 
-        #short-circuit basic cases
-        if {![regexp {[\uFF-\U10FFFF]} $text]} {
-            #control chars?
-            return [string length $text]
-        }
 
 
         #todo - various combining diacritical marks.. from grave - to various complicated unicode joiners and composing chars etc
@@ -1831,9 +1831,32 @@ namespace eval punk::char {
         #
         # initial simplistic approach is just to strip these ... todo REVIEW
 
+        #experiment to detect leading diacritics - but this isn't necessary - it's still zero-width
+        #(leading combiners may display in terminal as mark on rightmost prompt char which is usually a space - but won't add width even then)
+        #set re_leading_diacritic {^(?:[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+)} 
+        #if {[regexp $re_leading_diacritic $text]} {
+        #    set text " $text" 
+        #}
         set re_diacritics {[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+} 
         set text [regsub -all $re_diacritics $text ""]
 
+
+
+        #only map control sequences to nothing after processing ones with special effects, such as \b (\x07f) 
+        #Note DEL \x1f will only 
+        set re_ascii_c0 {[\U0000-\U001F]}
+        set text [regsub -all $re_ascii_c0 $text ""]
+
+        #short-circuit basic cases
+        #support tcl pre 2023-11 - see regexp bug below
+        #if {![regexp {[\uFF-\U10FFFF]} $text]} {
+        #    return [string length $text]
+        #}
+        if {![regexp "\[\uFF-\U10FFFF\]" $text]} {
+            return [string length $text]
+        }
+
+        #todo - check double-width chars in unicode blocks.. try to do reasonably quicky 
         set re_ascii_fullwidth {[\uFF01-\uFF5e]} 
 
         set doublewidth_char_count 0
@@ -1886,6 +1909,55 @@ namespace eval punk::char {
         error "char_uc_width unimplemented"
     }
 
+
+    #split into plaintext and runs of combiners 
+    proc combiner_split {text} {
+        #split into odd numbered list (or zero) in a similar way to punk::ansi::ta::_perlish_split
+        #
+        set re_diacritics {[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+} 
+        set graphemes [list]
+        set g ""
+        if {[string length $text] == 0} {
+            return {}
+        }
+        set list [list]
+        set start 0
+        set strlen [string length $text]
+        #make sure our regexes aren't non-greedy - or we may not have exit condition for loop 
+        #review
+        while {$start < $strlen && [regexp -start $start -indices -- $re_diacritics $text match]} {
+            lassign $match      matchStart matchEnd
+            #puts "->start $start ->match $matchStart $matchEnd"
+            lappend list [string range $text $start $matchStart-1] [string range $text $matchStart $matchEnd] 
+            set start [expr {$matchEnd+1}]
+
+            #if {$start >= [string length $text]} {
+            #    break
+            #}
+        }
+        lappend list [string range $text $start end]
+
+        return $list 
+    }
+
+    #1st shot - basic diacritics
+    #todo - become aware of unicode grapheme cluster boundaries
+    #
+    proc grapheme_split {text} {
+        set graphemes [list]
+        set csplits [combiner_split $text]
+        foreach {pt combiners} [lrange $csplits 0 end-1] {
+            set clist [split $pt ""]
+            lappend graphemes {*}[lrange $clist 0 end-1]
+            lappend graphemes [string cat [lindex $clist end] $combiners]
+        } 
+        #last csplit never has a combiner (_perlish_split style) - and may be empty - in which case we don't append it as a grapheme
+        if {[lindex $csplits end] ne ""} {
+            lappend graphemes {*}[split [lindex $csplits end] ""]
+        }
+        return $graphemes
+    }
+
     # -- --- --- --- ---
     #will accept a single char or a string - test using console cursor position reporting
     proc char_info_testwidth {ch {emit 0}} {

src/modules/punk/du-999999.0a1.0.tm

@@ -18,6 +18,7 @@
 ##  Requirements
 ##e.g package require frobz
 package require punk::mix::base
+package require struct::set
 
 
 namespace eval punk::du {
@@ -65,7 +66,6 @@ namespace eval punk::du {
     #breadth-first with sort can be quite fast .. but memory usage can easily get out of control
     proc du { args } {
         variable has_twapi
-        package require struct::set
 
 
         if 0 {

src/modules/punk/encmime-999999.0a1.0.tm

@@ -50,9 +50,9 @@
 #[para] packages used by punk::encmime
 #[list_begin itemized]
 
-package require Tcl 8.6
+package require Tcl 8.6-
 #*** !doctools
-#[item] [package {Tcl 8.6}]
+#[item] [package {Tcl 8.6-}]
 
 # #package require frobz
 # #*** !doctools

src/modules/punk/fileline-999999.0a1.0.tm

@@ -60,10 +60,10 @@
 #[para] packages needed by punk::fileline
 #[list_begin itemized]
 
-    package require Tcl 8.6
+    package require Tcl 8.6-
     package require punk::args
     #*** !doctools
-    #[item] [package {Tcl 8.6}]
+    #[item] [package {Tcl 8.6-}]
     #[item] [package {punk::args}]
 
 
@@ -1424,6 +1424,7 @@ namespace eval punk::fileline {
                     set encoding_selected $bomenc
                 }
             } else {
+                #!?
                 if {$bomenc eq "binary"} {
                     set datachunk [string range $rawchunk $startdata end]
                     set encoding_selected binary 
@@ -1523,7 +1524,7 @@ namespace eval punk::fileline::lib {
         #    is_span 1 boundaries {514 1026 1538} 
         #[example_end]
         #[para] This function automatically uses lseq (if Tcl >= 8.7) when number of boundaries spanned is approximately greater than 75
-        if {[catch {package require Tcl 8.7}]} {
+        if {[catch {package require Tcl 8.7-}]} {
             #only one implementation available for older Tcl
             tailcall punk::fileline::system::_range_spans_chunk_boundaries_tcl $start $end $chunksize {*}$args
         }
@@ -1675,7 +1676,7 @@ namespace eval punk::fileline::system {
     proc _range_spans_chunk_boundaries_TIMEIT {start end chunksize {repeat 1}} {
         puts "main  : [time {punk::fileline::lib::range_spans_chunk_boundaries $start $end $chunksize} $repeat]"
         puts "tcl : [time {punk::fileline::system::_range_spans_chunk_boundaries_tcl $start $end $chunksize} $repeat]"
-        if {![catch {package require Tcl 8.7}]} {
+        if {![catch {package require Tcl 8.7-}]} {
             puts "lseq : [time {punk::fileline::system::_range_spans_chunk_boundaries_lseq $start $end $chunksize} $repeat]"
         }
     }

src/modules/punk/flib-999999.0a1.0.tm

@@ -44,10 +44,10 @@
 #[para] packages used by punk::flib
 #[list_begin itemized]
 
-package require Tcl 8.6
+package require Tcl 8.6-
 package require pattern
 #*** !doctools
-#[item] [package {Tcl 8.6}]
+#[item] [package {Tcl 8.6-}]
 #[item] [package {pattern 1.2.4}]
 
 # #package require frobz

src/modules/punk/lib-999999.0a1.0.tm

@@ -47,9 +47,9 @@
 #[para] packages used by punk::lib
 #[list_begin itemized]
 
-package require Tcl 8.6
+package require Tcl 8.6-
 #*** !doctools
-#[item] [package {Tcl 8.6}]
+#[item] [package {Tcl 8.6-}]
 
 # #package require frobz
 # #*** !doctools
@@ -596,7 +596,7 @@ namespace eval punk::lib {
         #set opts [dict merge {-block {}}  $opts]
         set bposn [lsearch $opts -block]
         if {$bposn < 0} {
-            set opts {-block {}}
+            lappend opts -block {}
         }
         set text [lindex $args end]
         tailcall linelist {*}$opts $text
@@ -617,7 +617,6 @@ namespace eval punk::lib {
     #  -line trimline|trimleft|trimright  -block trimhead|trimtail|triminner|trimall|trimhead1|trimtail1|collateempty -commandprefix {string length} ?
     #  -block trimming only trims completely empty lines. use -line trimming to remove whitespace e.g -line trimright will clear empty lines without affecting leading whitespace on other lines that aren't pure whitespace
     proc linelist {args} {
-        #puts "---->linelist '$args'"
         set usage "linelist ?-line trimline|trimleft|trimright? ?-block trimhead|trimtail|triminner|trimall|trimhead1|trimtail1|collateempty? -commandprefix <cmdlist> text"
         if {[llength $args] == 0} {
             error "linelist missing textchunk argument usage:$usage" 
@@ -630,7 +629,7 @@ namespace eval punk::lib {
             -block {trimhead1 trimtail1}\
             -line  {}\
             -commandprefix ""\
-            -ansiresets 1\
+            -ansiresets 0\
         ] 
         dict for {o v} $arglist {
             if {$o ni {-block -line -commandprefix -ansiresets}} {
@@ -678,6 +677,8 @@ namespace eval punk::lib {
         # -- --- --- --- --- ---
         set opt_commandprefix   [dict get $opts -commandprefix]
         # -- --- --- --- --- ---
+        set opt_ansiresets      [dict get $opts -ansiresets]
+        # -- --- --- --- --- ---
         set linelist [list]
         set nlsplit [split $text \n]
         if {![llength $opt_line]} {
@@ -761,6 +762,103 @@ namespace eval punk::lib {
             set linelist [lrange $linelist $start $end]
         }
 
+        #review - we need to make sure ansiresets don't accumulate/grow on any line
+        #Each resulting line should have a reset of some type at start and a pure-reset at end to stop 
+        #see if we can find an ST sequence that most terminals will not display for marking sections?
+        if {$opt_ansiresets} {
+            set RST [a]
+            set replaycodes $RST ;#todo - default?
+            set transformed [list]
+            #shortcircuit common case of no ansi
+            if {![punk::ansi::ta::detect $linelist]} {
+                foreach ln $linelist {
+                    lappend transformed $RST$ln$RST
+                }
+                set linelist $transformed
+            } else {
+
+
+                foreach ln $linelist {
+                    set is_replay_pure_reset [punk::ansi::codetype::is_sgr_reset $replaycodes] ;#only looks at tail code - but if tail is pure reset - any prefix is ignorable
+
+                    set ansisplits [punk::ansi::ta::split_codes_single $ln]
+                    if {[llength $ansisplits]<= 1} {
+                        #plaintext only - no ansi codes in line
+                        lappend transformed [string cat $replaycodes $ln $RST]
+                        #leave replaycodes as is for next line
+                        set nextreplay $replaycodes
+                    } else {
+                        set tail $RST 
+                        set lastcode [lindex $ansisplits end-1] ;#may or may not be SGR
+                        if {[punk::ansi::codetype::is_sgr_reset $lastcode]} {
+                            if {[lindex $ansisplits end] eq ""} {
+                                #last plaintext is empty. So the line is already suffixed with a reset
+                                set tail ""
+                                set nextreplay $RST 
+                            } else {
+                                #trailing text has been reset within line - but no tail reset present
+                                #we normalize by putting a tail reset on anyway
+                                set tail $RST 
+                                set nextreplay $RST 
+                            }
+                        } elseif {[lindex $ansisplits end] ne "" && [punk::ansi::codetype::has_sgr_leadingreset $lastcode]} {
+                            #No tail reset - and no need to examine whole line to determine stack that is in effect 
+                            set tail $RST 
+                            set nextreplay $lastcode
+                        } else {
+                            #last codeset doesn't reset from earlier codes or isn't SGR - so we have to look at whole line to determine codes in effect 
+                            #last codeset doesn't end in a pure-reset
+                            #whether code was at very end or not - add a reset tail
+                            set tail $RST 
+                            #determine effective replay for line
+                            set codestack [list start]
+                            foreach {pt code} $ansisplits {
+                                if {[punk::ansi::codetype::is_sgr_reset $code]} {
+                                    set codestack [list] ;#different from 'start' marked - this means we've had a reset
+                                } elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} {
+                                    set codestack [list $code]
+                                } else {
+                                    if {[punk::ansi::codetype::is_sgr $code]} {
+                                        lappend codestack $code
+                                    } ;#else gx0 or other code - we don't want to stack it with SGR codes
+                                }
+                            }
+                            if {$codestack eq [list start]} {
+                                #No SGRs - may have been other codes
+                                set line_has_sgr 0
+                            } else {
+                                #list is either empty or begins with start - empty means it had SGR reset - so it still invalidates current state of replaycodes
+                                set line_has_sgr 1
+                                if {[lindex $codestack 0] eq "start"} {
+                                    set codestack [lrange $codestack 1 end]
+                                }
+                            }
+
+                            set newreplay [join $codestack ""]
+                            if {$line_has_sgr && $newreplay ne $replaycodes} {
+                                #adjust if it doesn't already does a reset at start
+                                if {[punk::ansi::codetype::has_sgr_leadingreset $newreplay]} {
+                                    set nextreplay $newreplay
+                                } else {
+                                    set nextreplay $RST$newreplay
+                                }
+                            } else {
+                                set nextreplay $replaycodes
+                            } 
+                        }
+                        if {[punk::ansi::codetype::has_sgr_leadingreset $ln]} {
+                            #no point attaching any replay
+                            lappend transformed [string cat $ln $tail]
+                        } else {
+                            lappend transformed [string cat $replaycodes $ln $tail]
+                        }
+                    }
+                    set replaycodes $nextreplay
+                }
+                set linelist $transformed
+            }
+        }
+
         if {[llength $opt_commandprefix]} {
             set transformed [list]
             foreach ln $linelist {
@@ -1233,7 +1331,46 @@ namespace eval punk::lib {
         return [dict create opts $opts values $values]
     }
 
-    
+    #tcl8.7/9 compatibility for 8.6
+    if {[info commands ::tcl::string::insert] eq ""} {
+        #https://wiki.tcl-lang.org/page/string+insert
+        # Pure Tcl implementation of [string insert] command.
+        proc ::tcl::string::insert {string index insertString} {
+            # Convert end-relative and TIP 176 indexes to simple integers.
+            if {[regexp -expanded {
+                ^(end(?![\t\n\v\f\r ])      # "end" is never followed by whitespace
+                |[\t\n\v\f\r ]*[+-]?\d+)    # m, with optional leading whitespace
+                (?:([+-])                   # op, omitted when index is "end"
+                ([+-]?\d+))?                # n, omitted when index is "end"
+                [\t\n\v\f\r ]*$             # optional whitespace (unless "end")
+            } $index _ m op n]} {
+                # Convert first index to an integer.
+                switch $m {
+                    end     {set index [string length $string]}
+                    default {scan $m %d index}
+                }
+
+                # Add or subtract second index, if provided.
+                switch $op {
+                    + {set index [expr {$index + $n}]}
+                    - {set index [expr {$index - $n}]}
+                }
+            } elseif {![string is integer -strict $index]} {
+                # Reject invalid indexes.
+                return -code error "bad index \"$index\": must be\
+                        integer?\[+-\]integer? or end?\[+-\]integer?"
+            }
+
+            # Concatenate the pre-insert, insertion, and post-insert strings.
+            string cat [string range $string 0 [expr {$index - 1}]] $insertString\
+                    [string range $string $index end]
+        }
+
+        # Bind [string insert] to [::tcl::string::insert].
+        namespace ensemble configure string -map [dict replace\
+            [namespace ensemble configure string -map]\
+            insert ::tcl::string::insert]
+    }
 
     #*** !doctools
     #[list_end] [comment {--- end definitions namespace punk::lib ---}]
@@ -1322,6 +1459,7 @@ namespace eval punk::lib::system {
         return [concat $smallfactors [lreverse $largefactors] $x]
     }
 
+    # incomplte - report which is the innermost bracket/quote etc awaiting completion for a Tcl command
     #important - used by punk::repl
     proc incomplete {partial} {
         #we can apparently get away without concatenating current innerpartial to previous in list - REVIEW.
@@ -1333,9 +1471,11 @@ namespace eval punk::lib::system {
         set waiting [list ""]
         set innerpartials [list ""]
         set escaped 0
+        set i 0
         foreach c $clist {
             if {$c eq "\\"} {
                 set escaped [expr {!$escaped}]
+                incr i
                 continue
             } ;# set escaped 0 at end
             set p [lindex $innerpartials end]
@@ -1390,6 +1530,7 @@ namespace eval punk::lib::system {
                 lset innerpartials end $p
             }
             set escaped 0
+            incr i
         }
         set incomplete [list]
         foreach w $waiting {
@@ -1404,7 +1545,7 @@ namespace eval punk::lib::system {
         set debug 0
         if {$debug} {
             foreach w $waiting p $innerpartials {
-                puts stderr "->'$w'  partial: $p"
+                puts stderr "->awaiting:'$w'  partial: $p"
             }
         }
         return $incomplete

src/modules/punk/mix/commandset/layout-999999.0a1.0.tm

@@ -114,11 +114,11 @@ namespace eval punk::mix::commandset::layout {
             set tablewidth [expr {$widest(name) + $vsep_w + $widest(pathtype) + $vsep_w + $widest(path)}]
             set table ""
             append table [string repeat - $tablewidth] \n
-            append table "[textblock::join [overtype::left $col(name) $title(name)] $vsep [overtype::left $col(pathtype) $title(pathtype)] $vsep [overtype::left $col(path) $title(path)]]" \n
+            append table "[textblock::join -- [overtype::left $col(name) $title(name)] $vsep [overtype::left $col(pathtype) $title(pathtype)] $vsep [overtype::left $col(path) $title(path)]]" \n
             append table [string repeat - $tablewidth] \n
 
             foreach n $names pt $pathtypes p $paths {
-            append table "[textblock::join [overtype::left $col(name) $n] $vsep [overtype::left $col(pathtype) $pt] $vsep [overtype::left $col(path) $p]]" \n 
+            append table "[textblock::join -- [overtype::left $col(name) $n] $vsep [overtype::left $col(pathtype) $pt] $vsep [overtype::left $col(path) $p]]" \n 
             }
 
             return $table
@@ -161,11 +161,11 @@ namespace eval punk::mix::commandset::layout {
             set tablewidth [expr {$widest(name) + $vsep_w + $widest(pathtype) + $vsep_w + $widest(path)}]
             set table ""
             append table [string repeat - $tablewidth] \n
-            append table "[textblock::join [overtype::left $col(name) $title(name)] $vsep [overtype::left $col(pathtype) $title(pathtype)] $vsep [overtype::left $col(path) $title(path)]]" \n
+            append table "[textblock::join -- [overtype::left $col(name) $title(name)] $vsep [overtype::left $col(pathtype) $title(pathtype)] $vsep [overtype::left $col(path) $title(path)]]" \n
             append table [string repeat - $tablewidth] \n
 
             foreach n $names pt $pathtypes p $paths {
-                append table "[textblock::join [overtype::left $col(name) $n] $vsep [overtype::left $col(pathtype) $pt] $vsep [overtype::left $col(path) $p]]" \n 
+                append table "[textblock::join -- [overtype::left $col(name) $n] $vsep [overtype::left $col(pathtype) $pt] $vsep [overtype::left $col(path) $p]]" \n 
             }
 
             return $table

src/modules/punk/mix/commandset/project-999999.0a1.0.tm

@@ -59,9 +59,9 @@
 #[para] packages used by punk::mix::commandset::project 
 #[list_begin itemized]
 
-package require Tcl 8.6
+package require Tcl 8.6-
 #*** !doctools
-#[item] [package {Tcl 8.6}]
+#[item] [package {Tcl 8.6-}]
 #[item] [package punk::ns]
 #[item] [package sqlite3] (binary)
 #[item] [package overtype]

src/modules/punk/mix/templates/layouts/project/src/build.tcl

@@ -0,0 +1,6 @@
+#!/bin/sh
+# -*- tcl -*- \
+# 'build.tcl' name as required by kettle
+# Can be run directly - but also using `deck Kettle ...`  or `deck KettleShell  ...`\
+exec ./kettle -f "$0" "${1+$@}"
+kettle doc

src/modules/punk/mix/templates/layouts/project/src/make.tcl

@@ -0,0 +1,995 @@
+# tcl
+#
+#make any tclkits and modules in src and place them and associated data files/scripts in the parent folder of src.
+#e.g in 'bin' and 'modules' folders at same level as 'src' folder.
+
+set hashline "# ## ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ###"
+puts $hashline
+puts "    punkshell make script " 
+puts $hashline\n
+namespace eval ::punkmake {
+    variable scriptfolder [file normalize [file dirname [info script]]]
+    variable foldername [file tail $scriptfolder]
+    variable pkg_requirements [list]; variable pkg_missing [list];variable pkg_loaded [list]
+    variable non_help_flags [list -k]
+    variable help_flags     [list -help --help /?]
+    variable known_commands [list project get-project-info shell bootsupport]
+}
+if {"::try" ni [info commands ::try]} {
+    puts stderr "Tcl interpreter possibly too old - 'try' command not found - aborting"
+    exit 1
+}
+
+#------------------------------------------------------------------------------
+#Module loading from /src/bootsupport or src/*.vfs if script is within a .vfs folder
+#------------------------------------------------------------------------------
+#If the there is a folder  under the current directory /src/bootsupport/modules which contains .tm files 
+# - then it will attempt to preference these modules
+# This allows a source update via 'fossil update' 'git pull' etc to pull in a minimal set of support modules for the make script
+# and load these in preference to ones that may have been in the interp's tcl::tm::list or auto_path due to environment variables
+set startdir [pwd]
+if {[file exists [file join $startdir src bootsupport]]} {
+    set bootsupport_mod [file join $startdir src bootsupport modules]
+    set bootsupport_lib [file join $startdir src bootsupport lib]
+} else {
+    set bootsupport_mod [file join $startdir bootsupport modules]
+    set bootsupport_lib [file join $startdir bootsupport lib]
+}
+if {[file exists $bootsupport_mod] || [file exists $bootsupport_lib]} {
+
+    set original_tm_list [tcl::tm::list]
+    tcl::tm::remove {*}$original_tm_list
+    set original_auto_path $::auto_path
+    set ::auto_path [list $bootsupport_lib]
+
+    set support_modules [glob -nocomplain -dir $bootsupport_mod -type f -tail *.tm]
+    set tcl_core_packages [list tcl::zlib zlib tcl::oo TclOO tcl::tommath tcl::zipfs Tcl Tk] ;#packages we 
+    if {[llength $support_modules] || [llength [glob -nocomplain -dir $bootsupport_lib  -tail *]]} {
+        #only forget all *unloaded* package names
+        foreach pkg [package names] {
+            if {$pkg in $tcl_core_packages} {
+                continue
+            }
+            if {![llength [package versions $pkg]]} {
+                #puts stderr "Got no versions for pkg $pkg"
+                continue
+            }
+            if {![string length [package provide $pkg]]} {
+                #no returned version indicates it wasn't loaded - so we can forget its index
+                package forget $pkg
+            }
+        }
+        tcl::tm::add $bootsupport_mod
+    }
+
+
+    if {[file exists [pwd]/modules]} {
+        tcl::tm::add [pwd]/modules
+    }
+
+    #package require Thread
+    # - the full repl requires Threading and punk,shellfilter,shellrun to call and display properly.
+    
+    
+    # tm list already indexed - need 'package forget' to find modules based on current tcl::tm::list
+    #These are strong dependencies 
+    package forget  punk::mix
+    package require punk::mix
+    package forget  punk::repo 
+    package require punk::repo
+    package forget  punkcheck 
+    package require punkcheck
+
+
+
+    #restore module paths and auto_path in addition to the bootsupport ones
+    set tm_list_now [tcl::tm::list]
+    foreach p $original_tm_list {
+        if {$p ni $tm_list_now} {
+            tcl::tm::add $p
+        }
+    }
+    set ::auto_path [list $bootsupport_lib {*}$original_auto_path]
+    #------------------------------------------------------------------------------
+}
+
+# ** *** *** *** *** *** *** *** *** *** *** ***
+#*temporarily* hijack package command
+# ** *** *** *** *** *** *** *** *** *** *** ***
+try {
+    rename ::package ::punkmake::package_temp_aside
+    proc ::package {args} {
+        if {[lindex $args 0] eq "require"} {
+            lappend ::punkmake::pkg_requirements [lindex $args 1]
+        }
+    }
+    package require punk::mix
+    package require punk::repo
+} finally {
+    catch {rename ::package ""}
+    catch {rename ::punkmake::package_temp_aside ::package}
+}
+# ** *** *** *** *** *** *** *** *** *** *** ***
+foreach pkg $::punkmake::pkg_requirements {
+    if {[catch {package require $pkg} errM]} {
+        puts stderr "missing pkg: $pkg"
+        lappend ::punkmake::pkg_missing $pkg 
+    } else {
+        lappend ::punkmake::pkg_loaded $pkg
+    }
+}
+
+
+
+
+
+proc punkmake_gethelp {args} {
+    set scriptname [file tail [info script]]
+    append h "Usage:" \n 
+    append h "" \n
+    append h "  $scriptname -help  or $scriptname --help or $scriptname /? or just $scriptname" \n
+    append h "  - This help." \n \n
+    append h "  $scriptname project ?-k?" \n
+    append h "  - this is the literal word project - and confirms you want to run the project build" \n
+    append h "  - the optional -k flag will terminate processes running as the executable being built (if applicable)" \n \n
+    append h "  $scriptname bootsupport"  \n
+    append h "  - update the src/bootsupport modules as well as the mixtemplates/layouts/<layoutname>/src/bootsupport modules if the folder exists" \n \n
+    append h "  $scriptname get-project-info" \n
+    append h "  - show the name and base folder of the project to be built" \n
+    append h "" \n
+    if {[llength $::punkmake::pkg_missing]} {
+        append h "* ** NOTE ** ***" \n
+        append h "    punkmake has detected that the following packages could not be loaded:" \n
+        append h "    " [join $::punkmake::pkg_missing "\n    "] \n
+        append h "* ** *** *** ***" \n
+        append h "    These packages are required for punk make to function" \n \n
+        append h "* ** *** *** ***" \n\n
+        append h "Successfully Loaded packages:" \n
+        append h "    " [join $::punkmake::pkg_loaded "\n    "] \n
+    }
+    return $h
+}
+set scriptargs $::argv
+set do_help 0
+if {![llength $scriptargs]} {
+    set do_help 1
+} else {
+    foreach h $::punkmake::help_flags {
+        if {[lsearch $scriptargs $h] >= 0} {
+            set do_help 1
+            break
+        }
+    }
+}
+set commands_found [list]
+foreach a $scriptargs {
+    if {![string match -* $a]} {
+        lappend commands_found $a
+    } else {
+        if {$a ni $::punkmake::non_help_flags} {
+            set do_help 1
+        }
+    }
+}
+if {[llength $commands_found] != 1 } {
+    set do_help 1
+} elseif {[lindex $commands_found 0] ni $::punkmake::known_commands} {
+    puts stderr "Unknown command: [lindex $commands_found 0]\n\n"
+    set do_help 1
+}
+if {$do_help} {
+    puts stderr [punkmake_gethelp] 
+    exit 0
+}
+
+set ::punkmake::command [lindex $commands_found 0]
+
+
+if {[lsearch $::argv -k] >= 0} {
+    set forcekill 1
+} else {
+    set forcekill 0
+}
+#puts stdout "::argv  $::argv"
+# ----------------------------------------
+
+set scriptfolder $::punkmake::scriptfolder
+
+
+
+#first look for a project root (something under fossil or git revision control AND matches punk project folder structure)
+#If that fails - just look for a 'project shaped folder' ie meets minimum requirements of /src /src/lib /src/modules /lib /modules
+if {![string length [set projectroot [punk::repo::find_project $scriptfolder]]]} {
+    if {![string length [set projectroot [punk::repo::find_candidate $scriptfolder]]]} {
+        puts stderr "punkmake script unable to determine an approprite project root at or above the path '$scriptfolder' ensure the make script is within a project folder structure"
+        puts stderr " -aborted- "
+        exit 2
+        #todo?
+        #ask user for a project name and create basic structure?
+        #call punk::mix::cli::new $projectname on parent folder?
+    } else {
+        puts stderr "WARNING punkmake script operating in project space that is not under version control"
+    }
+} else {
+    
+}
+
+set sourcefolder $projectroot/src
+
+if {$::punkmake::command eq "get-project-info"} {
+    puts stdout "- -- --- --- --- --- --- --- --- --- ---"
+    puts stdout "- -- get-project-info -- -"
+    puts stdout "- -- --- --- --- --- --- --- --- --- ---"
+    puts stdout "- projectroot     : $projectroot"
+    if {[punk::repo::find_fossil $scriptfolder] eq $projectroot} {
+        set vc "fossil"
+        set rev [punk::repo::fossil_revision $scriptfolder]
+        set rem [punk::repo::fossil_remote $scriptfolder]
+    } elseif {[punk::repo::find_git $scriptfolder] eq $projectroot} {
+        set vc "git"
+        set rev [punk::repo::git_revision $scriptfolder]
+        set rem [punk::repo::git_remote  $scriptfolder]
+    } else {
+        set vc " - none found -"
+        set rev "n/a"
+        set remotes "n/a"
+    }
+    puts stdout "- version control : $vc"
+    puts stdout "- revision        : $rev"
+    puts stdout "- remote          : $rem"
+    puts stdout "- -- --- --- --- --- --- --- --- --- ---"
+
+    exit 0
+}
+
+if {$::punkmake::command eq "shell"} {
+    package require punk
+    package require punk::repl
+    puts stderr "make shell not fully implemented - dropping into ordinary punk shell"
+    repl::start stdin
+
+    exit 1
+}
+
+if {$::punkmake::command eq "bootsupport"} {
+    puts "projectroot: $projectroot"
+    puts "script: [info script]"
+    #puts "-- [tcl::tm::list] --"
+    puts stdout "Updating bootsupport from local files"
+
+    proc bootsupport_localupdate {projectroot} {
+        set bootsupport_modules [list]
+        set bootsupport_module_folders [list]
+        set bootsupport_config  $projectroot/src/bootsupport/include_modules.config ;#
+        if {[file exists $bootsupport_config]} {
+            set targetroot $projectroot/src/bootsupport/modules
+            source $bootsupport_config ;#populate $bootsupport_modules with project-specific list
+            if {![llength $bootsupport_modules]} {
+                puts stderr "No local bootsupport modules configured for updating"
+            } else {
+
+                if {[catch {
+                    #----------
+                    set boot_installer [punkcheck::installtrack new make.tcl $projectroot/src/bootsupport/.punkcheck]
+                    $boot_installer set_source_target $projectroot $projectroot/src/bootsupport
+                    set boot_event [$boot_installer start_event {-make_step bootsupport}]
+                    #----------
+                } errM]} {
+                    puts stderr "Unable to use punkcheck for bootsupport error: $errM"
+                    set boot_event ""
+                }
+
+                foreach {relpath module} $bootsupport_modules {
+                    set module [string trim $module :]
+                    set module_subpath [string map [list :: /] [namespace qualifiers $module]]
+                    set srclocation [file join $projectroot $relpath $module_subpath]
+                    #puts stdout "$relpath  $module $module_subpath $srclocation"
+                    set pkgmatches [glob -nocomplain -dir $srclocation -tail [namespace tail $module]-*]
+                    #lsort won't sort version numbers properly e.g with -dictionary 0.1.1 comes before 0.1
+                    if {![llength $pkgmatches]} {
+                        puts stderr "Missing source for bootsupport module $module - not found in $srclocation"
+                        continue
+                    }
+                    set latestfile [lindex $pkgmatches 0]
+                    set latestver [lindex [split [file rootname $latestfile] -] 1]
+                    foreach m $pkgmatches {
+                        lassign [split [file rootname $m] -] _pkg ver
+                        #puts "comparing $ver vs $latestver"
+                        if {[package vcompare $ver $latestver] == 1} {
+                            set latestver $ver
+                            set latestfile $m
+                        } 
+                    }
+                    set srcfile [file join $srclocation $latestfile]
+                    set tgtfile [file join $targetroot $module_subpath $latestfile]
+                    if {$boot_event ne ""} {
+                        #----------
+                        $boot_event targetset_init INSTALL   $tgtfile
+                        $boot_event targetset_addsource      $srcfile
+                        #----------
+                        if {\
+                                [llength [dict get [$boot_event targetset_source_changes] changed]]\
+                            || [llength [$boot_event get_targets_exist]] < [llength [$boot_event get_targets]]\
+                            } {
+                            file mkdir [file dirname $tgtfile] ;#ensure containing folder for target exists
+                            $boot_event targetset_started
+                            # -- --- --- --- --- ---
+                            puts "BOOTSUPPORT update: $srcfile -> $tgtfile"
+                            if {[catch {
+                                file copy -force $srcfile  $tgtfile
+                            } errM]} {
+                                $boot_event targetset_end FAILED
+                            } else {
+                                $boot_event targetset_end OK
+                            }
+                            # -- --- --- --- --- ---
+                        } else {
+                            puts -nonewline stderr "."
+                            $boot_event targetset_end SKIPPED
+                        }
+                        $boot_event end
+                    } else {
+                        file copy -force $srcfile  $tgtfile
+                    }
+                }
+                if {$boot_event ne ""} {
+                    puts \n
+                    $boot_event destroy
+                    $boot_installer destroy
+                }
+            }
+
+            if {[llength $bootsupport_module_folders] % 2 != 0} {
+                #todo - change include_modules.config structure to be line based? we have no way of verifying paired entries because we accept a flat list
+                puts stderr "WARNING - Skipping bootsupport_module_folders - list should be a list of base subpath pairs"
+            } else {
+                foreach {base subfolder} $bootsupport_module_folders {
+                    #user should be careful not to include recursive/cyclic structures e.g module that has a folder which contains other modules from this project
+                    #It will probably work somewhat.. but may make updates confusing.. or worse - start making deeper and deeper copies
+                    set src [file join $projectroot $base $subfolder]
+                    if {![file isdirectory $src]} {
+                        puts stderr "bootsupport folder not found: $src"
+                        continue
+                    }
+
+                    #subfolder is the common relative path - so don't include the base in the target path
+                    set tgt [file join $targetroot $subfolder]
+                    file mkdir $tgt
+
+                    puts stdout "BOOTSUPPORT non_tm_files $src - copying to $tgt (if source file changed)"
+                    set overwrite "installedsourcechanged-targets"
+                    set resultdict [punkcheck::install_non_tm_files $src $tgt -installer make.tcl -overwrite $overwrite -punkcheck_folder $projectroot/src/bootsupport]
+                    puts stdout [punkcheck::summarize_install_resultdict $resultdict]
+                }
+            }
+
+        }
+    }
+
+    bootsupport_localupdate $projectroot
+
+    #/modules/punk/mix/templates/layouts only applies if the project has it's own copy of the punk/mix modules. Generally this should only apply to the punkshell project itself.
+    set layout_bases [list\
+        $sourcefolder/project_layouts/custom/_project\
+    ]
+    foreach project_layout_base $layout_bases {
+        if {[file exists $project_layout_base]} {
+            set project_layouts [glob -nocomplain -dir $project_layout_base -type d -tail *]
+            foreach layoutname $project_layouts {
+                #don't auto-create src/bootsupport - just update it if it exists
+                if {[file exists  [file join $project_layout_base $layoutname/src/bootsupport]]} {
+                    set antipaths [list\
+                        README.md\
+                    ]
+                    set sourcemodules $projectroot/src/bootsupport/modules
+                    set targetroot [file join $project_layout_base $layoutname/src/bootsupport/modules]
+                    file mkdir $targetroot
+
+                    puts stdout "BOOTSUPPORT layouts/$layoutname: copying from $sourcemodules to $targetroot (if source file changed)"
+                    set resultdict [punkcheck::install $sourcemodules $targetroot -overwrite installedsourcechanged-targets -antiglob_paths $antipaths]
+                    puts stdout [punkcheck::summarize_install_resultdict $resultdict]
+                    flush stdout
+                }
+            }
+        } else {
+            puts stderr "No layout base at $project_layout_base"
+        }
+    }
+    puts stdout " bootsupport done "
+    flush stderr
+    flush stdout
+    #punk86 can hang if calling make.tcl via 'run' without this 'after' delay. punk87 unaffected. cause unknown.
+    #after 500
+    ::exit 0
+}
+
+
+
+if {$::punkmake::command ne "project"} {
+    puts stderr "Command $::punkmake::command not implemented - aborting."
+    flush stderr
+    after 100
+    exit 1
+}
+
+
+
+#only a single consolidated /modules folder used for target
+set target_modules_base $projectroot/modules
+file mkdir $target_modules_base
+
+#external libs and modules first - and any supporting files - no 'building' required
+if {[file exists $sourcefolder/vendorlib]} {
+    #exclude README.md from source folder - but only the root one
+    #-antiglob_paths takes relative patterns e.g
+    # */test.txt  will only match test.txt exactly one level deep.
+    # */*/*.foo will match any path ending in .foo that is exactly 2 levels deep.
+    # **/test.txt will match at any level below the root (but not in the root)
+    set antipaths [list\
+        README.md\
+    ]
+
+    puts stdout "VENDORLIB: copying from $sourcefolder/vendorlib to $projectroot/lib (if source file changed)"
+    set resultdict [punkcheck::install $sourcefolder/vendorlib $projectroot/lib -overwrite installedsourcechanged-targets -antiglob_paths $antipaths]
+    puts stdout [punkcheck::summarize_install_resultdict $resultdict]
+
+} else {
+    puts stderr "VENDORLIB: No src/vendorlib folder found."
+}
+
+if {[file exists $sourcefolder/vendormodules]} {
+    #install .tm *and other files*
+    puts stdout "VENDORMODULES: copying from $sourcefolder/vendormodules to $target_modules_base (if source file changed)"
+    set resultdict [punkcheck::install $sourcefolder/vendormodules  $target_modules_base -installer make.tcl -overwrite installedsourcechanged-targets -antiglob_paths {README.md}]
+    puts stdout [punkcheck::summarize_install_resultdict $resultdict]
+} else {
+    puts stderr "VENDORMODULES: No src/vendormodules folder found."
+}
+
+########################################################
+#templates
+#e.g The default project layout is mainly folder structure and readme files - but has some scripts developed under the main src that we want to sync
+#src to  src/modules/punk/mix/templates/layouts/project/src
+
+set old_layout_update_list    [list\
+    [list project $sourcefolder/modules/punk/mix/templates]\
+    [list basic $sourcefolder/mixtemplates]\
+    ]  
+set layout_bases    [list\
+    $sourcefolder/project_layouts/custom/_project\
+    ]  
+
+foreach layoutbase $layout_bases {
+    if {![file exists $layoutbase]} {
+        continue
+    }
+    set project_layouts [glob -nocomplain -dir $layoutbase -type d -tail *]
+    foreach layoutname $project_layouts {
+        set config [dict create\
+            -make-step sync_layouts\
+        ]
+        #----------
+        set tpl_installer [punkcheck::installtrack new make.tcl $layoutbase/.punkcheck]
+        $tpl_installer set_source_target $sourcefolder $layoutbase
+        set tpl_event [$tpl_installer start_event $config]
+        #----------
+        set pairs [list]
+        set pairs [list\
+            [list $sourcefolder/build.tcl  $layoutbase/$layoutname/src/build.tcl]\
+            [list $sourcefolder/make.tcl  $layoutbase/$layoutname/src/make.tcl]\
+        ]
+
+        foreach filepair $pairs {
+            lassign $filepair srcfile tgtfile
+
+            file mkdir [file dirname $tgtfile]
+            #----------
+            $tpl_event targetset_init INSTALL   $tgtfile
+            $tpl_event targetset_addsource      $srcfile
+            #----------
+            if {\
+                [llength [dict get [$tpl_event targetset_source_changes] changed]]\
+                || [llength [$tpl_event get_targets_exist]] < [llength [$tpl_event get_targets]]\
+                } {
+                $tpl_event targetset_started
+                # -- --- --- --- --- ---
+                puts stdout "PROJECT LAYOUT update - layoutname: $layoutname Copying from $srcfile to $tgtfile"
+                if {[catch {
+                    file copy -force $srcfile $tgtfile
+                } errM]} {
+                    $tpl_event targetset_end FAILED -note "layout:$layoutname copy failed with err: $errM"
+                } else {
+                    $tpl_event targetset_end OK -note "layout:$layoutname"
+                }
+                # -- --- --- --- --- ---
+            } else {
+                puts stderr "."
+                $tpl_event targetset_end SKIPPED
+            }
+        }
+
+        $tpl_event end
+        $tpl_event destroy
+        $tpl_installer destroy
+    }
+}
+########################################################
+
+
+#default source module folder is at projectroot/src/modules
+#There may be multiple other src module folders at same level (e.g folder not being other special-purpose folder and not matching name vendor* that contains at least one .tm file in its root) 
+set source_module_folderlist [punk::mix::cli::lib::find_source_module_paths $projectroot]
+foreach src_module_dir $source_module_folderlist {
+    puts stderr "Processing source module dir: $src_module_dir"
+    set dirtail [file tail $src_module_dir]
+    #modules and associated files belonging to this package/app
+    set copied [punk::mix::cli::lib::build_modules_from_source_to_base $src_module_dir $target_modules_base -glob *.tm] ;#will only accept a glob ending in .tm
+    #set copied [list]
+    puts stdout "--------------------------"
+    puts stderr "Copied [llength $copied] tm modules from src/$dirtail to $target_modules_base "
+    puts stdout "--------------------------"
+
+    set overwrite "installedsourcechanged-targets"
+    #set overwrite "ALL-TARGETS"
+    puts stdout "MODULEFOLDER non_tm_files $src_module_dir - copying to $target_modules_base (if source file changed)"
+    set resultdict [punkcheck::install_non_tm_files $src_module_dir $target_modules_base -installer make.tcl -overwrite $overwrite -antiglob_paths {README.md}]
+    puts stdout [punkcheck::summarize_install_resultdict $resultdict]
+}
+
+set installername "make.tcl"
+
+# ----------------------------------------
+if {[punk::repo::is_fossil_root $projectroot]} {
+    set config [dict create\
+        -make-step configure_fossil\
+    ]
+    #----------
+    set installer [punkcheck::installtrack new $installername $projectroot/.punkcheck]
+    $installer set_source_target $projectroot $projectroot
+
+    set event [$installer start_event $config]
+    $event targetset_init VIRTUAL fossil_settings_mainmenu ;#VIRTUAL - since there is no actual target file
+    set menufile $projectroot/.fossil-custom/mainmenu
+    $event targetset_addsource $menufile
+    #----------
+
+    if {\
+            [llength [dict get [$event targetset_source_changes] changed]]\
+        } {
+        $event targetset_started
+        # -- --- --- --- --- ---
+        puts stdout "Configuring fossil setting: mainmenu from: $menufile"
+        if {[catch {
+            set fd [open $menufile r]
+            fconfigure $fd -translation binary
+            set data [read $fd]
+            close $fd
+            exec fossil settings mainmenu $data
+        } errM]} {
+            $event targetset_end FAILED -note "fossil update failed: $errM"
+        } else {
+            $event targetset_end OK
+        }
+        # -- --- --- --- --- ---
+    } else {
+        puts stderr "."
+        $event targetset_end SKIPPED
+    }
+    $event end
+    $event destroy
+    $installer destroy
+}
+
+set buildfolder [punk::mix::cli::lib::get_build_workdir $sourcefolder]
+if {$buildfolder ne "$sourcefolder/_build"} {
+    puts stderr "$sourcefolder/_build doesn't match the project buildfolder $buildfolder - check project filestructure"
+    puts stdout " -aborted- "
+    exit 2
+}
+
+
+#find runtimes
+set rtfolder $sourcefolder/runtime
+set runtimes [glob -nocomplain -dir $rtfolder -types {f x} -tail *]
+if {![llength $runtimes]} {
+    puts stderr "No executable runtimes found in $rtfolder - unable to build any .vfs folders into executables."
+    puts stderr "Add runtimes to $sourcefolder/runtime if required"
+    exit 0
+}
+
+if {[catch {exec sdx help} errM]} {
+    puts stderr "FAILED to find usable sdx command - check that sdx executable is on path"
+    puts stderr "err: $errM"
+    exit 1
+}
+
+# -- --- --- --- --- --- --- --- --- ---
+#load mapvfs.config file (if any) in runtime folder to map runtimes to vfs folders.
+#build a dict keyed on runtime executable name. 
+#If no mapfile (or no mapfile entry for that runtime) - the runtime will be paired with a matching .vfs folder in src folder.  e.g punk.exe to src/punk.vfs
+#If vfs folders or runtime executables which are explicitly listed in the mapfile don't exist - warn on stderr - but continue. if such nonexistants found; prompt user for whether to continue or abort.
+set mapfile $rtfolder/mapvfs.config
+set runtime_vfs_map [dict create]
+set vfs_runtime_map [dict create]
+if {[file exists $mapfile]} {
+    set fdmap [open $mapfile r]
+    fconfigure $fdmap -translation binary
+    set mapdata [read $fdmap]
+    close $fdmap
+    set mapdata [string map [list \r\n \n] $mapdata]
+    set missing [list]
+    foreach ln [split $mapdata \n] {
+        set ln [string trim $ln]
+        if {$ln eq "" || [string match #* $ln]} {
+            continue
+        }
+        set vfspaths [lassign $ln runtime]
+        if {[string match *.exe $runtime]} {
+            #.exe is superfluous but allowed
+            #drop windows .exe suffix so same config can work cross platform - extension will be re-added if necessary later
+            set runtime [string range $runtime 0 end-4]
+        }
+        if {$runtime ne "-"} {
+            set runtime_test $runtime
+            if {"windows" eq $::tcl_platform(platform)} {
+                set runtime_test $runtime.exe
+            }
+            if {![file exists [file join $rtfolder $runtime_test]]} {
+                puts stderr "WARNING: Missing runtime file $rtfolder/$runtime_test (line in mapvfs.config: $ln)"
+                lappend missing $runtime
+            }
+        }
+        foreach vfs $vfspaths {
+            if {![file isdirectory [file join $sourcefolder $vfs]]} {
+                puts stderr "WARNNING: Missing vfs folder [file join $sourcefolder $vfs] specified in mapvfs.config for runtime $runtime"
+                lappend missing $vfs
+            } 
+            dict lappend vfs_runtime_map $vfs $runtime
+        }
+        if {[dict exists $runtime_vfs_map $runtime]} {
+            puts stderr "CONFIG FILE ERROR. runtime: $runtime was specified more than once in $mapfile."
+            exit 3
+        }
+        dict set runtime_vfs_map $runtime $vfspaths
+    }
+    if {[llength $missing]} {
+        puts stderr "WARNING [llength $missing] missing items from $mapfile. (TODO - prompt user to continue/abort)"
+        foreach m $missing {
+            puts stderr "    $m"
+        }
+        puts stderr "continuing..."
+    }
+}
+# -- --- --- --- --- --- --- --- --- ---
+
+set vfs_folders [glob -nocomplain -dir $sourcefolder -types d -tail *.vfs]
+#add any extra .vfs folders found in runtime/mapvfs.config file (e.g myotherruntimes/something.vfs)
+dict for {vfs -} $vfs_runtime_map {
+    if {$vfs ni $vfs_folders} {
+        lappend vfs_folders $vfs
+    }
+}
+if {![llength $vfs_folders]} {
+    puts stdout "No .vfs folders found at '$sourcefolder' - no kits to build"
+    puts stdout " -done- "
+    exit 0
+}
+
+set vfs_folder_changes [dict create] ;#cache whether each .vfs folder has changes so we don't re-run tests if building from same .vfs with multiple runtime executables
+
+# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
+#set runtimefile [lindex $runtimes 0]
+foreach  runtimefile $runtimes {
+    #runtimefile e.g tclkit86bi.exe on windows tclkit86bi on other platforms
+
+    #sdx *may* be pointed to use the runtime we use to build the kit, or the user may manually use this runtime if they don't have tclsh
+    #sdx will complain if the same runtime is used for the shell as is used in the -runtime argument - so we make a copy (REVIEW)
+    #if {![file exists $buildfolder/buildruntime.exe]} {
+    #    file copy $rtfolder/$runtimefile $buildfolder/buildruntime.exe
+    #}
+
+    set basedir $buildfolder
+    set config [dict create\
+        -make-step copy_runtime\
+    ]
+    #----------
+    set installer [punkcheck::installtrack new $installername $basedir/.punkcheck]
+    $installer set_source_target $rtfolder $buildfolder
+    set event [$installer start_event $config]
+    $event targetset_init INSTALL $buildfolder/build_$runtimefile
+    $event targetset_addsource $rtfolder/$runtimefile
+    #----------
+
+    #set changed_unchanged [punkcheck::recordlist::file_install_record_source_changes [lindex [dict get $file_record body] end]]
+    if {\
+            [llength [dict get [$event targetset_source_changes] changed]]\
+         || [llength [$event get_targets_exist]] < [llength [$event get_targets]]\
+        } {
+        $event targetset_started
+        # -- --- --- --- --- ---
+        puts stdout "Copying runtime from $rtfolder/$runtimefile to $buildfolder/build_$runtimefile"
+        if {[catch {
+            file copy -force $rtfolder/$runtimefile $buildfolder/build_$runtimefile
+        } errM]} {
+            $event targetset_end FAILED
+        } else {
+            $event targetset_end OK
+        }
+        # -- --- --- --- --- ---
+    } else {
+        puts stderr "."
+        $event targetset_end SKIPPED
+    }
+    $event end
+
+}
+
+# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
+
+#
+# loop over vfs_folders and for each one, loop over configured (or matching)  runtimes - build with sdx if source .vfs or source runtime exe has changed.
+# we are using punkcheck to install result to buildfolder so we create a .punkcheck file at the target folder to store metadata.
+# punkcheck allows us to not rely purely on timestamps (which may be unreliable)  
+#
+set startdir [pwd]
+puts stdout "Found [llength $vfs_folders] .vfs folders - building executable for each..."
+cd [file dirname $buildfolder] 
+#root folder mtime is insufficient for change detection. Tree mtime of folders only is a barely  passable mechanism for vfs change detection in some circumstances - e.g if files added/removed but never edited in place
+#a hash of full tree file & dir mtime may be more reasonable - but it remains to be seen if just tar & checksum is any/much slower.
+#Simply rebuilding all the time may be close the speed of detecting change anyway - and almost certainly much faster when there is a change.
+#Using first mtime encountered that is later than target is another option - but likely to be highly variable in speed. Last file in the tree could happen to be the latest, and this mechanism doesn't handle build on reversion to older source.
+set exe_names_seen [list]
+foreach vfs $vfs_folders {
+    
+    set vfsname [file rootname $vfs]
+    puts stdout "  Processing vfs $sourcefolder/$vfs"
+    puts stdout "  ------------------------------------"
+    set skipped_vfs_build 0
+    # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
+    set basedir $buildfolder
+    set config [dict create\
+        -make-step build_vfs\
+    ]
+
+    set runtimes  [list]
+    if {[dict exists $vfs_runtime_map $vfs]} {
+        set runtimes [dict get $vfs_runtime_map $vfs] ;#map dict is unsuffixed (.exe stripped or was not present)
+        if {"windows" eq $::tcl_platform(platform)} {
+            set runtimes_raw $runtimes
+            set runtimes [list]
+            foreach rt $runtimes_raw {
+                if {![string match *.exe $rt] && $rt ne "-"} {
+                    set rt $rt.exe
+                }
+                lappend runtimes $rt
+            }
+        }
+    } else {
+        #only match this vfs to a correspondingly named runtime if there was no explicit entry for that runtime
+        set matchrt [file rootname [file tail $vfs]] ;#e.g project.vfs -> project
+        if {![dict exists $runtime_vfs_map $matchrt]} {
+            if {"windows" eq $::tcl_platform(platform)} {
+                if {[file exists $rtfolder/$matchrt.exe]} {
+                    lappend runtimes $matchrt.exe
+                }
+            } else {
+                lappend runtimes $matchrt
+            }
+        }   
+    }
+    #assert $runtimes is a list of executable names suffixed with .exe if on windows - whether or not specified with .exe in the mapvfs.config
+
+
+    #todo - non kit based - zipkit?
+    # $runtimes may now include a dash entry "-" (from mapvfs.config file)
+    foreach rtname $runtimes {
+        #rtname of "-" indicates build a kit without a runtime
+
+        #first configured runtime will be the one to use the same name as .vfs folder for output executable. Additional runtimes on this .vfs will need to suffix the runtime name to disambiguate.
+        #review: This mechanism may not be great for multiplatform builds ? We may be better off consistently combining vfsname and rtname and letting a later platform-specific step choose ones to install in bin with simpler names.
+        if {$rtname eq "-"} {
+            set targetkit $vfsname.kit
+        } else {
+            if {$::tcl_platform(platform) eq "windows"} {
+                set targetkit ${vfsname}.exe
+            } else {
+                set targetkit $vfsname
+            }
+            if {$targetkit in $exe_names_seen} {
+                #more than one runtime for this .vfs 
+                set targetkit ${vfsname}_$rtname
+            }
+        }
+        lappend exe_names_seen $targetkit
+        # -- ----------
+        set vfs_installer [punkcheck::installtrack new $installername $basedir/.punkcheck]
+        $vfs_installer set_source_target $sourcefolder $buildfolder
+        set vfs_event [$vfs_installer start_event {-make-step build_vfs}]
+        $vfs_event targetset_init INSTALL $buildfolder/$targetkit
+        $vfs_event targetset_addsource $sourcefolder/$vfs
+        if {$rtname ne "-"} {
+            $vfs_event targetset_addsource $buildfolder/build_$rtname
+        }
+        # -- ----------
+
+        set changed_unchanged [$vfs_event targetset_source_changes]
+
+        if {[llength [dict get $changed_unchanged changed]] ||  [llength [$vfs_event get_targets_exist]] < [llength [$vfs_event get_targets]]} {
+            #source .vfs folder has changes
+            $vfs_event targetset_started
+            # -- --- --- --- --- ---
+
+            #use 
+            if {[file exists $buildfolder/$vfsname.new]} {
+                puts stderr "deleting existing $buildfolder/$vfsname.new"
+                file delete $buildfolder/$vfsname.new
+            }
+
+            puts stdout "building $vfsname with sdx.. vfsdir:$vfs cwd: [pwd]"
+
+
+            if {[catch {
+                if {$rtname ne "-"} {
+                    exec sdx wrap $buildfolder/$vfsname.new -vfs $sourcefolder/$vfs -runtime $buildfolder/build_$rtname -verbose
+                } else {
+                    exec sdx wrap $buildfolder/$vfsname.new -vfs $sourcefolder/$vfs  -verbose
+                }
+                } result]} {
+                if {$rtname ne "-"} {
+                    puts stderr "sdx wrap $buildfolder/$vfsname.new -vfs $sourcefolder/$vfs -runtime $buildfolder/build_$rtname -verbose failed with msg: $result"
+                } else {
+                    puts stderr "sdx wrap $buildfolder/$vfsname.new -vfs $sourcefolder/$vfs  -verbose failed with msg: $result"
+                }
+            } else {
+                puts stdout "ok - finished sdx"
+                set separator [string repeat = 40]
+                puts stdout $separator
+                puts stdout $result
+                puts stdout $separator
+            }
+
+            if {![file exists $buildfolder/$vfsname.new]} {
+                puts stderr "|err> make.tcl build didn't seem to produce output at $sourcefolder/_build/$vfsname.new"
+                $vfs_event targetset_end FAILED
+                exit 2
+            }
+
+            # -- --- ---
+            if {$::tcl_platform(platform) eq "windows"} {
+                set pscmd "tasklist"
+            } else {
+                set pscmd "ps"
+            }
+
+            #killing process doesn't apply to .kit build 
+            if {$rtname ne "-"} {
+                if {![catch {
+                        exec $pscmd | grep $vfsname
+                    } still_running]} {
+
+                    puts stdout "found $vfsname instances still running\n"
+                    set count_killed 0
+                    foreach ln [split $still_running \n] {
+                        puts stdout "    $ln"
+                        
+                        if {$::tcl_platform(platform) eq "windows"} {
+                            set pid [lindex $ln 1]
+                            if {$forcekill} {
+                                set killcmd [list taskkill /F /PID $pid]
+                            } else {
+                                set killcmd [list taskkill /PID $pid]
+                            }
+                        } else {
+                            set pid [lindex $ln 0]
+                            #review!
+                            if {$forcekill} {
+                                set killcmd [list kill -9 $pid]
+                            } else {
+                                set killcmd [list kill $pid]
+                            }
+                        }
+                        puts stdout "    pid: $pid (attempting to kill now using '$killcmd')"
+                        if {[catch {
+                                exec {*}$killcmd
+                                } errMsg]} {
+                            puts stderr "$killcmd returned an error:"
+                            puts stderr $errMsg
+                            if {!$forcekill} {
+                                puts stderr "(try '[info script] -k' option to force kill)"
+                            }
+                            #avoid exiting if the kill failure was because the task has already exited
+                            #review - *no running instance* works with windows taskkill - "*No such process*" works with kill -9 on FreeBSD and linux - other platforms?
+                            if {![string match "*no running instance*" $errMsg] && ![string match "*No such process*" $errMsg]} {
+                                exit 4
+                            }
+                        } else {
+                            puts stderr "$killcmd ran without error"
+                            incr count_killed
+                        }
+                    }
+                    if {$count_killed > 0} {
+                        puts stderr "\nKilled $count_killed processes. Waiting a short time before attempting to delete executable"
+                        after 1000
+                    }
+                } else {
+                    puts stderr "Ok.. no running '$vfsname' processes found"
+                }
+            }
+
+            if {[file exists $buildfolder/$targetkit]} {
+                puts stderr "deleting existing $buildfolder/$targetkit"
+                if {[catch {
+                    file delete $buildfolder/$targetkit
+                } msg]} {
+                    puts stderr "Failed to delete $buildfolder/$targetkit"
+                    exit 4
+                }
+            }
+            #WINDOWS filesystem 'tunneling' (file replacement within 15secs) could cause targetkit to copy ctime & shortname metadata from previous file!
+            #This is probably harmless - but worth being aware of.
+            file rename $buildfolder/$vfsname.new $buildfolder/$targetkit
+            # -- --- --- --- --- ---
+            $vfs_event targetset_end OK
+
+
+            after 200
+            set deployment_folder [file dirname $sourcefolder]/bin
+            file mkdir $deployment_folder
+
+            # -- ----------
+            set bin_installer [punkcheck::installtrack new "make.tcl" $deployment_folder/.punkcheck]
+            $bin_installer set_source_target $buildfolder $deployment_folder
+            set bin_event [$bin_installer start_event {-make-step final_kit_install}]
+            $bin_event targetset_init INSTALL $deployment_folder/$targetkit
+            #todo - move final deployment step outside of the build vfs loop? (final deployment can fail and then isn't rerun even though _build and deployed versions differ, unless .vfs modified again)
+            #set last_completion [$bin_event targetset_last_complete]
+
+            $bin_event targetset_addsource $buildfolder/$targetkit
+            $bin_event targetset_started
+            # -- ----------
+
+
+            set delete_failed 0
+            if {[file exists $deployment_folder/$targetkit]} {
+                puts stderr "deleting existing deployed at $deployment_folder/$targetkit"
+                if {[catch {
+                    file delete $deployment_folder/$targetkit
+                    } errMsg]} {
+                    puts stderr "deletion of deployed version at $deployment_folder/$targetkit failed: $errMsg"
+                    set delete_failed 1
+                }
+            }
+            if {!$delete_failed} {
+                puts stdout "copying.."
+                puts stdout "$buildfolder/$targetkit"
+                puts stdout "to:"
+                puts stdout "$deployment_folder/$targetkit"
+                after 300
+                file copy $buildfolder/$targetkit $deployment_folder/$targetkit
+                # -- ----------
+                $bin_event targetset_end OK
+                # -- ----------
+            } else {
+                $bin_event targetset_end FAILED -note "could not delete"
+                exit 5
+            }
+            $bin_event destroy
+            $bin_installer destroy
+
+        } else {
+            set skipped_vfs_build 1
+            puts stderr "."
+            puts stdout "Skipping build for vfs $vfs with runtime $rtname - no change detected"
+            $vfs_event targetset_end SKIPPED
+        }
+        $vfs_event destroy
+        $vfs_installer destroy
+    } ;#end foreach rtname in runtimes
+    # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
+}
+cd $startdir
+
+puts stdout "done"
+exit 0
+
+

src/modules/punk/mix/templates/modules/template_cli-0.0.1.tm

@@ -42,12 +42,12 @@
 #[para] packages used by %pkg%
 #[list_begin itemized]
 
-package require Tcl 8.6
+package require Tcl 8.6-
 package require punk::overlay
 package require punk::mix::base
 package require punk::mix::util
 #*** !doctools
-#[item] [package {Tcl 8.6}]
+#[item] [package {Tcl 8.6-}]
 #[item] [package {punk::overlay}]
 #[item] [package {punk::mix::base}]
 #[item] [package {punk::mix::util}]

src/modules/punk/mix/templates/modules/template_module-0.0.1.tm

@@ -44,9 +44,9 @@
 #[para] packages used by %pkg%
 #[list_begin itemized]
 
-package require Tcl 8.6
+package require Tcl 8.6-
 #*** !doctools
-#[item] [package {Tcl 8.6}]
+#[item] [package {Tcl 8.6-}]
 
 # #package require frobz
 # #*** !doctools

src/modules/punk/ns-999999.0a1.0.tm

@@ -766,8 +766,9 @@ namespace eval punk::ns {
         set e [a+ yellow bold]
         set o [a+ cyan bold]
         set p [a+ white bold]
+
+        set a1 [a][a+ cyan]
         foreach ch1 $children1 ch2 $children2 cmd1 $elements1 cmd2 $elements2 cmd3 $elements3 cmd4 $elements4 {
-            set a1 [a+ cyan]
             set c1 [a+ white]
             set c2 [a+ white]
             set c3 [a+ white]

src/modules/punk/path-999999.0a1.0.tm

@@ -44,9 +44,9 @@
 #[para] packages used by punk::path
 #[list_begin itemized]
 
-package require Tcl 8.6
+package require Tcl 8.6-
 #*** !doctools
-#[item] [package {Tcl 8.6}]
+#[item] [package {Tcl 8.6-}]
 
 # #package require frobz
 # #*** !doctools

src/modules/punkapp-0.1.tm

@@ -203,7 +203,8 @@ namespace eval punkapp {
             set pinfo [twapi::get_process_info $pid -name] 
             set pname [dict get $pinfo -name]
             set wstyle [twapi::get_window_style $h]
-            if {$pname in [list cmd.exe pwsh.exe powershell.exe] && "popup" ni $wstyle} {
+            #tclkitsh/tclsh?
+            if {($pname in [list cmd.exe pwsh.exe powershell.exe] || [string match punk*.exe $pname]) && "popup" ni $wstyle} {
                 twapi::hide_window $h 
                 return 1
             } else {

src/modules/shellrun-0.1.1.tm

@@ -184,6 +184,7 @@ namespace eval shellrun {
         variable runerr
         set runout ""
         set runerr ""
+        set RST [a]
 
         set splitargs [get_run_opts $args]
         set runopts [dict get $splitargs runopts]
@@ -245,7 +246,7 @@ namespace eval shellrun {
         set chunklist [list]
 
         #exitcode not part of return value for runout - colourcode appropriately
-        set n [a]
+        set n $RST 
         set c ""
         if [dict exists $exitinfo exitcode] {
             set code [dict get $exitinfo exitcode]
@@ -268,7 +269,7 @@ namespace eval shellrun {
         }
 
 
-        set chunk "[a+ red bold]stderr[a]"
+        set chunk "[a+ red bold]stderr$RST"
         lappend chunklist [list "info" $chunk]
 
         set chunk ""
@@ -278,15 +279,15 @@ namespace eval shellrun {
             } else {
                 set e $::shellrun::runerr
             }
-            #append chunk "[a+ red light]$e[a]\n"
-            append chunk "[a+ red light]$e[a]"
+            #append chunk "[a+ red light]$e$RST\n"
+            append chunk "[a+ red light]$e$RST"
         }
         lappend chunklist [list stderr $chunk]
 
 
 
 
-        lappend chunklist [list "info" "[a+ white bold]stdout[a]"]
+        lappend chunklist [list "info" "[a+ white bold]stdout$RST"]
         set chunk ""
         if {[string length $::shellrun::runout]} {
             if {$nonewline} {

src/modules/textblock-999999.0a1.0.tm

@@ -82,9 +82,9 @@ namespace eval textblock {
         set textblock [textutil::tabify::untabify2 $textblock] 
 
         if {[string first \n $textblock] >= 0} {
-            return [tcl::mathfunc::max {*}[lmap v [punk::lib::lines_as_list -- $textblock] {::punk::char::string_width [stripansi $v]}]]
+            return [tcl::mathfunc::max {*}[lmap v [punk::lib::lines_as_list -- $textblock] {::punk::char::ansifreestring_width [stripansi $v]}]]
         }
-        return [punk::char::string_width [stripansi $textblock]] 
+        return [punk::char::ansifreestring_width [stripansi $textblock]] 
     } 
     proc width_naive {textblock} {
         # doesn't deal with backspaces, vertical tabs,carriage returns, ansi movements 
@@ -119,9 +119,9 @@ namespace eval textblock {
         #stripansi on entire block in one go rather than line by line - result should be the same - review - make tests
         set textblock [punk::ansi::stripansi $textblock]
         if {[string first \n $textblock] >= 0} {
-            set width [tcl::mathfunc::max {*}[lmap v [punk::lib::lines_as_list -- $textblock] {::punk::char::string_width $v}]]
+            set width [tcl::mathfunc::max {*}[lmap v [punk::lib::lines_as_list -- $textblock] {::punk::char::ansifreestring_width $v}]]
         } else {
-            set width [punk::char::string_width $textblock] 
+            set width [punk::char::ansifreestring_width $textblock] 
         }
         set num_le [expr {[string length $textblock]-[string length [string map [list \n {} \v {}] $textblock]]}] ;#faster than splitting into single-char list
         #our concept of block-height is likely to be different to other line-counting mechanisms
@@ -206,8 +206,9 @@ namespace eval textblock {
                 >} .= {lmap v $data w $data2 {val "[overtype::left $col1 $v][overtype::left $col2 $w]"}} {|
                 >} punk::lib::list_as_lines -- <lhs/0,rhs/1|            
 
-    proc ::textblock::join {args} {
+    proc ::textblock::join1 {args} {
         lassign [punk::args::opts_values {
+            -ansiresets -default 1 -type integer
             blocks -type string -multiple 1
         } $args] _o opts _v values
         set blocks [dict get $values blocks]
@@ -216,7 +217,7 @@ namespace eval textblock {
         set fordata [list]
         foreach b $blocks {
             set c($idx) [string repeat " " [width $b]]
-            lappend fordata "v($idx)" [punk::lib::lines_as_list -- $b] 
+            lappend fordata "v($idx)" [punk::lib::lines_as_list {*}$opts -- $b] 
             incr idx
         }
         set outlines [list]
@@ -229,6 +230,31 @@ namespace eval textblock {
         }
         return [punk::lib::list_as_lines -- $outlines]
     }
+    proc ::textblock::join {args} {
+        lassign [punk::args::opts_values {
+            blocks -type string -multiple 1
+        } $args] _o opts _v values
+        set blocks [dict get $values blocks]
+
+        set idx 0
+        set fordata [list]
+        foreach b $blocks {
+            set c($idx) [string repeat " " [width $b]]
+            #lappend fordata "v($idx)" [punk::lib::lines_as_list -- $b] 
+            lappend fordata "v($idx)" [punk::lib::lines_as_list -ansiresets 1 -- $b] 
+            incr idx
+        }
+        set outlines [list]
+        set colindices [lsort -integer -increasing [array names c]]
+        foreach {*}$fordata {
+            set row ""
+            foreach colidx $colindices {
+                append row [overtype::left $c($colidx) $v($colidx)]
+            }
+            lappend outlines $row
+        }
+        return [::join $outlines \n]
+    }
 
     proc ::textblock::trim {block} {
         set trimlines []
@@ -242,7 +268,34 @@ namespace eval textblock {
                 >} .= {lmap v $data w $data2 {val "[overtype::right $col1 $v][overtype::right $col2 $w]"}} {|
                 >} punk::lib::list_as_lines <lhs/0,rhs/1|            
 
-    proc example {{text "test\netc\nmore text"}} {
+    proc example {} {
+        set pleft [>punk . rhs]
+        set pright [>punk . lhs]
+        set prightair [>punk . lhs_air]
+        set red [a+ red]; set redb [a+ red bold]
+        set green [a+ green]; set greenb [a+ green bold]
+        set cyan [a+ cyan];set cyanb [a+ cyan bold]
+        set blue [a+ blue];set blueb [a+ blue bold]
+        set RST [a]
+        set gr0 [punk::ansi::g0 abcdefghijklm\nnopqrstuvwxyz]
+        set punks [textblock::join $pleft $pright]
+        set pleft_greenb $greenb$pleft$RST 
+        set pright_redb  $redb$pright$RST
+        set prightair_cyanb $cyanb$prightair$RST
+        set cpunks [textblock::join $pleft_greenb $pright_redb]
+        set out ""
+        append out $punks \n
+        append out $cpunks \n
+        append out [textblock::join $punks $cpunks] \n
+        set 2frames_a [textblock::join [textblock::frame $cpunks] [textblock::frame $punks]]
+        append out $2frames_a \n
+        set 2frames_b [textblock::join [textblock::frame -ansiborder $cyanb -title "plainpunks" $punks] [textblock::frame -ansiborder $greenb -title "fancypunks" $cpunks]]
+        append out [textblock::frame -title "punks" $2frames_b\n$RST$2frames_a] \n
+        append out [overtype::right  [overtype::left [textblock::frame -ansiborder [a+ green bold] -type unicode_box_heavy -title ${redb}PATTERN$RST -subtitle ${redb}PUNK$RST $prightair_cyanb] "$blueb\n\n\P\nU\nN\nK$RST"] "$blueb\n\nL\nI\nF\nE"] \n
+        return $out
+    }
+
+    proc example3 {{text "test\netc\nmore text"}} {
         package require patternpunk
         .= textblock::join [punk::lib::list_as_lines -- [list 1 2 3 4 5 6 7]] [>punk . lhs] |> .=>1 textblock::join " " |> .=>1 textblock::join $text |>  .=>1 textblock::join [>punk . rhs]  |> .=>1 textblock::join [punk::lib::list_as_lines -- [lrepeat 7 " | "]]
     }
@@ -263,47 +316,270 @@ namespace eval textblock {
         set contents [lindex $args end]
         set arglist [lrange $args 0 end-1]
         if {[llength $arglist] % 2 != 0} {
-            error "Usage frame ?-ansi 0|1? <contents>"
+            error "Usage frame ?-type unicode|altg|ascii|<dict hl (c) vl (c) tlc (c) trc (c) blc (c) brc (c)>? ?-title <ansitext>? ?-subtitle <ansitext>? ?-width <columns>? ?-ansiborder <ansi_sgr>? <contents>"
         }
         #todo args -justify left|centre|right (center)
 
         set defaults [dict create\
-            -ansi 0\
+            -type unicode_box\
+            -title ""\
+            -subtitle ""\
+            -width ""\
+            -ansiborder ""\
+            -align "left"\
         ]
         set opts [dict merge $defaults $arglist]
+        foreach {k v} $opts {
+            if {$k ni [dict keys $defaults]} {
+                error "frame option '$k' not understood. Valid options are [dict keys $defaults]"
+            }
+        }
         # -- --- --- --- --- --- 
-        set ansi        [dict get $opts -ansi]
+        set opt_type        [dict get $opts -type]
+        set known_types [list unicode_box unicode_box_heavy unicode_arc unicode_double ascii altg]
+        set default_custom [dict create hl " " vl " " tlc " " trc " " blc " " brc " "]
+        set custom_keys [list hl hlt hlb vl vll vlr tlc trc blc brc]
+        if {$opt_type ni $known_types} {
+            set is_custom_dict_ok 1
+            if {[llength $opt_type] %2 == 0} {
+                #custom dict may leave out keys - but cannot have unknown keys
+                dict for {k v} $opt_type {
+                    if {$k ni $custom_keys} {
+                        set is_custom_dict_ok 0
+                        break
+                    }
+                }
+            } else {
+                set is_custom_dict_ok 0
+            }
+            if {!$is_custom_dict_ok} {
+                error "frame option -type must be one of known types: $known_types or a dictionary with any of keys hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc"
+            }
+            set custom_frame [dict merge $default_custom $opt_type]
+        }
+        # -- --- --- --- --- --- 
+        set opt_title     [dict get $opts -title]
+        set opt_subtitle  [dict get $opts -subtitle]
+        set opt_width     [dict get $opts -width]
+        # -- --- --- --- --- ---
+        set opt_align     [dict get $opts -align]
+        set opt_align     [string tolower $opt_align]
+        if {$opt_align ni [list left right centre center]} {
+            #these are all valid commands for overtype::<cmd>
+            error "frame option -align must be left|right|centre|center - received: $$opt_align"
+        }
         # -- --- --- --- --- --- 
+        set opt_ansiborder [dict get $opts -ansiborder]
+        # -- --- --- --- --- ---
 
         set contents [textutil::tabify::untabify2 $contents]
         set contents [string map [list \r\n \n] $contents]
-        if {[string first \n $contents] >= 0} {
-            set width [width $contents]
+
+        set actual_contentwidth [width $contents]
+        if {$opt_title ne ""} {
+            set titlewidth [punk::ansi::printing_length $opt_title]
+            set content_or_title_width [expr {max($actual_contentwidth,$titlewidth)}]
         } else {
-            set width [width [list $contents]]
+            set titlewith 0
+            set content_or_title_width  $actual_contentwidth
         }
-        set lines [split $contents \n]
 
-        if {$ansi} {
-            #old style ansi escape sequences with alternate graphics page G0
-            append fs [cd::tlc][string repeat [cd::hl] $width][cd::trc]\n
-            foreach l $lines {
-                append fs [cd::vl]${l}[string repeat " " [expr {$width-[::punk::char::string_width [stripansi $l]]}]][cd::vl]\n
-            }
-            append fs [cd::blc][string repeat [cd::hl] $width][cd::brc]
-            return [cd::groptim $fs]
+        if {[$opt_width eq ""]} {
+            set contentwidth $content_or_title_width
         } else {
+            set contentwidth [expr {$opt_width -2}] ;#default
+        }
+
+        #todo - render it with vertical overflow so we can process ansi moves?
+        set linecount [textblock::height $contents]
+        set rst [a]
+        set column [string repeat " " $contentwidth] ;#default - may need to override for custom frame
+        if {$opt_type eq "altg"} {
+            #old style ansi escape sequences with alternate graphics page G0
+            set hl [cd::hl]
+            set hlt $hl
+            set hlb $hl
+            set vl [cd::vl]
+            set vll $vl
+            set vlr $vl
+            set tlc [cd::tlc]
+            set trc [cd::trc]
+            set blc [cd::blc]
+            set brc [cd::brc]
+            set tbar [string repeat $hl $contentwidth]
+            set tbar [cd::groptim $tbar]
+            set bbar $tbar
+        } elseif {$opt_type eq "ascii"} {
+            set hl -
+            set hlt -
+            set hlb -
+            set vl |
+            set vll |
+            set vlr |
+            set tlc +
+            set trc +
+            set blc +
+            set brc +
+            set tbar [string repeat - $contentwidth]
+            set bbar $tbar
+        } elseif {$opt_type eq "unicode_box"} {
+            #unicode box drawing set
+            set hl [punk::char::charshort boxd_lhz] ;# light horizontal
+            set hlt $hl
+            set hlb $hl
+            set vl [punk::char::charshort boxd_lv] ;#light vertical
+            set vll $vl
+            set vlr $vl
+            set tlc [punk::char::charshort boxd_ldr]
+            set trc [punk::char::charshort boxd_ldl]
+            set blc [punk::char::charshort boxd_lur]
+            set brc [punk::char::charshort boxd_lul]
+            set tbar      [string repeat $hl $contentwidth]
+            set bbar $tbar
+        } elseif {$opt_type eq "unicode_box_heavy"} {
+            #unicode box drawing set
+            set hl [punk::char::charshort boxd_hhz] ;# light horizontal
+            set hlt $hl
+            set hlb $hl
+            set vl [punk::char::charshort boxd_hv] ;#light vertical
+            set vll $vl
+            set vlr $vl
+            set tlc [punk::char::charshort boxd_hdr]
+            set trc [punk::char::charshort boxd_hdl]
+            set blc [punk::char::charshort boxd_hur]
+            set brc [punk::char::charshort boxd_hul]
+            set tbar      [string repeat $hl $contentwidth]
+            set bbar $tbar
+        } elseif {$opt_type eq "unicode_double"} {
             #unicode box drawing set
-            set hz [punk::char::charshort boxd_lhz] ;# light horizontal
-            append fs [punk::char::charshort boxd_ldr][string repeat $hz $width][punk::char::charshort boxd_ldl]\n
+            set hl [punk::char::charshort boxd_dhz] ;# double horizontal \U2550
+            set hlt $hl
+            set hlb $hl
+            set vl [punk::char::charshort boxd_dv] ;#double vertical \U2551
+            set vll $vl
+            set vlr $vl
+            set tlc [punk::char::charshort boxd_ddr] ;#double down and right \U2554
+            set trc [punk::char::charshort boxd_ddl] ;#double down and left \U2557
+            set blc [punk::char::charshort boxd_dur] ;#double up and right \U255A
+            set brc [punk::char::charshort boxd_dul] ;#double up and left \U255D
+            set tbar      [string repeat $hl $contentwidth]
+            set bbar $tbar
+        } elseif {$opt_type eq "unicode_arc"} {
+            #unicode box drawing set
+            set hl [punk::char::charshort boxd_lhz] ;# light horizontal
+            set hlt $hl
+            set hlb $hl
             set vl [punk::char::charshort boxd_lv] ;#light vertical
-            foreach l $lines {
-                append fs $vl${l}[string repeat " " [expr {$width-[::punk::char::string_width [stripansi $l]]}]]$vl\n
+            set vll $vl
+            set vlr $vl
+            set tlc [punk::char::charshort boxd_ladr] ;#light arc down and right \U256D
+            set trc [punk::char::charshort boxd_ladl] ;#light arc down and left \U256E
+            set blc [punk::char::charshort boxd_laur] ;#light arc up and right \U2570
+            set brc [punk::char::charshort boxd_laul] ;#light arc up and left \U256F
+            set tbar      [string repeat $hl $contentwidth]
+            set bbar $tbar
+        } else {
+            dict with custom_frame {} ;#extract keys as vars
+            if {[dict exists $custom_frame hlt]} {
+                set hlt [dict get $custom_frame hlt]
+            } else {
+                set hlt $hl
+            }
+            set hlt_width [punk::ansi::printing_length $hlt]
+            if {[dict exists $custom_frame hlb]} {
+                set hlb [dict get $custom_frame hlb]
+            } else {
+                set hlb $hl
+            }
+            set hlb_width [punk::ansi::printing_length $hlb]
+
+            if {[dict exists $custom_frame vll]} {
+                set vll [dict get $custom_frame vll]
+            } else {
+                set vll $vl
+            }
+            set vll_width [punk::ansi::printing_length $vll]
+            if {[dict exists $custom_frame vlr]} {
+                set vlr [dict get $custom_frame vlr]
+            } else {
+                set vlr $vl
+            }
+            set vlr_width [punk::ansi::printing_length $vlr]
+
+            set tlc_width [punk::ansi::printing_length $tlc]
+            set trc_width [punk::ansi::printing_length $trc]
+            set blc_width [punk::ansi::printing_length $blc]
+            set brc_width [punk::ansi::printing_length $brc]
+
+
+            set framewidth [expr {$contentwidth + 2}] ;#reverse default assumption
+            if {$opt_width eq ""} {
+                #width wasn't specified - so user is expecting frame to adapt to title/contents
+                #content shouldn't truncate because of extra wide frame
+                set contentwidth $content_or_title_width 
+                set tbarwidth [expr {$content_or_title_width + 2 - $tlc_width - $trc_width - 2 + $vll_width + $vlr_width}] ;#+/2's for difference between border element widths and standard element single-width
+                set bbarwidth [expr {$content_or_title_width + 2 - $blc_width - $brc_width - 2 + $vll_width + $vlr_width}]
+            } else {
+                set contentwidth [expr $opt_width - $vll_width - $vlr_width]  ;#content may be truncated
+                set tbarwidth [expr {$opt_width - $tlc_width - $trc_width}]
+                set bbarwidth [expr {$opt_width - $blc_width - $brc_width}]
+            }
+            set column [string repeat " " $contentwidth]
+
+            if {$hlt_width == 1} {
+                set tbar [string repeat $hlt $tbarwidth]
+            } else {
+                #possibly mixed width chars that make up hlt - string range won't get width right
+                set blank [string repeat " " $tbarwidth]
+                set count [expr {($tbarwidth / $hlt_width) + 1}]
+                set tbar [string repeat $hlt $count]
+                #set tbar [string range $tbar 0 $tbarwidth-1]
+                set tbar [overtype::left -overflow 0 -exposed1 " " -exposed2 " " $blank $tbar];#spaces for exposed halves of 2w chars instead of default replacement character
             }
-            append fs [punk::char::charshort boxd_lur][string repeat $hz $width][punk::char::charshort boxd_lul]
-            return $fs
+            if {$hlb_width == 1} {
+                set bbar [string repeat $hlb $bbarwidth]
+            } else {
+                set blank [string repeat " " $bbarwidth]
+                set count [expr {($bbarwidth / $hlb_width) + 1}]
+                set bbar [string repeat $hlb $count]
+                #set bbar [string range $bbar 0 $bbarwidth-1]
+                set bbar [overtype::left -overflow 0 -exposed1 " " -exposed2 " " $blank $bbar]
+            }
+        }
+        #keep lhs/rhs separate? can we do vertical text on sidebars?
+        set lhs [string repeat $vll\n $linecount]
+        set lhs [string range $lhs 0 end-1]
+        set rhs [string repeat $vlr\n $linecount]
+        set rhs [string range $rhs 0 end-1]
+        if {$opt_ansiborder ne ""} {
+            set tbar $opt_ansiborder$tbar$rst
+            set bbar $opt_ansiborder$bbar$rst
+            set tlc $opt_ansiborder$tlc$rst
+            set trc $opt_ansiborder$trc$rst
+            set blc $opt_ansiborder$blc$rst
+            set brc $opt_ansiborder$brc$rst
+            set lhs $opt_ansiborder$lhs$rst ;#wrap the whole block and let textblock::join figure it out
+            set rhs $opt_ansiborder$rhs$rst
         }
 
+        if {$opt_title ne ""} {
+            set topbar [overtype::centre -overflow 0 -exposed1 " " -exposed2 " " -ellipsis 1 -bias left $tbar $opt_title] ;#overtype supports gx0 on/off
+        } else {
+            set topbar $tbar
+        }
+        if {$opt_subtitle ne ""} {
+            set bottombar [overtype::centre -overflow 0 -exposed1 " " -exposed2 " " -ellipsis 1 -bias left $bbar $opt_subtitle] ;#overtype supports gx0 on/off
+        } else {
+            set bottombar $bbar
+        }
+        append fs $tlc$topbar$trc\n
+        set inner [overtype::$opt_align -ellipsis 1 $column $contents]
+        set body [textblock::join -- $lhs $inner $rhs]
+        append fs $body
+        append fs \n $blc$bottombar$brc
+
+        return $fs
+
     }
     proc gcross {{size 1} args} {
         if {$size == 0} {
@@ -395,7 +671,8 @@ namespace eval textblock {
         set b2 [a= green]a\nb\nc[a=]
         set result [textblock::join $b1 $b2]
         puts $result
-        return [list $b1 $b2 $result]
+        #return [list $b1 $b2 $result]
+        return [ansistring VIEW $result]
     }
     namespace import ::punk::ansi::stripansi
 }
@@ -404,7 +681,7 @@ namespace eval textblock {
 namespace eval ::textblock::piper {
     namespace export *
     proc join {rhs pipelinedata} {
-        tailcall ::textblock::join $pipelinedata $rhs
+        tailcall ::textblock::join -- $pipelinedata $rhs
     }
 }
 interp alias {} piper_blockjoin {} ::textblock::piper::join

src/vendorlib/base64/ascii85.tcl

@@ -0,0 +1,271 @@
+# ascii85.tcl --
+#
+# Encode/Decode ascii85 for a string
+#
+# Copyright (c) Emiliano Gavilan
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+package require Tcl 8.4
+
+namespace eval ascii85 {
+    namespace export encode encodefile decode
+    # default values for encode options
+    variable options
+    array set options [list -wrapchar \n -maxlen 76]
+}
+
+# ::ascii85::encode --
+#
+#   Ascii85 encode a given string.
+#
+# Arguments:
+#   args    ?-maxlen maxlen? ?-wrapchar wrapchar? string
+#
+#   If maxlen is 0, the output is not wrapped.
+#
+# Results:
+#   A Ascii85 encoded version of $string, wrapped at $maxlen characters
+#   by $wrapchar.
+
+proc ascii85::encode {args} {
+    variable options
+
+    set alen [llength $args]
+    if {$alen != 1 && $alen != 3 && $alen != 5} {
+        return -code error "wrong # args:\
+            should be \"[lindex [info level 0] 0]\
+            ?-maxlen maxlen?\
+            ?-wrapchar wrapchar? string\""
+    }
+
+    set data [lindex $args end]
+    array set opts [array get options]
+    array set opts [lrange $args 0 end-1]
+    foreach key [array names opts] {
+        if {[lsearch -exact [array names options] $key] == -1} {
+            return -code error "unknown option \"$key\":\
+                must be -maxlen or -wrapchar"
+        }
+    }
+
+    if {![string is integer -strict $opts(-maxlen)]
+        || $opts(-maxlen) < 0} {
+        return -code error "expected positive integer but got\
+            \"$opts(-maxlen)\""
+    }
+
+    # perform this check early
+    if {[string length $data] == 0} {
+        return ""
+    }
+
+    # shorten the names
+    set ml $opts(-maxlen)
+    set wc $opts(-wrapchar)
+
+    # if maxlen is zero, don't wrap the output
+    if {$ml == 0} {
+        set wc ""
+    }
+
+    set encoded {}
+
+    binary scan $data c* X
+    set len      [llength $X]
+    set rest     [expr {$len % 4}]
+    set lastidx  [expr {$len - $rest - 1}]
+
+    foreach {b1 b2 b3 b4} [lrange $X 0 $lastidx] {
+        # calculate the 32 bit value
+        # this is an inlined version of the [encode4bytes] proc
+        # included here for performance reasons
+        set val [expr {
+            (  (($b1 & 0xff) << 24)
+              |(($b2 & 0xff) << 16)
+              |(($b3 & 0xff) << 8)
+              | ($b4 & 0xff)
+            ) & 0xffffffff }]
+
+        if {$val == 0} {
+            # four \0 bytes encodes as "z" instead of "!!!!!"
+            append current "z"
+        } else {
+            # no magic numbers here.
+            # 52200625 -> 85 ** 4
+            # 614125   -> 85 ** 3
+            # 7225     -> 85 ** 2
+            append current [binary format ccccc \
+                [expr { ( $val / 52200625) + 33 }] \
+                [expr { (($val % 52200625) / 614125) + 33 }] \
+                [expr { (($val % 614125) / 7225) + 33 }] \
+                [expr { (($val % 7225) / 85) + 33 }] \
+                [expr { ( $val % 85) + 33 }]]
+        }
+
+        if {[string length $current] >= $ml} {
+            append encoded [string range $current 0 [expr {$ml - 1}]] $wc
+            set current    [string range $current $ml end]
+        }
+    }
+
+    if { $rest } {
+        # there are remaining bytes.
+        # pad with \0 and encode not using the "z" convention.
+        # finally, add ($rest + 1) chars.
+        set val 0
+        foreach {b1 b2 b3 b4} [pad [lrange $X [incr lastidx] end] 4 0] break
+        append current [string range [encode4bytes $b1 $b2 $b3 $b4] 0 $rest]
+    }
+    append encoded [regsub -all -- ".{$ml}" $current "&$wc"]
+
+    return $encoded
+}
+
+proc ascii85::encode4bytes {b1 b2 b3 b4} {
+    set val [expr {
+        (  (($b1 & 0xff) << 24)
+          |(($b2 & 0xff) << 16)
+          |(($b3 & 0xff) << 8)
+          | ($b4 & 0xff)
+        ) & 0xffffffff }]
+    return [binary format ccccc \
+            [expr { ( $val / 52200625) + 33 }] \
+            [expr { (($val % 52200625) / 614125) + 33 }] \
+            [expr { (($val % 614125) / 7225) + 33 }] \
+            [expr { (($val % 7225) / 85) + 33 }] \
+            [expr { ( $val % 85) + 33 }]]
+}
+
+# ::ascii85::encodefile --
+#
+#   Ascii85 encode the contents of a file using default values
+#   for maxlen and wrapchar parameters.
+#
+# Arguments:
+#   fname    The name of the file to encode.
+#
+# Results:
+#   An Ascii85 encoded version of the contents of the file.
+#   This is a convenience command
+
+proc ascii85::encodefile {fname} {
+    set fd [open $fname]
+    fconfigure $fd -encoding binary -translation binary
+    return [encode [read $fd]][close $fd]
+}
+
+# ::ascii85::decode --
+#
+#   Ascii85 decode a given string.
+#
+# Arguments:
+#   string      The string to decode.
+# Leading spaces and tabs are removed, along with trailing newlines
+#
+# Results:
+#   The decoded value.
+
+proc ascii85::decode {data} {
+    # get rid of leading spaces/tabs and trailing newlines
+    set data [string map [list \n {} \t {} { } {}] $data]
+    set len [string length $data]
+
+    # perform this ckeck early
+    if {! $len} {
+        return ""
+    }
+
+    set decoded {}
+    set count 0
+    set group [list]
+    binary scan $data c* X
+
+    foreach char $X {
+        # we must check that every char is in the allowed range
+        if {$char < 33 || $char > 117 } {
+            # "z" is an exception
+            if {$char == 122} {
+                if {$count == 0} {
+                    # if a "z" char appears at the beggining of a group,
+                    # it decodes as four null bytes
+                    append decoded \x00\x00\x00\x00
+                    continue
+                } else {
+                    # if not, is an error
+                    return -code error \
+                        "error decoding data: \"z\" char misplaced"
+                }
+            }
+            # char is not in range and not a "z" at the beggining of a group
+            return -code error \
+                "error decoding data: chars outside the allowed range"
+        }
+
+        lappend group $char
+        incr count
+        if {$count == 5} {
+            # this is an inlined version of the [decode5chars] proc
+            # included here for performance reasons
+            set val [expr {
+                ([lindex $group 0] - 33) * wide(52200625) +
+                ([lindex $group 1] - 33) * 614125 +
+                ([lindex $group 2] - 33) * 7225 +
+                ([lindex $group 3] - 33) * 85 +
+                ([lindex $group 4] - 33) }]
+            if {$val > 0xffffffff} {
+                return -code error "error decoding data: decoded group overflow"
+            } else {
+                append decoded [binary format I $val]
+                incr count -5
+                set group [list]
+            }
+        }
+    }
+
+    set len [llength $group]
+    switch -- $len {
+        0 {
+            # all input has been consumed
+            # do nothing
+        }
+        1 {
+            # a single char is a condition error, there should be at least 2
+            return -code error \
+                "error decoding data: trailing char"
+        }
+        default {
+            # pad with "u"s, decode and add ($len - 1) bytes
+            append decoded [string range \
+                    [decode5chars [pad $group 5 122]] \
+                    0 \
+                    [expr {$len - 2}]]
+        }
+    }
+
+    return $decoded
+}
+
+proc ascii85::decode5chars {group} {
+    set val [expr {
+        ([lindex $group 0] - 33) * wide(52200625) +
+        ([lindex $group 1] - 33) * 614125 +
+        ([lindex $group 2] - 33) * 7225 +
+        ([lindex $group 3] - 33) * 85 +
+        ([lindex $group 4] - 33) }]
+    if {$val > 0xffffffff} {
+        return -code error "error decoding data: decoded group overflow"
+    }
+
+    return [binary format I $val]
+}
+
+proc ascii85::pad {chars len padchar} {
+    while {[llength $chars] < $len} {
+        lappend chars $padchar
+    }
+
+    return $chars
+}
+
+package provide ascii85 1.0

src/vendorlib/base64/base64.tcl

@@ -0,0 +1,410 @@
+# base64.tcl --
+#
+# Encode/Decode base64 for a string
+# Stephen Uhler / Brent Welch (c) 1997 Sun Microsystems
+# The decoder was done for exmh by Chris Garrigues
+#
+# Copyright (c) 1998-2000 by Ajuba Solutions.
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+# Version 1.0   implemented Base64_Encode, Base64_Decode
+# Version 2.0   uses the base64 namespace
+# Version 2.1   fixes various decode bugs and adds options to encode
+# Version 2.2   is much faster, Tcl8.0 compatible
+# Version 2.2.1 bugfixes
+# Version 2.2.2 bugfixes
+# Version 2.3   bugfixes and extended to support Trf
+# Version 2.4.x bugfixes
+
+# @mdgen EXCLUDE: base64c.tcl
+
+package require Tcl 8.2
+namespace eval ::base64 {
+    namespace export encode decode
+}
+
+package provide base64 2.5
+
+if {[package vsatisfies [package require Tcl] 8.6]} {
+    proc ::base64::encode {args} {
+	binary encode base64 -maxlen 76 {*}$args
+    }
+
+    proc ::base64::decode {string} {
+	# Tcllib is strict with respect to end of input, yet lax for
+	# invalid characters outside of that.
+	regsub -all -- {[^ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/]} $string {} string
+	binary decode base64 -strict $string
+    }
+
+    return
+}
+
+if {![catch {package require Trf 2.0}]} {
+    # Trf is available, so implement the functionality provided here
+    # in terms of calls to Trf for speed.
+
+    # ::base64::encode --
+    #
+    #	Base64 encode a given string.
+    #
+    # Arguments:
+    #	args	?-maxlen maxlen? ?-wrapchar wrapchar? string
+    #
+    #		If maxlen is 0, the output is not wrapped.
+    #
+    # Results:
+    #	A Base64 encoded version of $string, wrapped at $maxlen characters
+    #	by $wrapchar.
+
+    proc ::base64::encode {args} {
+	# Set the default wrapchar and maximum line length to match
+	# the settings for MIME encoding (RFC 3548, RFC 2045). These
+	# are the settings used by Trf as well. Various RFCs allow for
+	# different wrapping characters and wraplengths, so these may
+	# be overridden by command line options.
+	set wrapchar "\n"
+	set maxlen 76
+
+	if { [llength $args] == 0 } {
+	    error "wrong # args: should be \"[lindex [info level 0] 0]\
+		    ?-maxlen maxlen? ?-wrapchar wrapchar? string\""
+	}
+
+	set optionStrings [list "-maxlen" "-wrapchar"]
+	for {set i 0} {$i < [llength $args] - 1} {incr i} {
+	    set arg [lindex $args $i]
+	    set index [lsearch -glob $optionStrings "${arg}*"]
+	    if { $index == -1 } {
+		error "unknown option \"$arg\": must be -maxlen or -wrapchar"
+	    }
+	    incr i
+	    if { $i >= [llength $args] - 1 } {
+		error "value for \"$arg\" missing"
+	    }
+	    set val [lindex $args $i]
+
+	    # The name of the variable to assign the value to is extracted
+	    # from the list of known options, all of which have an
+	    # associated variable of the same name as the option without
+	    # a leading "-". The [string range] command is used to strip
+	    # of the leading "-" from the name of the option.
+	    #
+	    # FRINK: nocheck
+	    set [string range [lindex $optionStrings $index] 1 end] $val
+	}
+
+	# [string is] requires Tcl8.2; this works with 8.0 too
+	if {[catch {expr {$maxlen % 2}}]} {
+	    return -code error "expected integer but got \"$maxlen\""
+	} elseif {$maxlen < 0} {
+	    return -code error "expected positive integer but got \"$maxlen\""
+	}
+
+	set string [lindex $args end]
+	set result [::base64 -mode encode -- $string]
+
+	# Trf's encoder implicitly uses the settings -maxlen 76,
+	# -wrapchar \n for its output. We may have to reflow this for
+	# the settings chosen by the user. A second difference is that
+	# Trf closes the output with the wrap char sequence,
+	# always. The code here doesn't. Therefore 'trimright' is
+	# needed in the fast cases.
+
+	if {($maxlen == 76) && [string equal $wrapchar \n]} {
+	    # Both maxlen and wrapchar are identical to Trf's
+	    # settings. This is the super-fast case, because nearly
+	    # nothing has to be done. Only thing to do is strip a
+	    # terminating wrapchar.
+	    set result [string trimright $result]
+	} elseif {$maxlen == 76} {
+	    # wrapchar has to be different here, length is the
+	    # same. We can use 'string map' to transform the wrap
+	    # information.
+	    set result [string map [list \n $wrapchar] \
+			    [string trimright $result]]
+	} elseif {$maxlen == 0} {
+	    # Have to reflow the output to no wrapping. Another fast
+	    # case using only 'string map'. 'trimright' is not needed
+	    # here.
+
+	    set result [string map [list \n ""] $result]
+	} else {
+	    # Have to reflow the output from 76 to the chosen maxlen,
+	    # and possibly change the wrap sequence as well.
+
+	    # Note: After getting rid of the old wrap sequence we
+	    # extract the relevant segments from the string without
+	    # modifying the string. Modification, i.e. removal of the
+	    # processed part, means 'shifting down characters in
+	    # memory', making the algorithm O(n^2). By avoiding the
+	    # modification we stay in O(n).
+
+	    set result [string map [list \n ""] $result]
+	    set l [expr {[string length $result]-$maxlen}]
+	    for {set off 0} {$off < $l} {incr off $maxlen} {
+		append res [string range $result $off [expr {$off+$maxlen-1}]] $wrapchar
+	    }
+	    append res [string range $result $off end]
+	    set result $res
+	}
+
+	return $result
+    }
+
+    # ::base64::decode --
+    #
+    #	Base64 decode a given string.
+    #
+    # Arguments:
+    #	string	The string to decode.  Characters not in the base64
+    #		alphabet are ignored (e.g., newlines)
+    #
+    # Results:
+    #	The decoded value.
+
+    proc ::base64::decode {string} {
+	regsub -all {\s} $string {} string
+	::base64 -mode decode -- $string
+    }
+
+} else {
+    # Without Trf use a pure tcl implementation
+
+    namespace eval base64 {
+	variable base64 {}
+	variable base64_en {}
+
+	# We create the auxiliary array base64_tmp, it will be unset later.
+	variable base64_tmp
+	variable i
+
+	set i 0
+	foreach char {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z \
+		a b c d e f g h i j k l m n o p q r s t u v w x y z \
+		0 1 2 3 4 5 6 7 8 9 + /} {
+	    set base64_tmp($char) $i
+	    lappend base64_en $char
+	    incr i
+	}
+
+	#
+	# Create base64 as list: to code for instance C<->3, specify
+	# that [lindex $base64 67] be 3 (C is 67 in ascii); non-coded
+	# ascii chars get a {}. we later use the fact that lindex on a
+	# non-existing index returns {}, and that [expr {} < 0] is true
+	#
+
+	# the last ascii char is 'z'
+	variable char
+	variable len
+	variable val
+
+	scan z %c len
+	for {set i 0} {$i <= $len} {incr i} {
+	    set char [format %c $i]
+	    set val {}
+	    if {[info exists base64_tmp($char)]} {
+		set val $base64_tmp($char)
+	    } else {
+		set val {}
+	    }
+	    lappend base64 $val
+	}
+
+	# code the character "=" as -1; used to signal end of message
+	scan = %c i
+	set base64 [lreplace $base64 $i $i -1]
+
+	# remove unneeded variables
+	unset base64_tmp i char len val
+
+	namespace export encode decode
+    }
+
+    # ::base64::encode --
+    #
+    #	Base64 encode a given string.
+    #
+    # Arguments:
+    #	args	?-maxlen maxlen? ?-wrapchar wrapchar? string
+    #
+    #		If maxlen is 0, the output is not wrapped.
+    #
+    # Results:
+    #	A Base64 encoded version of $string, wrapped at $maxlen characters
+    #	by $wrapchar.
+
+    proc ::base64::encode {args} {
+	set base64_en $::base64::base64_en
+
+	# Set the default wrapchar and maximum line length to match
+	# the settings for MIME encoding (RFC 3548, RFC 2045). These
+	# are the settings used by Trf as well. Various RFCs allow for
+	# different wrapping characters and wraplengths, so these may
+	# be overridden by command line options.
+	set wrapchar "\n"
+	set maxlen 76
+
+	if { [llength $args] == 0 } {
+	    error "wrong # args: should be \"[lindex [info level 0] 0]\
+		    ?-maxlen maxlen? ?-wrapchar wrapchar? string\""
+	}
+
+	set optionStrings [list "-maxlen" "-wrapchar"]
+	for {set i 0} {$i < [llength $args] - 1} {incr i} {
+	    set arg [lindex $args $i]
+	    set index [lsearch -glob $optionStrings "${arg}*"]
+	    if { $index == -1 } {
+		error "unknown option \"$arg\": must be -maxlen or -wrapchar"
+	    }
+	    incr i
+	    if { $i >= [llength $args] - 1 } {
+		error "value for \"$arg\" missing"
+	    }
+	    set val [lindex $args $i]
+
+	    # The name of the variable to assign the value to is extracted
+	    # from the list of known options, all of which have an
+	    # associated variable of the same name as the option without
+	    # a leading "-". The [string range] command is used to strip
+	    # of the leading "-" from the name of the option.
+	    #
+	    # FRINK: nocheck
+	    set [string range [lindex $optionStrings $index] 1 end] $val
+	}
+
+	# [string is] requires Tcl8.2; this works with 8.0 too
+	if {[catch {expr {$maxlen % 2}}]} {
+	    return -code error "expected integer but got \"$maxlen\""
+	} elseif {$maxlen < 0} {
+	    return -code error "expected positive integer but got \"$maxlen\""
+	}
+
+	set string [lindex $args end]
+
+	set result {}
+	set state 0
+	set length 0
+
+
+	# Process the input bytes 3-by-3
+
+	binary scan $string c* X
+
+	foreach {x y z} $X {
+	    ADD [lindex $base64_en [expr {($x >>2) & 0x3F}]]
+	    if {$y != {}} {
+		ADD [lindex $base64_en [expr {(($x << 4) & 0x30) | (($y >> 4) & 0xF)}]]
+		if {$z != {}} {
+		    ADD [lindex $base64_en [expr {(($y << 2) & 0x3C) | (($z >> 6) & 0x3)}]]
+		    ADD [lindex $base64_en [expr {($z & 0x3F)}]]
+		} else {
+		    set state 2
+		    break
+		}
+	    } else {
+		set state 1
+		break
+	    }
+	}
+	if {$state == 1} {
+	    ADD [lindex $base64_en [expr {(($x << 4) & 0x30)}]]
+	    ADD =
+	    ADD =
+	} elseif {$state == 2} {
+	    ADD [lindex $base64_en [expr {(($y << 2) & 0x3C)}]]
+	    ADD =
+	}
+	return $result
+    }
+
+    proc ::base64::ADD {x} {
+	# The line length check is always done before appending so
+	# that we don't get an extra newline if the output is a
+	# multiple of $maxlen chars long.
+
+	upvar 1 maxlen maxlen length length result result wrapchar wrapchar
+	if {$maxlen && $length >= $maxlen} {
+	    append result $wrapchar
+	    set length 0
+	}
+	append result $x
+	incr length
+	return
+    }
+
+    # ::base64::decode --
+    #
+    #	Base64 decode a given string.
+    #
+    # Arguments:
+    #	string	The string to decode.  Characters not in the base64
+    #		alphabet are ignored (e.g., newlines)
+    #
+    # Results:
+    #	The decoded value.
+
+    proc ::base64::decode {string} {
+	if {[string length $string] == 0} {return ""}
+
+	set base64 $::base64::base64
+	set output "" ; # Fix for [Bug 821126]
+	set nums {}
+
+	binary scan $string c* X
+	lappend X 61 ;# force a terminator
+	foreach x $X {
+	    set bits [lindex $base64 $x]
+	    if {$bits >= 0} {
+		if {[llength [lappend nums $bits]] == 4} {
+		    foreach {v w z y} $nums break
+		    set a [expr {($v << 2) | ($w >> 4)}]
+		    set b [expr {(($w & 0xF) << 4) | ($z >> 2)}]
+		    set c [expr {(($z & 0x3) << 6) | $y}]
+		    append output [binary format ccc $a $b $c]
+		    set nums {}
+		}
+	    } elseif {$bits == -1} {
+		# = indicates end of data.  Output whatever chars are
+		# left, if any.
+		if {![llength $nums]} break
+		# The encoding algorithm dictates that we can only
+		# have 1 or 2 padding characters.  If x=={}, we must
+		# (*) have 12 bits of input (enough for 1 8-bit
+		# output).  If x!={}, we have 18 bits of input (enough
+		# for 2 8-bit outputs).
+		#
+		# (*) If we don't then the input is broken (bug 2976290).
+
+		foreach {v w z} $nums break
+
+		# Bug 2976290
+		if {$w == {}} {
+		    return -code error "Not enough data to process padding"
+		}
+
+		set a [expr {($v << 2) | (($w & 0x30) >> 4)}]
+		if {$z == {}} {
+		    append output [binary format c $a ]
+		} else {
+		    set b [expr {(($w & 0xF) << 4) | (($z & 0x3C) >> 2)}]
+		    append output [binary format cc $a $b]
+		}
+		break
+	    } else {
+		# RFC 2045 says that line breaks and other characters not part
+		# of the Base64 alphabet must be ignored, and that the decoder
+		# can optionally emit a warning or reject the message.  We opt
+		# not to do so, but to just ignore the character.
+		continue
+	    }
+	}
+	return $output
+    }
+}
+
+# # ## ### ##### ######## ############# #####################
+return
+

src/vendorlib/base64/base64c.tcl

@@ -0,0 +1,19 @@
+# base64c - Copyright (C) 2003 Pat Thoyts <patthoyts@users.sourceforge.net>
+#
+# This package is a place-holder for the critcl enhanced code present in
+# the tcllib base64 module.
+#
+# Normally this code will become part of the tcllibc library.
+#
+
+# @sak notprovided base64c
+package require critcl
+package provide base64c 0.1.0
+
+namespace eval ::base64c {
+    variable base64c_rcsid {$Id: base64c.tcl,v 1.5 2008/03/25 07:15:35 andreas_kupries Exp $}
+
+    critcl::ccode {
+        /* no code required in this file */
+    }
+}

src/vendorlib/base64/pkgIndex.tcl

@@ -0,0 +1,5 @@
+if {![package vsatisfies [package provide Tcl] 8.2]} {return}
+package ifneeded base64   2.5 [list source [file join $dir base64.tcl]]
+package ifneeded uuencode 1.1.5 [list source [file join $dir uuencode.tcl]]
+package ifneeded yencode  1.1.3 [list source [file join $dir yencode.tcl]]
+package ifneeded ascii85  1.0   [list source [file join $dir ascii85.tcl]]

src/vendorlib/base64/uuencode.tcl

@@ -0,0 +1,335 @@
+# uuencode - Copyright (C) 2002 Pat Thoyts <patthoyts@users.sourceforge.net>
+#
+# Provide a Tcl only implementation of uuencode and uudecode.
+#
+# -------------------------------------------------------------------------
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# -------------------------------------------------------------------------
+
+package require Tcl 8.2;                # tcl minimum version
+
+# Try and get some compiled helper package.
+if {[catch {package require tcllibc}]} {
+    catch {package require Trf}
+}
+
+namespace eval ::uuencode {
+    namespace export encode decode uuencode uudecode
+}
+
+proc ::uuencode::Enc {c} {
+    return [format %c [expr {($c != 0) ? (($c & 0x3f) + 0x20) : 0x60}]]
+}
+
+proc ::uuencode::Encode {s} {
+    set r {}
+    binary scan $s c* d
+    foreach {c1 c2 c3} $d {
+        if {$c1 == {}} {set c1 0}
+        if {$c2 == {}} {set c2 0}
+        if {$c3 == {}} {set c3 0}
+        append r [Enc [expr {$c1 >> 2}]]
+        append r [Enc [expr {(($c1 << 4) & 060) | (($c2 >> 4) & 017)}]]
+        append r [Enc [expr {(($c2 << 2) & 074) | (($c3 >> 6) & 003)}]]
+        append r [Enc [expr {($c3 & 077)}]]
+    }
+    return $r
+}
+
+
+proc ::uuencode::Decode {s} {
+    if {[string length $s] == 0} {return ""}
+    set r {}
+    binary scan [pad $s] c* d
+
+    foreach {c0 c1 c2 c3} $d {
+        append r [format %c [expr {((($c0-0x20)&0x3F) << 2) & 0xFF
+                                   | ((($c1-0x20)&0x3F) >> 4) & 0xFF}]]
+        append r [format %c [expr {((($c1-0x20)&0x3F) << 4) & 0xFF
+                                   | ((($c2-0x20)&0x3F) >> 2) & 0xFF}]]
+        append r [format %c [expr {((($c2-0x20)&0x3F) << 6) & 0xFF
+                                   | (($c3-0x20)&0x3F) & 0xFF}]]
+    }
+    return $r
+}
+
+# -------------------------------------------------------------------------
+# C coded version of the Encode/Decode functions for base64c package.
+# -------------------------------------------------------------------------
+if {[package provide critcl] != {}} {
+    namespace eval ::uuencode {
+        critcl::ccode {
+            #include <string.h>
+            static unsigned char Enc(unsigned char c) {
+                return (c != 0) ? ((c & 0x3f) + 0x20) : 0x60;
+            }
+        }
+        critcl::ccommand CEncode {dummy interp objc objv} {
+            Tcl_Obj *inputPtr, *resultPtr;
+            int len, rlen, xtra;
+            unsigned char *input, *p, *r;
+
+            if (objc !=  2) {
+                Tcl_WrongNumArgs(interp, 1, objv, "data");
+                return TCL_ERROR;
+            }
+
+            inputPtr = objv[1];
+            input = Tcl_GetByteArrayFromObj(inputPtr, &len);
+            if ((xtra = (3 - (len % 3))) != 3) {
+                if (Tcl_IsShared(inputPtr))
+                    inputPtr = Tcl_DuplicateObj(inputPtr);
+                input = Tcl_SetByteArrayLength(inputPtr, len + xtra);
+                memset(input + len, 0, xtra);
+                len += xtra;
+            }
+
+            rlen = (len / 3) * 4;
+            resultPtr = Tcl_NewObj();
+            r = Tcl_SetByteArrayLength(resultPtr, rlen);
+            memset(r, 0, rlen);
+
+            for (p = input; p < input + len; p += 3) {
+                char a, b, c;
+                a = *p; b = *(p+1), c = *(p+2);
+                *r++ = Enc(a >> 2);
+                *r++ = Enc(((a << 4) & 060) | ((b >> 4) & 017));
+                *r++ = Enc(((b << 2) & 074) | ((c >> 6) & 003));
+                *r++ = Enc(c & 077);
+            }
+            Tcl_SetObjResult(interp, resultPtr);
+            return TCL_OK;
+        }
+
+        critcl::ccommand CDecode {dummy interp objc objv} {
+            Tcl_Obj *inputPtr, *resultPtr;
+            int len, rlen, xtra;
+            unsigned char *input, *p, *r;
+
+            if (objc !=  2) {
+                Tcl_WrongNumArgs(interp, 1, objv, "data");
+                return TCL_ERROR;
+            }
+
+            /* if input is not mod 4, extend it with nuls */
+            inputPtr = objv[1];
+            input = Tcl_GetByteArrayFromObj(inputPtr, &len);
+            if ((xtra = (4 - (len % 4))) != 4) {
+                if (Tcl_IsShared(inputPtr))
+                    inputPtr = Tcl_DuplicateObj(inputPtr);
+                input = Tcl_SetByteArrayLength(inputPtr, len + xtra);
+                memset(input + len, 0, xtra);
+                len += xtra;
+            }
+
+            /* output will be 1/3 smaller than input and a multiple of 3 */
+            rlen = (len / 4) * 3;
+            resultPtr = Tcl_NewObj();
+            r = Tcl_SetByteArrayLength(resultPtr, rlen);
+            memset(r, 0, rlen);
+
+            for (p = input; p < input + len; p += 4) {
+                char a, b, c, d;
+                a = *p; b = *(p+1), c = *(p+2), d = *(p+3);
+                *r++ = (((a - 0x20) & 0x3f) << 2) | (((b - 0x20) & 0x3f) >> 4);
+                *r++ = (((b - 0x20) & 0x3f) << 4) | (((c - 0x20) & 0x3f) >> 2);
+                *r++ = (((c - 0x20) & 0x3f) << 6) | (((d - 0x20) & 0x3f) );
+            }
+            Tcl_SetObjResult(interp, resultPtr);
+            return TCL_OK;
+        }
+    }
+}
+
+# -------------------------------------------------------------------------
+
+# Description:
+#  Permit more tolerant decoding of invalid input strings by padding to
+#  a multiple of 4 bytes with nulls.
+# Result:
+#  Returns the input string - possibly padded with uuencoded null chars.
+#
+proc ::uuencode::pad {s} {
+    if {[set mod [expr {[string length $s] % 4}]] != 0} {
+        append s [string repeat "`" [expr {4 - $mod}]]
+    }
+    return $s
+}
+
+# -------------------------------------------------------------------------
+
+# If the Trf package is available then we shall use this by default but the
+# Tcllib implementations are always visible if needed (ie: for testing)
+if {[info commands ::uuencode::CDecode] != {}} {
+    # tcllib critcl package
+    interp alias {} ::uuencode::encode {} ::uuencode::CEncode
+    interp alias {} ::uuencode::decode {} ::uuencode::CDecode
+} elseif {[package provide Trf] != {}} {
+    proc ::uuencode::encode {s} {
+        return [::uuencode -mode encode -- $s]
+    }
+    proc ::uuencode::decode {s} {
+        return [::uuencode -mode decode -- [pad $s]]
+    }
+} else {
+    # pure-tcl then
+    interp alias {} ::uuencode::encode {} ::uuencode::Encode
+    interp alias {} ::uuencode::decode {} ::uuencode::Decode
+}
+
+# -------------------------------------------------------------------------
+
+proc ::uuencode::uuencode {args} {
+    array set opts {mode 0644 filename {} name {}}
+    set wrongargs "wrong \# args: should be\
+            \"uuencode ?-name string? ?-mode octal?\
+            (-file filename | ?--? string)\""
+    while {[string match -* [lindex $args 0]]} {
+        switch -glob -- [lindex $args 0] {
+            -f* {
+                if {[llength $args] < 2} {
+                    return -code error $wrongargs
+                }
+                set opts(filename) [lindex $args 1]
+                set args [lreplace $args 0 0]
+            }
+            -m* {
+                if {[llength $args] < 2} {
+                    return -code error $wrongargs
+                }
+                set opts(mode) [lindex $args 1]
+                set args [lreplace $args 0 0]
+            }
+            -n* {
+                if {[llength $args] < 2} {
+                    return -code error $wrongargs
+                }
+                set opts(name) [lindex $args 1]
+                set args [lreplace $args 0 0]
+            }
+            -- {
+                set args [lreplace $args 0 0]
+                break
+            }
+            default {
+                return -code error "bad option [lindex $args 0]:\
+                      must be -file, -mode, or -name"
+            }
+        }
+        set args [lreplace $args 0 0]
+    }
+
+    if {$opts(name) == {}} {
+        set opts(name) $opts(filename)
+    }
+    if {$opts(name) == {}} {
+        set opts(name) "data.dat"
+    }
+
+    if {$opts(filename) != {}} {
+        set f [open $opts(filename) r]
+        fconfigure $f -translation binary
+        set data [read $f]
+        close $f
+    } else {
+        if {[llength $args] != 1} {
+            return -code error $wrongargs
+        }
+        set data [lindex $args 0]
+    }
+
+    set r {}
+    append r [format "begin %o %s" $opts(mode) $opts(name)] "\n"
+    for {set n 0} {$n < [string length $data]} {incr n 45} {
+        set s [string range $data $n [expr {$n + 44}]]
+        append r [Enc [string length $s]]
+        append r [encode $s] "\n"
+    }
+    append r "`\nend"
+    return $r
+}
+
+# -------------------------------------------------------------------------
+# Description:
+#  Perform uudecoding of a file or data. A file may contain more than one
+#  encoded data section so the result is a list where each element is a
+#  three element list of the provided filename, the suggested mode and the
+#  data itself.
+#
+proc ::uuencode::uudecode {args} {
+    array set opts {mode 0644 filename {}}
+    set wrongargs "wrong \# args: should be \"uudecode (-file filename | ?--? string)\""
+    while {[string match -* [lindex $args 0]]} {
+        switch -glob -- [lindex $args 0] {
+            -f* {
+                if {[llength $args] < 2} {
+                    return -code error $wrongargs
+                }
+                set opts(filename) [lindex $args 1]
+                set args [lreplace $args 0 0]
+            }
+            -- {
+                set args [lreplace $args 0 0]
+                break
+            }
+            default {
+                return -code error "bad option [lindex $args 0]:\
+                      must be -file"
+            }
+        }
+        set args [lreplace $args 0 0]
+    }
+
+    if {$opts(filename) != {}} {
+        set f [open $opts(filename) r]
+        set data [read $f]
+        close $f
+    } else {
+        if {[llength $args] != 1} {
+            return -code error $wrongargs
+        }
+        set data [lindex $args 0]
+    }
+
+    set state false
+    set result {}
+
+    foreach {line} [split $data "\n"] {
+        switch -exact -- $state {
+            false {
+                if {[regexp {^begin ([0-7]+) ([^\s]*)} $line \
+                         -> opts(mode) opts(name)]} {
+                    set state true
+                    set r {}
+                }
+            }
+
+            true {
+                if {[string match "end" $line]} {
+                    set state false
+                    lappend result [list $opts(name) $opts(mode) $r]
+                } else {
+                    scan $line %c c
+                    set n [expr {($c - 0x21)}]
+                    append r [string range \
+                                  [decode [string range $line 1 end]] 0 $n]
+                }
+            }
+        }
+    }
+
+    return $result
+}
+
+# -------------------------------------------------------------------------
+
+package provide uuencode 1.1.5
+
+# -------------------------------------------------------------------------
+#
+# Local variables:
+#   mode: tcl
+#   indent-tabs-mode: nil
+# End:
+

src/vendorlib/base64/yencode.tcl

@@ -0,0 +1,307 @@
+# yencode.tcl - Copyright (C) 2002 Pat Thoyts <patthoyts@users.sourceforge.net>
+#
+# Provide a Tcl only implementation of yEnc encoding algorithm
+#
+# -------------------------------------------------------------------------
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# -------------------------------------------------------------------------
+
+# FUTURE: Rework to allow switching between the tcl/critcl implementations.
+
+package require Tcl 8.2;                # tcl minimum version
+catch {package require crc32};          # tcllib 1.1
+catch {package require tcllibc};        # critcl enhancements for tcllib
+
+namespace eval ::yencode {
+    namespace export encode decode yencode ydecode
+}
+
+# -------------------------------------------------------------------------
+
+proc ::yencode::Encode {s} {
+    set r {}
+    binary scan $s c* d
+    foreach {c} $d {
+        set v [expr {($c + 42) % 256}]
+        if {$v == 0x00 || $v == 0x09 || $v == 0x0A
+            || $v == 0x0D || $v == 0x3D} {
+            append r "="
+            set v [expr {($v + 64) % 256}]
+        }
+        append r [format %c $v]
+    }
+    return $r
+}
+
+proc ::yencode::Decode {s} {
+    if {[string length $s] == 0} {return ""}
+    set r {}
+    set esc 0
+    binary scan $s c* d
+    foreach c $d {
+        if {$c == 61 && $esc == 0} {
+            set esc 1
+            continue
+        }
+        set v [expr {($c - 42) % 256}]
+        if {$esc} {
+            set v [expr {($v - 64) % 256}]
+            set esc 0
+        }
+        append r [format %c $v]
+    }
+    return $r
+}
+
+# -------------------------------------------------------------------------
+# C coded versions for critcl built base64c package
+# -------------------------------------------------------------------------
+
+if {[package provide critcl] != {}} {
+    namespace eval ::yencode {
+        critcl::ccode {
+            #include <string.h>
+        }
+        critcl::ccommand CEncode {dummy interp objc objv} {
+            Tcl_Obj *inputPtr, *resultPtr;
+            int len, rlen, xtra;
+            unsigned char *input, *p, *r, v;
+
+            if (objc !=  2) {
+                Tcl_WrongNumArgs(interp, 1, objv, "data");
+                return TCL_ERROR;
+            }
+
+            /* fetch the input data */
+            inputPtr = objv[1];
+            input = Tcl_GetByteArrayFromObj(inputPtr, &len);
+
+            /* calculate the length of the encoded result */
+            rlen = len;
+            for (p = input; p < input + len; p++) {
+                v = (*p + 42) % 256;
+                if (v == 0 || v == 9 || v == 0x0A || v == 0x0D || v == 0x3D)
+                   rlen++;
+            }
+
+            /* allocate the output buffer */
+            resultPtr = Tcl_NewObj();
+            r = Tcl_SetByteArrayLength(resultPtr, rlen);
+
+            /* encode the input */
+            for (p = input; p < input + len; p++) {
+                v = (*p + 42) % 256;
+                if (v == 0 || v == 9 || v == 0x0A || v == 0x0D || v == 0x3D) {
+                    *r++ = '=';
+                    v = (v + 64) % 256;
+                }
+                *r++ = v;
+            }
+            Tcl_SetObjResult(interp, resultPtr);
+            return TCL_OK;
+        }
+
+        critcl::ccommand CDecode {dummy interp objc objv} {
+            Tcl_Obj *inputPtr, *resultPtr;
+            int len, rlen, esc;
+            unsigned char *input, *p, *r, v;
+
+            if (objc !=  2) {
+                Tcl_WrongNumArgs(interp, 1, objv, "data");
+                return TCL_ERROR;
+            }
+
+            /* fetch the input data */
+            inputPtr = objv[1];
+            input = Tcl_GetByteArrayFromObj(inputPtr, &len);
+
+            /* allocate the output buffer */
+            resultPtr = Tcl_NewObj();
+            r = Tcl_SetByteArrayLength(resultPtr, len);
+
+            /* encode the input */
+            for (p = input, esc = 0, rlen = 0; p < input + len; p++) {
+                if (*p == 61 && esc == 0) {
+                    esc = 1;
+                    continue;
+                }
+                v = (*p - 42) % 256;
+                if (esc) {
+                    v = (v - 64) % 256;
+                    esc = 0;
+                }
+                *r++ = v;
+                rlen++;
+            }
+            Tcl_SetByteArrayLength(resultPtr, rlen);
+            Tcl_SetObjResult(interp, resultPtr);
+            return TCL_OK;
+        }
+    }
+}
+
+if {[info commands ::yencode::CEncode] != {}} {
+    interp alias {} ::yencode::encode {} ::yencode::CEncode
+    interp alias {} ::yencode::decode {} ::yencode::CDecode
+} else {
+    interp alias {} ::yencode::encode {} ::yencode::Encode
+    interp alias {} ::yencode::decode {} ::yencode::Decode
+}
+
+# -------------------------------------------------------------------------
+# Description:
+#  Pop the nth element off a list. Used in options processing.
+#
+proc ::yencode::Pop {varname {nth 0}} {
+    upvar $varname args
+    set r [lindex $args $nth]
+    set args [lreplace $args $nth $nth]
+    return $r
+}
+
+# -------------------------------------------------------------------------
+
+proc ::yencode::yencode {args} {
+    array set opts {mode 0644 filename {} name {} line 128 crc32 1}
+    while {[string match -* [lindex $args 0]]} {
+        switch -glob -- [lindex $args 0] {
+            -f* { set opts(filename) [Pop args 1] }
+            -m* { set opts(mode) [Pop args 1] }
+            -n* { set opts(name) [Pop args 1] }
+            -l* { set opts(line) [Pop args 1] }
+            -c* { set opts(crc32) [Pop args 1] }
+            --  { Pop args ; break }
+            default {
+                set options [join [lsort [array names opts]] ", -"]
+                return -code error "bad option [lindex $args 0]:\
+                      must be -$options"
+            }
+        }
+        Pop args
+    }
+
+    if {$opts(name) == {}} {
+        set opts(name) $opts(filename)
+    }
+    if {$opts(name) == {}} {
+        set opts(name) "data.dat"
+    }
+    if {! [string is boolean $opts(crc32)]} {
+        return -code error "bad option -crc32: argument must be true or false"
+    }
+
+    if {$opts(filename) != {}} {
+        set f [open $opts(filename) r]
+        fconfigure $f -translation binary
+        set data [read $f]
+        close $f
+    } else {
+        if {[llength $args] != 1} {
+            return -code error "wrong \# args: should be\
+                  \"yencode ?options? -file name | data\""
+        }
+        set data [lindex $args 0]
+    }
+
+    set opts(size) [string length $data]
+
+    set r {}
+    append r [format "=ybegin line=%d size=%d name=%s" \
+                  $opts(line) $opts(size) $opts(name)] "\n"
+
+    set ndx 0
+    while {$ndx < $opts(size)} {
+        set pln [string range $data $ndx [expr {$ndx + $opts(line) - 1}]]
+        set enc [encode $pln]
+        incr ndx [string length $pln]
+        append r $enc "\r\n"
+    }
+
+    append r [format "=yend size=%d" $ndx]
+    if {$opts(crc32)} {
+        append r " crc32=" [crc::crc32 -format %x $data]
+    }
+    return $r
+}
+
+# -------------------------------------------------------------------------
+# Description:
+#  Perform ydecoding of a file or data. A file may contain more than one
+#  encoded data section so the result is a list where each element is a
+#  three element list of the provided filename, the file size and the
+#  data itself.
+#
+proc ::yencode::ydecode {args} {
+    array set opts {mode 0644 filename {} name default.bin}
+    while {[string match -* [lindex $args 0]]} {
+        switch -glob -- [lindex $args 0] {
+            -f* { set opts(filename) [Pop args 1] }
+            -- { Pop args ; break; }
+            default {
+                set options [join [lsort [array names opts]] ", -"]
+                return -code error "bad option [lindex $args 0]:\
+                      must be -$opts"
+            }
+        }
+        Pop args
+    }
+
+    if {$opts(filename) != {}} {
+        set f [open $opts(filename) r]
+        set data [read $f]
+        close $f
+    } else {
+        if {[llength $args] != 1} {
+            return -code error "wrong \# args: should be\
+                  \"ydecode ?options? -file name | data\""
+        }
+        set data [lindex $args 0]
+    }
+
+    set state false
+    set result {}
+
+    foreach {line} [split $data "\n"] {
+        set line [string trimright $line "\r\n"]
+        switch -exact -- $state {
+            false {
+                if {[string match "=ybegin*" $line]} {
+                    regexp {line=(\d+)} $line -> opts(line)
+                    regexp {size=(\d+)} $line -> opts(size)
+                    regexp {name=(\d+)} $line -> opts(name)
+
+                    if {$opts(name) == {}} {
+                        set opts(name) default.bin
+                    }
+
+                    set state true
+                    set r {}
+                }
+            }
+
+            true {
+                if {[string match "=yend*" $line]} {
+                    set state false
+                    lappend result [list $opts(name) $opts(size) $r]
+                } else {
+                    append r [decode $line]
+                }
+            }
+        }
+    }
+
+    return $result
+}
+
+# -------------------------------------------------------------------------
+
+package provide yencode 1.1.3
+
+# -------------------------------------------------------------------------
+#
+# Local variables:
+#   mode: tcl
+#   indent-tabs-mode: nil
+# End:
+

src/vendorlib/control/ascaller.tcl

@@ -0,0 +1,72 @@
+# ascaller.tcl - 
+#
+#       A few utility procs that manage the evaluation of a command
+#	or a script in the context of a caller, taking care of all 
+#	the ugly details of proper return codes, errorcodes, and
+#	a good stack trace in ::errorInfo as appropriate.
+# -------------------------------------------------------------------------
+#
+# RCS: @(#) $Id: ascaller.tcl,v 1.3 2004/01/15 06:36:12 andreas_kupries Exp $
+
+namespace eval ::control {
+
+    proc CommandAsCaller {cmdVar resultVar {where {}} {codeVar code}} {
+	set x [expr {[string equal "" $where] 
+		? {} : [subst -nobackslashes {\n    ($where)}]}]
+	set script [subst -nobackslashes -nocommands {
+	    set $codeVar [catch {uplevel 1 $$cmdVar} $resultVar]
+	    if {$$codeVar > 1} {
+		return -code $$codeVar $$resultVar
+	    }
+	    if {$$codeVar == 1} {
+		if {[string equal {"uplevel 1 $$cmdVar"} \
+			[lindex [split [set ::errorInfo] \n] end]]} {
+		    set $codeVar [join \
+			    [lrange [split [set ::errorInfo] \n] 0 \
+			    end-[expr {4+[llength [split $$cmdVar \n]]}]] \n]
+		} else {
+		    set $codeVar [join \
+			    [lrange [split [set ::errorInfo] \n] 0 end-1] \n]
+		}
+		return -code error -errorcode [set ::errorCode] \
+			-errorinfo "$$codeVar$x" $$resultVar
+	    }
+	}]
+	return $script
+    }
+
+    proc BodyAsCaller {bodyVar resultVar codeVar {where {}}} {
+	set x [expr {[string equal "" $where]
+		? {} : [subst -nobackslashes -nocommands \
+		{\n    ($where[string map {{    ("uplevel"} {}} \
+		[lindex [split [set ::errorInfo] \n] end]]}]}]
+	set script [subst -nobackslashes -nocommands {
+	    set $codeVar [catch {uplevel 1 $$bodyVar} $resultVar]
+	    if {$$codeVar == 1} {
+		if {[string equal {"uplevel 1 $$bodyVar"} \
+			[lindex [split [set ::errorInfo] \n] end]]} {
+		    set ::errorInfo [join \
+			    [lrange [split [set ::errorInfo] \n] 0 end-2] \n]
+		} 
+		set $codeVar [join \
+			[lrange [split [set ::errorInfo] \n] 0 end-1] \n]
+		return -code error -errorcode [set ::errorCode] \
+			-errorinfo "$$codeVar$x" $$resultVar
+	    }
+	}]
+	return $script
+    }
+
+    proc ErrorInfoAsCaller {find replace} {
+	set info $::errorInfo
+	set i [string last "\n    (\"$find" $info]
+	if {$i == -1} {return $info}
+	set result [string range $info 0 [incr i 6]]	;# keep "\n    (\""
+	append result $replace			;# $find -> $replace
+	incr i [string length $find]
+	set j [string first ) $info [incr i]]	;# keep rest of parenthetical
+	append result [string range $info $i $j]
+        return $result
+    }
+
+}

src/vendorlib/control/assert.tcl

@@ -0,0 +1,91 @@
+# assert.tcl --
+#
+#	The [assert] command of the package "control".
+#
+# RCS: @(#) $Id: assert.tcl,v 1.3 2004/01/15 06:36:12 andreas_kupries Exp $
+
+namespace eval ::control {
+
+    namespace eval assert {
+	namespace export EnabledAssert DisabledAssert
+	variable CallbackCmd [list return -code error]
+
+	namespace import [namespace parent]::no-op
+	rename no-op DisabledAssert
+
+	proc EnabledAssert {expr args} {
+	    variable CallbackCmd
+
+	    set code [catch {uplevel 1 [list expr $expr]} res]
+	    if {$code} {
+		return -code $code $res
+	    }
+	    if {![string is boolean -strict $res]} {
+		return -code error "invalid boolean expression: $expr"
+	    }
+	    if {$res} {return}
+	    if {[llength $args]} {
+		set msg [join $args]
+	    } else {
+		set msg "assertion failed: $expr"
+	    }
+	    # Might want to catch this
+	    namespace eval :: $CallbackCmd [list $msg]
+	}
+
+	proc enabled {args} {
+	    set n [llength $args]
+	    if {$n > 1} {
+		return -code error "wrong # args: should be\
+			\"[lindex [info level 0] 0] ?boolean?\""
+	    }
+	    if {$n} {
+		set val [lindex $args 0]
+		if {![string is boolean -strict $val]} {
+		    return -code error "invalid boolean value: $val"
+		}
+		if {$val} {
+		    [namespace parent]::AssertSwitch Disabled Enabled
+		} else {
+		    [namespace parent]::AssertSwitch Enabled Disabled
+		}
+	    } else {
+		return [string equal [namespace origin EnabledAssert] \
+			[namespace origin [namespace parent]::assert]]
+	    }
+	    return ""
+	}
+
+	proc callback {args} {
+	    set n [llength $args]
+	    if {$n > 1} {
+		return -code error "wrong # args: should be\
+			\"[lindex [info level 0] 0] ?command?\""
+	    }
+	    if {$n} {
+	        return [variable CallbackCmd [lindex $args 0]]
+	    }
+	    variable CallbackCmd
+	    return $CallbackCmd
+	}
+
+    }
+
+    proc AssertSwitch {old new} {
+	if {[string equal [namespace origin assert] \
+		[namespace origin assert::${new}Assert]]} {return}
+	rename assert ${old}Assert
+	rename ${new}Assert assert
+    }
+
+    namespace import assert::DisabledAssert assert::EnabledAssert
+
+    # For indexer
+    proc assert args #
+    rename assert {}
+
+    # Initial default: disabled asserts
+    rename DisabledAssert assert
+
+}
+

src/vendorlib/control/control.tcl

@@ -0,0 +1,24 @@
+# control.tcl --
+#
+#	This is the main package provide script for the package
+#	"control".  It provides commands that govern the flow of
+#	control of a program.
+
+package require Tcl 8.2
+
+namespace eval ::control {
+    namespace export assert control do no-op rswitch
+
+    proc control {command args} {
+	# Need to add error handling here
+	namespace eval [list $command] $args
+    }
+
+    # Set up for auto-loading the commands
+    variable home [file join [pwd] [file dirname [info script]]]
+    if {[lsearch -exact $::auto_path $home] == -1} {
+	lappend ::auto_path $home
+    }
+
+    package provide [namespace tail [namespace current]] 0.1.3
+}

src/vendorlib/control/do.tcl

@@ -0,0 +1,81 @@
+# do.tcl --
+#
+#        Tcl implementation of a "do ... while|until" loop.
+#
+# Originally written for the "Texas Tcl Shootout" programming contest
+# at the 2000 Tcl Conference in Austin/Texas.
+#
+# Copyright (c) 2001 by Reinhard Max <Reinhard.Max@gmx.de>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id: do.tcl,v 1.6 2004/01/15 06:36:12 andreas_kupries Exp $
+#
+namespace eval ::control {
+
+    proc do {body args} {
+
+	#
+	# Implements a "do body while|until test" loop
+	# 
+	# It is almost as fast as builtin "while" command for loops with
+	# more than just a few iterations.
+	#
+
+	set len [llength $args]
+	if {$len !=2 && $len != 0} {
+	    set proc [namespace current]::[lindex [info level 0] 0]
+	    return -code error "wrong # args: should be \"$proc body\" or \"$proc body \[until|while\] test\""
+	}
+	set test 0
+	foreach {whileOrUntil test} $args {
+	    switch -exact -- $whileOrUntil {
+		"while" {}
+		"until" { set test !($test) }
+		default {
+		    return -code error \
+			"bad option \"$whileOrUntil\": must be until, or while"
+		}
+	    }
+	    break
+	}
+
+	# the first invocation of the body
+	set code [catch { uplevel 1 $body } result]
+
+	# decide what to do upon the return code:
+	#
+	#               0 - the body executed successfully
+	#               1 - the body raised an error
+	#               2 - the body invoked [return]
+	#               3 - the body invoked [break]
+	#               4 - the body invoked [continue]
+	# everything else - return and pass on the results
+	#
+	switch -exact -- $code {
+	    0 {}
+	    1 {
+		return -errorinfo [ErrorInfoAsCaller uplevel do]  \
+		    -errorcode $::errorCode -code error $result
+	    }
+	    3 {
+		# FRINK: nocheck
+		return
+	    }
+	    4 {}
+	    default {
+		return -code $code $result
+	    }
+	}
+	# the rest of the loop
+	set code [catch {uplevel 1 [list while $test $body]} result]
+	if {$code == 1} {
+	    return -errorinfo [ErrorInfoAsCaller while do] \
+		-errorcode $::errorCode -code error $result
+	}
+	return -code $code $result
+	
+    }
+
+}

src/vendorlib/control/no-op.tcl

@@ -0,0 +1,14 @@
+# no-op.tcl --
+#
+#	The [no-op] command of the package "control".
+#	It accepts any number of arguments and does nothing.
+#	It returns an empty string.
+#
+# RCS: @(#) $Id: no-op.tcl,v 1.2 2004/01/15 06:36:12 andreas_kupries Exp $
+
+namespace eval ::control {
+
+    proc no-op args {}
+
+}
+

src/vendorlib/control/pkgIndex.tcl

@@ -0,0 +1,2 @@
+if {![package vsatisfies [package provide Tcl] 8.2]} {return}
+package ifneeded control 0.1.3 [list source [file join $dir control.tcl]]

src/vendorlib/control/tclIndex

@@ -0,0 +1,18 @@
+# Tcl autoload index file, version 2.0
+# This file is generated by the "auto_mkindex" command
+# and sourced to set up indexing information for one or
+# more commands.  Typically each line is a command that
+# sets an element in the auto_index array, where the
+# element name is the name of a command and the value is
+# a script that loads the command.
+
+set auto_index(::control::CommandAsCaller) [list source [file join $dir ascaller.tcl]]
+set auto_index(::control::BodyAsCaller) [list source [file join $dir ascaller.tcl]]
+set auto_index(::control::ErrorInfoAsCaller) [list source [file join $dir ascaller.tcl]]
+set auto_index(::control::assert::EnabledAssert) [list source [file join $dir assert.tcl]]
+set auto_index(::control::assert::enabled) [list source [file join $dir assert.tcl]]
+set auto_index(::control::assert::callback) [list source [file join $dir assert.tcl]]
+set auto_index(::control::AssertSwitch) [list source [file join $dir assert.tcl]]
+set auto_index(::control::assert) [list source [file join $dir assert.tcl]]
+set auto_index(::control::do) [list source [file join $dir do.tcl]]
+set auto_index(::control::no-op) [list source [file join $dir no-op.tcl]]

src/vendorlib/debug/caller.tcl

@@ -0,0 +1,97 @@
+## -*- tcl -*-
+# ### ### ### ######### ######### #########
+
+## Utility command for use as debug prefix command to un-mangle snit
+## and TclOO method calls.
+
+# ### ### ### ######### ######### #########
+## Requisites
+
+package require Tcl 8.5
+package require debug
+
+namespace eval ::debug {
+    namespace export caller
+    namespace ensemble create
+}
+
+# ### ### ### ######### ######### #########
+## API & Implementation
+
+proc ::debug::caller {args} {
+    # For snit (type)methods, rework the command line to be more
+    # legible and in line with what the user would expect. To this end
+    # we pull the primary command out of the arguments, be it type or
+    # object, massage the command to match the original (type)method
+    # name, then resort and expand the words to match the call before
+    # the snit got its claws into it.
+
+    set a [lassign [info level -1] m]
+    regsub {.*Snit_} $m {} m
+
+    if {[string match ::oo::Obj*::my $m]} {
+	# TclOO call.
+	set m [uplevel 1 self]
+	return [list $m {*}[Filter $a $args]]
+    }
+    if {$m eq "my"} {
+	# TclOO call.
+	set m [uplevel 1 self]
+	return [list $m {*}[Filter $a $args]]
+    }
+
+    switch -glob -- $m {
+	htypemethod* {
+	    # primary = type, a = type
+	    set a [lassign $a primary]
+	    set m [string map {_ { }} [string range $m 11 end]]
+	}
+	typemethod* {
+	    # primary = type, a = type
+	    set a [lassign $a primary]
+	    set m [string range $m 10 end]
+	}
+	hmethod* {
+	    # primary = self, a = type selfns self win ...
+	    set a [lassign $a _ _ primary _]
+	    set m [string map {_ { }} [string range $m 7 end]]
+	}
+	method* {
+	    # primary = self, a = type selfns self win ...
+	    set a [lassign $a _ _ primary _]
+	    set m [string range $m 6 end]
+	}
+	destructor -
+	constructor {
+	    # primary = self, a = type selfns self win ...
+	    set a [lassign $a _ _ primary _]
+	}
+	typeconstructor {
+	    return [list {*}$a $m]
+	}
+	default {
+	    # Unknown
+	    return [list $m {*}[Filter $a $args]]
+	}
+    }
+    return [list $primary {*}$m {*}[Filter $a $args]]
+}
+
+proc ::debug::Filter {args droplist} {
+    if {[llength $droplist]} {
+	# Replace unwanted arguments with '*'. This is usually done
+	# for arguments which can be large Tcl values. These would
+	# screw up formatting and, to add insult to this injury, also
+	# repeat for each debug output in the same proc, method, etc.
+	foreach i [lsort -integer $droplist] {
+	    set args [lreplace $args $i $i *]
+	}
+    }
+    return $args
+}
+
+# ### ######### ###########################
+## Ready for use
+
+package provide debug::caller 1.1
+return

src/vendorlib/debug/debug.tcl

@@ -0,0 +1,306 @@
+# Debug - a debug narrative logger.
+# -- Colin McCormack / originally Wub server utilities
+#
+# Debugging areas of interest are represented by 'tokens' which have 
+# independantly settable levels of interest (an integer, higher is more detailed)
+#
+# Debug narrative is provided as a tcl script whose value is [subst]ed in the 
+# caller's scope if and only if the current level of interest matches or exceeds
+# the Debug call's level of detail.  This is useful, as one can place arbitrarily
+# complex narrative in code without unnecessarily evaluating it.
+#
+# TODO: potentially different streams for different areas of interest.
+# (currently only stderr is used.  there is some complexity in efficient
+# cross-threaded streams.)
+
+# # ## ### ##### ######## ############# #####################
+## Requisites
+
+package require Tcl 8.5
+
+namespace eval ::debug {
+    namespace export -clear \
+	define on off prefix suffix header trailer \
+	names 2array level setting parray pdict \
+	nl tab hexl
+    namespace ensemble create -subcommands {}
+}
+
+# # ## ### ##### ######## ############# #####################
+## API & Implementation
+
+proc ::debug::noop {args} {}
+
+proc ::debug::debug {tag message {level 1}} {
+    variable detail
+    if {$detail($tag) < $level} {
+	#puts stderr "$tag @@@ $detail($tag) >= $level"
+	return
+    }
+
+    variable prefix
+    variable suffix
+    variable header
+    variable trailer
+    variable fds
+
+    if {[info exists fds($tag)]} {
+	set fd $fds($tag)
+    } else {
+	set fd stderr
+    }
+
+    # Assemble the shown text from the user message and the various
+    # prefixes and suffices (global + per-tag).
+
+    set themessage ""
+    if {[info exists prefix(::)]}   { append themessage $prefix(::)   }
+    if {[info exists prefix($tag)]} { append themessage $prefix($tag) }
+    append themessage $message
+    if {[info exists suffix($tag)]} { append themessage $suffix($tag) }
+    if {[info exists suffix(::)]}   { append themessage $suffix(::)   }
+
+    # Resolve variables references and command invokations embedded
+    # into the message with plain text.
+    set code [catch {
+	set smessage [uplevel 1 [list ::subst -nobackslashes $themessage]]
+	set sheader  [uplevel 1 [list ::subst -nobackslashes $header]]
+	set strailer [uplevel 1 [list ::subst -nobackslashes $trailer]]
+    } __ eo]
+
+    # And dump an internal error if that resolution failed.
+    if {$code} {
+	if {[catch {
+	    set caller [info level -1]
+	}]} { set caller GLOBAL }
+	if {[string length $caller] >= 1000} {
+	    set caller "[string range $caller 0 200]...[string range $caller end-200 end]"
+	}
+	foreach line [split $caller \n] {
+	    puts -nonewline $fd "@@(DebugError from $tag ($eo): $line)"
+	}
+	return
+    }
+
+    # From here we have a good message to show. We only shorten it a
+    # bit if its a bit excessive in size.
+
+    if {[string length $smessage] > 4096} {
+	set head [string range $smessage 0 2048]
+	set tail [string range $smessage end-2048 end]
+	set smessage "${head}...(truncated)...$tail"
+    }
+
+    foreach line [split $smessage \n] {
+	puts $fd "$sheader$tag | $line$strailer"
+    }
+    return
+}
+
+# names - return names of debug tags
+proc ::debug::names {} {
+    variable detail
+    return [lsort [array names detail]]
+}
+
+proc ::debug::2array {} {
+    variable detail
+    set result {}
+    foreach n [lsort [array names detail]] {
+	if {[interp alias {} debug.$n] ne "::debug::noop"} {
+	    lappend result $n $detail($n)
+	} else {
+	    lappend result $n -$detail($n)
+	}
+    }
+    return $result
+}
+
+# level - set level and fd for tag
+proc ::debug::level {tag {level ""} {fd {}}} {
+    variable detail
+    # TODO: Force level >=0.
+    if {$level ne ""} {
+	set detail($tag) $level
+    }
+
+    if {![info exists detail($tag)]} {
+	set detail($tag) 1
+    }
+
+    variable fds
+    if {$fd ne {}} {
+	set fds($tag) $fd
+    }
+
+    return $detail($tag)
+}
+
+proc ::debug::header  {text} { variable header  $text }
+proc ::debug::trailer {text} { variable trailer $text }
+
+proc ::debug::define {tag} {
+    if {[interp alias {} debug.$tag] ne {}} return
+    off $tag
+    return
+}
+
+# Set a prefix/suffix to use for tag.
+# The global (tag-independent) prefix/suffix is adressed through tag '::'.
+# This works because colon (:) is an illegal character for user-specified tags.
+
+proc ::debug::prefix {tag {theprefix {}}} {
+    variable prefix
+    set prefix($tag) $theprefix
+
+    if {[interp alias {} debug.$tag] ne {}} return
+    off $tag
+    return
+}
+
+proc ::debug::suffix {tag {theprefix {}}} {
+    variable suffix
+    set suffix($tag) $theprefix
+
+    if {[interp alias {} debug.$tag] ne {}} return
+    off $tag
+    return
+}
+
+# turn on debugging for tag
+proc ::debug::on {tag {level ""} {fd {}}} {
+    variable active
+    set active($tag) 1
+    level $tag $level $fd
+    interp alias {} debug.$tag {} ::debug::debug $tag
+    return
+}
+
+# turn off debugging for tag
+proc ::debug::off {tag {level ""} {fd {}}} {
+    variable active
+    set active($tag) 1
+    level $tag $level $fd
+    interp alias {} debug.$tag {} ::debug::noop
+    return
+}
+
+proc ::debug::setting {args} {
+    if {[llength $args] == 1} {
+	set args [lindex $args 0]
+    }
+    set fd stderr
+    if {[llength $args] % 2} {
+	set fd   [lindex $args end]
+	set args [lrange $args 0 end-1]
+    }
+    foreach {tag level} $args {
+	if {$level > 0} {
+	    level $tag $level $fd
+	    interp alias {} debug.$tag {} ::debug::debug $tag
+	} else {
+	    level $tag [expr {-$level}] $fd
+	    interp alias {} debug.$tag {} ::debug::noop
+	}
+    }
+    return
+}
+
+# # ## ### ##### ######## ############# #####################
+## Convenience commands.
+# Format arrays and dicts as multi-line message.
+# Insert newlines and tabs.
+
+proc ::debug::nl  {} { return \n }
+proc ::debug::tab {} { return \t }
+
+proc ::debug::parray {a {pattern *}} {
+    upvar 1 $a array
+    if {![array exists array]} {
+	error "\"$a\" isn't an array"
+    }
+    pdict [array get array] $pattern
+}
+
+proc ::debug::pdict {dict {pattern *}} {
+    set maxl 0
+    set names [lsort -dict [dict keys $dict $pattern]]
+    foreach name $names {
+	if {[string length $name] > $maxl} {
+	    set maxl [string length $name]
+	}
+    }
+    set maxl [expr {$maxl + 2}]
+    set lines {}
+    foreach name $names {
+	set nameString [format (%s) $name]
+	lappend lines [format "%-*s = %s" \
+			   $maxl $nameString \
+			   [dict get $dict $name]]
+    }
+    return [join $lines \n]
+}
+
+proc ::debug::hexl {data {prefix {}}} {
+    set r {}
+
+    # Convert the data to hex and to characters.
+    binary scan $data H*@0a* hexa asciia
+
+    # Replace non-printing characters in the data with dots.
+    regsub -all -- {[^[:graph:] ]} $asciia {.} asciia
+
+    # Pad with spaces to a full multiple of 32/16.
+    set n [expr {[string length $hexa] % 32}]
+    if {$n < 32} { append hexa   [string repeat { } [expr {32-$n}]] }
+    #puts "pad H [expr {32-$n}]"
+
+    set n [expr {[string length $asciia] % 32}]
+    if {$n < 16} { append asciia [string repeat { } [expr {16-$n}]] }
+    #puts "pad A [expr {32-$n}]"
+
+    # Reassemble formatted, in groups of 16 bytes/characters.
+    # The hex part is handled in groups of 32 nibbles.
+    set addr 0
+    while {[string length $hexa]} {
+	# Get front group of 16 bytes each.
+	set hex    [string range $hexa   0 31]
+	set ascii  [string range $asciia 0 15]
+	# Prep for next iteration
+	set hexa   [string range $hexa   32 end]  
+	set asciia [string range $asciia 16 end]
+
+	# Convert the hex to pairs of hex digits
+	regsub -all -- {..} $hex {& } hex
+
+	# Add the hex and latin-1 data to the result buffer
+	append r $prefix [format %04x $addr] { | } $hex { |} $ascii |\n
+	incr addr 16
+    }
+
+    # And done
+    return $r
+}
+
+# # ## ### ##### ######## ############# #####################
+
+namespace eval debug {
+    variable detail     ; # map: TAG -> level of interest
+    variable prefix     ; # map: TAG -> message prefix to use
+    variable suffix     ; # map: TAG -> message suffix to use
+    variable fds        ; # map: TAG -> handle of open channel to log to.
+    variable header  {} ; # per-line heading, subst'ed
+    variable trailer {} ; # per-line ending, subst'ed
+
+    # Notes:
+    # - The tag '::' is reserved. "prefix" and "suffix" use it to store
+    #   the global message prefix / suffix.
+    # - prefix and suffix are applied per message.
+    # - header and trailer are per line. And should not generate multiple lines!
+}
+
+# # ## ### ##### ######## ############# #####################
+## Ready
+
+package provide debug 1.0.6
+return

src/vendorlib/debug/heartbeat.tcl

@@ -0,0 +1,68 @@
+# -*- tcl -*
+# Debug -- Heartbeat. Track operation of Tcl's eventloop.
+# -- Colin McCormack / originally Wub server utilities
+
+# # ## ### ##### ######## ############# #####################
+## Requisites
+
+package require Tcl 8.5
+package require debug
+
+namespace eval ::debug {
+    namespace export heartbeat
+    namespace ensemble create
+}
+
+# # ## ### ##### ######## ############# #####################
+## API & Implementation
+
+proc ::debug::heartbeat {{delta 500}} {
+    variable duration $delta
+    variable timer
+
+    if {$duration > 0} {
+	# stop a previous heartbeat before starting the next
+	catch { after cancel $timer }
+	on heartbeat
+	::debug::every $duration {
+	    debug.heartbeat {[::debug::pulse]}
+	}
+    } else {
+	catch { after cancel $timer }
+	off heartbeat
+    }
+}
+
+proc ::debug::every {ms body} {
+    eval $body
+    variable timer [after $ms [info level 0]]
+    return
+}
+
+proc ::debug::pulse {} {
+    variable duration
+    variable hbtimer
+    variable heartbeat
+
+    set now  [::tcl::clock::milliseconds]
+    set diff [expr {$now - $hbtimer - $duration}]
+
+    set hbtimer $now
+
+    return [list [incr heartbeat] $diff]
+}
+
+# # ## ### ##### ######## ############# #####################
+
+namespace eval ::debug {
+    variable duration  0 ; # milliseconds between heart-beats
+    variable heartbeat 0 ; # beat counter
+    variable hbtimer   [::tcl::clock::milliseconds]
+    variable timer
+}
+
+# # ## ### ##### ######## ############# #####################
+## Ready
+
+package provide debug::heartbeat 1.0.1
+return

src/vendorlib/debug/pkgIndex.tcl

@@ -0,0 +1,5 @@
+if {![package vsatisfies [package require Tcl] 8.5]} return
+package ifneeded debug            1.0.6 [list source [file join $dir debug.tcl]]
+package ifneeded debug::heartbeat 1.0.1 [list source [file join $dir heartbeat.tcl]]
+package ifneeded debug::timestamp 1     [list source [file join $dir timestamp.tcl]]
+package ifneeded debug::caller    1.1   [list source [file join $dir caller.tcl]]

src/vendorlib/debug/timestamp.tcl

@@ -0,0 +1,47 @@
+# -*- tcl -*
+# Debug -- Timestamps.
+# -- Colin McCormack / originally Wub server utilities
+#
+# Generate timestamps for debug messages.
+# The provided commands are for use in prefixes and headers.
+
+# # ## ### ##### ######## ############# #####################
+## Requisites
+
+package require Tcl 8.5
+package require debug
+
+namespace eval ::debug {
+    namespace export timestamp
+    namespace ensemble create
+}
+
+# # ## ### ##### ######## ############# #####################
+## API & Implementation
+
+proc ::debug::timestamp {} {
+    variable timestamp::delta
+    variable timestamp::baseline
+
+    set now [::tcl::clock::milliseconds]
+    if {$delta} {
+	set time "${now}-[expr {$now - $delta}]mS "
+    } else {
+	set time "${now}mS "
+    }
+    set delta $now
+    return $time
+}
+
+# # ## ### ##### ######## ############# #####################
+
+namespace eval ::debug::timestamp {
+    variable delta    0
+    variable baseline [::tcl::clock::milliseconds]
+}
+
+# # ## ### ##### ######## ############# #####################
+## Ready
+
+package provide debug::timestamp 1
+return

src/vendorlib/term/ansi/code.tcl

@@ -0,0 +1,56 @@
+# -*- tcl -*-
+# ### ### ### ######### ######### #########
+## Terminal packages - ANSI
+## Generic commands to define commands for code sequences.
+
+# ### ### ### ######### ######### #########
+## Requirements
+
+namespace eval ::term::ansi::code {}
+
+# ### ### ### ######### ######### #########
+## API. Escape clauses, plain and bracket
+##      Used by 'define'd commands.
+
+proc ::term::ansi::code::esc  {str} {return \033$str}
+proc ::term::ansi::code::escb {str} {esc    \[$str}
+
+# ### ### ### ######### ######### #########
+## API. Define command for named control code, or constant.
+##      (Simple definitions without arguments)
+
+proc ::term::ansi::code::define {name escape code} {
+    proc [Qualified $name] {} [list ::term::ansi::code::$escape $code]
+}
+
+proc ::term::ansi::code::const {name code} {
+    proc [Qualified $name] {} [list return $code]
+}
+
+# ### ### ### ######### ######### #########
+## Internal helper to construct fully-qualified names.
+
+proc ::term::ansi::code::Qualified {name} {
+    if {![string match ::* $name]} {
+        # Get the caller's namespace; append :: if it is not the
+	# global namespace, for separation from the actual name.
+        set ns [uplevel 2 [list namespace current]]
+        if {$ns ne "::"} {append ns ::}
+        set name $ns$name
+    }
+    return $name
+}
+
+# ### ### ### ######### ######### #########
+
+namespace eval ::term::ansi::code {
+    namespace export esc escb define const
+}
+
+# ### ### ### ######### ######### #########
+## Ready
+
+package provide term::ansi::code 0.2
+
+##
+# ### ### ### ######### ######### #########

src/vendorlib/term/ansi/code/attr.tcl

@@ -0,0 +1,108 @@
+# -*- tcl -*-
+# ### ### ### ######### ######### #########
+## Terminal packages - ANSI - Attribute codes
+
+# ### ### ### ######### ######### #########
+## Requirements
+
+package require  term::ansi::code ; # Constants
+
+namespace eval ::term::ansi::code::attr {}
+
+# ### ### ### ######### ######### #########
+## API. Symbolic names.
+
+proc ::term::ansi::code::attr::names {} {
+    variable attr
+    return  $attr
+}
+
+proc ::term::ansi::code::attr::import {{ns attr} args} {
+    if {![llength $args]} {set args *}
+    set args ::term::ansi::code::attr::[join $args " ::term::ansi::code::attr::"]
+    uplevel 1 [list namespace eval ${ns} [linsert $args 0 namespace import]]
+    return
+}
+
+# ### ### ### ######### ######### #########
+## Internal - Setup
+
+proc ::term::ansi::code::attr::DEF {name value} {
+    variable  attr
+    const            $name $value
+    lappend   attr   $name
+    namespace export $name
+    return
+}
+
+proc ::term::ansi::code::attr::INIT {} {
+    # ### ### ### ######### ######### #########
+    ##
+
+    # Colors. Foreground <=> Text
+    DEF	fgblack   30	; # Black
+    DEF	fgred     31	; # Red
+    DEF	fggreen   32	; # Green
+    DEF	fgyellow  33	; # Yellow
+    DEF	fgblue    34	; # Blue
+    DEF	fgmagenta 35	; # Magenta
+    DEF	fgcyan    36	; # Cyan
+    DEF	fgwhite   37	; # White
+    DEF	fgdefault 39    ; # Default (Black)
+
+    # Colors. Background.
+    DEF	bgblack   40	; # Black
+    DEF	bgred     41	; # Red
+    DEF	bggreen   42	; # Green
+    DEF	bgyellow  43	; # Yellow
+    DEF	bgblue    44	; # Blue
+    DEF	bgmagenta 45	; # Magenta
+    DEF	bgcyan    46	; # Cyan
+    DEF	bgwhite   47	; # White
+    DEF	bgdefault 49    ; # Default (Transparent)
+
+    # Non-color attributes. Activation.
+    DEF	bold      1	; # Bold
+    DEF	dim       2	; # Dim
+    DEF	italic    3     ; # Italics
+    DEF	underline 4	; # Underscore
+    DEF	blink     5	; # Blink
+    DEF	revers    7	; # Reverse
+    DEF	hidden    8	; # Hidden
+    DEF	strike    9     ; # StrikeThrough
+
+    # Non-color attributes. Deactivation.
+    DEF	nobold      22	; # Bold
+    DEF	nodim       __	; # Dim
+    DEF	noitalic    23  ; # Italics
+    DEF	nounderline 24	; # Underscore
+    DEF	noblink     25	; # Blink
+    DEF	norevers    27	; # Reverse
+    DEF	nohidden    28	; # Hidden
+    DEF	nostrike    29  ; # StrikeThrough
+
+    # Remainder
+    DEF	reset       0   ; # Reset
+
+    ##
+    # ### ### ### ######### ######### #########
+    return
+}
+
+# ### ### ### ######### ######### #########
+## Data structures.
+
+namespace eval ::term::ansi::code::attr {
+    namespace import ::term::ansi::code::const
+    variable attr {}
+}
+
+::term::ansi::code::attr::INIT
+
+# ### ### ### ######### ######### #########
+## Ready
+
+package provide term::ansi::code::attr 0.1
+
+##
+# ### ### ### ######### ######### #########

src/vendorlib/term/ansi/code/ctrl.tcl

@@ -0,0 +1,272 @@
+# -*- tcl -*-
+# ### ### ### ######### ######### #########
+## Terminal packages - ANSI - Control codes
+
+## References
+# [0] Google: ansi terminal control
+# [1] http://vt100.net/docs/vt100-ug/chapter3.html
+# [2] http://www.termsys.demon.co.uk/vtansi.htm
+# [3] http://rrbrandt.dyndns.org:60000/docs/tut/redes/ansi.php
+# [4] http://www.dee.ufcg.edu.br/~rrbrandt/tools/ansi.html
+# [5] http://www.ecma-international.org/publications/standards/Ecma-048.htm
+
+# ### ### ### ######### ######### #########
+## Requirements
+
+package require  term::ansi::code
+package require  term::ansi::code::attr
+
+namespace eval ::term::ansi::code::ctrl {}
+
+# ### ### ### ######### ######### #########
+## API. Symbolic names.
+
+proc ::term::ansi::code::ctrl::names {} {
+    variable ctrl
+    return  $ctrl
+}
+
+proc ::term::ansi::code::ctrl::import {{ns ctrl} args} {
+    if {![llength $args]} {set args *}
+    set args ::term::ansi::code::ctrl::[join $args " ::term::ansi::code::ctrl::"]
+    uplevel 1 [list namespace eval $ns [linsert $args 0 namespace import]]
+    return
+}
+
+# ### ### ### ######### ######### #########
+
+## TODO = symbolic key codes for skd.
+
+# ### ### ### ######### ######### #########
+## Internal - Setup
+
+proc ::term::ansi::code::ctrl::DEF {name esc value} {
+    variable  ctrl
+    define           $name $esc $value
+    lappend   ctrl   $name
+    namespace export $name
+    return
+}
+
+proc ::term::ansi::code::ctrl::DEFC {name arguments script} {
+    variable  ctrl
+    proc             $name $arguments $script
+    lappend   ctrl   $name
+    namespace export $name
+    return
+}
+
+proc ::term::ansi::code::ctrl::INIT {} {
+    # ### ### ### ######### ######### #########
+    ##
+
+    # Erasing
+
+    DEF	eeol    escb K  ; # Erase (to) End Of Line
+    DEF	esol    escb 1K ; # Erase (to) Start Of Line
+    DEF	el      escb 2K ; # Erase (current) Line
+    DEF	ed      escb J  ; # Erase Down (to bottom)
+    DEF	eu      escb 1J ; # Erase Up (to top)
+    DEF	es      escb 2J ; # Erase Screen
+
+    # Scrolling
+
+    DEF	sd      esc D    ; # Scroll Down
+    DEF	su      esc M    ; # Scroll Up
+
+    # Cursor Handling
+
+    DEF	ch      escb H  ; # Cursor Home
+    DEF	sc      escb s  ; # Save Cursor
+    DEF	rc      escb u  ; # Restore Cursor (Unsave)
+    DEF	sca     esc  7  ; # Save Cursor + Attributes
+    DEF	rca     esc  8  ; # Restore Cursor + Attributes
+
+    # Tabbing
+
+    DEF	st      esc  H  ; # Set Tab (@ current position)
+    DEF	ct      escb g  ; # Clear Tab (@ current position)
+    DEF	cat     escb 3g ; # Clear All Tabs
+
+    # Device Introspection
+
+    DEF	qdc     escb c  ; # Query Device Code
+    DEF	qds     escb 5n ; # Query Device Status
+    DEF	qcp     escb 6n ; # Query Cursor Position
+    DEF	rd      esc  c  ; # Reset Device
+
+    # Linewrap on/off
+
+    DEF	elw     escb 7h ; # Enable Line Wrap
+    DEF	dlw     escb 7l ; # Disable Line Wrap
+
+    # Graphics Mode (aka use alternate font on/off)
+
+    DEF eg      esc F   ; # Enter Graphics Mode
+    DEF lg      esc G   ; # Exit Graphics Mode
+
+    ##
+    # ### ### ### ######### ######### #########
+
+    # ### ### ### ######### ######### #########
+    ## Complex, parameterized codes
+
+    # Select Character Set
+    # Choose which char set is used for default and
+    # alternate font. This does not change whether
+    # default or alternate font are used
+
+    DEFC scs0 {tag} {esc  ($tag}  ; # Set default character set
+    DEFC scs1 {tag} {esc  )$tag}  ; # Set alternate character set
+
+    # tags in A : United Kingdom Set
+    #         B : ASCII Set
+    #         0 : Special Graphics
+    #         1 : Alternate Character ROM Standard Character Set
+    #         2 : Alternate Character ROM Special Graphics
+
+    # Set Display Attributes
+
+    DEFC sda {args} {escb [join $args \;]m}
+
+    # Force Cursor Position (aka Go To)
+
+    DEFC fcp {r c}  {escb ${r}\;${c}f}
+
+    # Cursor Up, Down, Forward, Backward
+
+    DEFC cu {{n 1}} {escb [expr {$n == 1 ? "A" : "${n}A"}]}
+    DEFC cd {{n 1}} {escb [expr {$n == 1 ? "B" : "${n}B"}]}
+    DEFC cf {{n 1}} {escb [expr {$n == 1 ? "C" : "${n}C"}]}
+    DEFC cb {{n 1}} {escb [expr {$n == 1 ? "D" : "${n}D"}]}
+
+    # Scroll Screen (entire display, or between rows start end, inclusive).
+
+    DEFC ss {args} {
+	if {[llength $args] == 0} {return [escb r]}
+	if {[llength $args] == 2} {foreach {s e} $args break ; return [escb ${s};${e}r]}
+	return -code error "wrong\#args"
+    }
+
+    # Set Key Definition
+
+    DEFC skd {code str} {escb $code\;\"$str\"p}
+
+    # Terminal title
+
+    DEFC title {str} {esc \]0\;$str\007}
+
+    # Switch to and from character/box graphics.
+
+    DEFC gron  {} {esc (0}
+    DEFC groff {} {esc (B}
+
+    # Character graphics, box symbols
+    # - 4 corners, 4 t-junctions,
+    #   one 4-way junction, 2 lines
+
+    DEFC tlc   {} {return [gron]l[groff]} ; # Top    Left  Corner
+    DEFC trc   {} {return [gron]k[groff]} ; # Top    Right Corner
+    DEFC brc   {} {return [gron]j[groff]} ; # Bottom Right Corner
+    DEFC blc   {} {return [gron]m[groff]} ; # Bottom Left  Corner
+
+    DEFC ltj   {} {return [gron]t[groff]} ; # Left   T Junction
+    DEFC ttj   {} {return [gron]w[groff]} ; # Top    T Junction
+    DEFC rtj   {} {return [gron]u[groff]} ; # Right  T Junction
+    DEFC btj   {} {return [gron]v[groff]} ; # Bottom T Junction
+
+    DEFC fwj   {} {return [gron]n[groff]} ; # Four-Way Junction
+
+    DEFC hl    {} {return [gron]q[groff]} ; # Horizontal Line
+    DEFC vl    {} {return [gron]x[groff]} ; # Vertical   Line
+
+    # Optimize character graphics. The generator commands above create
+    # way to many superfluous commands shifting into and out of the
+    # graphics mode. The command below removes all shifts which are
+    # not needed. To this end it also knows which characters will look
+    # the same in both modes, to handle strings created outside this
+    # package.
+
+    DEFC groptim {string} {
+	variable grforw
+	variable grback
+	set offon [groff][gron]
+	set onoff [gron][groff]
+	while {![string equal $string [set new [string map \
+		[list $offon {} $onoff {}] [string map \
+		$grback [string map \
+		$grforw $string]]]]]} {
+	    set string $new
+	}
+	return $string
+    }
+
+    ##
+    # ### ### ### ######### ######### #########
+
+    # ### ### ### ######### ######### #########
+    ## Higher level operations
+
+    # Clear screen <=> CursorHome + EraseDown
+    # Init (Fonts): Default ASCII, Alternate Graphics
+    # Show a block of text at a specific location.
+
+    DEFC clear {} {return [ch][ed]}
+    DEFC init  {} {return [scs0 B][scs1 0]}
+
+    DEFC showat {r c text} {
+	if {![string length $text]} {return {}}
+	return [fcp $r $c][sca][join \
+		[split $text \n] \
+		[rca][cd][sca]][rca][cd]
+    }
+
+    ##
+    # ### ### ### ######### ######### #########
+
+    # ### ### ### ######### ######### #########
+    ## Attribute control (single attributes)
+
+    foreach a [::term::ansi::code::attr::names] {
+	DEF sda_$a escb [::term::ansi::code::attr::$a]m
+    }
+
+    ##
+    # ### ### ### ######### ######### #########
+    return
+}
+
+# ### ### ### ######### ######### #########
+## Data structures.
+
+namespace eval ::term::ansi::code::ctrl {
+    namespace import ::term::ansi::code::define
+    namespace import ::term::ansi::code::esc
+    namespace import ::term::ansi::code::escb
+
+    variable grforw
+    variable grback
+    variable _
+
+    foreach _ {
+	! \" # $ % & ' ( ) * + , - . /
+	0 1 2 3 4 5 6 7 8 9 : ; < = >
+	? @ A B C D E F G H I J K L M
+	N O P Q R S T U V W X Y Z [ ^
+	\\ ]
+    } {
+	lappend grforw \016$_ $_\016
+	lappend grback $_\017 \017$_
+    }
+    unset _
+}
+
+::term::ansi::code::ctrl::INIT
+
+# ### ### ### ######### ######### #########
+## Ready
+
+package provide term::ansi::code::ctrl 0.3
+
+##
+# ### ### ### ######### ######### #########

src/vendorlib/term/ansi/code/macros.tcl

@@ -0,0 +1,93 @@
+# -*- tcl -*-
+# ### ### ### ######### ######### #########
+## Terminal packages - ANSI - Higher level macros
+
+# ### ### ### ######### ######### #########
+## Requirements
+
+package require textutil::repeat
+package require textutil::tabify
+package require term::ansi::code::ctrl
+
+namespace eval ::term::ansi::code::macros {}
+
+# ### ### ### ######### ######### #########
+## API. Symbolic names.
+
+proc ::term::ansi::code::macros::import {{ns macros} args} {
+    if {![llength $args]} {set args *}
+    set args ::term::ansi::code::macros::[join $args " ::term::ansi::code::macros::"]
+    uplevel 1 [list namespace eval ${ns} [linsert $args 0 namespace import]]
+    return
+}
+
+# ### ### ### ######### ######### #########
+## Higher level operations
+
+# Format a menu / framed block of text
+
+proc ::term::ansi::code::macros::menu {menu} {
+    # Menu = dict (label => char)
+    array set _ {}
+    set shift 0
+    foreach {label c} $menu {
+	if {[string first $c $label] < 0} {
+	    set shift 1
+	    break
+	}
+    }
+    set max 0
+    foreach {label c} $menu {
+	set pos [string first $c $label]
+	if {$shift || ($pos < 0)} {
+	    set xlabel "$c $label"
+	    set pos 0
+	} else {
+	    set xlabel $label
+	}
+	set len [string length $xlabel]
+	if {$len > $max} {set max $len}
+	set _($label) " [string replace $xlabel $pos $pos \
+		[cd::sda_fgred][cd::sda_bold][string index $xlabel $pos][cd::sda_reset]]"
+    }
+
+    append ms [cd::tlc][textutil::repeat::strRepeat [cd::hl] $max][cd::trc]\n
+    foreach {l c} $menu {append ms $_($l)\n}
+    append ms [cd::blc][textutil::repeat::strRepeat [cd::hl] $max][cd::brc]
+
+    return [cd::groptim $ms]
+}
+
+proc ::term::ansi::code::macros::frame {string} {
+    set lines [split [textutil::tabify::untabify2 $string] \n]
+    set max 0
+    foreach l $lines {
+	if {[set len [string length $l]] > $max} {set max $len}
+    }
+    append fs [cd::tlc][textutil::repeat::strRepeat [cd::hl] $max][cd::trc]\n
+    foreach l $lines {
+	append fs [cd::vl]${l}[textutil::repeat::strRepeat " " [expr {$max-[string length $l]}]][cd::vl]\n
+    }
+    append fs [cd::blc][textutil::repeat::strRepeat [cd::hl] $max][cd::brc]
+    return [cd::groptim $fs]
+}
+
+##
+# ### ### ### ######### ######### #########
+
+# ### ### ### ######### ######### #########
+## Data structures.
+
+namespace eval ::term::ansi::code::macros {
+    term::ansi::code::ctrl::import cd
+
+    namespace export menu frame
+}
+
+# ### ### ### ######### ######### #########
+## Ready
+
+package provide term::ansi::code::macros 0.1
+
+##
+# ### ### ### ######### ######### #########

src/vendorlib/term/ansi/ctrlunix.tcl

@@ -0,0 +1,91 @@
+# -*- tcl -*-
+# ### ### ### ######### ######### #########
+## Terminal packages - ANSI - Control operations
+## (Unix specific implementation).
+
+## This was originally taken from page 11820 (Pure Tcl Console Editor)
+## of the Tcler's Wiki, however page 14693 (Reading a single character
+## ...) is the same in a more self-contained manner.
+
+# ### ### ### ######### ######### #########
+## Requirements
+
+namespace eval ::term::ansi::ctrl::unix {}
+
+# ### ### ### ######### ######### #########
+## Make command easily available
+
+proc ::term::ansi::ctrl::unix::import {{ns ctrl} args} {
+    if {![llength $args]} {set args *}
+    set args ::term::ansi::ctrl::unix::[join $args " ::term::ansi::ctrl::unix::"]
+    uplevel 1 [list namespace eval ${ns} [linsert $args 0 namespace import]]
+    return
+}
+
+# ### ### ### ######### ######### #########
+## API
+
+# We use the <@stdin because stty works out what terminal to work with
+# using standard input on some platforms. On others it prefers
+# /dev/tty instead, but putting in the redirection makes the code more
+# portable
+
+proc ::term::ansi::ctrl::unix::raw {} {
+    variable stty
+    exec $stty raw -echo <@stdin
+    return
+}
+
+proc ::term::ansi::ctrl::unix::cooked {} {
+    variable stty
+    exec $stty -raw echo <@stdin
+    return
+}
+
+proc ::term::ansi::ctrl::unix::columns {} {
+    variable tput
+    return [exec $tput cols <@stdin]
+}
+
+proc ::term::ansi::ctrl::unix::rows {} {
+    variable tput
+    return [exec $tput lines <@stdin]
+}
+
+# ### ### ### ######### ######### #########
+## Package setup
+
+proc ::term::ansi::ctrl::unix::INIT {} {
+    variable tput [auto_execok tput]
+    variable stty [auto_execok stty]
+
+    if {($stty eq "/usr/ucb/stty") &&
+	($::tcl_platform(os) eq "SunOS")} {
+	set stty /usr/bin/stty
+    }
+
+    if {($tput eq "") || ($stty eq "")} {
+	return -code error \
+		"The external requirements for the \
+		use of this package (tput, stty in \
+		\$PATH) are not met."
+    }
+    return
+}
+
+namespace eval ::term::ansi::ctrl::unix {
+    variable tput {}
+    variable stty {}
+
+    namespace export columns rows raw cooked
+}
+
+::term::ansi::ctrl::unix::INIT
+
+# ### ### ### ######### ######### #########
+## Ready
+
+package provide term::ansi::ctrl::unix 0.1.1
+
+##
+# ### ### ### ######### ######### #########

src/vendorlib/term/ansi/send.tcl

@@ -0,0 +1,92 @@
+# -*- tcl -*-
+# ### ### ### ######### ######### #########
+## Terminal packages - ANSI - Control codes
+
+# ### ### ### ######### ######### #########
+## Requirements
+
+package require Tcl 8.4
+package require term::send
+package require term::ansi::code::ctrl
+
+namespace eval ::term::ansi::send {}
+
+# ### ### ### ######### ######### #########
+## Make command easily available
+
+proc ::term::ansi::send::import {{ns send} args} {
+    if {![llength $args]} {set args *}
+    set args ::term::ansi::send::[join $args " ::term::ansi::send::"]
+    uplevel 1 [list namespace eval ${ns} [linsert $args 0 namespace import]]
+    return
+}
+
+# ### ### ### ######### ######### #########
+## Internal - Setup.
+
+proc ::term::ansi::send::ChName {n} {
+    if {![string match *-* $n]} {
+	return ${n}ch
+    }
+    set nl   [split $n -]
+    set stem [lindex       $nl 0]
+    set sfx  [join [lrange $nl 1 end] -]
+    return ${stem}ch-$sfx
+}
+
+proc ::term::ansi::send::Args {n -> arv achv avv} {
+    upvar 1 $arv a $achv ach $avv av
+    set code ::term::ansi::code::ctrl::$n
+    set a   [info args $code]
+    set av  [expr {
+	[llength $a]
+	? " \$[join $a { $}]"
+	: $a
+    }]
+    foreach a1 $a[set a {}] {
+        if {[info default $code $a1 default]} {
+            lappend a [list $a1 $default]
+        } else {
+            lappend a $a1
+        }
+    }
+    set ach [linsert $a 0 ch]
+    return $code
+}
+
+proc ::term::ansi::send::INIT {} {
+    foreach n [::term::ansi::code::ctrl::names] {
+	set nch  [ChName $n]
+	set code [Args $n -> a ach av]
+
+	if {[lindex $a end] eq "args"} {
+	    # An args argument requires more care, and an eval
+	    set av [lrange $av 0 end-1]
+	    if {$av ne {}} {set av " $av"}
+	    set gen "eval \[linsert \$args 0 $code$av\]"
+	    #8.5: (written for clarity): set gen "$code$av {*}\$args"
+	} else {
+	    set gen $code$av
+	}
+
+	proc $n   $a   "wr        \[$gen\]" ; namespace export $n
+	proc $nch $ach "wrch \$ch \[$gen\]" ; namespace export $nch
+    }
+    return
+}
+
+namespace eval ::term::ansi::send {
+    namespace import ::term::send::wr
+    namespace import ::term::send::wrch
+    namespace export wr wrch
+}
+
+::term::ansi::send::INIT
+
+# ### ### ### ######### ######### #########
+## Ready
+
+package provide term::ansi::send 0.2
+
+##
+# ### ### ### ######### ######### #########

src/vendorlib/term/bind.tcl

@@ -0,0 +1,132 @@
+# -*- tcl -*-
+# ### ### ### ######### ######### #########
+## Terminal packages - string -> action mappings
+## (bind objects). For use with 'receive listen'.
+## In essence a DFA with tree structure.
+
+# ### ### ### ######### ######### #########
+## Requirements
+
+package require  snit
+package require  term::receive
+namespace eval ::term::receive::bind {}
+
+# ### ### ### ######### ######### #########
+
+snit::type ::term::receive::bind {
+
+    constructor {{dict {}}} {
+	foreach {str cmd} $dict {Register $str $cmd}
+	return
+    }
+
+    method map {str cmd} {
+	Register $str $cmd
+	return
+    }
+
+    method default {cmd} {
+	set default $cmd
+	return
+    }
+
+    # ### ### ### ######### ######### #########
+    ##
+
+    method listen {{chan stdin}} {
+	#parray dfa
+	::term::receive::listen $self $chan
+	return
+    }
+
+    method unlisten {{chan stdin}} {
+	::term::receive::unlisten $chan
+	return
+    }
+
+    # ### ### ### ######### ######### #########
+    ##
+
+    variable default {}
+    variable state   {}
+
+    method reset {} {
+	set state {}
+	return
+    }
+
+    method next {c} {Next $c ; return}
+    method process {str} {
+	foreach c [split $str {}] {Next $c}
+	return
+    }
+
+    method eof {} {Eof ; return}
+
+    proc Next {c} {
+	upvar 1 dfa dfa state state default default
+	set key [list $state $c]
+
+	#puts -nonewline stderr "('$state' x '$c')"
+
+	if {![info exists dfa($key)]} {
+	    # Unknown sequence. Reset. Restart.
+	    # Run it through the default action.
+
+	    if {$default ne ""} {
+		uplevel #0 [linsert $default end $state$c]
+	    }
+
+	    #puts stderr =\ RESET
+	    set state {}
+	} else {
+	    foreach {what detail} $dfa($key) break
+	    #puts -nonewline stderr "= $what '$detail'"
+	    if {$what eq "t"} {
+		# Incomplete sequence. Next state.
+		set state $detail
+		#puts stderr " goto ('$state')"
+	    } elseif {$what eq "a"} {
+		# Action, then reset.
+		set state {}
+		#puts stderr " run ($detail)"
+		uplevel #0 [linsert $detail end $state$c]
+	    } else {
+		return -code error \
+			"Internal error. Bad DFA."
+	    }
+	}
+	return
+    }
+
+    proc Eof {} {}
+
+    # ### ### ### ######### ######### #########
+    ##
+
+    proc Register {str cmd} {
+	upvar 1 dfa dfa
+	set prefix {}
+	set last   {{} {}}
+	foreach c [split $str {}] {
+	    set key [list $prefix $c]
+	    set next $prefix$c
+	    set dfa($key) [list t $next]
+	    set last $key
+	    set prefix $next
+	}
+	set dfa($last) [list a $cmd]
+    }
+    variable dfa -array {}
+
+    ##
+    # ### ### ### ######### ######### #########
+}
+
+# ### ### ### ######### ######### #########
+## Ready
+
+package provide term::receive::bind 0.1
+
+##
+# ### ### ### ######### ######### #########

src/vendorlib/term/imenu.tcl

@@ -0,0 +1,202 @@
+# -*- tcl -*-
+# ### ### ### ######### ######### #########
+## Terminal packages - string -> action mappings
+## (menu objects). For use with 'receive listen'.
+## In essence a DFA with tree structure.
+
+# ### ### ### ######### ######### #########
+## Requirements
+
+package require snit
+package require textutil::repeat
+package require textutil::tabify
+package require term::ansi::send
+package require term::receive::bind
+package require term::ansi::code::ctrl
+
+namespace eval ::term::receive::menu {}
+
+# ### ### ### ######### ######### #########
+
+snit::type ::term::interact::menu {
+
+    option -in          -default stdin
+    option -out         -default stdout
+    option -column      -default 0
+    option -line        -default 0
+    option -height      -default 25
+    option -actions     -default {}
+    option -hilitleft   -default 0
+    option -hilitright  -default end
+    option -framed      -default 0 -readonly 1
+
+    # ### ### ### ######### ######### #########
+    ##
+
+    constructor {dict args} {
+	$self configurelist $args
+	Save $dict
+
+	install bind using ::term::receive::bind \
+	    ${selfns}::bind $options(-actions)
+
+	$bind map [cd::cu] [mymethod Up]
+	$bind map [cd::cd] [mymethod Down]
+	$bind map \n       [mymethod Select]
+	#$bind default [mymethod DEF]
+
+	return
+    }
+
+    # ### ### ### ######### ######### #########
+    ##
+
+    method interact {} {
+	Show
+	$bind listen   $options(-in)
+	vwait [myvar done]
+	$bind unlisten $options(-in)
+	return $map($done)
+    }
+
+    method done  {} {set done $at ; return}
+    method clear {} {Clear        ; return}
+
+    # ### ### ### ######### ######### #########
+    ##
+
+    component bind
+
+    # ### ### ### ######### ######### #########
+    ##
+
+    variable map -array {}
+    variable header
+    variable labels
+    variable footer
+    variable empty
+
+    proc Save {dict} {
+	upvar 1 header header labels labels footer footer
+	upvar 1 empty empty at at map map top top
+	upvar 1 options(-height) height
+
+	set max 0
+	foreach {l code} $dict {
+	    if {[set len [string length $l]] > $max} {set max $len}
+	}
+
+	set header [cd::groptim [cd::tlc][textutil::repeat::strRepeat [cd::hl] $max][cd::trc]]
+	set footer [cd::groptim [cd::blc][textutil::repeat::strRepeat [cd::hl] $max][cd::brc]]
+
+	set labels {}
+	set at 0
+	foreach {l code} $dict {
+	    set map($at) $code
+	    lappend labels ${l}[textutil::repeat::strRepeat " " [expr {$max-[string length $l]}]]
+	    incr at
+	}
+
+	set h $height
+	if {$h > [llength $labels]} {set h [llength $labels]}
+
+	set eline "  [textutil::repeat::strRepeat {  } $max]"
+	set empty $eline
+	for {set i 0} {$i <= $h} {incr i} {
+	    append empty \n$eline
+	}
+
+	set at  0
+	set top 0
+	return
+    }
+
+    variable top  0
+    variable at   0
+    variable done .
+
+    proc Show {} {
+	upvar 1 header header labels labels footer footer at at
+	upvar 1 options(-in)     in  options(-column) col top top
+	upvar 1 options(-out)    out options(-line)   row
+	upvar 1 options(-height) height options(-framed) framed
+	upvar 1 options(-hilitleft)  left
+	upvar 1 options(-hilitright) right
+
+	set bot [expr {$top + $height - 1}]
+	set fr  [expr {$framed ? [cd::vl] : { }}]
+
+	set text $header\n
+	set i $top
+	foreach l [lrange $labels $top $bot] {
+	    append text $fr
+	    if {$i != $at} {
+		append text $l
+	    } else {
+		append text [string replace $l $left $right \
+			[cd::sda_revers][string range $l $left $right][cd::sda_reset]]
+	    }
+	    append text $fr \n
+	    incr i
+	}
+	append text $footer
+
+	vt::wrch $out [cd::showat $row $col $text]
+	return
+    }
+
+    proc Clear {} {
+	upvar 1 empty         empty options(-column) col
+	upvar 1 options(-out) out   options(-line)   row
+
+	vt::wrch $out [cd::showat $row $col $empty]
+	return
+    }
+
+    # ### ### ### ######### ######### #########
+    ##
+
+    method Up {str} {
+	if {$at == 0} return
+	incr at -1
+	if {$at < $top} {incr top -1}
+	Show
+	return
+    }
+
+    method Down {str} {
+	upvar 0 options(-height) height
+	if {$at == ([llength $labels]-1)} return
+	incr at
+	set bot [expr {$top + $height - 1}]
+	if {$at > $bot} {incr top}
+	Show
+	return
+    }
+
+    method Select {str} {
+	$self done
+	return
+    }
+
+    method DEF {str} {
+	puts stderr "($str)"
+	exit
+    }
+
+    ##
+    # ### ### ### ######### ######### #########
+}
+
+# ### ### ### ######### ######### #########
+## Ready
+
+namespace eval ::term::interact::menu {
+    term::ansi::code::ctrl::import cd
+    term::ansi::send::import       vt
+}
+
+package provide term::interact::menu 0.1
+
+##
+# ### ### ### ######### ######### #########

src/vendorlib/term/ipager.tcl

@@ -0,0 +1,206 @@
+# -*- tcl -*-
+# ### ### ### ######### ######### #########
+## Terminal packages - string -> action mappings
+## (pager objects). For use with 'receive listen'.
+## In essence a DFA with tree structure.
+
+# ### ### ### ######### ######### #########
+## Requirements
+
+package require snit
+package require textutil::repeat
+package require textutil::tabify
+package require term::ansi::send
+package require term::receive::bind
+package require term::ansi::code::ctrl
+
+namespace eval ::term::receive::pager {}
+
+# ### ### ### ######### ######### #########
+
+snit::type ::term::interact::pager {
+
+    option -in      -default stdin
+    option -out     -default stdout
+    option -column  -default 0
+    option -line    -default 0
+    option -height  -default 25
+    option -actions -default {}
+
+    # ### ### ### ######### ######### #########
+    ##
+
+    constructor {str args} {
+	$self configurelist $args
+	Save $str
+
+	install bind using ::term::receive::bind \
+	    ${selfns}::bind $options(-actions)
+
+	$bind map [cd::cu] [mymethod Up]
+	$bind map [cd::cd] [mymethod Down]
+	$bind map \033\[5~ [mymethod PageUp]
+	$bind map \033\[6~ [mymethod PageDown]
+	$bind map \n       [mymethod Done]
+	#$bind default [mymethod DEF]
+
+	return
+    }
+
+    # ### ### ### ######### ######### #########
+    ##
+
+    method interact {} {
+	Show
+	$bind listen   $options(-in)
+	set interacting 1
+	vwait [myvar done]
+	set interacting 0
+	$bind unlisten $options(-in)
+	return
+    }
+
+    method done  {} {set done . ; return}
+    method clear {} {Clear      ; return}
+
+    method text {str} {
+	if {$interacting} {Clear}
+	Save $str
+	if {$interacting} {Show}
+	return
+    }
+
+    # ### ### ### ######### ######### #########
+    ##
+
+    component bind
+
+    # ### ### ### ######### ######### #########
+    ##
+
+    variable header
+    variable text
+    variable footer
+    variable empty
+
+    proc Save {str} {
+	upvar 1 header header text text footer footer maxline maxline
+	upvar 1 options(-height) height empty empty at at
+
+	set lines [split [textutil::tabify::untabify2 $str] \n]
+
+	set max 0
+	foreach l $lines {
+	    if {[set len [string length $l]] > $max} {set max $len}
+	}
+
+	set header [cd::groptim [cd::tlc][textutil::repeat::strRepeat [cd::hl] $max][cd::trc]]
+	set footer [cd::groptim [cd::blc][textutil::repeat::strRepeat [cd::hl] $max][cd::brc]]
+
+	set text {}
+	foreach l $lines {
+	    lappend text [cd::vl]${l}[textutil::repeat::strRepeat " " [expr {$max-[string length $l]}]][cd::vl]
+	}
+
+	set h $height
+	if {$h > [llength $text]} {set h [llength $text]}
+
+	set eline "  [textutil::repeat::strRepeat {  } $max]"
+	set empty $eline
+	for {set i 0} {$i <= $h} {incr i} {
+	    append empty \n$eline
+	}
+
+	set maxline [expr {[llength $text] - $height}]
+	if {$maxline < 0} {set maxline 0}
+	set at 0
+	return
+    }
+
+    variable interacting 0
+    variable at   0
+    variable maxline -1
+    variable done .
+
+    proc Show {} {
+	upvar 1 header header text text footer footer at at
+	upvar 1 options(-in)     in  options(-column) col
+	upvar 1 options(-out)    out options(-line)   row
+	upvar 1 options(-height) height
+
+	set to [expr {$at + $height -1}]
+
+	vt::wrch $out [cd::showat $row $col \
+			   $header\n[join [lrange $text $at $to] \n]\n$footer]
+	return
+    }
+
+    proc Clear {} {
+	upvar 1 empty         empty options(-column) col
+	upvar 1 options(-out) out   options(-line)   row
+
+	vt::wrch $out [cd::showat $row $col $empty]
+	return
+    }
+
+    # ### ### ### ######### ######### #########
+    ##
+
+    method Up {str} {
+	if {$at == 0} return
+	incr at -1
+	Show
+	return
+    }
+
+    method Down {str} {
+	if {$at >= $maxline} return
+	incr at
+	Show
+	return
+    }
+
+    method PageUp {str} {
+	set newat [expr {$at - $options(-height) + 1}]
+	if {$newat < 0} {set newat 0}
+	if {$newat == $at} return
+	set at $newat
+	Show
+	return
+    }
+
+    method PageDown {str} {
+	set newat [expr {$at + $options(-height) - 1}]
+	if {$newat >= $maxline} {set newat $maxline}
+	if {$newat == $at} return
+	set at $newat
+	Show
+	return
+    }
+
+    method Done {str} {
+	$self done
+	return
+    }
+
+    method DEF {str} {
+	puts stderr "($str)"
+	exit
+    }
+
+    ##
+    # ### ### ### ######### ######### #########
+}
+
+# ### ### ### ######### ######### #########
+## Ready
+
+namespace eval ::term::interact::pager {
+    term::ansi::code::ctrl::import cd
+    term::ansi::send::import       vt
+}
+
+package provide term::interact::pager 0.1
+
+##
+# ### ### ### ######### ######### #########

src/vendorlib/term/pkgIndex.tcl

@@ -0,0 +1,13 @@
+if {![package vsatisfies [package provide Tcl] 8.4]} return
+package ifneeded term                     0.1 [list source [file join $dir term.tcl]]
+package ifneeded term::ansi::code         0.2 [list source [file join $dir ansi/code.tcl]]
+package ifneeded term::ansi::code::attr   0.1 [list source [file join $dir ansi/code/attr.tcl]]
+package ifneeded term::ansi::code::ctrl   0.3 [list source [file join $dir ansi/code/ctrl.tcl]]
+package ifneeded term::ansi::code::macros 0.1 [list source [file join $dir ansi/code/macros.tcl]]
+package ifneeded term::ansi::ctrl::unix   0.1.1 [list source [file join $dir ansi/ctrlunix.tcl]]
+package ifneeded term::ansi::send         0.2 [list source [file join $dir ansi/send.tcl]]
+package ifneeded term::interact::menu     0.1 [list source [file join $dir imenu.tcl]]
+package ifneeded term::interact::pager    0.1 [list source [file join $dir ipager.tcl]]
+package ifneeded term::receive            0.1 [list source [file join $dir receive.tcl]]
+package ifneeded term::receive::bind      0.1 [list source [file join $dir bind.tcl]]
+package ifneeded term::send               0.1 [list source [file join $dir send.tcl]]

src/vendorlib/term/receive.tcl

@@ -0,0 +1,60 @@
+# -*- tcl -*-
+# ### ### ### ######### ######### #########
+## Terminal packages - Generic receiver operations
+
+# ### ### ### ######### ######### #########
+## Requirements
+
+namespace eval ::term::receive {}
+
+# ### ### ### ######### ######### #########
+## API. Read character from specific channel,
+##      or default (stdin). Processing of
+##      character sequences.
+
+proc ::term::receive::getch {{chan stdin}} {
+    return [read $chan 1]
+}
+
+proc ::term::receive::listen {cmd {chan stdin}} {
+    fconfigure $chan -blocking 0
+    fileevent  $chan readable \
+	    [list ::term::receive::Foreach $chan $cmd]
+    return
+}
+
+proc ::term::receive::unlisten {{chan stdin}} {
+    fileevent $chan readable {}
+    return
+}
+
+# ### ### ### ######### ######### #########
+## Internals
+
+proc ::term::receive::Foreach {chan cmd} {
+    set string [read $chan]
+    if {[string length $string]} {
+	#puts stderr "F($string)"
+	uplevel #0 [linsert $cmd end process $string]
+    }
+    if {[eof $chan]} {
+	close $chan
+	uplevel #0 [linsert $cmd end eof]
+    }
+    return
+}
+
+# ### ### ### ######### ######### #########
+## Initialization
+
+namespace eval ::term::receive {
+    namespace export getch listen
+}
+
+# ### ### ### ######### ######### #########
+## Ready
+
+package provide term::receive 0.1
+
+##
+# ### ### ### ######### ######### #########

src/vendorlib/term/send.tcl

@@ -0,0 +1,34 @@
+# -*- tcl -*-
+# ### ### ### ######### ######### #########
+## Terminal packages - Generic sender operations
+
+# ### ### ### ######### ######### #########
+## Requirements
+
+namespace eval ::term::send {}
+
+# ### ### ### ######### ######### #########
+## API. Write to channel, or default (stdout)
+
+proc ::term::send::wr {str} {
+    wrch stdout $str
+    return
+}
+
+proc ::term::send::wrch {ch str} {
+    puts -nonewline $ch $str
+    flush           $ch
+    return
+}
+
+namespace eval ::term::send {
+    namespace export wr wrch
+}
+
+# ### ### ### ######### ######### #########
+## Ready
+
+package provide term::send 0.1
+
+##
+# ### ### ### ######### ######### #########

src/vendorlib/term/term.tcl

@@ -0,0 +1,19 @@
+# -*- tcl -*-
+# ### ### ### ######### ######### #########
+## Terminal packages - Main :: Generic operations
+
+# Currently we have no generica at all. We make the package, but it
+# provides nothing for now.
+
+# ### ### ### ######### ######### #########
+## Requirements
+
+namespace eval ::term {}
+
+# ### ### ### ######### ######### #########
+## Ready
+
+package provide term 0.1
+
+##
+# ### ### ### ######### ######### #########

src/vendormodules/cmdline-1.5.2.tm

@@ -0,0 +1,933 @@
+# cmdline.tcl --
+#
+#	This package provides a utility for parsing command line
+#	arguments that are processed by our various applications.
+#	It also includes a utility routine to determine the
+#	application name for use in command line errors.
+#
+# Copyright (c) 1998-2000 by Ajuba Solutions.
+# Copyright (c) 2001-2015 by Andreas Kupries <andreas_kupries@users.sf.net>.
+# Copyright (c) 2003      by David N. Welton  <davidw@dedasys.com>
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+package require Tcl 8.5-
+package provide cmdline 1.5.2
+
+namespace eval ::cmdline {
+    namespace export getArgv0 getopt getKnownOpt getfiles getoptions \
+	    getKnownOptions usage
+}
+
+# ::cmdline::getopt --
+#
+#	The cmdline::getopt works in a fashion like the standard
+#	C based getopt function.  Given an option string and a
+#	pointer to an array or args this command will process the
+#	first argument and return info on how to proceed.
+#
+# Arguments:
+#	argvVar		Name of the argv list that you
+#			want to process.  If options are found the
+#			arg list is modified and the processed arguments
+#			are removed from the start of the list.
+#	optstring	A list of command options that the application
+#			will accept.  If the option ends in ".arg" the
+#			getopt routine will use the next argument as
+#			an argument to the option.  Otherwise the option
+#			is a boolean that is set to 1 if present.
+#	optVar		The variable pointed to by optVar
+#			contains the option that was found (without the
+#			leading '-' and without the .arg extension).
+#	valVar		Upon success, the variable pointed to by valVar
+#			contains the value for the specified option.
+#			This value comes from the command line for .arg
+#			options, otherwise the value is 1.
+#			If getopt fails, the valVar is filled with an
+#			error message.
+#
+# Results:
+# 	The getopt function returns 1 if an option was found, 0 if no more
+# 	options were found, and -1 if an error occurred.
+
+proc ::cmdline::getopt {argvVar optstring optVar valVar} {
+    upvar 1 $argvVar argsList
+    upvar 1 $optVar option
+    upvar 1 $valVar value
+
+    set result [getKnownOpt argsList $optstring option value]
+
+    if {$result < 0} {
+        # Collapse unknown-option error into any-other-error result.
+        set result -1
+    }
+    return $result
+}
+
+# ::cmdline::getKnownOpt --
+#
+#	The cmdline::getKnownOpt works in a fashion like the standard
+#	C based getopt function.  Given an option string and a
+#	pointer to an array or args this command will process the
+#	first argument and return info on how to proceed.
+#
+# Arguments:
+#	argvVar		Name of the argv list that you
+#			want to process.  If options are found the
+#			arg list is modified and the processed arguments
+#			are removed from the start of the list.  Note that
+#			unknown options and the args that follow them are
+#			left in this list.
+#	optstring	A list of command options that the application
+#			will accept.  If the option ends in ".arg" the
+#			getopt routine will use the next argument as
+#			an argument to the option.  Otherwise the option
+#			is a boolean that is set to 1 if present.
+#	optVar		The variable pointed to by optVar
+#			contains the option that was found (without the
+#			leading '-' and without the .arg extension).
+#	valVar		Upon success, the variable pointed to by valVar
+#			contains the value for the specified option.
+#			This value comes from the command line for .arg
+#			options, otherwise the value is 1.
+#			If getopt fails, the valVar is filled with an
+#			error message.
+#
+# Results:
+# 	The getKnownOpt function returns 1 if an option was found,
+#	0 if no more options were found, -1 if an unknown option was
+#	encountered, and -2 if any other error occurred.
+
+proc ::cmdline::getKnownOpt {argvVar optstring optVar valVar} {
+    upvar 1 $argvVar argsList
+    upvar 1 $optVar  option
+    upvar 1 $valVar  value
+
+    # default settings for a normal return
+    set value ""
+    set option ""
+    set result 0
+
+    # check if we're past the end of the args list
+    if {[llength $argsList] != 0} {
+
+	# if we got -- or an option that doesn't begin with -, return (skipping
+	# the --).  otherwise process the option arg.
+	switch -glob -- [set arg [lindex $argsList 0]] {
+	    "--" {
+		set argsList [lrange $argsList 1 end]
+	    }
+	    "--*" -
+	    "-*" {
+		set option [string range $arg 1 end]
+		if {[string equal [string range $option 0 0] "-"]} {
+		    set option [string range $arg 2 end]
+		}
+
+		# support for format: [-]-option=value
+		set idx [string first "=" $option 1]
+		if {$idx != -1} {
+		    set _val   [string range $option [expr {$idx+1}] end]
+		    set option [string range $option 0   [expr {$idx-1}]]
+		}
+
+		if {[lsearch -exact $optstring $option] != -1} {
+		    # Booleans are set to 1 when present
+		    set value 1
+		    set result 1
+		    set argsList [lrange $argsList 1 end]
+		} elseif {[lsearch -exact $optstring "$option.arg"] != -1} {
+		    set result 1
+		    set argsList [lrange $argsList 1 end]
+
+		    if {[info exists _val]} {
+			set value $_val
+		    } elseif {[llength $argsList]} {
+			set value [lindex $argsList 0]
+			set argsList [lrange $argsList 1 end]
+		    } else {
+			set value "Option \"$option\" requires an argument"
+			set result -2
+		    }
+		} else {
+		    # Unknown option.
+		    set value "Illegal option \"-$option\""
+		    set result -1
+		}
+	    }
+	    default {
+		# Skip ahead
+	    }
+	}
+    }
+
+    return $result
+}
+
+# ::cmdline::getoptions --
+#
+#	Process a set of command line options, filling in defaults
+#	for those not specified.  This also generates an error message
+#	that lists the allowed flags if an incorrect flag is specified.
+#
+# Arguments:
+#	argvVar		The name of the argument list, typically argv.
+#			We remove all known options and their args from it.
+#                       In other words, after the call to this command the
+#                       referenced variable contains only the non-options,
+#                       and unknown options.
+#	optlist		A list-of-lists where each element specifies an option
+#			in the form:
+#				(where flag takes no argument)
+#					flag comment
+#
+#				(or where flag takes an argument)
+#					flag default comment
+#
+#			If flag ends in ".arg" then the value is taken from the
+#			command line. Otherwise it is a boolean and appears in
+#			the result if present on the command line. If flag ends
+#			in ".secret", it will not be displayed in the usage.
+#	usage		Text to include in the usage display. Defaults to
+#			"options:"
+#
+# Results
+#	Name value pairs suitable for using with array set.
+#       A modified `argvVar`.
+
+proc ::cmdline::getoptions {argvVar optlist {usage options:}} {
+    upvar 1 $argvVar argv
+
+    set opts [GetOptionDefaults $optlist result]
+
+    set argc [llength $argv]
+    while {[set err [getopt argv $opts opt arg]]} {
+	if {$err < 0} {
+            set result(?) ""
+            break
+	}
+	set result($opt) $arg
+    }
+    if {[info exist result(?)] || [info exists result(help)]} {
+	Error [usage $optlist $usage] USAGE
+    }
+    return [array get result]
+}
+
+# ::cmdline::getKnownOptions --
+#
+#	Process a set of command line options, filling in defaults
+#	for those not specified.  This ignores unknown flags, but generates
+#	an error message that lists the correct usage if a known option
+#	is used incorrectly.
+#
+# Arguments:
+#	argvVar		The name of the argument list, typically argv.  This
+#			We remove all known options and their args from it.
+#                       In other words, after the call to this command the
+#                       referenced variable contains only the non-options,
+#                       and unknown options.
+#	optlist		A list-of-lists where each element specifies an option
+#			in the form:
+#				flag default comment
+#			If flag ends in ".arg" then the value is taken from the
+#			command line. Otherwise it is a boolean and appears in
+#			the result if present on the command line. If flag ends
+#			in ".secret", it will not be displayed in the usage.
+#	usage		Text to include in the usage display. Defaults to
+#			"options:"
+#
+# Results
+#	Name value pairs suitable for using with array set.
+#       A modified `argvVar`.
+
+proc ::cmdline::getKnownOptions {argvVar optlist {usage options:}} {
+    upvar 1 $argvVar argv
+
+    set opts [GetOptionDefaults $optlist result]
+
+    # As we encounter them, keep the unknown options and their
+    # arguments in this list.  Before we return from this procedure,
+    # we'll prepend these args to the argList so that the application
+    # doesn't lose them.
+
+    set unknownOptions [list]
+
+    set argc [llength $argv]
+    while {[set err [getKnownOpt argv $opts opt arg]]} {
+	if {$err == -1} {
+            # Unknown option.
+
+            # Skip over any non-option items that follow it.
+            # For now, add them to the list of unknownOptions.
+            lappend unknownOptions [lindex $argv 0]
+            set argv [lrange $argv 1 end]
+            while {([llength $argv] != 0) \
+                    && ![string match "-*" [lindex $argv 0]]} {
+                lappend unknownOptions [lindex $argv 0]
+                set argv [lrange $argv 1 end]
+            }
+	} elseif {$err == -2} {
+            set result(?) ""
+            break
+        } else {
+            set result($opt) $arg
+        }
+    }
+
+    # Before returning, prepend the any unknown args back onto the
+    # argList so that the application doesn't lose them.
+    set argv [concat $unknownOptions $argv]
+
+    if {[info exist result(?)] || [info exists result(help)]} {
+	Error [usage $optlist $usage] USAGE
+    }
+    return [array get result]
+}
+
+# ::cmdline::GetOptionDefaults --
+#
+#	This internal procedure processes the option list (that was passed to
+#	the getopt or getKnownOpt procedure).  The defaultArray gets an index
+#	for each option in the option list, the value of which is the option's
+#	default value.
+#
+# Arguments:
+#	optlist		A list-of-lists where each element specifies an option
+#			in the form:
+#				flag default comment
+#			If flag ends in ".arg" then the value is taken from the
+#			command line. Otherwise it is a boolean and appears in
+#			the result if present on the command line. If flag ends
+#			in ".secret", it will not be displayed in the usage.
+#	defaultArrayVar	The name of the array in which to put argument defaults.
+#
+# Results
+#	Name value pairs suitable for using with array set.
+
+proc ::cmdline::GetOptionDefaults {optlist defaultArrayVar} {
+    upvar 1 $defaultArrayVar result
+
+    set opts {? help}
+    foreach opt $optlist {
+	set name [lindex $opt 0]
+	if {[regsub -- {\.secret$} $name {} name] == 1} {
+	    # Need to hide this from the usage display and getopt
+	}
+	lappend opts $name
+	if {[regsub -- {\.arg$} $name {} name] == 1} {
+
+	    # Set defaults for those that take values.
+
+	    set default [lindex $opt 1]
+	    set result($name) $default
+	} else {
+	    # The default for booleans is false
+	    set result($name) 0
+	}
+    }
+    return $opts
+}
+
+# ::cmdline::usage --
+#
+#	Generate an error message that lists the allowed flags.
+#
+# Arguments:
+#	optlist		As for cmdline::getoptions
+#	usage		Text to include in the usage display. Defaults to
+#			"options:"
+#
+# Results
+#	A formatted usage message
+
+proc ::cmdline::usage {optlist {usage {options:}}} {
+    set str "[getArgv0] $usage\n"
+    set longest 20
+    set lines {}
+    foreach opt [concat $optlist \
+	     {{- "Forcibly stop option processing"} {help "Print this message"} {? "Print this message"}}] {
+	set name "-[lindex $opt 0]"
+	if {[regsub -- {\.secret$} $name {} name] == 1} {
+	    # Hidden option
+	    continue
+	}
+	if {[regsub -- {\.arg$} $name {} name] == 1} {
+	    append name " value"
+	    set desc "[lindex $opt 2] <[lindex $opt 1]>"
+	} else {
+	    set desc "[lindex $opt 1]"
+	}
+	set n [string length $name]
+	if {$n > $longest} { set longest $n }
+	# max not available before 8.5 - set longest [expr {max($longest, )}]
+	lappend lines $name $desc
+    }
+    foreach {name desc} $lines {
+	append str "[string trimright [format " %-*s %s" $longest $name $desc]]\n"
+    }
+
+    return $str
+}
+
+# ::cmdline::getfiles --
+#
+#	Given a list of file arguments from the command line, compute
+#	the set of valid files.  On windows, file globbing is performed
+#	on each argument.  On Unix, only file existence is tested.  If
+#	a file argument produces no valid files, a warning is optionally
+#	generated.
+#
+#	This code also uses the full path for each file.  If not
+#	given it prepends [pwd] to the filename.  This ensures that
+#	these files will never conflict with files in our zip file.
+#
+# Arguments:
+#	patterns	The file patterns specified by the user.
+#	quiet		If this flag is set, no warnings will be generated.
+#
+# Results:
+#	Returns the list of files that match the input patterns.
+
+proc ::cmdline::getfiles {patterns quiet} {
+    set result {}
+    if {$::tcl_platform(platform) == "windows"} {
+	foreach pattern $patterns {
+	    set pat [file join $pattern]
+	    set files [glob -nocomplain -- $pat]
+	    if {$files == {}} {
+		if {! $quiet} {
+		    puts stdout "warning: no files match \"$pattern\""
+		}
+	    } else {
+		foreach file $files {
+		    lappend result $file
+		}
+	    }
+	}
+    } else {
+	set result $patterns
+    }
+    set files {}
+    foreach file $result {
+	# Make file an absolute path so that we will never conflict
+	# with files that might be contained in our zip file.
+	set fullPath [file join [pwd] $file]
+
+	if {[file isfile $fullPath]} {
+	    lappend files $fullPath
+	} elseif {! $quiet} {
+	    puts stdout "warning: no files match \"$file\""
+	}
+    }
+    return $files
+}
+
+# ::cmdline::getArgv0 --
+#
+#	This command returns the "sanitized" version of argv0.  It will strip
+#	off the leading path and remove the ".bin" extensions that our apps
+#	use because they must be wrapped by a shell script.
+#
+# Arguments:
+#	None.
+#
+# Results:
+#	The application name that can be used in error messages.
+
+proc ::cmdline::getArgv0 {} {
+    global argv0
+
+    set name [file tail $argv0]
+    return [file rootname $name]
+}
+
+##
+# ### ### ### ######### ######### #########
+##
+# Now the typed versions of the above commands.
+##
+# ### ### ### ######### ######### #########
+##
+
+# typedCmdline.tcl --
+#
+#    This package provides a utility for parsing typed command
+#    line arguments that may be processed by various applications.
+#
+# Copyright (c) 2000 by Ross Palmer Mohn.
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id: cmdline.tcl,v 1.28 2011/02/23 17:41:52 andreas_kupries Exp $
+
+namespace eval ::cmdline {
+    namespace export typedGetopt typedGetoptions typedUsage
+
+    # variable cmdline::charclasses --
+    #
+    #    Create regexp list of allowable character classes
+    #    from "string is" error message.
+    #
+    # Results:
+    #    String of character class names separated by "|" characters.
+
+    variable charclasses
+    #checker exclude badKey
+    catch {string is . .} charclasses
+    variable dummy
+    regexp      -- {must be (.+)$} $charclasses dummy charclasses
+    regsub -all -- {, (or )?}      $charclasses {|}   charclasses
+    unset dummy
+}
+
+# ::cmdline::typedGetopt --
+#
+#	The cmdline::typedGetopt works in a fashion like the standard
+#	C based getopt function.  Given an option string and a
+#	pointer to a list of args this command will process the
+#	first argument and return info on how to proceed. In addition,
+#	you may specify a type for the argument to each option.
+#
+# Arguments:
+#	argvVar		Name of the argv list that you want to process.
+#			If options are found, the arg list is modified
+#			and the processed arguments are removed from the
+#			start of the list.
+#
+#	optstring	A list of command options that the application
+#			will accept.  If the option ends in ".xxx", where
+#			xxx is any valid character class to the tcl
+#			command "string is", then typedGetopt routine will
+#			use the next argument as a typed argument to the
+#			option. The argument must match the specified
+#			character classes (e.g. integer, double, boolean,
+#			xdigit, etc.). Alternatively, you may specify
+#			".arg" for an untyped argument.
+#
+#	optVar		Upon success, the variable pointed to by optVar
+#			contains the option that was found (without the
+#			leading '-' and without the .xxx extension).  If
+#			typedGetopt fails the variable is set to the empty
+#			string. SOMETIMES! Different for each -value!
+#
+#	argVar		Upon success, the variable pointed to by argVar
+#			contains the argument for the specified option.
+#			If typedGetopt fails, the variable is filled with
+#			an error message.
+#
+# Argument type syntax:
+#	Option that takes no argument.
+#		foo
+#
+#	Option that takes a typeless argument.
+#		foo.arg
+#
+#	Option that takes a typed argument. Allowable types are all
+#	valid character classes to the tcl command "string is".
+#	Currently must be one of alnum, alpha, ascii, control,
+#	boolean, digit, double, false, graph, integer, lower, print,
+#	punct, space, true, upper, wordchar, or xdigit.
+#		foo.double
+#
+#	Option that takes an argument from a list.
+#		foo.(bar|blat)
+#
+# Argument quantifier syntax:
+#	Option that takes an optional argument.
+#		foo.arg?
+#
+#	Option that takes a list of arguments terminated by "--".
+#		foo.arg+
+#
+#	Option that takes an optional list of arguments terminated by "--".
+#		foo.arg*
+#
+#	Argument quantifiers work on all argument types, so, for
+#	example, the following is a valid option specification.
+#		foo.(bar|blat|blah)?
+#
+# Argument syntax miscellany:
+#	Options may be specified on the command line using a unique,
+#	shortened version of the option name. Given that program foo
+#	has an option list of {bar.alpha blah.arg blat.double},
+#	"foo -b fob" returns an error, but "foo -ba fob"
+#	successfully returns {bar fob}
+#
+# Results:
+#	The typedGetopt function returns one of the following:
+#	 1	a valid option was found
+#	 0	no more options found to process
+#	-1	invalid option
+#	-2	missing argument to a valid option
+#	-3	argument to a valid option does not match type
+#
+# Known Bugs:
+#	When using options which include special glob characters,
+#	you must use the exact option. Abbreviating it can cause
+#	an error in the "cmdline::prefixSearch" procedure.
+
+proc ::cmdline::typedGetopt {argvVar optstring optVar argVar} {
+    variable charclasses
+
+    upvar $argvVar argsList
+
+    upvar $optVar retvar
+    upvar $argVar optarg
+
+    # default settings for a normal return
+    set optarg ""
+    set retvar ""
+    set retval 0
+
+    # check if we're past the end of the args list
+    if {[llength $argsList] != 0} {
+
+        # if we got -- or an option that doesn't begin with -, return (skipping
+        # the --).  otherwise process the option arg.
+        switch -glob -- [set arg [lindex $argsList 0]] {
+            "--" {
+                set argsList [lrange $argsList 1 end]
+            }
+
+            "-*" {
+                # Create list of options without their argument extensions
+
+                set optstr ""
+                foreach str $optstring {
+                    lappend optstr [file rootname $str]
+                }
+
+                set _opt [string range $arg 1 end]
+
+                set i [prefixSearch $optstr [file rootname $_opt]]
+                if {$i != -1} {
+                    set opt [lindex $optstring $i]
+
+                    set quantifier "none"
+                    if {[regexp -- {\.[^.]+([?+*])$} $opt dummy quantifier]} {
+                        set opt [string range $opt 0 end-1]
+                    }
+
+                    if {[string first . $opt] == -1} {
+                        set retval 1
+                        set retvar $opt
+                        set argsList [lrange $argsList 1 end]
+
+                    } elseif {[regexp -- "\\.(arg|$charclasses)\$" $opt dummy charclass]
+                            || [regexp -- {\.\(([^)]+)\)} $opt dummy charclass]} {
+				if {[string equal arg $charclass]} {
+                            set type arg
+			} elseif {[regexp -- "^($charclasses)\$" $charclass]} {
+                            set type class
+                        } else {
+                            set type oneof
+                        }
+
+                        set argsList [lrange $argsList 1 end]
+                        set opt [file rootname $opt]
+
+                        while {1} {
+                            if {[llength $argsList] == 0
+                                    || [string equal "--" [lindex $argsList 0]]} {
+                                if {[string equal "--" [lindex $argsList 0]]} {
+                                    set argsList [lrange $argsList 1 end]
+                                }
+
+                                set oneof ""
+                                if {$type == "arg"} {
+                                    set charclass an
+                                } elseif {$type == "oneof"} {
+                                    set oneof ", one of $charclass"
+                                    set charclass an
+                                }
+
+                                if {$quantifier == "?"} {
+                                    set retval 1
+                                    set retvar $opt
+                                    set optarg ""
+                                } elseif {$quantifier == "+"} {
+                                    set retvar $opt
+                                    if {[llength $optarg] < 1} {
+                                        set retval -2
+                                        set optarg "Option requires at least one $charclass argument$oneof -- $opt"
+                                    } else {
+                                        set retval 1
+                                    }
+                                } elseif {$quantifier == "*"} {
+                                    set retval 1
+                                    set retvar $opt
+                                } else {
+                                    set optarg "Option requires $charclass argument$oneof -- $opt"
+                                    set retvar $opt
+                                    set retval -2
+                                }
+                                set quantifier ""
+                            } elseif {($type == "arg")
+                                    || (($type == "oneof")
+                                    && [string first "|[lindex $argsList 0]|" "|$charclass|"] != -1)
+                                    || (($type == "class")
+                                    && [string is $charclass [lindex $argsList 0]])} {
+                                set retval 1
+                                set retvar $opt
+                                lappend optarg [lindex $argsList 0]
+                                set argsList [lrange $argsList 1 end]
+                            } else {
+                                set oneof ""
+                                if {$type == "arg"} {
+                                    set charclass an
+                                } elseif {$type == "oneof"} {
+                                    set oneof ", one of $charclass"
+                                    set charclass an
+                                }
+                                set optarg "Option requires $charclass argument$oneof -- $opt"
+                                set retvar $opt
+                                set retval -3
+
+                                if {$quantifier == "?"} {
+                                    set retval 1
+                                    set optarg ""
+                                }
+                                set quantifier ""
+                            }
+                             if {![regexp -- {[+*]} $quantifier]} {
+                                break;
+                            }
+                        }
+                    } else {
+                        Error \
+			    "Illegal option type specification: must be one of $charclasses" \
+			    BAD OPTION TYPE
+                    }
+                } else {
+                    set optarg "Illegal option -- $_opt"
+                    set retvar $_opt
+                    set retval -1
+                }
+            }
+	    default {
+		# Skip ahead
+	    }
+        }
+    }
+
+    return $retval
+}
+
+# ::cmdline::typedGetoptions --
+#
+#	Process a set of command line options, filling in defaults
+#	for those not specified. This also generates an error message
+#	that lists the allowed options if an incorrect option is
+#	specified.
+#
+# Arguments:
+#	argvVar		The name of the argument list, typically argv
+#	optlist		A list-of-lists where each element specifies an option
+#			in the form:
+#
+#				option default comment
+#
+#			Options formatting is as described for the optstring
+#			argument of typedGetopt. Default is for optionally
+#			specifying a default value. Comment is for optionally
+#			specifying a comment for the usage display. The
+#			options "--", "-help", and "-?" are automatically included
+#			in optlist.
+#
+# Argument syntax miscellany:
+#	Options formatting and syntax is as described in typedGetopt.
+#	There are two additional suffixes that may be applied when
+#	passing options to typedGetoptions.
+#
+#	You may add ".multi" as a suffix to any option. For options
+#	that take an argument, this means that the option may be used
+#	more than once on the command line and that each additional
+#	argument will be appended to a list, which is then returned
+#	to the application.
+#		foo.double.multi
+#
+#	If a non-argument option is specified as ".multi", it is
+#	toggled on and off for each time it is used on the command
+#	line.
+#		foo.multi
+#
+#	If an option specification does not contain the ".multi"
+#	suffix, it is not an error to use an option more than once.
+#	In this case, the behavior for options with arguments is that
+#	the last argument is the one that will be returned. For
+#	options that do not take arguments, using them more than once
+#	has no additional effect.
+#
+#	Options may also be hidden from the usage display by
+#	appending the suffix ".secret" to any option specification.
+#	Please note that the ".secret" suffix must be the last suffix,
+#	after any argument type specification and ".multi" suffix.
+#		foo.xdigit.multi.secret
+#
+# Results
+#	Name value pairs suitable for using with array set.
+
+proc ::cmdline::typedGetoptions {argvVar optlist {usage options:}} {
+    variable charclasses
+
+    upvar 1 $argvVar argv
+
+    set opts {? help}
+    foreach opt $optlist {
+        set name [lindex $opt 0]
+        if {[regsub -- {\.secret$} $name {} name] == 1} {
+            # Remove this extension before passing to typedGetopt.
+        }
+        if {[regsub -- {\.multi$} $name {} name] == 1} {
+            # Remove this extension before passing to typedGetopt.
+
+            regsub -- {\..*$} $name {} temp
+            set multi($temp) 1
+        }
+        lappend opts $name
+        if {[regsub -- "\\.(arg|$charclasses|\\(.+).?\$" $name {} name] == 1} {
+            # Set defaults for those that take values.
+            # Booleans are set just by being present, or not
+
+            set dflt [lindex $opt 1]
+            if {$dflt != {}} {
+                set defaults($name) $dflt
+            }
+        }
+    }
+    set argc [llength $argv]
+    while {[set err [typedGetopt argv $opts opt arg]]} {
+        if {$err == 1} {
+            if {[info exists result($opt)]
+                    && [info exists multi($opt)]} {
+                # Toggle boolean options or append new arguments
+
+                if {$arg == ""} {
+                    unset result($opt)
+                } else {
+                    set result($opt) "$result($opt) $arg"
+                }
+            } else {
+                set result($opt) "$arg"
+            }
+        } elseif {($err == -1) || ($err == -3)} {
+            Error [typedUsage $optlist $usage] USAGE
+        } elseif {$err == -2 && ![info exists defaults($opt)]} {
+            Error [typedUsage $optlist $usage] USAGE
+        }
+    }
+    if {[info exists result(?)] || [info exists result(help)]} {
+        Error [typedUsage $optlist $usage] USAGE
+    }
+    foreach {opt dflt} [array get defaults] {
+        if {![info exists result($opt)]} {
+            set result($opt) $dflt
+        }
+    }
+    return [array get result]
+}
+
+# ::cmdline::typedUsage --
+#
+#	Generate an error message that lists the allowed flags,
+#	type of argument taken (if any), default value (if any),
+#	and an optional description.
+#
+# Arguments:
+#	optlist		As for cmdline::typedGetoptions
+#
+# Results
+#	A formatted usage message
+
+proc ::cmdline::typedUsage {optlist {usage {options:}}} {
+    variable charclasses
+
+    set str "[getArgv0] $usage\n"
+    set longest 20
+    set lines {}
+    foreach opt [concat $optlist \
+            {{help "Print this message"} {? "Print this message"}}] {
+        set name "-[lindex $opt 0]"
+        if {[regsub -- {\.secret$} $name {} name] == 1} {
+            # Hidden option
+	    continue
+	}
+
+	if {[regsub -- {\.multi$} $name {} name] == 1} {
+	    # Display something about multiple options
+	}
+
+	if {[regexp -- "\\.(arg|$charclasses)\$" $name dummy charclass] ||
+	    [regexp -- {\.\(([^)]+)\)} $opt dummy charclass]
+	} {
+	    regsub -- "\\..+\$" $name {} name
+	    append name " $charclass"
+	    set desc [lindex $opt 2]
+	    set default [lindex $opt 1]
+	    if {$default != ""} {
+		append desc " <$default>"
+	    }
+	} else {
+	    set desc [lindex $opt 1]
+	}
+	lappend accum $name $desc
+	set n [string length $name]
+	if {$n > $longest} { set longest $n }
+	# max not available before 8.5 - set longest [expr {max($longest, [string length $name])}]
+    }
+    foreach {name desc} $accum {
+	append str "[string trimright [format " %-*s %s" $longest $name $desc]]\n"
+    }
+    return $str
+}
+
+# ::cmdline::prefixSearch --
+#
+#	Search a Tcl list for a pattern; searches first for an exact match,
+#	and if that fails, for a unique prefix that matches the pattern
+#	(i.e, first "lsearch -exact", then "lsearch -glob $pattern*"
+#
+# Arguments:
+#	list		list of words
+#	pattern		word to search for
+#
+# Results:
+#	Index of found word is returned. If no exact match or
+#	unique short version is found then -1 is returned.
+
+proc ::cmdline::prefixSearch {list pattern} {
+    # Check for an exact match
+
+    if {[set pos [::lsearch -exact $list $pattern]] > -1} {
+        return $pos
+    }
+
+    # Check for a unique short version
+
+    set slist [lsort $list]
+    if {[set pos [::lsearch -glob $slist $pattern*]] > -1} {
+        # What if there is nothing for the check variable?
+
+        set check [lindex $slist [expr {$pos + 1}]]
+        if {[string first $pattern $check] != 0} {
+            return [::lsearch -exact $list [lindex $slist $pos]]
+        }
+    }
+    return -1
+}
+# ::cmdline::Error --
+#
+#	Internal helper to throw errors with a proper error-code attached.
+#
+# Arguments:
+#	message		text of the error message to throw.
+#	args		additional parts of the error code to use,
+#                       with CMDLINE as basic prefix added by this command.
+#
+# Results:
+#	An error is thrown, always.
+
+proc ::cmdline::Error {message args} {
+    return -code error -errorcode [linsert $args 0 CMDLINE] $message
+}

src/vendormodules/csv-0.9.tm

@@ -0,0 +1,787 @@
+# csv.tcl --
+#
+#	Tcl implementations of CSV reader and writer
+#
+# Copyright (c) 2001      by Jeffrey Hobbs
+# Copyright (c) 2001-2013,2022 by Andreas Kupries <andreas.kupries@gmail.com>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+package require Tcl 8.5
+package provide csv 0.9
+
+namespace eval ::csv {
+    namespace export join joinlist read2matrix read2queue report
+    namespace export split split2matrix split2queue writematrix writequeue
+}
+
+# ::csv::join --
+#
+#	Takes a list of values and generates a string in CSV format.
+#
+# Arguments:
+#	values	A list of the values to join
+#	sepChar	The separator character, defaults to comma
+#	delChar	The delimiter character, defaults to quote
+#	delMode	If set to 'always', values are always surrounded by delChar
+#
+# Results:
+#	A string containing the values in CSV format.
+
+proc ::csv::join {values {sepChar ,} {delChar \"} {delMode auto}} {
+    set out ""
+    set sep {}
+    foreach val $values {
+	if {($delMode eq "always") || [string match "*\[${delChar}$sepChar\r\n\]*" $val]} {
+	    append out $sep${delChar}[string map [list $delChar ${delChar}${delChar}] $val]${delChar}
+	} else {
+	    append out $sep${val}
+	}
+	set sep $sepChar
+    }
+    return $out
+}
+
+# ::csv::joinlist --
+#
+#	Takes a list of lists of values and generates a string in CSV
+#	format. Each item in the list is made into a single CSV
+#	formatted record in the final string, the records being
+#	separated by newlines.
+#
+# Arguments:
+#	values	A list of the lists of the values to join
+#	sepChar	The separator character, defaults to comma
+#	delChar	The delimiter character, defaults to quote
+#	delMode	If set to 'always', values are always surrounded by delChar
+#
+# Results:
+#	A string containing the values in CSV format, the records
+#	separated by newlines.
+
+proc ::csv::joinlist {values {sepChar ,} {delChar \"} {delMode auto}} {
+    set out ""
+    foreach record $values {
+	# note that this is ::csv::join
+	append out "[join $record $sepChar $delChar $delMode]\n"
+    }
+    return $out
+}
+
+# ::csv::joinmatrix --
+#
+#	Takes a matrix object following the API specified for the
+#	struct::matrix package. Each row of the matrix is converted
+#	into a single CSV formatted record in the final string, the
+#	records being separated by newlines.
+#
+# Arguments:
+#	matrix	Matrix object command.
+#	sepChar	The separator character, defaults to comma
+#	delChar	The delimiter character, defaults to quote
+#	delMode	If set to 'always', values are always surrounded by delChar
+#
+# Results:
+#	A string containing the values in CSV format, the records
+#	separated by newlines.
+
+proc ::csv::joinmatrix {matrix {sepChar ,} {delChar \"} {delMode auto}} {
+    return [joinlist [$matrix get rect 0 0 end end] $sepChar $delChar $delMode]
+}
+
+# ::csv::iscomplete --
+#
+#	A predicate checking if the argument is a complete csv record.
+#
+# Arguments
+#	data	The (partial) csv record to check.
+#
+# Results:
+#	A boolean flag indicating the completeness of the data. The
+#	result is true if the data is complete.
+
+proc ::csv::iscomplete {data} {
+    expr {1 - [regexp -all \" $data] % 2}
+}
+
+# ::csv::read2matrix --
+#
+#	A wrapper around "Split2matrix" reading CSV formatted
+#	lines from the specified channel and adding it to the given
+#	matrix.
+#
+# Arguments:
+#	m		The matrix to add the read data too.
+#	chan		The channel to read from.
+#	sepChar		The separator character, defaults to comma
+#	expand		The expansion mode. The default is none
+#
+# Results:
+#	A list of the values in 'line'.
+
+proc ::csv::read2matrix {args} {
+    # FR #481023
+    # See 'split2matrix' for the available expansion modes.
+
+    # Argument syntax:
+    #
+    #2)            chan m
+    #3)            chan m sepChar
+    #3) -alternate chan m
+    #4) -alternate chan m sepChar
+    #4)            chan m sepChar expand
+    #5) -alternate chan m sepChar expand
+
+    set alternate 0
+    set sepChar   ,
+    set expand    none
+
+    switch -exact -- [llength $args] {
+	2 {
+	    foreach {chan m} $args break
+	}
+	3 {
+	    foreach {a b c} $args break
+	    if {[string equal $a "-alternate"]} {
+		set alternate 1
+		set chan      $b
+		set m         $c
+	    } else {
+		set chan    $a
+		set m       $b
+		set sepChar $c
+	    }
+	}
+	4 {
+	    foreach {a b c d} $args break
+	    if {[string equal $a "-alternate"]} {
+		set alternate 1
+		set chan      $b
+		set m         $c
+		set sepChar   $d
+	    } else {
+		set chan    $a
+		set m       $b
+		set sepChar $c
+		set expand  $d
+	    }
+	}
+	5 {
+	    foreach {a b c d e} $args break
+	    if {![string equal $a "-alternate"]} {
+		return -code error "wrong#args: Should be ?-alternate? chan m ?separator? ?expand?"
+	    }
+	    set alternate 1
+
+	    set chan    $b
+	    set m       $c
+	    set sepChar $d
+	    set expand  $e
+	}
+	0 - 1 -
+	default {
+	    return -code error "wrong#args: Should be ?-alternate? chan m ?separator? ?expand?"
+	}
+    }
+
+    if {[string length $sepChar] < 1} {
+	return -code error "illegal separator character \"$sepChar\", is empty"
+    } elseif {[string length $sepChar] > 1} {
+	return -code error "illegal separator character \"$sepChar\", is a string"
+    }
+
+    set data ""
+    while {![eof $chan]} {
+	if {[gets $chan line] < 0} {continue}
+
+	# Why skip empty lines? They may be in data. Except if the
+	# buffer is empty, i.e. we are between records.
+	if {$line == {} && $data == {}} {continue}
+
+       append data $line
+       if {![iscomplete $data]} {
+           # Odd number of quotes - must have embedded newline
+           append data \n
+           continue
+       }
+
+       Split2matrix $alternate $m $data $sepChar $expand
+       set data ""
+    }
+    return
+}
+
+# ::csv::read2queue --
+#
+#	A wrapper around "::csv::split2queue" reading CSV formatted
+#	lines from the specified channel and adding it to the given
+#	queue.
+#
+# Arguments:
+#	q		The queue to add the read data too.
+#	chan		The channel to read from.
+#	sepChar		The separator character, defaults to comma
+#
+# Results:
+#	A list of the values in 'line'.
+
+proc ::csv::read2queue {args} {
+    # Argument syntax:
+    #
+    #2)            chan q
+    #3)            chan q sepChar
+    #3) -alternate chan q
+    #4) -alternate chan q sepChar
+
+    set alternate 0
+    set sepChar   ,
+
+    switch -exact -- [llength $args] {
+	2 {
+	    foreach {chan q} $args break
+	}
+	3 {
+	    foreach {a b c} $args break
+	    if {[string equal $a "-alternate"]} {
+		set alternate 1
+		set chan      $b
+		set q         $c
+	    } else {
+		set chan    $a
+		set q       $b
+		set sepChar $c
+	    }
+	}
+	4 {
+	    foreach {a b c d} $args break
+	    if {![string equal $a "-alternate"]} {
+		return -code error "wrong#args: Should be ?-alternate? chan q ?separator?"
+	    }
+	    set alternate 1
+	    set chan    $b
+	    set q       $c
+	    set sepChar $d
+	}
+	0 - 1 -
+	default {
+	    return -code error "wrong#args: Should be ?-alternate? chan q ?separator?"
+	}
+    }
+
+    if {[string length $sepChar] < 1} {
+	return -code error "illegal separator character \"$sepChar\", is empty"
+    } elseif {[string length $sepChar] > 1} {
+	return -code error "illegal separator character \"$sepChar\", is a string"
+    }
+
+    set data ""
+    while {![eof $chan]} {
+	if {[gets $chan line] < 0} {continue}
+
+	# Why skip empty lines? They may be in data. Except if the
+	# buffer is empty, i.e. we are between records.
+	if {$line == {} && $data == {}} {continue}
+
+	append data $line
+	if {![iscomplete $data]} {
+	    # Odd number of quotes - must have embedded newline
+	    append data \n
+	    continue
+	}
+
+	$q put [Split $alternate $data $sepChar]
+	set data ""
+    }
+    return
+}
+
+# ::csv::report --
+#
+#	A report command which can be used by the matrix methods
+#	"format-via" and "format2chan-via". For the latter this
+#	command delegates the work to "::csv::writematrix". "cmd" is
+#	expected to be either "printmatrix" or
+#	"printmatrix2channel". The channel argument, "chan", has to
+#	be present for the latter and must not be present for the first.
+#
+# Arguments:
+#	cmd		Either 'printmatrix' or 'printmatrix2channel'
+#	matrix		The matrix to format.
+#	args		0 (chan): The channel to write to
+#
+# Results:
+#	None for 'printmatrix2channel', else the CSV formatted string.
+
+proc ::csv::report {cmd matrix args} {
+    switch -exact -- $cmd {
+	printmatrix {
+	    if {[llength $args] > 0} {
+		return -code error "wrong # args:\
+			::csv::report printmatrix matrix"
+	    }
+	    return [joinlist [$matrix get rect 0 0 end end]]
+	}
+	printmatrix2channel {
+	    if {[llength $args] != 1} {
+		return -code error "wrong # args:\
+			::csv::report printmatrix2channel matrix chan"
+	    }
+	    writematrix $matrix [lindex $args 0]
+	    return ""
+	}
+	default {
+	    return -code error "Unknown method $cmd"
+	}
+    }
+}
+
+# ::csv::split --
+#
+#	Split a string according to the rules for CSV processing.
+#	This assumes that the string contains a single line of CSVs
+#
+# Arguments:
+#	line		The string to split
+#	sepChar		The separator character, defaults to comma
+#
+# Results:
+#	A list of the values in 'line'.
+
+proc ::csv::split {args} {
+    # Argument syntax:
+    #
+    # (1)            line
+    # (2)            line sepChar
+    # (2) -alternate line
+    # (3) -alternate line sepChar
+
+    # (3)            line sepChar delChar
+    # (4) -alternate line sepChar delChar
+
+    set alternate 0
+    set sepChar   ,
+    set delChar   \"
+
+    switch -exact -- [llength $args] {
+	1 {
+	    set line [lindex $args 0]
+	}
+	2 {
+	    foreach {a b} $args break
+	    if {[string equal $a "-alternate"]} {
+		set alternate 1
+		set line     $b
+	    } else {
+		set line    $a
+		set sepChar $b
+	    }
+	}
+	3 {
+	    foreach {a b c} $args break
+	    if {[string equal $a "-alternate"]} {
+	        set alternate 1
+		set line    $b
+		set sepChar $c
+	    } else {
+		set line    $a
+		set sepChar $b
+		set delChar $c
+            }
+	}
+	4 {
+	    foreach {a b c d} $args break
+	    if {![string equal $a "-alternate"]} {
+		return -code error "wrong#args: Should be ?-alternate? line ?separator? ?delimiter?"
+	    }
+	    set alternate 1
+	    set line    $b
+	    set sepChar $c
+	    set delChar $d
+	}
+	0 -
+	default {
+	    return -code error "wrong#args: Should be ?-alternate? line ?separator? ?delimiter?"
+	}
+    }
+
+    if {[string length $sepChar] < 1} {
+	return -code error "illegal separator character ${delChar}$sepChar${delChar}, is empty"
+    } elseif {[string length $sepChar] > 1} {
+	return -code error "illegal separator character ${delChar}$sepChar${delChar}, is a string"
+    }
+
+    if {[string length $delChar] < 1} {
+	return -code error "illegal separator character \"$delChar\", is empty"
+    } elseif {[string length $delChar] > 1} {
+	return -code error "illegal separator character \"$delChar\", is a string"
+    }
+
+    return [Split $alternate $line $sepChar $delChar]
+}
+
+proc ::csv::Split {alternate line sepChar {delChar \"}} {
+    # Protect the sepchar from special interpretation by
+    # the regex calls below.
+
+    set sepRE \[\[.${sepChar}.]]
+    set delRE \[\[.${delChar}.]]
+
+    if {$alternate} {
+	# The alternate syntax requires a different parser.
+	# A variation of the string map / regsub parser for the
+	# regular syntax was tried but does not handle embedded
+	# doubled " well (testcase csv-91.3 was 'knownBug', sole
+	# one, still a bug). Now we just tokenize the input into
+	# the primary parts (sep char, "'s and the rest) and then
+	# use an explicitly coded state machine (DFA) to parse
+	# and convert token sequences.
+
+	## puts 1->>$line<<
+	set line [string map [list \
+		$sepChar \0$sepChar\0 \
+		$delChar \0${delChar}\0 \
+		] $line]
+
+	## puts 2->>$line<<
+	set line [string map [list \0\0 \0] $line]
+	regsub "^\0" $line {} line
+	regsub "\0$" $line {} line
+
+	## puts 3->>$line<<
+
+	set val ""
+	set res ""
+	set state base
+
+	## puts 4->>[::split $line \0]
+	foreach token [::split $line \0] {
+
+	    ## puts "\t*= $state\t>>$token<<"
+	    switch -exact -- $state {
+		base {
+		    if {[string equal $token "${delChar}"]} {
+			set state qvalue
+			continue
+		    }
+		    if {[string equal $token $sepChar]} {
+			lappend res $val
+			set val ""
+			continue
+		    }
+		    append val $token
+		}
+		qvalue {
+		    if {[string equal $token "${delChar}"]} {
+			# May end value, may be a doubled "
+			set state endordouble
+			continue
+		    }
+		    append val $token
+		}
+		endordouble {
+		    if {[string equal $token "${delChar}"]} {
+			# Doubled ", append to current value
+			append val ${delChar}
+			set state qvalue
+			continue
+		    }
+		    # Last " was end of quoted value. Close it.
+		    # We expect current as $sepChar
+
+		    lappend res $val
+		    set          val ""
+		    set state base
+
+		    if {[string equal $token $sepChar]} {continue}
+
+		    # Undoubled " in middle of text. Just assume that
+		    # remainder is another qvalue.
+		    set state qvalue
+		}
+		default {
+		    return -code error "Internal error, illegal parsing state"
+		}
+	    }
+	}
+
+	## puts "/= $state\t>>$val<<"
+
+	lappend res $val
+
+	## puts 5->>$res<<
+	return $res
+    } else {
+	regsub -- "$sepRE${delRE}${delRE}$" $line $sepChar\0${delChar}${delChar}\0 line
+	regsub -- "^${delRE}${delRE}$sepRE" $line \0${delChar}${delChar}\0$sepChar line
+	regsub -all -- {(^${delChar}|${delChar}$)} $line \0 line
+
+	set line [string map [list \
+		$sepChar${delChar}${delChar}${delChar} $sepChar\0${delChar} \
+		${delChar}${delChar}${delChar}$sepChar ${delChar}\0$sepChar \
+		${delChar}${delChar}           ${delChar} \
+		${delChar}             \0 \
+		] $line]
+
+	set end 0
+	while {[regexp -indices -start $end -- {(\0)[^\0]*(\0)} $line \
+		-> start end]} {
+	    set start [lindex $start 0]
+	    set end   [lindex $end 0]
+	    set range [string range $line $start $end]
+	    if {[string first $sepChar $range] >= 0} {
+		set line [string replace $line $start $end \
+			[string map [list $sepChar \1] $range]]
+	    }
+	    incr end
+	}
+	set line [string map [list $sepChar \0 \1 $sepChar \0 {} ] $line]
+	return [::split $line \0]
+
+    }
+}
+
+# ::csv::split2matrix --
+#
+#	Split a string according to the rules for CSV processing.
+#	This assumes that the string contains a single line of CSVs.
+#	The resulting list of values is appended to the specified
+#	matrix, as a new row. The code assumes that the matrix provides
+#	the same interface as the queue provided by the 'struct'
+#	module of tcllib, "add row" in particular.
+#
+# Arguments:
+#	m		The matrix to write the resulting list to.
+#	line		The string to split
+#	sepChar		The separator character, defaults to comma
+#	expand		The expansion mode. The default is none
+#
+# Results:
+#	A list of the values in 'line', written to 'q'.
+
+proc ::csv::split2matrix {args} {
+    # FR #481023
+
+    # Argument syntax:
+    #
+    #2)            m line
+    #3)            m line sepChar
+    #3) -alternate m line
+    #4) -alternate m line sepChar
+    #4)            m line sepChar expand
+    #5) -alternate m line sepChar expand
+
+    set alternate 0
+    set sepChar   ,
+    set expand    none
+
+    switch -exact -- [llength $args] {
+	2 {
+	    foreach {m line} $args break
+	}
+	3 {
+	    foreach {a b c} $args break
+	    if {[string equal $a "-alternate"]} {
+		set alternate 1
+		set m         $b
+		set line      $c
+	    } else {
+		set m       $a
+		set line    $b
+		set sepChar $c
+	    }
+	}
+	4 {
+	    foreach {a b c d} $args break
+	    if {[string equal $a "-alternate"]} {
+		set alternate 1
+		set m         $b
+		set line      $c
+		set sepChar   $d
+	    } else {
+		set m       $a
+		set line    $b
+		set sepChar $c
+		set expand  $d
+	    }
+	}
+	4 {
+	    foreach {a b c d e} $args break
+	    if {![string equal $a "-alternate"]} {
+		return -code error "wrong#args: Should be ?-alternate? m line ?separator? ?expand?"
+	    }
+	    set alternate 1
+
+	    set m       $b
+	    set line    $c
+	    set sepChar $d
+	    set expand  $e
+	}
+	0 - 1 -
+	default {
+	    return -code error "wrong#args: Should be ?-alternate? m line ?separator? ?expand?"
+	}
+    }
+
+    if {[string length $sepChar] < 1} {
+	return -code error "illegal separator character \"$sepChar\", is empty"
+    } elseif {[string length $sepChar] > 1} {
+	return -code error "illegal separator character \"$sepChar\", is a string"
+    }
+
+    Split2matrix $alternate $m $line $sepChar $expand
+    return
+}
+
+proc ::csv::Split2matrix {alternate m line sepChar expand} {
+    set csv [Split $alternate $line $sepChar]
+
+    # Expansion modes
+    # - none  : default, behaviour of original implementation.
+    #           no expansion is done, lines are silently truncated
+    #           to the number of columns in the matrix.
+    #
+    # - empty : A matrix without columns is expanded to the number
+    #           of columns in the first line added to it. All
+    #           following lines are handled as if "mode == none"
+    #           was set.
+    #
+    # - auto  : Full auto-mode. The matrix is expanded as needed to
+    #           hold all columns of all lines.
+
+    switch -exact -- $expand {
+	none {}
+	empty {
+	    if {[$m columns] == 0} {
+		$m add columns [llength $csv]
+	    }
+	}
+	auto {
+	    if {[$m columns] < [llength $csv]} {
+		$m add columns [expr {[llength $csv] - [$m columns]}]
+	    }
+	}
+    }
+    $m add row $csv
+    return
+}
+
+# ::csv::split2queue --
+#
+#	Split a string according to the rules for CSV processing.
+#	This assumes that the string contains a single line of CSVs.
+#	The resulting list of values is appended to the specified
+#	queue, as a single item. IOW each item in the queue represents
+#	a single CSV record. The code assumes that the queue provides
+#	the same interface as the queue provided by the 'struct'
+#	module of tcllib, "put" in particular.
+#
+# Arguments:
+#	q		The queue to write the resulting list to.
+#	line		The string to split
+#	sepChar		The separator character, defaults to comma
+#
+# Results:
+#	A list of the values in 'line', written to 'q'.
+
+proc ::csv::split2queue {args} {
+    # Argument syntax:
+    #
+    #2)            q line
+    #3)            q line sepChar
+    #3) -alternate q line
+    #4) -alternate q line sepChar
+
+    set alternate 0
+    set sepChar   ,
+
+    switch -exact -- [llength $args] {
+	2 {
+	    foreach {q line} $args break
+	}
+	3 {
+	    foreach {a b c} $args break
+	    if {[string equal $a "-alternate"]} {
+		set alternate 1
+		set q         $b
+		set line      $c
+	    } else {
+		set q       $a
+		set line    $b
+		set sepChar $c
+	    }
+	}
+	4 {
+	    foreach {a b c d} $args break
+	    if {![string equal $a "-alternate"]} {
+		return -code error "wrong#args: Should be ?-alternate? q line ?separator?"
+	    }
+	    set alternate 1
+
+	    set q       $b
+	    set line    $c
+	    set sepChar $d
+	}
+	0 - 1 -
+	default {
+	    return -code error "wrong#args: Should be ?-alternate? q line ?separator?"
+	}
+    }
+
+    if {[string length $sepChar] < 1} {
+	return -code error "illegal separator character \"$sepChar\", is empty"
+    } elseif {[string length $sepChar] > 1} {
+	return -code error "illegal separator character \"$sepChar\", is a string"
+    }
+
+    $q put [Split $alternate $line $sepChar]
+    return
+}
+
+# ::csv::writematrix --
+#
+#	A wrapper around "::csv::join" taking the rows in a matrix and
+#	writing them as CSV formatted lines into the channel.
+#
+# Arguments:
+#	m		The matrix to take the data to write from.
+#	chan		The channel to write into.
+#	sepChar		The separator character, defaults to comma
+#
+# Results:
+#	None.
+
+proc ::csv::writematrix {m chan {sepChar ,} {delChar \"}} {
+    set n [$m rows]
+    for {set r 0} {$r < $n} {incr r} {
+	puts $chan [join [$m get row $r] $sepChar $delChar]
+    }
+
+    # Memory intensive alternative:
+    # puts $chan [joinlist [m get rect 0 0 end end] $sepChar $delChar]
+    return
+}
+
+# ::csv::writequeue --
+#
+#	A wrapper around "::csv::join" taking the rows in a queue and
+#	writing them as CSV formatted lines into the channel.
+#
+# Arguments:
+#	q		The queue to take the data to write from.
+#	chan		The channel to write into.
+#	sepChar		The separator character, defaults to comma
+#
+# Results:
+#	None.
+
+proc ::csv::writequeue {q chan {sepChar ,} {delChar \"}} {
+    while {[$q size] > 0} {
+	puts $chan [join [$q get] $sepChar $delChar]
+    }
+
+    # Memory intensive alternative:
+    # puts $chan [joinlist [$q get [$q size]] $sepChar $delChar]
+    return
+}
+

src/vendormodules/dictutils-0.2.1.tm

@@ -0,0 +1,145 @@
+# dictutils.tcl --
+ #
+ #       Various dictionary utilities.
+ #
+ # Copyright (c) 2007 Neil Madden (nem@cs.nott.ac.uk).
+ #
+ # License: http://www.cs.nott.ac.uk/~nem/license.terms (Tcl-style).
+ #
+
+ #2023 0.2.1 - changed "package require Tcl 8.6" to "package require Tcl 8.6-"
+ 
+ package require Tcl         8.6-
+ package provide dictutils   0.2.1
+ 
+ namespace eval dictutils {
+     namespace export equal apply capture witharray nlappend
+     namespace ensemble create
+
+     # dictutils witharray dictVar arrayVar script --
+     #
+     #       Unpacks the elements of the dictionary in dictVar into the array
+     #       variable arrayVar and then evaluates the script. If the script
+     #       completes with an ok, return or continue status, then the result is copied
+     #       back into the dictionary variable, otherwise it is discarded. A
+     #       [break] can be used to explicitly abort the transaction.
+     #
+     proc witharray {dictVar arrayVar script} {
+         upvar 1 $dictVar dict $arrayVar array
+         array set array $dict
+         try { uplevel 1 $script
+         } on break    {}     { # Discard the result
+         } on continue result - on ok result {
+             set dict [array get array] ;# commit changes
+             return $result
+         } on return   {result opts} {
+             set dict [array get array] ;# commit changes
+             dict incr opts -level ;# remove this proc from level
+             return -options $opts $result
+         }
+         # All other cases will discard the changes and propagage
+     }
+ 
+     # dictutils equal equalp d1 d2 --
+     #
+     #       Compare two dictionaries for equality. Two dictionaries are equal
+     #       if they (a) have the same keys, (b) the corresponding values for
+     #       each key in the two dictionaries are equal when compared using the
+     #       equality predicate, equalp (passed as an argument). The equality
+     #       predicate is invoked with the key and the two values from each
+     #       dictionary as arguments.
+     #
+     proc equal {equalp d1 d2} {
+         if {[dict size $d1] != [dict size $d2]} { return 0 }
+         dict for {k v} $d1 {
+             if {![dict exists $d2 $k]} { return 0 }
+             if {![invoke $equalp $k $v [dict get $d2 $k]]} { return 0 }
+         }
+         return 1
+     }
+ 
+     # apply dictVar lambdaExpr ?arg1 arg2 ...? --
+     #
+     #       A combination of *dict with* and *apply*, this procedure creates a
+     #       new procedure scope populated with the values in the dictionary
+     #       variable. It then applies the lambdaTerm (anonymous procedure) in
+     #       this new scope. If the procedure completes normally, then any
+     #       changes made to variables in the dictionary are reflected back to
+     #       the dictionary variable, otherwise they are ignored. This provides
+     #       a transaction-style semantics whereby atomic updates to a
+     #       dictionary can be performed. This procedure can also be useful for
+     #       implementing a variety of control constructs, such as mutable
+     #       closures.
+     #
+     proc apply {dictVar lambdaExpr args} {
+         upvar 1 $dictVar dict
+         set env $dict ;# copy
+         lassign $lambdaExpr params body ns
+         if {$ns eq ""} { set ns "::" }
+         set body [format {
+             upvar 1 env __env__
+             dict with __env__ %s
+         } [list $body]]
+         set lambdaExpr [list $params $body $ns]
+         set rc [catch { ::apply $lambdaExpr {*}$args } ret opts]
+         if {$rc == 0} {
+             # Copy back any updates
+             set dict $env
+         }
+         return -options $opts $ret
+     }
+ 
+     # capture ?level? ?exclude? ?include? --
+     #
+     #       Captures a snapshot of the current (scalar) variable bindings at
+     #       $level on the stack into a dictionary environment. This dictionary
+     #       can later be used with *dictutils apply* to partially restore the
+     #       scope, creating a first approximation of closures. The *level*
+     #       argument should be of the forms accepted by *uplevel* and
+     #       designates which level to capture. It defaults to 1 as in uplevel.
+     #       The *exclude* argument specifies an optional list of literal
+     #       variable names to avoid when performing the capture. No variables
+     #       matching any item in this list will be captured. The *include*
+     #       argument can be used to specify a list of glob patterns of
+     #       variables to capture. Only variables matching one of these
+     #       patterns are captured. The default is a single pattern "*", for
+     #       capturing all visible variables (as determined by *info vars*).
+     #
+     proc capture {{level 1} {exclude {}} {include {*}}} {
+         if {[string is integer $level]} { incr level }
+         set env [dict create]
+         foreach pattern $include {
+             foreach name [uplevel $level [list info vars $pattern]] {
+                 if {[lsearch -exact -index 0 $exclude $name] >= 0} { continue }
+                 upvar $level $name value
+                 catch { dict set env $name $value } ;# no arrays
+             }
+         }
+         return $env
+     }
+ 
+     # nlappend dictVar keyList ?value ...?
+     #
+     #       Append zero or more elements to the list value stored in the given
+     #       dictionary at the path of keys specified in $keyList.  If $keyList
+     #       specifies a non-existent path of keys, nlappend will behave as if
+     #       the path mapped to an empty list.
+     #
+     proc nlappend {dictvar keylist args} {
+         upvar 1 $dictvar dict
+         if {[info exists dict] && [dict exists $dict {*}$keylist]} {
+             set list [dict get $dict {*}$keylist]
+         }
+         lappend list {*}$args
+         dict set dict {*}$keylist $list
+     }
+
+     # invoke cmd args... --
+     #
+     #       Helper procedure to invoke a callback command with arguments at
+     #       the global scope. The helper ensures that proper quotation is
+     #       used. The command is expected to be a list, e.g. {string equal}.
+     #
+     proc invoke {cmd args} { uplevel #0 $cmd $args }
+
+ }

src/vendormodules/overtype-1.5.6.tm

@@ -0,0 +1,928 @@
+# -*- tcl -*-
+# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from <pkg>-buildversion.txt
+#
+# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem.
+# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository.
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+# (C) Julian Noble 2003-2023
+#
+# @@ Meta Begin
+# Application overtype 1.5.6
+# Meta platform     tcl
+# Meta license      BSD 
+# @@ Meta End
+
+
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+# doctools header
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+#*** !doctools
+#[manpage_begin overtype_module_overtype 0 1.5.6]
+#[copyright "2024"]
+#[titledesc {overtype text layout - ansi aware}]  [comment {-- Name section and table of contents description --}]
+#[moddesc {overtype text layout}]             [comment {-- Description at end of page heading --}] 
+#[require overtype]
+#[keywords module text ansi]
+#[description]
+#[para] -
+
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+
+#*** !doctools
+#[section Overview]
+#[para] overview of overtype 
+#[subsection Concepts]
+#[para] -
+
+
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+##  Requirements
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+
+#*** !doctools
+#[subsection dependencies]
+#[para] packages used by overtype 
+#[list_begin itemized]
+
+package require Tcl 8.6
+package require textutil
+package require punk::lib   ;#required for lines_as_list
+package require punk::ansi  ;#required to detect, split, strip and calculate lengths
+package require punk::char  ;#box drawing - and also unicode character width determination for proper layout of text with double-column-width chars
+#*** !doctools
+#[item] [package {Tcl 8.6}]
+#[item] [package textutil]
+#[item] [package punk::ansi]
+#[para] - required to detect, split, strip and calculate lengths of text possibly containing ansi codes
+#[item] [package punk::char]
+#[para] - box drawing - and also unicode character width determination for proper layout of text with double-column-width chars
+
+# #package require frobz
+# #*** !doctools
+# #[item] [package {frobz}]
+
+#*** !doctools
+#[list_end]
+
+
+
+
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+#*** !doctools
+#[section API]
+
+
+#Julian Noble <julian@precisium.com.au> - 2003 
+#Released under standard 'BSD license' conditions.
+#
+#todo - ellipsis truncation indicator for center,right
+
+#v1.4 2023-07 - naive ansi color handling - todo - fix string range 
+# - need to extract and replace ansi codes?
+
+namespace eval overtype {
+	namespace export *
+    variable default_ellipsis_horizontal "..." ;#fallback 
+    variable default_ellipsis_vertical "..." 
+    namespace eval priv {
+        proc _init {} {
+            upvar ::overtype::default_ellipsis_horizontal e_h
+            upvar ::overtype::default_ellipsis_vertical e_v
+            set e_h [format %c 0x2026] ;#Unicode Horizontal Ellipsis
+            set e_v [format %c 0x22EE]
+            #The unicode ellipsis looks more natural than triple-dash which is centred vertically whereas ellipsis is at floorline of text
+            #Also - unicode ellipsis has semantic meaning that other processors can interpret
+            #unicode does also provide a midline horizontal ellipsis 0x22EF
+
+            #set e [format %c 0x2504] ;#punk::char::charshort boxd_ltdshhz  - Box Drawings Light Triple Dash Horizontal
+            #if {![catch {package require punk::char}]} {
+            #    set e [punk::char::charshort boxd_ltdshhz] 
+            #}
+        }
+    }
+    priv::_init
+}
+proc overtype::about {} {
+	return "Simple text formatting. Author JMN. BSD-License"
+}
+
+namespace eval overtype {
+    variable escape_terminals
+    #single "final byte" in the range 0x40–0x7E (ASCII @A–Z[\]^_`a–z{|}~).
+    dict set escape_terminals CSI [list @ \\ ^ _ ` | ~ a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z "\{" "\}"]
+    #dict set escape_terminals CSI [list J K m n A B C D E F G s u] ;#basic 
+    dict set escape_terminals OSC [list \007 \033\\] ;#note mix of 1 and 2-byte terminals 
+
+    #self-contained 2 byte ansi escape sequences - review more?
+    variable ansi_2byte_codes_dict
+    set  ansi_2byte_codes_dict [dict create\
+        "reset_terminal"            "\u001bc"\
+        "save_cursor_posn"          "\u001b7"\
+        "restore_cursor_posn"       "\u001b8"\
+        "cursor_up_one"             "\u001bM"\
+        "NEL - Next Line"           "\u001bE"\
+        "IND - Down one line"       "\u001bD"\
+        "HTS - Set Tab Stop"        "\u001bH"\
+        ]
+
+        #debatable whether strip should reveal the somethinghidden - some terminals don't hide it anyway.
+        #  "PM - Privacy Message"      "\u001b^somethinghidden\033\\"\
+}
+
+
+#proc overtype::stripansi {text} {
+#    variable escape_terminals  ;#dict
+#    variable ansi_2byte_codes_dict
+#    #important that we don't spend too much time on this for plain text that doesn't contain any escapes anyway
+#    if {[string first \033 $text] <0 && [string first \009c $text] <0} {
+#        #\033 same as \x1b
+#        return $text
+#    }
+#
+#    set text [convert_g0 $text] 
+#
+#    #we process char by char - line-endings whether \r\n or \n should be processed as per any other character.
+#    #line endings can theoretically occur within an ansi escape sequence (review e.g title?)
+#    set inputlist [split $text ""]
+#    set outputlist [list] 
+#
+#    set 2bytecodes [dict values $ansi_2byte_codes_dict]
+#
+#    set in_escapesequence 0
+#    #assumption - undertext already 'rendered' - ie no backspaces or carriagereturns or other cursor movement controls
+#    set i 0
+#    foreach u $inputlist {
+#        set v [lindex $inputlist $i+1]
+#        set uv ${u}${v}
+#        if {$in_escapesequence eq "2b"} {
+#            #2nd byte - done.
+#            set in_escapesequence 0
+#        } elseif {$in_escapesequence != 0} {
+#            set escseq [dict get $escape_terminals $in_escapesequence]
+#            if {$u in $escseq} {
+#                set in_escapesequence 0
+#            } elseif {$uv in $escseq} {
+#                set in_escapseequence 2b ;#flag next byte as last in sequence
+#            }
+#        } else {
+#            #handle both 7-bit and 8-bit CSI and OSC
+#            if {[regexp {^(?:\033\[|\u009b)} $uv]} {
+#                set in_escapesequence CSI
+#            } elseif {[regexp {^(?:\033\]|\u009c)} $uv]} {
+#                set in_escapesequence OSC
+#            } elseif {$uv in $2bytecodes} {
+#                #self-contained e.g terminal reset - don't pass through.
+#                set in_escapesequence 2b
+#            } else {
+#                lappend outputlist $u
+#            }
+#        }
+#        incr i
+#    }
+#    return [join $outputlist ""]
+#}
+
+
+
+
+
+proc overtype::string_columns {text} {
+    if {[punk::ansi::ta::detect $text]} {
+        #error "error string_columns is for calculating character length of string - ansi codes must be stripped/rendered first e.g with punk::ansi::stripansi. Alternatively try punk::ansi::printing_length"
+        set text [punk::ansi::stripansi $text]
+    }
+    return [punk::char::string_width $text]
+}
+
+
+#string range should generally be avoided for both undertext and overtext which contain ansi escapes and other cursor affecting chars such as \b and \r
+proc overtype::left {args} {
+	# @c overtype starting at left (overstrike) 
+	# @c can/should we use something like this?: 'format "%-*s" $len $overtext 
+    variable default_ellipsis_horizontal
+
+	if {[llength $args] < 2} {
+		error {usage: ?-transparent [0|1]? ?-overflow [1|0]? ?-ellipsis [1|0]? ?-ellipsistext ...? undertext overtext}
+	}
+    lassign [lrange $args end-1 end] underblock overblock
+    set defaults [dict create\
+        -bias       ignored\
+        -ellipsis   0\
+        -ellipsistext   $default_ellipsis_horizontal\
+        -ellipsiswhitespace 0\
+        -overflow   0\
+        -transparent 0\
+        -exposed1 \uFFFD\
+        -exposed2 \uFFFD\
+    ]
+    set known_opts [dict keys $defaults]
+    set argsflags [lrange $args 0 end-2]
+    dict for {k v} $argsflags {
+        if {$k ni $known_opts} {
+            error "overtype::left unknown option '$k'. Known options: $known_opts"
+        }
+    }
+    set opts [dict merge $defaults $argsflags]
+    # -- --- --- --- --- ---
+    set opt_transparent     [dict get $opts -transparent]
+    set opt_ellipsistext    [dict get $opts -ellipsistext]
+    set opt_ellipsiswhitespace [dict get $opts -ellipsiswhitespace]
+    set opt_exposed1        [dict get $opts -exposed1] ;#widechar_exposed_left  - todo
+    set opt_exposed2        [dict get $opts -exposed2] ;#widechar_exposed_right - todo
+    # -- --- --- --- --- ---
+
+    set norm [list \r\n \n]
+    set underblock [string map $norm $underblock]
+    set overblock  [string map $norm $overblock]
+
+    set underlines [split $underblock \n]
+    #set colwidth [tcl::mathfunc::max {*}[lmap v $underlines {punk::ansi::printing_length $v}]]
+    lassign [blocksize $underblock] _w colwidth _h colheight
+    set overlines  [split $overblock \n]
+    #set overblock_width [tcl::mathfunc::max {*}[lmap v $overlines {punk::ansi::printing_length $v}]]
+    lassign [blocksize $overblock] _w overblock_width _h overblock_height
+    set under_exposed_max [expr {$colwidth - $overblock_width}]
+    set right_exposed $under_exposed_max 
+
+    set outputlines [list]
+    foreach undertext $underlines overtext $overlines {    
+        set undertext_printlen [punk::ansi::printing_length $undertext]
+        if {$undertext_printlen < $colwidth} {
+            set udiff [expr {$colwidth - $undertext_printlen}]
+            set undertext "$undertext[string repeat { } $udiff]"
+        }
+        set overtext_printlen [punk::ansi::printing_length $overtext]
+        set overflowlength [expr {$overtext_printlen - $colwidth}]
+
+        #review
+        #append overtext "\033\[0m"
+
+
+        if {$overflowlength > 0} {
+            #background line is narrower than data in line
+            set rendered [renderline -transparent $opt_transparent -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 -overflow [dict get $opts -overflow] $undertext $overtext]
+            if {![dict get $opts -overflow]} {
+                #set overtext [string range $overtext 0 $colwidth-1] ;#string range won't be correct e.g if contains ansi codes or leading \r or \b etc
+                if {[dict get $opts -ellipsis]} {
+                    set show_ellipsis 1
+                    if {!$opt_ellipsiswhitespace} {
+                        #we don't want ellipsis if only whitespace was lost
+                        set lostdata [string range $overtext end-[expr {$overflowlength-1}] end]
+                        if {[string trim $lostdata] eq ""} {
+                            set show_ellipsis 0
+                        }
+                    }
+                    if {$show_ellipsis} {
+                        set rendered [overtype::right $rendered $opt_ellipsistext]
+                    }
+                }
+            }
+            lappend outputlines $rendered
+        } else {
+            #we know overtext data is shorter or equal (for this line)
+            lappend outputlines [renderline -transparent $opt_transparent -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 $undertext $overtext]
+        }
+    }
+    return [join $outputlines \n]
+
+}
+
+namespace eval overtype::piper {
+    proc overcentre {args} {
+        if {[llength $args] < 2} {
+            error {usage: ?-bias left|right? ?-transparent [0|1|<regexp>]? ?-exposed1 <char>? ?-exposed2 <char>?  ?-overflow [1|0]? overtext pipelinedata}
+        }
+        lassign [lrange $args end-1 end] over under
+        set argsflags [lrange $args 0 end-2]
+        tailcall overtype::centre {*}$argsflags $under $over
+    }
+    proc overleft {args} {
+        if {[llength $args] < 2} {
+            error {usage: ?-start <column>? ?-transparent [0|1|<regexp>]? ?-exposed1 <char>? ?-exposed2 <char>?  ?-overflow [1|0]? overtext pipelinedata}
+        }
+        lassign [lrange $args end-1 end] over under
+        set argsflags [lrange $args 0 end-2]
+        tailcall overtype::left {*}$argsflags $under $over
+    }
+}
+#todo - left-right ellipsis ?
+proc overtype::centre {args} {
+    variable default_ellipsis_horizontal
+	if {[llength $args] < 2} {
+		error {usage: ?-transparent [0|1]? ?-bias [left|right]?  ?-overflow [1|0]? undertext overtext}
+	}
+	
+    foreach {underblock overblock} [lrange $args end-1 end] break
+
+    #todo - vertical vs horizontal overflow for blocks
+    set defaults [dict create\
+        -bias       left\
+        -ellipsis   0\
+        -ellipsistext   $default_ellipsis_horizontal\
+        -ellipsiswhitespace 0\
+        -overflow   0\
+        -transparent 0\
+        -exposed1 \uFFFD\
+        -exposed2 \uFFFD\
+    ]
+    set known_opts [dict keys $defaults]
+    set argsflags [lrange $args 0 end-2]
+    dict for {k v} $argsflags {
+        if {$k ni $known_opts} {
+            error "overtype::centre unknown option '$k'. Known options: $known_opts"
+        }
+    }
+    set opts [dict merge $defaults $argsflags]
+    # -- --- --- --- --- ---
+    set opt_transparent     [dict get $opts -transparent]
+    set opt_ellipsis        [dict get $opts -ellipsis]
+    set opt_ellipsistext    [dict get $opts -ellipsistext]
+    set opt_ellipsiswhitespace [dict get $opts -ellipsiswhitespace]
+    set opt_exposed1        [dict get $opts -exposed1]
+    set opt_exposed2        [dict get $opts -exposed2]
+    # -- --- --- --- --- ---
+
+
+    set norm [list \r\n \n]
+    set underblock [string map $norm $underblock]
+    set overblock  [string map $norm $overblock]
+
+    set underlines [split $underblock \n]
+    #set colwidth [tcl::mathfunc::max {*}[lmap v $underlines {punk::ansi::printing_length $v}]]
+    lassign [blocksize $underblock] _w colwidth _h colheight
+    set overlines  [split $overblock \n]
+    #set overblock_width [tcl::mathfunc::max {*}[lmap v $overlines {punk::ansi::printing_length $v}]]
+    lassign [blocksize $overblock] _w overblock_width _h overblock_height 
+    set under_exposed_max [expr {$colwidth - $overblock_width}]
+    if {$under_exposed_max > 0} {
+        #background block is wider
+        if {$under_exposed_max % 2 == 0} {
+            #even left/right exposure
+            set left_exposed [expr {$under_exposed_max / 2}]
+        } else {
+            set beforehalf [expr {$under_exposed_max / 2}] ;#1 less than half due to integer division
+            if {[string tolower [dict get $opts -bias]] eq "left"} {
+                set left_exposed $beforehalf
+            } else {
+                #bias to the right
+                set left_exposed [expr {$beforehalf + 1}]
+            }
+        }
+    } else {
+        set left_exposed 0
+    }
+
+    set outputlines [list]
+    foreach undertext $underlines overtext $overlines {    
+        set overtext_datalen [punk::ansi::printing_length $overtext]
+        set ulen [punk::ansi::printing_length $undertext]
+        if {$ulen < $colwidth} {
+            set udiff [expr {$colwidth - $ulen}]
+            set undertext "$undertext[string repeat { } $udiff]"
+        }
+
+        set overflowlength [expr {$overtext_datalen - $colwidth}]
+        #review - right-to-left langs should elide on left! - extra option required
+
+        if {$overflowlength > 0} {
+            #overlay line wider or equal
+            set rendered [renderline -transparent $opt_transparent -overflow [dict get $opts -overflow] -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 $undertext $overtext]
+            #overlay line data is wider - trim if overflow not specified in opts - and overtype an ellipsis at right if it was specified
+            if {![dict get $opts -overflow]} {
+                #lappend outputlines [string range $overtext 0 [expr {$colwidth - 1}]]
+                #set overtext [string range $overtext 0 $colwidth-1 ]
+                if {$opt_ellipsis} {
+                    set show_ellipsis 1
+                    if {!$opt_ellipsiswhitespace} {
+                        #we don't want ellipsis if only whitespace was lost
+                        set lostdata [string range $overtext end-[expr {$overflowlength-1}] end]
+                        if {[string trim $lostdata] eq ""} {
+                            set show_ellipsis 0
+                        }
+                    }
+                    if {$show_ellipsis} {
+                        set rendered [overtype::right $rendered $opt_ellipsistext]
+                    }
+                }
+            }
+            lappend outputlines $rendered
+            #lappend outputlines [renderline -transparent $opt_transparent $undertext $overtext]
+        } else {
+            #background block is wider than or equal to data for this line
+            lappend outputlines [renderline -start $left_exposed -transparent $opt_transparent -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 $undertext $overtext]
+        }
+    }
+    return [join $outputlines \n]
+}
+
+proc overtype::right {args} {
+    #NOT the same as align-right - which should be done to the overblock first if required
+    variable default_ellipsis_horizontal
+	# @d !todo - implement overflow, length checks etc
+
+	if {[llength $args] < 2} {
+		error {usage: ?-overflow [1|0]? undertext overtext}
+	}
+    foreach {underblock overblock} [lrange $args end-1 end] break
+
+    set defaults [dict create\
+        -bias       ignored\
+        -ellipsis   0\
+        -ellipsistext   $default_ellipsis_horizontal\
+        -ellipsiswhitespace 0\
+        -overflow   0\
+        -transparent 0\
+        -exposed1 \uFFFD\
+        -exposed2 \uFFFD\
+    ]
+    set known_opts [dict keys $defaults]
+    set argsflags [lrange $args 0 end-2]
+    dict for {k v} $argsflags {
+        if {$k ni $known_opts} {
+            error "overtype::centre unknown option '$k'. Known options: $known_opts"
+        }
+    }
+    set opts [dict merge $defaults $argsflags]
+    # -- --- --- --- --- ---
+    set opt_transparent     [dict get $opts -transparent]
+    set opt_ellipsis         [dict get $opts -ellipsis]
+    set opt_ellipsistext    [dict get $opts -ellipsistext]
+    set opt_ellipsiswhitespace [dict get $opts -ellipsiswhitespace]
+    set opt_overflow        [dict get $opts -overflow]
+    set opt_exposed1        [dict get $opts -exposed1]
+    set opt_exposed2        [dict get $opts -exposed2]
+    # -- --- --- --- --- ---
+    
+    set norm [list \r\n \n]
+    set underblock [string map $norm $underblock]
+    set overblock  [string map $norm $overblock]
+
+    set underlines [split $underblock \n]
+    #set colwidth [tcl::mathfunc::max {*}[lmap v $underlines {punk::ansi::printing_length $v}]]
+    lassign [blocksize $underblock] _w colwidth _h colheight
+    set overlines  [split $overblock \n]
+    #set overblock_width [tcl::mathfunc::max {*}[lmap v $overlines {punk::ansi::printing_length $v}]]
+    lassign [blocksize $overblock] _w overblock_width _h overblock_height 
+    set under_exposed_max [expr {$colwidth - $overblock_width}]
+    set left_exposed $under_exposed_max 
+
+    set outputlines [list]
+    foreach undertext $underlines overtext $overlines {    
+        set overtext_datalen [punk::ansi::printing_length $overtext]
+        set ulen [punk::ansi::printing_length $undertext]
+        if {$ulen < $colwidth} {
+            set udiff [expr {$colwidth - $ulen}]
+            puts xxx
+            set undertext "$undertext[string repeat { } $udiff]"
+        }
+        if {$overtext_datalen < $overblock_width} {
+            set odiff [expr {$overblock_width - $overtext_datalen}]
+            #padding always on right - if alignment is required it should be done to block beforehand - not here
+            set overtextpadding "$overtext[string repeat { } $odiff]"
+        }
+
+        set overflowlength [expr {$overtext_datalen - $colwidth}]
+        if {$overflowlength > 0} {	
+            #raw overtext wider than undertext column
+            set rendered [renderline -transparent $opt_transparent -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 -overflow $opt_overflow -start 0 $undertext $overtext]
+            if {!$opt_overflow} {
+                if {$opt_ellipsis} {
+                    set show_ellipsis 1
+                    if {!$opt_ellipsiswhitespace} {
+                        #we don't want ellipsis if only whitespace was lost
+                        set lostdata [string range $overtext end-[expr {$overflowlength-1}] end]
+                        if {[string trim $lostdata] eq ""} {
+                            set show_ellipsis 0
+                        }
+                    }
+                    if {$show_ellipsis} {
+                        set rendered [overtype::right $rendered $opt_ellipsistext]
+                    }
+                }
+            }
+            lappend outputlines $rendered
+        } else {
+            #padded overtext 
+            lappend outputlines [renderline -transparent $opt_transparent -start $left_exposed $undertext $overtext]
+        }
+    }
+
+    return [join $outputlines \n]
+}
+
+# -- --- --- --- --- --- --- --- --- --- ---
+proc overtype::transparentline {args} {
+    foreach {under over} [lrange $args end-1 end] break
+    set argsflags [lrange $args 0 end-2]
+    set defaults [dict create\
+        -transparent 1\
+        -exposed 1 " "\
+        -exposed 2 " "\
+    ]
+    set newargs [dict merge $defaults $argsflags]
+    tailcall overtype::renderline {*}$newargs $under $over
+}
+#renderline may not make sense as it is in the long run for blocks of text - but is handy in the single-line-handling form anyway.
+# We are trying to handle ansi codes in a block of text which is acting like a mini-terminal in some sense.
+#We can process standard cursor moves such as \b \r - but no way to respond to other cursor movements e.g moving to other lines.
+#
+namespace eval overtype::piper {
+    proc renderline {args} {
+        if {[llength $args] < 2} {
+            error {usage: ?-start <int>? ?-transparent [0|1|<regexp>]?  ?-overflow [1|0]? overtext pipelinedata}
+        }
+        foreach {over under} [lrange $args end-1 end] break
+        set argsflags [lrange $args 0 end-2]
+        tailcall overtype::renderline {*}$argsflags $under $over
+    }
+}
+interp alias "" piper_renderline "" overtype::piper::renderline 
+
+#-returnextra to enable returning of overflow and length
+# todo - use punk::ansi::ta::detect to short-circuit processing and do simple string calcs as an optimisation?
+#review - DECSWL/DECDWL double width line codes - very difficult/impossible to align and compose with other elements
+#todo - review transparency issues with single/double width characters!
+proc overtype::renderline {args} {
+	if {[llength $args] < 2} {
+		error {usage: ?-start <int>? ?-transparent [0|1|<regexp>]?  ?-overflow [1|0]? undertext overtext}
+	}
+    lassign [lrange $args end-1 end] under over
+    #should also rule out \v
+    if {[string first \n $over] >=0 || [string first \n $under] >= 0} {
+        error "overtype::renderline not allowed to contain newlines"
+    }
+    set defaults [dict create\
+        -overflow   0\
+        -transparent 0\
+        -start 0\
+        -returnextra 0\
+        -exposed1 \uFFFD\
+        -exposed2 \uFFFD\
+    ]
+    #exposed1 and exposed2 for first and second col of underying 2wide char which is truncated by transparency or overflow
+
+    set known_opts [dict keys $defaults]
+    set argsflags [lrange $args 0 end-2]
+    dict for {k v} $argsflags {
+        if {$k ni $known_opts} {
+            error "overtype::renderline unknown option '$k'. Known options: $known_opts"
+        }
+    }
+    set opts [dict merge $defaults $argsflags]
+    # -- --- --- --- --- --- --- --- --- --- --- ---
+    set opt_overflow            [dict get $opts -overflow]
+    set opt_colstart            [dict get $opts -start]
+    # -- --- --- --- --- --- --- --- --- --- --- ---
+    set opt_transparent         [dict get $opts -transparent]  
+    if {$opt_transparent eq "0"} {
+        set do_transparency 0
+    } else {
+        set do_transparency 1
+        if {$opt_transparent eq "1"} {
+            set opt_transparent {[\s]}
+        }
+    }
+    # -- --- --- --- --- --- --- --- --- --- --- ---
+    set opt_returnextra         [dict get $opts -returnextra]
+    # -- --- --- --- --- --- --- --- --- --- --- ---
+    set opt_exposed1            [dict get $opts -exposed1]
+    set opt_exposed2            [dict get $opts -exposed2]
+    # -- --- --- --- --- --- --- --- --- --- --- ---
+
+    #-----
+    #
+    if {[string first \t $under] >= 0} {
+        #set under [textutil::tabify::untabify2 $under]
+        set under [textutil::tabify::untabifyLine $under 8] ;#8 is default for untabify2 - review
+    }
+    set overdata $over
+    if {[string first \t $over] >= 0} {
+        #set overdata [textutil::tabify::untabify2 $over]
+        set overdata [textutil::tabify::untabifyLine $over 8]
+    }
+    #-------
+
+    #ta_detect ansi and do simpler processing?
+
+
+    # -- --- --- --- --- --- --- ---
+    set undermap [punk::ansi::ta::split_codes_single $under]
+    set understacks [dict create]
+
+    set i_u -1
+    set i_o 0 
+    set out [list] 
+    set u_codestack [list]
+    set pt_underchars "" ;#for string_columns length calculation for overflow 0 truncation
+    set remainder [list] ;#for returnextra
+    foreach {pt code} $undermap {
+        #pt = plain text
+        append pt_underchars $pt
+        foreach grapheme [punk::char::grapheme_split $pt] {
+            set width [punk::char::string_width $grapheme]
+            incr i_u
+            dict set understacks $i_u $u_codestack 
+            lappend out $grapheme
+            if {$width > 1} {
+                incr i_u
+                #presumably there are no triple-column or wider unicode chars.. until the aliens arrive.(?)
+                #but what about emoji combinations etc - can they be wider than 2?
+                dict set understacks $i_u $u_codestack 
+                lappend out ""
+            }
+        }
+
+        #underlay should already have been rendered and not have non-sgr codes - but let's retain the check for them and not stack them if other codes are here
+
+        #only stack SGR (graphics rendition) codes - not title sets, cursor moves etc 
+        #order of if-else based on assumptions:
+        # that pure resets are fairly common - more so than leading resets with other info
+        # that non-sgr codes are not that common, so ok to check for resets before verifying it is actually SGR at all.
+        if {[punk::ansi::codetype::is_sgr_reset $code]} {
+            set u_codestack [list]
+        } elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} {
+            set u_codestack [list $code]
+        } elseif {[punk::ansi::codetype::is_sgr $code]} {
+            lappend u_codestack $code
+        }
+        #consider also if there are other codes that should be stacked..?
+    }
+    #trailing codes in effect for underlay
+    if {[llength $undermap]} {
+        dict set understacks [expr {$i_u + 1}] $u_codestack
+    }
+
+
+    # -- --- --- --- --- --- --- ---
+    ####
+    #if opt_colstart - we need to build a space (or any singlewidth char really) padding on the left of the right number of columns.
+    #this will be processed as transparent - and handle doublewidth underlay characters appropriately
+    set startpad [string repeat " " $opt_colstart]
+    append startpad $overdata ;#overdata with left padding spaces based on col-start under will show through for left-padding portion regardless of -transparency
+    set overmap  [punk::ansi::ta::split_codes_single $startpad]
+    ####
+
+    #set re_diacritics {[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+} 
+    #as at 2024-02 punk::char::grapheme_split uses these - not aware of more complex graphemes
+
+
+    set overstacks [dict create]
+    set o_codestack [list]
+    set pt_overchars ""
+    foreach {pt code} $overmap {
+        append pt_overchars $pt
+        foreach grapheme [punk::char::grapheme_split $pt] {
+           dict set overstacks $i_o $o_codestack 
+           incr i_o 
+        }
+
+        if {[punk::ansi::codetype::is_sgr $code]} {
+            if {[punk::ansi::codetype::has_sgr_leadingreset $code]} {
+                #m code which has sgr reset at start - no need to replay prior sgr codes 
+                set o_codestack [list $code]
+            } else {
+                lappend o_codestack $code
+            }
+        }
+
+        #only stack SGR (graphics rendition) codes - not title sets, cursor moves etc 
+        #order of if-else based on assumptions:
+        # that pure resets are fairly common - more so than leading resets with other info
+        # that non-sgr codes are not that common, so ok to check for resets before verifying it is actually SGR at all.
+        if {[punk::ansi::codetype::is_sgr_reset $code]} {
+            set o_codestack [list]
+        } elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} {
+            set o_codestack [list $code]
+        } elseif {[punk::ansi::codetype::is_sgr $code]} {
+            lappend o_codestack $code
+        }
+
+    }
+    # -- --- --- --- --- --- --- ---
+
+
+    #potential problem - combinining diacritics directly following control chars like \r \b
+
+    set bs [format %c 0x08]
+    set idx 0 ;# line index  (cursor - 1)
+    set idx_over -1
+    foreach {pt code} $overmap {
+        #set ptchars [split $pt ""] ;#for lookahead
+        set graphemes [punk::char::grapheme_split $pt]
+        #emit plaintext chars first using existing SGR codes from under/over stack as appropriate
+        #then check if the following code is a cursor movement within the line and adjust index if so
+        foreach ch $graphemes {
+            incr idx_over
+            if {$ch eq "\r"} {
+                set idx $opt_colstart
+            } elseif {$ch eq "\b"} {
+                #review - backspace effect on double-width chars
+                if {$idx > $opt_colstart} {
+                    incr idx -1
+                }
+            } elseif {($idx < $opt_colstart)} {
+                incr idx
+            } elseif {($do_transparency && [regexp $opt_transparent $ch])} {    
+                #pre opt_colstart is effectively transparent (we have applied padding of required number of columns to left of overlay)
+                set owidth [punk::char::string_width $ch]
+                if {$idx > [llength $out]-1} {
+                    lappend out " "
+                    dict set understacks $idx [list] ;#review - use idx-1 codestack?
+                    incr idx
+                } else {
+                    set uwidth [punk::char::string_width [lindex $out $idx]]
+                    if {[lindex $out $idx] eq ""} {
+                        #2nd col of 2-wide char in underlay 
+                        incr idx
+                    } elseif {$uwidth == 0} {
+                        #e.g control char  ? combining diacritic ?
+                        incr idx
+                    } elseif {$uwidth == 1} {
+                        incr idx
+                        if {$owidth > 1} {
+                            incr idx
+                        } 
+                    } elseif {$uwidth > 1} {
+                        if {[punk::char::string_width $ch] == 1} {
+                            #normal singlewide transparency 
+                            set next_pt_overchar [string index $pt_overchars $idx_over+1] ;#lookahead of next plain-text char in overlay
+                            if {$next_pt_overchar eq ""} {
+                                #special-case trailing transparent - no next_pt_overchar
+                                incr idx
+                            } else {
+                                if {[regexp $opt_transparent $next_pt_overchar]} {
+                                    incr idx
+                                } else {
+                                    #next overlay char is not transparent.. first-half of underlying 2wide char is exposed 
+                                    priv::render_addchar $idx $opt_exposed1 [dict get $overstacks $idx_over]
+                                    incr idx
+                                }
+                            }
+                        } else {
+                            #2wide transparency over 2wide in underlay
+                            incr idx
+                        }
+                    }
+                }
+            } else {
+                #non-transparent char in overlay
+                set owidth [punk::char::string_width $ch]
+                set uwidth [punk::char::string_width [lindex $out $idx]]
+                if {[lindex $out $idx] eq ""} {
+                    #2nd col of 2wide char in underlay
+                    priv::render_addchar $idx $ch [dict get $overstacks $idx_over]
+                    incr idx
+                } elseif {$uwidth == 0} {
+                    #e.g combining diacritic - increment before over char  REVIEW
+                    #arguably the previous overchar should have done this - ie lookahead for combiners?
+                    priv::render_addchar $idx "" [dict get $overstacks $idx_over]
+                    incr idx
+                    priv::render_addchar $idx $ch [dict get $overstacks $idx_over]
+                    incr idx
+
+                } elseif {$uwidth == 1} {
+                    if {$owidth == 1} {
+                        priv::render_addchar $idx $ch [dict get $overstacks $idx_over]
+                        incr idx
+                    } else {
+                        priv::render_addchar $idx $ch [dict get $overstacks $idx_over]
+                        incr idx
+                        priv::render_addchar $idx ""  [dict get $overstacks $idx_over]
+                    }
+                } elseif {$uwidth > 1} {
+                    if {$owidth == 1} {
+                        priv::render_addchar $idx $ch [dict get $overstacks $idx_over]
+                        incr idx
+                        priv::render_addchar $idx $opt_exposed2 [dict get $overstacks $idx_over]
+                        #don't incr idx - we are just putting a broken-indication in the underlay - which may get overwritten by next overlay char
+                    } else {
+                        #2wide over 2wide
+                        priv::render_addchar $idx $ch [dict get $overstacks $idx_over]
+                        incr idx 
+                    }
+                }
+            }
+        } 
+
+        #cursor movement?
+        #if {![punk::ansi::codetype::is_sgr $code]} {
+        #
+        #}
+    }
+
+    if {$opt_overflow == 0} {
+        #need to truncate to the width of the original undertext
+        #review - string_width vs printing_length here. undertext requirement to be already rendered therefore punk::char::string_width ok?
+        set num_under_columns [punk::char::string_width $pt_underchars] ;#plaintext underchars
+    }
+
+    #coalesce and replay codestacks for out char list
+    set outstring ""    
+    set remstring "" ;#remainder after overflow point reached
+    set i 0
+    set cstack [list]
+    set prevstack [list]
+    set out_rawchars ""; #for overflow counting 
+    set output_to "outstring" ;#var in effect depending on overflow
+    set in_overflow 0 ;#used to stop char-width scanning once in overflow
+    foreach ch $out {
+        append out_rawchars $ch
+        if {$opt_overflow == 0 && !$in_overflow} {
+            if {[set nextvisualwidth [punk::char::string_width $out_rawchars]] < $num_under_columns} {
+            } else {
+                #todo - check if we overflowed with a double-width char ? 
+                #store visualwidth which may be short
+                set in_overflow 1
+            }
+        }
+        set cstack [dict get $understacks $i]
+        if {$cstack ne $prevstack} {
+            if {[llength $prevstack]} {
+                append $output_to \033\[m
+            }
+            foreach code $cstack {
+                append $output_to $code
+            }
+        }
+        append $output_to $ch
+        set prevstack $cstack
+        incr i
+        if {$in_overflow} {
+            set output_to "remstring"
+        }
+    }
+    if {[dict size $understacks] > 0} {
+        append $output_to [join [dict get $understacks [expr {[dict size $understacks]-1}]] ""] ;#tail codes
+    }
+    if {[string length $remstring]} {
+        #puts stderr "remainder:$remstring"
+    }
+    #pdict $understacks
+    if {$opt_returnextra} {
+        return [list $outstring $visualwidth [string length $outstring] $remstring]
+    } else {
+        return $outstring
+    }
+    #return [join $out ""]
+}
+proc overtype::test_renderline {} {
+    set t \uFF5E ;#2-wide tilde
+    set u \uFF3F ;#2-wide underscore
+    set missing \uFFFD
+    return [list $t $u A${t}B]
+}
+
+#same as textblock::size - but we don't want that circular dependency
+proc overtype::blocksize {textblock} {
+    if {$textblock eq ""} {
+        return [dict create width 0 height 1] ;#no such thing as zero-height block - for consistency with non-empty strings having no line-endings
+    }
+    set textblock [textutil::tabify::untabify2 $textblock]
+    #stripansi on entire block in one go rather than line by line - result should be the same - review - make tests
+    set textblock [punk::ansi::stripansi $textblock]
+    if {[string first \n $textblock] >= 0} {
+        set width [tcl::mathfunc::max {*}[lmap v [punk::lib::lines_as_list -- $textblock] {::punk::char::string_width $v}]]
+    } else {
+        set width [punk::char::string_width $textblock] 
+    }
+    set num_le [expr {[string length $textblock]-[string length [string map [list \n {}] $textblock]]}] ;#faster than splitting into single-char list
+    #our concept of block-height is likely to be different to other line-counting mechanisms
+    set height [expr {$num_le + 1}] ;# one line if no le - 2 if there is one trailing le even if no data follows le
+
+    return [dict create width $width height $height] ;#maintain order in 'image processing' standard width then height - caller may use lassign [dict values [blocksize <data>]] width height
+}
+
+namespace eval overtype::priv {
+
+    #is actually addgrapheme?
+    proc render_addchar {i c stack} {
+        upvar out o
+        upvar understacks ustacks
+        set nxt [llength $o] 
+        if {$i < $nxt} {
+            lset o $i $c
+        } else {
+            lappend o $c
+        }
+        dict set ustacks $i $stack
+    }
+
+}
+
+
+
+# -- --- --- --- --- --- --- --- --- --- ---
+namespace eval overtype {
+	interp alias {} ::overtype::center {} ::overtype::centre
+}
+
+# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
+##  Ready   
+package provide overtype [namespace eval overtype {
+    variable version
+    set version 1.5.6 
+}]
+return
+
+#*** !doctools
+#[manpage_end]

src/vendormodules/struct/set-2.2.3.tm

@@ -0,0 +1,189 @@
+#----------------------------------------------------------------------
+#
+# sets.tcl --
+#
+#	Definitions for the processing of sets.
+#
+# Copyright (c) 2004-2008 by Andreas Kupries.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id: sets.tcl,v 1.17 2008/03/09 04:24:37 andreas_kupries Exp $
+#
+#----------------------------------------------------------------------
+
+# @mdgen EXCLUDE: sets_c.tcl
+
+package require Tcl 8.5-
+
+namespace eval ::struct::set {}
+
+# ### ### ### ######### ######### #########
+## Management of set implementations.
+
+# ::struct::set::LoadAccelerator --
+#
+#	Loads a named implementation, if possible.
+#
+# Arguments:
+#	key	Name of the implementation to load.
+#
+# Results:
+#	A boolean flag. True if the implementation
+#	was successfully loaded; and False otherwise.
+
+proc ::struct::set::LoadAccelerator {key} {
+    variable accel
+    set r 0
+    switch -exact -- $key {
+	critcl {
+	    # Critcl implementation of set requires Tcl 8.4.
+	    if {![package vsatisfies [package provide Tcl] 8.4]} {return 0}
+	    if {[catch {package require tcllibc}]} {return 0}
+	    set r [llength [info commands ::struct::set_critcl]]
+	}
+	tcl {
+	    variable selfdir
+	    source [file join $selfdir sets_tcl.tcl]
+	    set r 1
+	}
+        default {
+            return -code error "invalid accelerator/impl. package $key:\
+                must be one of [join [KnownImplementations] {, }]"
+        }
+    }
+    set accel($key) $r
+    return $r
+}
+
+# ::struct::set::SwitchTo --
+#
+#	Activates a loaded named implementation.
+#
+# Arguments:
+#	key	Name of the implementation to activate.
+#
+# Results:
+#	None.
+
+proc ::struct::set::SwitchTo {key} {
+    variable accel
+    variable loaded
+
+    if {[string equal $key $loaded]} {
+	# No change, nothing to do.
+	return
+    } elseif {![string equal $key ""]} {
+	# Validate the target implementation of the switch.
+
+	if {![info exists accel($key)]} {
+	    return -code error "Unable to activate unknown implementation \"$key\""
+	} elseif {![info exists accel($key)] || !$accel($key)} {
+	    return -code error "Unable to activate missing implementation \"$key\""
+	}
+    }
+
+    # Deactivate the previous implementation, if there was any.
+
+    if {![string equal $loaded ""]} {
+	rename ::struct::set ::struct::set_$loaded
+    }
+
+    # Activate the new implementation, if there is any.
+
+    if {![string equal $key ""]} {
+	rename ::struct::set_$key ::struct::set
+    }
+
+    # Remember the active implementation, for deactivation by future
+    # switches.
+
+    set loaded $key
+    return
+}
+
+proc ::struct::set::Loaded {} {
+    variable loaded
+    return  $loaded
+}
+
+# ::struct::set::Implementations --
+#
+#	Determines which implementations are
+#	present, i.e. loaded.
+#
+# Arguments:
+#	None.
+#
+# Results:
+#	A list of implementation keys.
+
+proc ::struct::set::Implementations {} {
+    variable accel
+    set res {}
+    foreach n [array names accel] {
+	if {!$accel($n)} continue
+	lappend res $n
+    }
+    return $res
+}
+
+# ::struct::set::KnownImplementations --
+#
+#	Determines which implementations are known
+#	as possible implementations.
+#
+# Arguments:
+#	None.
+#
+# Results:
+#	A list of implementation keys. In the order
+#	of preference, most prefered first.
+
+proc ::struct::set::KnownImplementations {} {
+    return {critcl tcl}
+}
+
+proc ::struct::set::Names {} {
+    return {
+	critcl {tcllibc based}
+	tcl    {pure Tcl}
+    }
+}
+
+# ### ### ### ######### ######### #########
+## Initialization: Data structures.
+
+namespace eval ::struct::set {
+    variable  selfdir [file dirname [info script]]
+    variable  accel
+    array set accel   {tcl 0 critcl 0}
+    variable  loaded  {}
+}
+
+# ### ### ### ######### ######### #########
+## Initialization: Choose an implementation,
+## most prefered first. Loads only one of the
+## possible implementations. And activates it.
+
+namespace eval ::struct::set {
+    variable e
+    foreach e [KnownImplementations] {
+	if {[LoadAccelerator $e]} {
+	    SwitchTo $e
+	    break
+	}
+    }
+    unset e
+}
+
+# ### ### ### ######### ######### #########
+## Ready
+
+namespace eval ::struct {
+    # Export the constructor command.
+    namespace export set
+}
+
+package provide struct::set 2.2.3

src/vendormodules/struct/sets.tcl

@@ -0,0 +1,189 @@
+#----------------------------------------------------------------------
+#
+# sets.tcl --
+#
+#	Definitions for the processing of sets.
+#
+# Copyright (c) 2004-2008 by Andreas Kupries.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id: sets.tcl,v 1.17 2008/03/09 04:24:37 andreas_kupries Exp $
+#
+#----------------------------------------------------------------------
+
+# @mdgen EXCLUDE: sets_c.tcl
+
+package require Tcl 8.5-
+
+namespace eval ::struct::set {}
+
+# ### ### ### ######### ######### #########
+## Management of set implementations.
+
+# ::struct::set::LoadAccelerator --
+#
+#	Loads a named implementation, if possible.
+#
+# Arguments:
+#	key	Name of the implementation to load.
+#
+# Results:
+#	A boolean flag. True if the implementation
+#	was successfully loaded; and False otherwise.
+
+proc ::struct::set::LoadAccelerator {key} {
+    variable accel
+    set r 0
+    switch -exact -- $key {
+	critcl {
+	    # Critcl implementation of set requires Tcl 8.4.
+	    if {![package vsatisfies [package provide Tcl] 8.4]} {return 0}
+	    if {[catch {package require tcllibc}]} {return 0}
+	    set r [llength [info commands ::struct::set_critcl]]
+	}
+	tcl {
+	    variable selfdir
+	    source [file join $selfdir sets_tcl.tcl]
+	    set r 1
+	}
+        default {
+            return -code error "invalid accelerator/impl. package $key:\
+                must be one of [join [KnownImplementations] {, }]"
+        }
+    }
+    set accel($key) $r
+    return $r
+}
+
+# ::struct::set::SwitchTo --
+#
+#	Activates a loaded named implementation.
+#
+# Arguments:
+#	key	Name of the implementation to activate.
+#
+# Results:
+#	None.
+
+proc ::struct::set::SwitchTo {key} {
+    variable accel
+    variable loaded
+
+    if {[string equal $key $loaded]} {
+	# No change, nothing to do.
+	return
+    } elseif {![string equal $key ""]} {
+	# Validate the target implementation of the switch.
+
+	if {![info exists accel($key)]} {
+	    return -code error "Unable to activate unknown implementation \"$key\""
+	} elseif {![info exists accel($key)] || !$accel($key)} {
+	    return -code error "Unable to activate missing implementation \"$key\""
+	}
+    }
+
+    # Deactivate the previous implementation, if there was any.
+
+    if {![string equal $loaded ""]} {
+	rename ::struct::set ::struct::set_$loaded
+    }
+
+    # Activate the new implementation, if there is any.
+
+    if {![string equal $key ""]} {
+	rename ::struct::set_$key ::struct::set
+    }
+
+    # Remember the active implementation, for deactivation by future
+    # switches.
+
+    set loaded $key
+    return
+}
+
+proc ::struct::set::Loaded {} {
+    variable loaded
+    return  $loaded
+}
+
+# ::struct::set::Implementations --
+#
+#	Determines which implementations are
+#	present, i.e. loaded.
+#
+# Arguments:
+#	None.
+#
+# Results:
+#	A list of implementation keys.
+
+proc ::struct::set::Implementations {} {
+    variable accel
+    set res {}
+    foreach n [array names accel] {
+	if {!$accel($n)} continue
+	lappend res $n
+    }
+    return $res
+}
+
+# ::struct::set::KnownImplementations --
+#
+#	Determines which implementations are known
+#	as possible implementations.
+#
+# Arguments:
+#	None.
+#
+# Results:
+#	A list of implementation keys. In the order
+#	of preference, most prefered first.
+
+proc ::struct::set::KnownImplementations {} {
+    return {critcl tcl}
+}
+
+proc ::struct::set::Names {} {
+    return {
+	critcl {tcllibc based}
+	tcl    {pure Tcl}
+    }
+}
+
+# ### ### ### ######### ######### #########
+## Initialization: Data structures.
+
+namespace eval ::struct::set {
+    variable  selfdir [file dirname [info script]]
+    variable  accel
+    array set accel   {tcl 0 critcl 0}
+    variable  loaded  {}
+}
+
+# ### ### ### ######### ######### #########
+## Initialization: Choose an implementation,
+## most prefered first. Loads only one of the
+## possible implementations. And activates it.
+
+namespace eval ::struct::set {
+    variable e
+    foreach e [KnownImplementations] {
+	if {[LoadAccelerator $e]} {
+	    SwitchTo $e
+	    break
+	}
+    }
+    unset e
+}
+
+# ### ### ### ######### ######### #########
+## Ready
+
+namespace eval ::struct {
+    # Export the constructor command.
+    namespace export set
+}
+
+package provide struct::set 2.2.3

src/vendormodules/struct/sets_c.tcl

@@ -0,0 +1,93 @@
+#----------------------------------------------------------------------
+#
+# sets_tcl.tcl --
+#
+#       Definitions for the processing of sets. C implementation.
+#
+# Copyright (c) 2007 by Andreas Kupries.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id: sets_c.tcl,v 1.3 2008/03/25 07:15:34 andreas_kupries Exp $
+#
+#----------------------------------------------------------------------
+
+package require critcl
+# @sak notprovided struct_setc
+package provide struct_setc 2.1.1
+package require Tcl 8.5-
+
+namespace eval ::struct {
+    # Supporting code for the main command.
+
+    catch {
+        #critcl::cheaders -g
+        #critcl::debug memory symbols
+    }
+
+    critcl::cheaders sets/*.h
+    critcl::csources sets/*.c
+
+    critcl::ccode {
+        /* -*- c -*- */
+
+        #include <m.h>
+    }
+
+    # Main command, set creation.
+
+    critcl::ccommand set_critcl {dummy interp objc objv} {
+	/* Syntax - dispatcher to the sub commands.
+	 */
+
+        static CONST char* methods [] = {
+            "add",      "contains",     "difference",   "empty",
+            "equal","exclude",  "include",      "intersect",
+            "intersect3",       "size", "subsetof",     "subtract",
+            "symdiff",  "union",
+            NULL
+        };
+        enum methods {
+            S_add,      S_contains,     S_difference,   S_empty,
+            S_equal,S_exclude,  S_include,      S_intersect,
+            S_intersect3,       S_size, S_subsetof,     S_subtract,
+            S_symdiff,  S_union
+        };
+
+	int m;
+
+        if (objc < 2) {
+            Tcl_WrongNumArgs (interp, objc, objv, "cmd ?arg ...?");
+            return TCL_ERROR;
+        } else if (Tcl_GetIndexFromObj (interp, objv [1], methods, "option",
+            0, &m) != TCL_OK) {
+            return TCL_ERROR;
+        }
+
+        /* Dispatch to methods. They check the #args in detail before performing
+         * the requested functionality
+         */
+
+        switch (m) {
+            case S_add:        return sm_ADD        (NULL, interp, objc, objv);
+            case S_contains:   return sm_CONTAINS   (NULL, interp, objc, objv);
+            case S_difference: return sm_DIFFERENCE (NULL, interp, objc, objv);
+            case S_empty:      return sm_EMPTY      (NULL, interp, objc, objv);
+            case S_equal:      return sm_EQUAL      (NULL, interp, objc, objv);
+            case S_exclude:    return sm_EXCLUDE    (NULL, interp, objc, objv);
+            case S_include:    return sm_INCLUDE    (NULL, interp, objc, objv);
+            case S_intersect:  return sm_INTERSECT  (NULL, interp, objc, objv);
+            case S_intersect3: return sm_INTERSECT3 (NULL, interp, objc, objv);
+            case S_size:       return sm_SIZE       (NULL, interp, objc, objv);
+            case S_subsetof:   return sm_SUBSETOF   (NULL, interp, objc, objv);
+            case S_subtract:   return sm_SUBTRACT   (NULL, interp, objc, objv);
+            case S_symdiff:    return sm_SYMDIFF    (NULL, interp, objc, objv);
+            case S_union:      return sm_UNION      (NULL, interp, objc, objv);
+        }
+        /* Not coming to this place */
+    }
+}
+
+# ### ### ### ######### ######### #########
+## Ready

src/vendormodules/struct/sets_tcl.tcl

@@ -0,0 +1,452 @@
+#----------------------------------------------------------------------
+#
+# sets_tcl.tcl --
+#
+#	Definitions for the processing of sets.
+#
+# Copyright (c) 2004-2008 by Andreas Kupries.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id: sets_tcl.tcl,v 1.4 2008/03/09 04:38:47 andreas_kupries Exp $
+#
+#----------------------------------------------------------------------
+
+package require Tcl 8.5-
+
+namespace eval ::struct::set {
+    # Only export one command, the one used to instantiate a new tree
+    namespace export set_tcl
+}
+
+##########################
+# Public functions
+
+# ::struct::set::set --
+#
+#	Command that access all set commands.
+#
+# Arguments:
+#	cmd	Name of the subcommand to dispatch to.
+#	args	Arguments for the subcommand.
+#
+# Results:
+#	Whatever the result of the subcommand is.
+
+proc ::struct::set::set_tcl {cmd args} {
+    # Do minimal args checks here
+    if { [llength [info level 0]] == 1 } {
+	return -code error "wrong # args: should be \"$cmd ?arg arg ...?\""
+    }
+    ::set sub S_$cmd
+    if { [llength [info commands ::struct::set::$sub]] == 0 } {
+	::set optlist [info commands ::struct::set::S_*]
+	::set xlist {}
+	foreach p $optlist {
+	    lappend xlist [string range $p 17 end]
+	}
+	return -code error \
+		"bad option \"$cmd\": must be [linsert [join [lsort $xlist] ", "] "end-1" "or"]"
+    }
+    return [uplevel 1 [linsert $args 0 ::struct::set::$sub]]
+}
+
+##########################
+# Implementations of the functionality.
+#
+
+# ::struct::set::S_empty --
+#
+#       Determines emptiness of the set
+#
+# Parameters:
+#       set	-- The set to check for emptiness.
+#
+# Results:
+#       A boolean value. True indicates that the set is empty.
+#
+# Side effects:
+#       None.
+#
+# Notes:
+
+proc ::struct::set::S_empty {set} {
+    return [expr {[llength $set] == 0}]
+}
+
+# ::struct::set::S_size --
+#
+#	Computes the cardinality of the set.
+#
+# Parameters:
+#	set	-- The set to inspect.
+#
+# Results:
+#       An integer greater than or equal to zero.
+#
+# Side effects:
+#       None.
+
+proc ::struct::set::S_size {set} {
+    return [llength [Cleanup $set]]
+}
+
+# ::struct::set::S_contains --
+#
+#	Determines if the item is in the set.
+#
+# Parameters:
+#	set	-- The set to inspect.
+#	item	-- The element to look for.
+#
+# Results:
+#	A boolean value. True indicates that the element is present.
+#
+# Side effects:
+#       None.
+
+proc ::struct::set::S_contains {set item} {
+    return [expr {[lsearch -exact $set $item] >= 0}]
+}
+
+# ::struct::set::S_union --
+#
+#	Computes the union of the arguments.
+#
+# Parameters:
+#	args	-- List of sets to unify.
+#
+# Results:
+#	The union of the arguments.
+#
+# Side effects:
+#       None.
+
+proc ::struct::set::S_union {args} {
+    switch -exact -- [llength $args] {
+	0 {return {}}
+	1 {return [lindex $args 0]}
+    }
+    foreach setX $args {
+	foreach x $setX {::set ($x) {}}
+    }
+    return [array names {}]
+}
+
+
+# ::struct::set::S_intersect --
+#
+#	Computes the intersection of the arguments.
+#
+# Parameters:
+#	args	-- List of sets to intersect.
+#
+# Results:
+#	The intersection of the arguments
+#
+# Side effects:
+#       None.
+
+proc ::struct::set::S_intersect {args} {
+    switch -exact -- [llength $args] {
+	0 {return {}}
+	1 {return [lindex $args 0]}
+    }
+    ::set res [lindex $args 0]
+    foreach set [lrange $args 1 end] {
+	if {[llength $res] && [llength $set]} {
+	    ::set res [Intersect $res $set]
+	} else {
+	    # Squash 'res'. Otherwise we get the wrong result if res
+	    # is not empty, but 'set' is.
+	    ::set res {}
+	    break
+	}
+    }
+    return $res
+}
+
+proc ::struct::set::Intersect {A B} {
+    if {[llength $A] == 0} {return {}}
+    if {[llength $B] == 0} {return {}}
+
+    # This is slower than local vars, but more robust
+    if {[llength $B] > [llength $A]} {
+	::set res $A
+	::set A $B
+	::set B $res
+    }
+    ::set res {}
+    foreach x $A {::set ($x) {}}
+    foreach x $B {
+	if {[info exists ($x)]} {
+	    lappend res $x
+	}
+    }
+    return $res
+}
+
+# ::struct::set::S_difference --
+#
+#	Compute difference of two sets.
+#
+# Parameters:
+#	A, B	-- Sets to compute the difference for.
+#
+# Results:
+#	A - B
+#
+# Side effects:
+#       None.
+
+proc ::struct::set::S_difference {A B} {
+    if {[llength $A] == 0} {return {}}
+    if {[llength $B] == 0} {return $A}
+
+    array set tmp {}
+    foreach x $A {::set tmp($x) .}
+    foreach x $B {catch {unset tmp($x)}}
+    return [array names tmp]
+}
+
+if {0} {
+    # Tcllib SF Bug 1002143. We cannot use the implementation below.
+    # It will treat set elements containing '(' and ')' as array
+    # elements, and this screws up the storage of elements as the name
+    # of local vars something fierce. No way around this. Disabling
+    # this code and always using the other implementation (s.a.) is
+    # the only possible fix.
+
+    if {[package vcompare [package provide Tcl] 8.4] < 0} {
+	# Tcl 8.[23]. Use explicit array to perform the operation.
+    } else {
+	# Tcl 8.4+, has 'unset -nocomplain'
+
+	proc ::struct::set::S_difference {A B} {
+	    if {[llength $A] == 0} {return {}}
+	    if {[llength $B] == 0} {return $A}
+
+	    # Get the variable B out of the way, avoid collisions
+	    # prepare for "pure list optimization"
+	    ::set ::struct::set::tmp [lreplace $B -1 -1 unset -nocomplain]
+	    unset B
+
+	    # unset A early: no local variables left
+	    foreach [lindex [list $A [unset A]] 0] {.} {break}
+
+	    eval $::struct::set::tmp
+	    return [info locals]
+	}
+    }
+}
+
+# ::struct::set::S_symdiff --
+#
+#	Compute symmetric difference of two sets.
+#
+# Parameters:
+#	A, B	-- The sets to compute the s.difference for.
+#
+# Results:
+#	The symmetric difference of the two input sets.
+#
+# Side effects:
+#       None.
+
+proc ::struct::set::S_symdiff {A B} {
+    # symdiff == (A-B) + (B-A) == (A+B)-(A*B)
+    if {[llength $A] == 0} {return $B}
+    if {[llength $B] == 0} {return $A}
+    return [S_union \
+	    [S_difference $A $B] \
+	    [S_difference $B $A]]
+}
+
+# ::struct::set::S_intersect3 --
+#
+#	Return intersection and differences for two sets.
+#
+# Parameters:
+#	A, B	-- The sets to inspect.
+#
+# Results:
+#	List containing A*B, A-B, and B-A
+#
+# Side effects:
+#       None.
+
+proc ::struct::set::S_intersect3 {A B} {
+    return [list \
+	    [S_intersect $A $B] \
+	    [S_difference $A $B] \
+	    [S_difference $B $A]]
+}
+
+# ::struct::set::S_equal --
+#
+#	Compares two sets for equality.
+#
+# Parameters:
+#	a	First set to compare.
+#	b	Second set to compare.
+#
+# Results:
+#	A boolean. True if the lists are equal.
+#
+# Side effects:
+#       None.
+
+proc ::struct::set::S_equal {A B} {
+    ::set A [Cleanup $A]
+    ::set B [Cleanup $B]
+
+    # Equal if of same cardinality and difference is empty.
+
+    if {[::llength $A] != [::llength $B]} {return 0}
+    return [expr {[llength [S_difference $A $B]] == 0}]
+}
+
+
+proc ::struct::set::Cleanup {A} {
+    # unset A to avoid collisions
+    if {[llength $A] < 2} {return $A}
+    # We cannot use variables to avoid an explicit array. The set
+    # elements may look like namespace vars (i.e. contain ::), and
+    # such elements break that, cannot be proc-local variables.
+    array set S {}
+    foreach item $A {set S($item) .}
+    return [array names S]
+}
+
+# ::struct::set::S_include --
+#
+#	Add an element to a set.
+#
+# Parameters:
+#	Avar	-- Reference to the set variable to extend.
+#	element	-- The item to add to the set.
+#
+# Results:
+#	None.
+#
+# Side effects:
+#       The set in the variable referenced by Avar is extended
+#	by the element (if the element was not already present).
+
+proc ::struct::set::S_include {Avar element} {
+    # Avar = Avar + {element}
+    upvar 1 $Avar A
+    if {![info exists A] || ![S_contains $A $element]} {
+	lappend A $element
+    }
+    return
+}
+
+# ::struct::set::S_exclude --
+#
+#	Remove an element from a set.
+#
+# Parameters:
+#	Avar	-- Reference to the set variable to shrink.
+#	element	-- The item to remove from the set.
+#
+# Results:
+#	None.
+#
+# Side effects:
+#       The set in the variable referenced by Avar is shrunk,
+#	the element remove (if the element was actually present).
+
+proc ::struct::set::S_exclude {Avar element} {
+    # Avar = Avar - {element}
+    upvar 1 $Avar A
+    if {![info exists A]} {return -code error "can't read \"$Avar\": no such variable"}
+    while {[::set pos [lsearch -exact $A $element]] >= 0} {
+	::set A [lreplace [K $A [::set A {}]] $pos $pos]
+    }
+    return
+}
+
+# ::struct::set::S_add --
+#
+#	Add a set to a set. Similar to 'union', but the first argument
+#	is a variable.
+#
+# Parameters:
+#	Avar	-- Reference to the set variable to extend.
+#	B	-- The set to add to the set in Avar.
+#
+# Results:
+#	None.
+#
+# Side effects:
+#       The set in the variable referenced by Avar is extended
+#	by all the elements in B.
+
+proc ::struct::set::S_add {Avar B} {
+    # Avar = Avar + B
+    upvar 1 $Avar A
+    if {![info exists A]} {set A {}}
+    ::set A [S_union [K $A [::set A {}]] $B]
+    return
+}
+
+# ::struct::set::S_subtract --
+#
+#	Remove a set from a set. Similar to 'difference', but the first argument
+#	is a variable.
+#
+# Parameters:
+#	Avar	-- Reference to the set variable to shrink.
+#	B	-- The set to remove from the set in Avar.
+#
+# Results:
+#	None.
+#
+# Side effects:
+#       The set in the variable referenced by Avar is shrunk,
+#	all elements of B are removed.
+
+proc ::struct::set::S_subtract {Avar B} {
+    # Avar = Avar - B
+    upvar 1 $Avar A
+    if {![info exists A]} {return -code error "can't read \"$Avar\": no such variable"}
+    ::set A [S_difference [K $A [::set A {}]] $B]
+    return
+}
+
+# ::struct::set::S_subsetof --
+#
+#	A predicate checking if the first set is a subset
+#	or equal to the second set.
+#
+# Parameters:
+#	A	-- The possible subset.
+#	B	-- The set to compare to.
+#
+# Results:
+#	A boolean value, true if A is subset of or equal to B
+#
+# Side effects:
+#       None.
+
+proc ::struct::set::S_subsetof {A B} {
+    # A subset|== B <=> (A == A*B)
+    return [S_equal $A [S_intersect $A $B]]
+}
+
+# ::struct::set::K --
+# Performance helper command.
+
+proc ::struct::set::K {x y} {::set x}
+
+# ### ### ### ######### ######### #########
+## Ready
+
+namespace eval ::struct {
+    # Put 'set::set' into the general structure namespace
+    # for pickup by the main management.
+
+    namespace import -force set::set_tcl
+}

src/vendormodules/textutil-0.9.tm

@@ -0,0 +1,80 @@
+# textutil.tcl --
+#
+#	Utilities for manipulating strings, words, single lines,
+#	paragraphs, ...
+#
+# Copyright (c) 2000      by Ajuba Solutions.
+# Copyright (c) 2000      by Eric Melski <ericm@ajubasolutions.com>
+# Copyright (c) 2002      by Joe English <jenglish@users.sourceforge.net>
+# Copyright (c) 2001-2006 by Andreas Kupries <andreas_kupries@users.sourceforge.net>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id: textutil.tcl,v 1.17 2006/09/21 06:46:24 andreas_kupries Exp $
+
+# ### ### ### ######### ######### #########
+## Requirements
+
+package require Tcl 8.2
+
+namespace eval ::textutil {}
+
+# ### ### ### ######### ######### #########
+## API implementation
+## All through sub-packages imported here.
+
+package require textutil::string
+package require textutil::repeat
+package require textutil::adjust
+package require textutil::split
+package require textutil::tabify
+package require textutil::trim
+package require textutil::wcswidth
+
+namespace eval ::textutil {
+    # Import the miscellaneous string command for public export
+
+    namespace import -force string::chop string::tail
+    namespace import -force string::cap string::uncap string::capEachWord
+    namespace import -force string::longestCommonPrefix
+    namespace import -force string::longestCommonPrefixList
+
+    # Import the repeat commands for public export
+
+    namespace import -force repeat::strRepeat repeat::blank
+
+    # Import the adjust commands for public export
+
+    namespace import -force adjust::adjust adjust::indent adjust::undent
+
+    # Import the split commands for public export
+
+    namespace import -force split::splitx split::splitn
+
+    # Import the trim commands for public export
+
+    namespace import -force trim::trim trim::trimleft trim::trimright
+    namespace import -force trim::trimPrefix trim::trimEmptyHeading
+
+    # Import the tabify commands for public export
+
+    namespace import -force tabify::tabify tabify::untabify
+    namespace import -force tabify::tabify2 tabify::untabify2
+
+    # Re-export all the imported commands
+
+    namespace export chop tail cap uncap capEachWord
+    namespace export longestCommonPrefix longestCommonPrefixList
+    namespace export strRepeat blank
+    namespace export adjust indent undent
+    namespace export splitx splitn
+    namespace export trim trimleft trimright trimPrefix trimEmptyHeading
+    namespace export tabify untabify tabify2 untabify2
+}
+
+
+# ### ### ### ######### ######### #########
+## Ready
+
+package provide textutil 0.9

src/vendormodules/textutil/adjust-0.7.3.tm

@@ -0,0 +1,761 @@
+# trim.tcl --
+#
+#	Various ways of trimming a string.
+#
+# Copyright (c) 2000      by Ajuba Solutions.
+# Copyright (c) 2000      by Eric Melski <ericm@ajubasolutions.com>
+# Copyright (c) 2002-2004 by Johannes-Heinrich Vogeler <vogeler@users.sourceforge.net>
+# Copyright (c) 2001-2006 by Andreas Kupries <andreas_kupries@users.sourceforge.net>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id: adjust.tcl,v 1.16 2011/12/13 18:12:56 andreas_kupries Exp $
+
+# ### ### ### ######### ######### #########
+## Requirements
+
+package require Tcl 8.2
+package require textutil::repeat
+package require textutil::string
+
+namespace eval ::textutil::adjust {}
+
+# ### ### ### ######### ######### #########
+## API implementation
+
+namespace eval ::textutil::adjust {
+    namespace import -force ::textutil::repeat::strRepeat
+}
+
+proc ::textutil::adjust::adjust {text args} {
+    if {[string length [string trim $text]] == 0} {
+        return ""
+    }
+
+    Configure $args
+    Adjust text newtext
+
+    return $newtext
+}
+
+proc ::textutil::adjust::Configure {args} {
+    variable Justify      left
+    variable Length       72
+    variable FullLine     0
+    variable StrictLength 0
+    variable Hyphenate    0
+    variable HyphPatterns    ; # hyphenation patterns (TeX)
+
+    set args [ lindex $args 0 ]
+    foreach { option value } $args {
+	switch -exact -- $option {
+	    -full {
+		if { ![ string is boolean -strict $value ] } then {
+		    error "expected boolean but got \"$value\""
+		}
+		set FullLine [ string is true $value ]
+	    }
+	    -hyphenate {
+		# the word exceeding the length of line is tried to be
+		# hyphenated; if a word cannot be hyphenated to fit into
+		# the line processing stops! The length of the line should
+		# be set to a reasonable value!
+
+		if { ![ string is boolean -strict $value ] } then {
+		    error "expected boolean but got \"$value\""
+		}
+		set Hyphenate [string is true $value]
+		if { $Hyphenate && ![info exists HyphPatterns(_LOADED_)]} {
+		    error "hyphenation patterns not loaded!"
+		}
+	    }
+	    -justify {
+		set lovalue [ string tolower $value ]
+		switch -exact -- $lovalue {
+		    left -
+		    right -
+		    center -
+		    plain {
+			set Justify $lovalue
+		    }
+		    default {
+			error "bad value \"$value\": should be center, left, plain or right"
+		    }
+		}
+	    }
+	    -length {
+		if { ![ string is integer $value ] } then {
+		    error "expected positive integer but got \"$value\""
+		}
+		if { $value < 1 } then {
+		    error "expected positive integer but got \"$value\""
+		}
+		set Length $value
+	    }
+	    -strictlength {
+		# the word exceeding the length of line is moved to the
+		# next line without hyphenation; words longer than given
+		# line length are cut into smaller pieces
+
+		if { ![ string is boolean -strict $value ] } then {
+		    error "expected boolean but got \"$value\""
+		}
+		set StrictLength [ string is true $value ]
+	    }
+	    default {
+		error "bad option \"$option\": must be -full, -hyphenate, \
+			-justify, -length, or -strictlength"
+	    }
+	}
+    }
+
+    return ""
+}
+
+# ::textutil::adjust::Adjust
+#
+# History:
+#      rewritten on 2004-04-13 for bugfix tcllib-bugs-882402 (jhv)
+
+proc ::textutil::adjust::Adjust { varOrigName varNewName } {
+    variable Length
+    variable FullLine
+    variable StrictLength
+    variable Hyphenate
+
+    upvar $varOrigName orig
+    upvar $varNewName  text
+
+    set pos 0;                                   # Cursor after writing
+    set line ""
+    set text ""
+
+
+    if {!$FullLine} {
+	regsub -all -- "(\n)|(\t)"     $orig   " "  orig
+	regsub -all -- " +"            $orig  " "   orig
+	regsub -all -- "(^ *)|( *\$)"  $orig  ""    orig
+    }
+
+    set words [split $orig]
+    set numWords [llength $words]
+    set numline 0
+
+    for {set cnt 0} {$cnt < $numWords} {incr cnt} {
+
+	set w [lindex $words $cnt]
+	set wLen [string length $w]
+
+	# the word $w doesn't fit into the present line
+	# case #1: we try to hyphenate
+
+	if {$Hyphenate && ($pos+$wLen >= $Length)} {
+	    # Hyphenation instructions
+	    set w2 [textutil::adjust::Hyphenation $w]
+
+	    set iMax [llength $w2]
+	    if {$iMax == 1 && [string length $w] > $Length} {
+		# word cannot be hyphenated and exceeds linesize
+
+		error "Word \"$w2\" can\'t be hyphenated\
+			and exceeds linesize $Length!"
+	    } else {
+		# hyphenating of $w was successfull, but we have to look
+		# that every sylable would fit into the line
+
+		foreach x $w2 {
+		    if {[string length $x] >= $Length} {
+			error "Word \"$w\" can\'t be hyphenated\
+				to fit into linesize $Length!"
+		    }
+		}
+	    }
+
+	    for {set i 0; set w3 ""} {$i < $iMax} {incr i} {
+		set syl [lindex $w2 $i]
+		if {($pos+[string length " $w3$syl-"]) > $Length} {break}
+		append w3 $syl
+	    }
+	    for {set w4 ""} {$i < $iMax} {incr i} {
+		set syl [lindex $w2 $i]
+		append w4 $syl
+	    }
+
+	    if {[string length $w3] && [string length $w4]} {
+		# hyphenation was successfull: redefine
+		# list of words w => {"$w3-" "$w4"}
+
+		set x [lreplace $words $cnt $cnt "$w4"]
+		set words [linsert $x $cnt "$w3-"]
+		set w [lindex $words $cnt]
+		set wLen [string length $w]
+		incr numWords
+	    }
+	}
+
+	# the word $w doesn't fit into the present line
+	# case #2: we try to cut the word into pieces
+
+	if {$StrictLength && ([string length $w] > $Length)} {
+	    # cut word into two pieces
+	    set w2 $w
+
+	    set over [expr {$pos+2+$wLen-$Length}]
+
+	    incr Length -1
+	    set w3   [string range $w2 0 $Length]
+	    incr Length
+	    set w4   [string range $w2 $Length end]
+
+	    set x [lreplace $words $cnt $cnt $w4]
+	    set words [linsert $x $cnt $w3 ]
+	    set w [lindex $words $cnt]
+	    set wLen [string length $w]
+	    incr numWords
+	}
+
+	# continuing with the normal procedure
+
+	if {($pos+$wLen < $Length)} {
+	    # append word to current line
+
+	    if {$pos} {append line " "; incr pos}
+	    append line $w
+	    incr pos $wLen
+	} else {
+	    # line full => write buffer and  begin a new line
+
+	    if {[string length $text]} {append text "\n"}
+	    append text [Justification $line [incr numline]]
+	    set line $w
+	    set pos $wLen
+	}
+    }
+
+    # write buffer and return!
+
+    if {[string length $text]} {append text "\n"}
+    append text [Justification $line end]
+    return $text
+}
+
+# ::textutil::adjust::Justification
+#
+# justify a given line
+#
+# Parameters:
+#      line    text for justification
+#      index   index for line in text
+#
+# Returns:
+#      the justified line
+#
+# Remarks:
+#      Only lines with size not exceeding the max. linesize provided
+#      for text formatting are justified!!!
+
+proc ::textutil::adjust::Justification { line index } {
+    variable Justify
+    variable Length
+    variable FullLine
+
+    set len [string length $line];               # length of current line
+
+    if { $Length <= $len } then {
+	# the length of current line ($len) is equal as or greater than
+	# the value provided for text formatting ($Length) => to avoid
+	# inifinite loops we leave $line unchanged and return!
+
+	return $line
+    }
+
+    # Special case:
+    # for the last line, and if the justification is set to 'plain'
+    # the real justification is 'left' if the length of the line
+    # is less than 90% (rounded) of the max length allowed. This is
+    # to avoid expansion of this line when it is too small: without
+    # it, the added spaces will 'unbeautify' the result.
+    #
+
+    set justify $Justify
+    if { ( "$index" == "end" ) && \
+	    ( "$Justify" == "plain" ) && \
+	    ( $len < round($Length * 0.90) ) } then {
+	set justify left
+    }
+
+    # For a left justification, nothing to do, but to
+    # add some spaces at the end of the line if requested
+
+    if { "$justify" == "left" } then {
+	set jus ""
+	if { $FullLine } then {
+	    set jus [strRepeat " " [ expr { $Length - $len } ]]
+	}
+	return "${line}${jus}"
+    }
+
+    # For a right justification, just add enough spaces
+    # at the beginning of the line
+
+    if { "$justify" == "right" } then {
+	set jus [strRepeat " " [ expr { $Length - $len } ]]
+	return "${jus}${line}"
+    }
+
+    # For a center justification, add half of the needed spaces
+    # at the beginning of the line, and the rest at the end
+    # only if needed.
+
+    if { "$justify" == "center" } then {
+	set mr [ expr { ( $Length - $len ) / 2 } ]
+	set ml [ expr { $Length - $len - $mr } ]
+	set jusl [strRepeat " " $ml]
+	set jusr [strRepeat " " $mr]
+	if { $FullLine } then {
+	    return "${jusl}${line}${jusr}"
+	} else {
+	    return "${jusl}${line}"
+	}
+    }
+
+    # For a plain justification, it's a little bit complex:
+    #
+    # if some spaces are missing, then
+    #
+    # 1) sort the list of words in the current line by decreasing size
+    # 2) foreach word, add one space before it, except if it's the
+    #    first word, until enough spaces are added
+    # 3) rebuild the line
+
+    if { "$justify" == "plain" } then {
+	set miss [ expr { $Length - [ string length $line ] } ]
+
+	# Bugfix tcllib-bugs-860753 (jhv)
+
+	set words [split $line]
+	set numWords [llength $words]
+
+	if {$numWords < 2} {
+	    # current line consists of less than two words - we can't
+	    # insert blanks to achieve a plain justification => leave
+	    # $line unchanged and return!
+
+	    return $line
+	}
+
+	for {set i 0; set totalLen 0} {$i < $numWords} {incr i} {
+	    set w($i) [lindex $words $i]
+	    if {$i > 0} {set w($i) " $w($i)"}
+	    set wLen($i) [string length $w($i)]
+	    set totalLen [expr {$totalLen+$wLen($i)}]
+	}
+
+	set miss [expr {$Length - $totalLen}]
+
+	# len walks through all lengths of words of the line under
+	# consideration
+
+	for {set len 1} {$miss > 0} {incr len} {
+	    for {set i 1} {($i < $numWords) && ($miss > 0)} {incr i} {
+		if {$wLen($i) == $len} {
+		    set w($i) " $w($i)"
+		    incr wLen($i)
+		    incr miss -1
+		}
+	    }
+	}
+
+	set line ""
+	for {set i 0} {$i < $numWords} {incr i} {
+	    set line "$line$w($i)"
+	}
+
+	# End of bugfix
+
+	return "${line}"
+    }
+
+    error "Illegal justification key \"$justify\""
+}
+
+proc ::textutil::adjust::SortList { list dir index } {
+
+    if { [ catch { lsort -integer -$dir -index $index $list } sl ] != 0 } then {
+        error "$sl"
+    }
+
+    return $sl
+}
+
+# Hyphenation utilities based on Knuth's algorithm
+#
+# Copyright (C) 2001-2003 by Dr.Johannes-Heinrich Vogeler (jhv)
+# These procedures may be used as part of the tcllib
+
+# textutil::adjust::Hyphenation
+#
+#      Hyphenate a string using Knuth's algorithm
+#
+# Parameters:
+#      str     string to be hyphenated
+#
+# Returns:
+#      the hyphenated string
+
+proc ::textutil::adjust::Hyphenation { str } {
+
+    # if there are manual set hyphenation marks e.g. "Recht\-schrei\-bung"
+    # use these for hyphenation and return
+
+    if {[regexp {[^\\-]*[\\-][.]*} $str]} {
+	regsub -all {(\\)(-)} $str {-} tmp
+	return [split $tmp -]
+    }
+
+    # Don't hyphenate very short words! Minimum length for hyphenation
+    # is set to 3 characters!
+
+    if { [string length $str] < 4 } then { return $str }
+
+    # otherwise follow Knuth's algorithm
+
+    variable HyphPatterns;                       # hyphenation patterns (TeX)
+
+    set w ".[string tolower $str].";             # transform to lower case
+    set wLen [string length $w];                 # and add delimiters
+
+    # Initialize hyphenation weights
+
+    set s {}
+    for {set i 0} {$i < $wLen} {incr i} {
+	lappend s 0
+    }
+
+    for {set i 0} {$i < $wLen} {incr i} {
+	set kmax [expr {$wLen-$i}]
+	for {set k 1} {$k < $kmax} {incr k} {
+	    set sw [string range $w $i [expr {$i+$k}]]
+	    if {[info exists HyphPatterns($sw)]} {
+		set hw $HyphPatterns($sw)
+		set hwLen [string length $hw]
+		for {set l1 0; set l2 0} {$l1 < $hwLen} {incr l1} {
+		    set c [string index $hw $l1]
+		    if {[string is digit $c]} {
+			set sPos [expr {$i+$l2}]
+			if {$c > [lindex $s $sPos]} {
+			    set s [lreplace $s $sPos $sPos $c]
+			}
+		    } else {
+			incr l2
+		    }
+		}
+	    }
+	}
+    }
+
+    # Replace all even hyphenation weigths by zero
+
+    for {set i 0} {$i < [llength $s]} {incr i} {
+	set c [lindex $s $i]
+	if {!($c%2)} { set s [lreplace $s $i $i 0] }
+    }
+
+    # Don't start with a hyphen! Take also care of words enclosed in quotes
+    # or that someone has forgotten to put a blank between a punctuation
+    # character and the following word etc.
+
+    for {set i 1} {$i < ($wLen-1)} {incr i} {
+	set c [string range $w $i end]
+	if {[regexp {^[:alpha:][.]*} $c]} {
+	    for {set k 1} {$k < ($i+1)} {incr k} {
+		set s [lreplace $s $k $k 0]
+	    }
+	    break
+	}
+    }
+
+    # Don't separate the last character of a word with a hyphen
+
+    set max [expr {[llength $s]-2}]
+    if {$max} {set s [lreplace $s $max end 0]}
+
+    # return the syllabels of the hyphenated word as a list!
+
+    set ret ""
+    set w ".$str."
+    for {set i 1} {$i < ($wLen-1)} {incr i} {
+	if {[lindex $s $i]} { append ret - }
+	append ret [string index $w $i]
+    }
+    return [split $ret -]
+}
+
+# textutil::adjust::listPredefined
+#
+#      Return the names of the hyphenation files coming with the package.
+#
+# Parameters:
+#      None.
+#
+# Result:
+#       List of filenames (without directory)
+
+proc ::textutil::adjust::listPredefined {} {
+    variable here
+    return [glob -type f -directory $here -tails *.tex]
+}
+
+# textutil::adjust::getPredefined
+#
+#      Retrieve the full path for a predefined hyphenation file
+#       coming with the package.
+#
+# Parameters:
+#      name     Name of the predefined file.
+#
+# Results:
+#       Full path to the file, or an error if it doesn't
+#       exist or is matching the pattern *.tex.
+
+proc ::textutil::adjust::getPredefined {name} {
+    variable here
+
+    if {![string match *.tex $name]} {
+        return -code error \
+                "Illegal hyphenation file \"$name\""
+    }
+    set path [file join $here $name]
+    if {![file exists $path]} {
+        return -code error \
+                "Unknown hyphenation file \"$path\""
+    }
+    return $path
+}
+
+# textutil::adjust::readPatterns
+#
+#      Read hyphenation patterns from a file and store them in an array
+#
+# Parameters:
+#      filNam  name of the file containing the patterns
+
+proc ::textutil::adjust::readPatterns { filNam } {
+
+    variable HyphPatterns;                       # hyphenation patterns (TeX)
+
+    # HyphPatterns(_LOADED_) is used as flag for having loaded
+    # hyphenation patterns from the respective file (TeX format)
+
+    if {[info exists HyphPatterns(_LOADED_)]} {
+	unset HyphPatterns(_LOADED_)
+    }
+
+    # the array xlat provides translation from TeX encoded characters
+    # to those of the ISO-8859-1 character set
+
+    set xlat(\"s) \337;  # 223 := sharp s    "
+    set xlat(\`a) \340;  # 224 := a, grave
+    set xlat(\'a) \341;  # 225 := a, acute
+    set xlat(\^a) \342;  # 226 := a, circumflex
+    set xlat(\"a) \344;  # 228 := a, diaeresis "
+    set xlat(\`e) \350;  # 232 := e, grave
+    set xlat(\'e) \351;  # 233 := e, acute
+    set xlat(\^e) \352;  # 234 := e, circumflex
+    set xlat(\`i) \354;  # 236 := i, grave
+    set xlat(\'i) \355;  # 237 := i, acute
+    set xlat(\^i) \356;  # 238 := i, circumflex
+    set xlat(\~n) \361;  # 241 := n, tilde
+    set xlat(\`o) \362;  # 242 := o, grave
+    set xlat(\'o) \363;  # 243 := o, acute
+    set xlat(\^o) \364;  # 244 := o, circumflex
+    set xlat(\"o) \366;  # 246 := o, diaeresis "
+    set xlat(\`u) \371;  # 249 := u, grave
+    set xlat(\'u) \372;  # 250 := u, acute
+    set xlat(\^u) \373;  # 251 := u, circumflex
+    set xlat(\"u) \374;  # 252 := u, diaeresis "
+
+    set fd [open $filNam RDONLY]
+    set status 0
+
+    while {[gets $fd line] >= 0} {
+
+	switch -exact $status {
+	    PATTERNS {
+		if {[regexp {^\}[.]*} $line]} {
+		    # End of patterns encountered: set status
+		    # and ignore that line
+		    set status 0
+		    continue
+		} else {
+		    # This seems to be pattern definition line; to process it
+		    # we have first to do some editing
+		    #
+		    # 1) eat comments in a pattern definition line
+		    # 2) eat braces and coded linefeeds
+
+		    set z [string first "%" $line]
+		    if {$z > 0} { set line [string range $line 0 [expr {$z-1}]] }
+
+		    regsub -all {(\\n|\{|\})} $line {} tmp
+		    set line $tmp
+
+		    # Now $line should consist only of hyphenation patterns
+		    # separated by white space
+
+		    # Translate TeX encoded characters to ISO-8859-1 characters
+		    # using the array xlat defined above
+
+		    foreach x [array names xlat] {
+			regsub -all {$x} $line $xlat($x) tmp
+			set line $tmp
+		    }
+
+		    # split the line and create a lookup array for
+		    # the repective hyphenation patterns
+
+		    foreach item [split $line] {
+			if {[string length $item]} {
+			    if {![string match {\\} $item]} {
+				# create index for hyphenation patterns
+
+				set var $item
+				regsub -all {[0-9]} $var {} idx
+				# store hyphenation patterns as elements of an array
+
+				set HyphPatterns($idx) $item
+			    }
+			}
+		    }
+		}
+	    }
+	    EXCEPTIONS {
+		if {[regexp {^\}[.]*} $line]} {
+		    # End of patterns encountered: set status
+		    # and ignore that line
+		    set status 0
+		    continue
+		} else {
+		    # to be done in the future
+		}
+	    }
+	    default {
+		if {[regexp {^\\endinput[.]*} $line]} {
+		    # end of data encountered, stop processing and
+		    # ignore all the following text ..
+		    break
+		} elseif {[regexp {^\\patterns[.]*} $line]} {
+		    # begin of patterns encountered: set status
+		    # and ignore that line
+		    set status PATTERNS
+		    continue
+		} elseif {[regexp {^\\hyphenation[.]*} $line]} {
+		    # some particular cases to be treated separately
+		    set status EXCEPTIONS
+		    continue
+		} else {
+		    set status 0
+		}
+	    }
+	}
+    }
+
+    close $fd
+    set HyphPatterns(_LOADED_) 1
+
+    return
+}
+
+#######################################################
+
+# @c The specified <a text>block is indented
+# @c by <a prefix>ing each line. The first
+# @c <a hang> lines ares skipped.
+#
+# @a text:   The paragraph to indent.
+# @a prefix: The string to use as prefix for each line
+# @a prefix: of <a text> with.
+# @a skip:   The number of lines at the beginning to leave untouched.
+#
+# @r Basically <a text>, but indented a certain amount.
+#
+# @i indent
+# @n This procedure is not checked by the testsuite.
+
+proc ::textutil::adjust::indent {text prefix {skip 0}} {
+    set text [string trimright $text]
+
+    set res [list]
+    foreach line [split $text \n] {
+	if {[string compare "" [string trim $line]] == 0} {
+	    lappend res {}
+	} else {
+	    set line [string trimright $line]
+	    if {$skip <= 0} {
+		lappend res $prefix$line
+	    } else {
+		lappend res $line
+	    }
+	}
+	if {$skip > 0} {incr skip -1}
+    }
+    return [join $res \n]
+}
+
+# Undent the block of text: Compute LCP (restricted to whitespace!)
+# and remove that from each line. Note that this preverses the
+# shaping of the paragraph (i.e. hanging indent are _not_ flattened)
+# We ignore empty lines !!
+
+proc ::textutil::adjust::undent {text} {
+
+    if {$text == {}} {return {}}
+
+    set lines [split $text \n]
+    set ne [list]
+    foreach l $lines {
+	if {[string length [string trim $l]] == 0} continue
+	lappend ne $l
+    }
+    set lcp [::textutil::string::longestCommonPrefixList $ne]
+
+    if {[string length $lcp] == 0} {return $text}
+
+    regexp "^(\[\t \]*)" $lcp -> lcp
+
+    if {[string length $lcp] == 0} {return $text}
+
+    set len [string length $lcp]
+
+    set res [list]
+    foreach l $lines {
+	if {[string length [string trim $l]] == 0} {
+	    lappend res {}
+	} else {
+	    lappend res [string range $l $len end]
+	}
+    }
+    return [join $res \n]
+}
+
+# ### ### ### ######### ######### #########
+## Data structures
+
+namespace eval ::textutil::adjust {
+    variable here [file dirname [info script]]
+
+    variable Justify      left
+    variable Length       72
+    variable FullLine     0
+    variable StrictLength 0
+    variable Hyphenate    0
+    variable HyphPatterns
+
+    namespace export adjust indent undent
+}
+
+# ### ### ### ######### ######### #########
+## Ready
+
+package provide textutil::adjust 0.7.3

src/vendormodules/textutil/dehypht.tex

@@ -0,0 +1,902 @@
+% This is `dehypht.tex' as of 03 March 1999.
+%
+% Copyright (C) 1988,1991 Rechenzentrum der Ruhr-Universitaet Bochum
+%               [german hyphen patterns]
+% Copyright (C) 1993,1994,1999 Bernd Raichle/DANTE e.V.
+%               [macros, adaption for TeX 2]
+%
+% -----------------------------------------------------------------
+% IMPORTANT NOTICE:
+%
+% This program can be redistributed and/or modified under the terms
+% of the LaTeX Project Public License Distributed from CTAN
+% archives in directory macros/latex/base/lppl.txt; either
+% version 1 of the License, or any later version.
+% -----------------------------------------------------------------
+%
+%
+% This file contains german hyphen patterns following traditional
+% hyphenation rules and includes umlauts and sharp s, but without
+% `c-k' and triple consonants.  It is based on hyphen patterns
+% containing 5719 german hyphen patterns with umlauts in the
+% recommended version of September 27, 1990.
+%
+% For use with TeX generated by
+%
+%          Norbert Schwarz
+%          Rechenzentrum Ruhr-Universitaet Bochum
+%          Universitaetsstrasse 150
+%          D-44721 Bochum, FRG
+%
+%
+% Adaption of these patterns for TeX, Version 2.x and 3.x and
+% all fonts in T1/`Cork'/EC/DC and/or OT1/CM encoding by
+%
+%          Bernd Raichle
+%          Stettener Str. 73
+%          D-73732 Esslingen, FRG
+%   Email: raichle@Informatik.Uni-Stuttgart.DE
+%
+%
+% Error reports in case of UNCHANGED versions to
+%
+%          DANTE e.V., Koordinator `german.sty'
+%          Postfach 10 18 40
+%          D-69008 Heidelberg, FRG
+%   Email: german@Dante.DE
+%
+% or one of the addresses given above.
+%
+%
+% Changes:
+%  1990-09-27 First version of `ghyphen3.tex' (Norbert Schwarz)
+%  1991-02-13 PC umlauts changed to ^^xx  (Norbert Schwarz)
+%  1993-08-27 Umlauts/\ss changed to "a/\3 macros, added macro
+%             definitions and additional logic to select correct
+%             patterns/encoding  (Bernd Raichle)
+%  1994-02-13 Release of `ghyph31.tex' V3.1a (Bernd Raichle)
+%  1999-03-03 Renamed file to `dehypht.tex' according to the
+%             naming scheme using the ISO country code `de', the
+%             common part `hyph' for all hyphenation patterns files,
+%             and the additional postfix `t' for traditional,
+%             removed wrong catcode change of ^^e (the comment
+%             character %) and ^^f (the character &),
+%             do _not_ change \catcode, \lccode, \uccode to avoid
+%             problems with other hyphenation pattern files,
+%             changed code to distinguish TeX 2.x/3.x,
+%             changed license conditions to LPPL (Bernd Raichle)
+%
+%
+% For more information see the additional documentation
+% at the end of this file.
+%
+% -----------------------------------------------------------------
+%
+\message{German Traditional Hyphenation Patterns %
+         `dehypht' Version 3.2a <1999/03/03>}
+\message{(Formerly known under the name `ghyph31' and `ghyphen'.)}
+%
+%
+% Next we define some commands which are used inside the patterns.
+% To keep them local, we enclose the rest of the file in a group
+% (The \patterns command globally changes the hyphenation trie!).
+%
+\begingroup
+%
+%
+% Make sure that doublequote is not active:
+\catcode`\"=12
+%
+%
+% Because ^^e4 is used in the following macros which is read by
+% TeX 2.x as ^^e or %, the comment character of TeX, some trick
+% has to be found to avoid this problem.  The same is true for the
+% character ^^f or & in the TeX 2.x code.
+% Therefore in the code the exclamationmark ! is used instead of
+% the circumflex ^ and its \catcode is set appropriately
+% (normally \catcode`\!=12, in the code \catcode`\!=7).
+%
+% The following \catcode, \lccode assignments and macro definitions
+% are defined in such a way that the following \pattern{...} list
+% can be used for both, TeX 2.x and TeX 3.x.
+%
+% We first change the \lccode of ^^Y to make sure that we can
+% include this character in the hyphenation patterns.
+%
+\catcode`\^^Y=11 \lccode`\^^Y=`\^^Y
+%
+% Then we have to define some macros depending on the TeX version.
+% Therefore we have to distinguish TeX version 2.x and 3.x:
+%
+\ifnum`\@=`\^^40 % true => TeX 3.x
+  %
+  % For TeX 3:
+  % ----------
+  %
+  % Assign appropriate \catcode and \lccode values for all
+  % accented characters used in the patterns (\uccode changes are
+  % not used within \patterns{...} and thus not necessary):
+  %
+  \catcode"E4=11 \catcode"C4=11 % \"a \"A
+  \catcode"F6=11 \catcode"D6=11 % \"o \"O
+  \catcode"FC=11 \catcode"DC=11 % \"u \"U
+  \catcode"FF=11 \catcode"DF=11 % \ss  SS
+  %
+  \lccode"C4="E4 \uccode"C4="C4  \lccode"E4="E4 \uccode"E4="C4
+  \lccode"D6="F6 \uccode"D6="D6  \lccode"F6="F6 \uccode"F6="D6
+  \lccode"DC="FC \uccode"DC="DC  \lccode"FC="FC \uccode"FC="DC
+  \lccode"DF="FF \uccode"DF="DF  \lccode"FF="FF \uccode"FF="DF
+  %
+  % In the following definitions we use ??xy instead of ^^xy
+  % to avoid errors when reading the following macro definitions
+  % with TeX 2.x (remember ^^e(4) is the comment character):
+  %
+  \catcode`\?=7
+  %
+  % Define the accent macro " in such a way that it
+  % expands to single letters in font encoding T1.
+  \catcode`\"=13
+  \def"#1{\ifx#1a??e4\else \ifx#1o??f6\else \ifx#1u??fc\else
+      \errmessage{Hyphenation pattern file corrupted!}%
+    \fi\fi\fi}
+  %
+  %   - patterns with umlauts are ok
+  \def\n#1{#1}
+  %
+  % For \ss which exists in T1 _and_ OT1 encoded fonts but with
+  % different glyph codes, duplicated patterns for both encodings
+  % are included.  Thus you can use these hyphenation patterns for
+  % T1 and OT1 encoded fonts:
+  %   - define \3 to be code `\^^ff (\ss in font encoding T1)
+  %   - define \9 to be code `\^^Y  (\ss in font encoding OT1)
+  \def\3{??ff}
+  \def\9{??Y}
+  %   - duplicated patterns to support font encoding OT1 are ok
+  \def\c#1{#1}
+  %   >>>>>>  UNCOMMENT the next line, if you do not want
+  %   >>>>>>  to use fonts in font encoding OT1
+  %\def\c#1{}
+  %
+  \catcode`\?=12
+  %
+\else
+  %
+  % For TeX 2:
+  % ----------
+  %
+  % Define the accent macro " to throw an error message.
+  \catcode`\"=13
+  \def"#1{\errmessage{Hyphenation pattern file corrupted!}}
+  %
+  %   - ignore all patterns with umlauts
+  \def\n#1{}
+  %
+  % With TeX 2 fonts in encoding T1 can be used, but all glyphs
+  % in positions > 127 can not be used in hyphenation patterns.
+  % Thus only patterns with glyphs in OT1 positions are included:
+  %   - define \3 to be code ^^Y (\ss in CM font encoding)
+  %   - define \9 to throw an error message
+  \def\3{^^Y}
+  \def\9{\errmessage{Hyphenation pattern file corrupted!}}
+  %   - ignore all duplicated patterns with \ss in T1 encoding
+  \def\c#1{}
+  %
+\fi
+%
+%
+\patterns{%
+.aa6l .ab3a4s .ab3ei .abi2 .ab3it .ab1l .ab1r .ab3u .ad3o4r .alti6
+.ana3c .an5alg .an1e .ang8s .an1s .ap1p .ar6sc .ar6ta .ar6tei .as2z
+.au2f1 .au2s3 .be5erb .be3na .ber6t5r .bie6r5 .bim6s5t .brot3 .bru6s
+.ch6 .che6f5 .da8c .da2r .dar5in .dar5u .den6ka .de5r6en .des6pe
+.de8spo .de3sz .dia3s4 .dien4 .dy2s1 .ehren5 .eine6 .ei6n5eh .ei8nen
+.ein5sa .en6der .en6d5r .en3k4 .en8ta8 .en8tei .en4t3r .epo1 .er6ban
+.er6b5ei .er6bla .er6d5um .er3ei .er5er .er3in .er3o4b .erwi5s .es1p
+.es8t .ex1a2 .ex3em .fal6sc .fe6st5a .flu4g3 .furch8 .ga6ner .ge3n4a
+\n{.ge5r"o} .ges6 .halb5 .halbe6 .hal6br .haup4 .hau4t .heima6 .he4r3e
+.her6za .he5x .hin3 .hir8sc .ho4c .hu3sa .hy5o .ibe5 .ima6ge .in1
+.ini6 .is5chi .jagd5 .kal6k5o .ka6ph .ki4e .kop6f3 .kraf6 \n{.k"u5ra}
+.lab6br .liie6 .lo6s5k \n{.l"o4s3t} .ma5d .mi2t1 .no6th .no6top
+.obe8ri .ob1l .obs2 .ob6st5e .or3c .ort6s5e .ost3a .oste8r .pe4re
+.pe3ts .ph6 .po8str .rau4m3 .re5an .ro8q .ru5the \n{.r"u5be}
+\n{.r"u8stet} .sch8 .se6e .se5n6h .se5ra .si2e .spi6ke .st4 .sy2n
+.tages5 .tan6kl .ta8th .te6e .te8str .to6der .to8nin .to6we .um1
+.umpf4 .un1 .une6 .unge5n .ur1c .ur5en .ve6rin .vora8 .wah6l5 .we8ges
+.wo6r .wor3a .wun4s .zi4e .zuch8 \n{."ande8re} \n{."och8} aa1c aa2gr
+aal5e aa6r5a a5arti aa2s1t aat2s 6aba ab3art 1abdr 6abel aben6dr
+ab5erk ab5err ab5esse 1abf 1abg \n{1abh"a} ab1ir 1abko a1bl ab1la
+5ablag a6bla\3 \c{a6bla\9} ab4ler ab1lu \n{a8bl"a} \n{5a6bl"o} abma5c
+1abn ab1ra ab1re 5a6brec ab1ro ab1s ab8sk abs2z 3abtei ab1ur 1abw
+5abze 5abzu \n{ab1"an} \n{ab"au8} a4ce.  a5chal ach5art ach5au a1che
+a8chent ach6er.  a6ch5erf a1chi ach1l ach3m ach5n a1cho ach3re a1chu
+ach1w a1chy \n{ach5"af} ack1o acks6t ack5sta a1d 8ad.  a6d5ac ad3ant
+ad8ar 5addi a8dein ade5o8 adi5en 1adj 1adle ad1op a2dre 3adres adt1
+1adv \n{a6d"a} a1e2d ae1r a1er.  1aero 8afa a3fal af1an a5far a5fat
+af1au a6fentl a2f1ex af1fr af5rau af1re 1afri af6tent af6tra aft5re
+a6f5um \n{8af"a} ag5abe 5a4gent ag8er ages5e 1aggr ag5las ag1lo a1gn
+ag2ne 1agog a6g5und a1ha a1he ah5ein a4h3erh a1hi ahl1a ah1le ah4m3ar
+ahn1a a5ho ahra6 ahr5ab ah1re ah8rei ahren8s ahre4s3 ahr8ti ah1ru a1hu
+\n{ah8"o} ai3d2s ai1e aif6 a3inse ai4re.  a5isch.  ais8e a3ismu ais6n
+aiso6 a1j 1akad a4kade a1ke a1ki 1akko 5akro1 a5lal al5ans 3al8arm
+al8beb al8berw alb5la 3album al1c a1le a6l5e6be a4l3ein a8lel a8lerb
+a8lerh a6lert 5a6l5eth 1algi al4gli al3int al4lab al8lan al4l3ar
+alle3g a1lo a4l5ob al6schm al4the altist5 al4t3re 8a1lu alu5i a6lur
+alu3ta \n{a1l"a} a6mate 8ame.  5a6meise am6m5ei am6mum am2n ampf3a
+am6schw am2ta a1mu \n{a1m"a} a3nac a1nad anadi5e an3ako an3alp 3analy
+an3ame an3ara a1nas an5asti a1nat anat5s an8dent ande4s3 an1ec an5eis
+an1e2k 4aner.  a6n5erd a8nerf a6n5erke 1anfa 5anfert \n{1anf"a} 3angab
+5angebo an3gli ang6lis an2gn 3angri ang5t6 \n{5anh"a} ani5g ani4ka
+an5i8on an1kl an6kno an4kro 1anl anma5c anmar4 3annah anne4s3 a1no
+5a6n1o2d 5a6n3oma 5a6nord 1anr an1sa 5anschl an4soz an1st 5anstal
+an1s2z 5antenn an1th \n{5anw"a} a5ny an4z3ed 5anzeig 5anzieh 3anzug
+\n{an1"a} \n{5an"as} \n{a1n"o} \n{an"o8d} a1os a1pa 3apfel a2ph1t
+\n{aph5"a6} a1pi 8apl apo1c apo1s a6poste a6poth 1appa ap1pr a1pr
+\n{a5p"a} \n{a3p"u} a1ra a4r3af ar3all 3arbei 2arbt ar1c 2a1re ar3ein
+ar2gl 2a1ri ari5es ar8kers ar6les ar4nan ar5o6ch ar1o2d a1rol ar3ony
+a8ror a3ros ar5ox ar6schl 8artei ar6t5ri a1ru a1ry 1arzt arz1w
+\n{ar8z"a} \n{ar"a8m} \n{ar"o6} \n{ar5"om} \n{ar1"u2} a1sa a6schec
+asch5l asch3m a6schn a3s4hi as1pa asp5l a8steb as5tev 1asth a6stoc
+a1str ast3re 8a1ta ata5c ata3la a6tapf ata5pl a1te a6teli aten5a
+ate5ran 6atf 6atg a1th at3hal 1athl 2a1ti 5atlant 3atlas 8atmus 6atn
+a1to a6t5ops ato6ra a6t5ort.  4a1tr a6t5ru at2t1h \n{at5t6h"a} 6a1tu
+atz1w \n{a1t"a} \n{a1t"u} au1a au6bre auch3a au1e aue4l 5aufent
+\n{3auff"u} 3aufga 1aufn auf1t 3auftr 1aufw 3auge.  au4kle aule8s 6aum
+au8mar aum5p 1ausb 3ausd 1ausf 1ausg au8sin 3auss au4sta 1ausw 1ausz
+aut5eng au1th 1auto au\3e8 \c{au\9e8} a1v ave5r6a aver6i a1w a6wes a1x
+a2xia a6xio a1ya a1z azi5er.  8a\3 \c{8a\9} 1ba 8ba8del ba1la ba1na
+ban6k5r ba5ot bardi6n ba1ro basten6 bau3sp 2b1b bb6le b2bli 2b1c 2b1d
+1be be1a be8at.  be1ch 8becht 8becke.  be5el be1en bee8rei be5eta bef2
+8beff be1g2 \n{beh"o8} bei1s 6b5eisen bei3tr b8el bel8o belu3t be3nac
+bend6o be6ners be6nerw be4nor ben4se6 bens5el \n{be1n"a} \n{be1n"u}
+be1o2 b8er.  be1ra be8rac ber8gab.  ber1r \n{be1r"u} bes8c bes5erh
+bes2p be5tha bet5sc be1un be1ur 8bex be6zwec 2b1f8 bfe6st5e 2b1g2
+bga2s5 bge1 2b1h bhole6 1bi bi1bl b6ie bi1el bi1la \n{bil"a5} bi1na
+bi4nok bi5str bi6stu bi5tr bit4t5r b1j 2b1k2 \n{bk"u6} bl8 b6la.
+6b1lad 6blag 8blam 1blat b8latt 3blau.  b6lav 3ble.  b1leb b1led
+8b1leg 8b1leh 8bleid 8bleih 6b3lein blei3s ble4m3o 4blich b4lind
+8bling b2lio 5blit b4litz b1loh 8b1los 1blu 5blum 2blun blut3a blut5sc
+\n{3bl"a} \n{bl"as5c} \n{5bl"o} \n{3bl"u} \n{bl"u8sc} 2b1m 2b1n 1bo
+bo1ch bo5d6s boe5 8boff 8bonk bo1ra b1ort 2b1p2 b1q 1br brail6 brast8
+bre4a b5red 8bref 8b5riem b6riga bro1s b1rup b2ruz \n{8br"oh}
+\n{br"os5c} 8bs b1sa b8sang b2s1ar b1sc bs3erl bs3erz b8sof b1s2p
+bst1h b3stru \n{b5st"a} b6sun 2b1t b2t1h 1bu bu1ie bul6k b8ure bu6sin
+6b1v 2b1w 1by1 by6te.  8b1z bzi1s \n{1b"a} \n{b5"a6s5} \n{1b"u}
+\n{b6"u5bere} \n{b"uge6} \n{b"ugel5e} \n{b"ur6sc} 1ca cag6 ca5la ca6re
+ca5y c1c 1ce celi4c celich5 ce1ro c8h 2ch.  1chae ch1ah ch3akt cha6mer
+8chanz 5chara 3chari 5chato 6chb 1chef 6chei ch3eil ch3eis 6cherkl
+6chf 4chh 5chiad 5chias 6chins 8chj chl6 5chlor 6ch2m 2chn6 ch8nie
+5cho.  8chob choi8d 6chp ch3ren ch6res \n{ch3r"u} 2chs 2cht cht5ha
+cht3hi 5chthon ch6tin 6chuh chu4la 6ch3unt chut6t 8chw 1ci ci5tr c2k
+2ck.  ck1ei 4ckh ck3l ck3n ck5o8f ck1r 2cks ck5stra ck6s5u c2l 1c8o
+con6ne 8corb cos6t c3q 1c6r 8c1t 1cu 1cy \n{5c"a1} \n{c"o5} 1da.
+8daas 2dabg 8dabr 6dabt 6dabw 1dac da2gr 6d5alk 8d5amt dan6ce.
+dani5er dan8ker 2danl danla6 6dans 8danzi 6danzu d1ap da2r1a8 2d1arb
+d3arc dar6men 4d3art 8darz 1dat 8datm 2d1auf 2d1aus 2d1b 2d1c 2d1d
+d5de d3d2h \n{dd"amme8} 1de 2deal de5an de3cha de1e defe6 6deff 2d1ehr
+5d4eic de5isc de8lar del6s5e del6spr de4mag de8mun de8nep dene6r
+8denge.  8dengen de5o6d 2deol de5ram 8derdb der5ein de1ro der1r d8ers
+der5um de4s3am de4s3an de4sau de6sil de4sin de8sor de4spr de2su 8deul
+de5us.  2d1f df2l 2d1g 2d1h 1di dia5c di5ara dice5 di3chr di5ena di1gn
+di1la dil8s di1na 8dind 6dinf 4d3inh 2d1ins di5o6d di3p4t di8sen dis1p
+di5s8per di6s5to dis5tra di8tan di8tin d1j 6dje 2dju 2d1k 2d1l 2d1m
+2d1n6 dni6 dnje6 1do 6d5obe do6berf 6d5ony do3ran 6dord 2d1org dor4t3h
+do6ste 6doth dott8e 2d1p d5q dr4 1drah 8drak d5rand 6dre.  4drech
+d6reck 4d3reg 8d3reic d5reife 8drem 8d1ren 2drer 8dres.  6d5rh 1dria
+d1ric 8drind droi6 dro5x 1dru 8drut \n{dr"os5c} \n{1dr"u} \n{dr"u5b}
+\n{dr"u8sc} 2ds d1sa d6san dsat6 d1sc 5d6scha.  5dschik dse8e d8serg
+8dsl d1sp d4spak ds2po \n{d8sp"a} d1st \n{d1s"u} 2dt d1ta d1te d1ti
+d1to dt1s6 d1tu \n{d5t"a} 1du du5als du1b6 du1e duf4t3r 4d3uh du5ie
+8duml 8dumw 2d1und du8ni 6d5unt dur2c durch3 6durl 6dursa 8durt du1s
+du8schr 2d1v 2d1w dwa8l 2d1z \n{1d"a} \n{6d"ah} \n{8d"and} \n{d"a6r}
+\n{d"o8bl} \n{d5"ol} \n{d"or6fl} \n{d"o8sc} \n{d5"o4st} \n{d"os3te}
+\n{1d"u} ea4ben e1ac e1ah e1akt e1al.  e5alf e1alg e5a8lin e1alk e1all
+e5alp e1alt e5alw e1am e1and ea6nim e1ar.  e5arf e1ark e5arm e3art
+e5at.  e6ate e6a5t6l e8ats e5att e6au.  e1aus e1b e6b5am ebens5e
+eb4lie eb4ser eb4s3in e1che e8cherz e1chi ech3m 8ech3n ech1r ech8send
+ech4su e1chu eck5an e5cl e1d ee5a ee3e ee5g e1ei ee5isc eei4s3t
+ee6lend e1ell \n{ee5l"o} e1erd ee3r4e ee8reng eere6s5 \n{ee5r"a}
+ee6tat e1ex e1f e6fau e8fe8b 3effek ef3rom ege6ra eglo6si 1egy e1ha
+e6h5ach eh5ans e6hap eh5auf e1he e1hi ehl3a eh1le ehl5ein eh1mu ehn5ec
+e1ho ehr1a eh1re ehre6n eh1ri eh1ru ehr5um e1hu eh1w e1hy \n{e1h"a}
+\n{e1h"o} \n{e3h"ut} ei1a eia6s ei6bar eich3a eich5r ei4dar ei6d5ei
+ei8derf ei3d4sc ei1e 8eifen 3eifri 1eign eil1d ei6mab ei8mag ein1a4
+ei8nat ei8nerh ei8ness ei6nete ein1g e8ini ein1k ei6n5od ei8nok ei4nor
+\n{e3ins"a} ei1o e1irr ei5ru ei8sab ei5schn ei6s5ent ei8sol ei4t3al
+eit3ar eit1h ei6thi ei8tho eit8samt ei6t5um e1j 1ekd e1ke e1ki e1k2l
+e1kn ekni4 e1la e2l1al 6elan e6lanf e8lanl e6l5ans el3arb el3arm
+e6l3art 5e6lasti e6lauge elbst5a e1le 6elef ele6h e6l5ehe e8leif
+e6l5einh 1elek e8lel 3eleme e6lemen e6lente el5epi e4l3err e6l5ersc
+elf2l elg2 e6l5ins ell8er 4e1lo e4l3ofe el8soh el8tent 5eltern e1lu
+elut2 \n{e1l"a} \n{e1l"u} em8dei em8meis 4emo emo5s 1emp1f 1empt 1emto
+e1mu emurk4 emurks5 \n{e1m"a} en5a6ben en5achs en5ack e1nad en5af
+en5all en3alt en1am en3an.  en3ant en3anz en1a6p en1ar en1a6s 6e1nat
+en3auf en3aus en2ce enda6l end5erf end5erg en8dess 4ene.  en5eck
+e8neff e6n5ehr e6n5eim en3eis 6enem.  6enen e4nent 4ener.  e8nerd
+e6n3erf e4nerg 5energi e6n5erla en5ers e6nerst en5erw 6enes e6n5ess
+e2nex en3glo 2eni enni6s5 ennos4 enns8 e1no e6nober eno8f en5opf
+e4n3ord en8sers ens8kl en1sp ens6por en5t6ag enta5go en8terbu en6tid
+3entla ent5ric 5entwic 5entwu 1entz enu5i e3ny en8zan \n{en1"of}
+\n{e1n"os} \n{e1n"ug} eo1c e5o6fe e5okk e1on.  e3onf e5onk e5onl e5onr
+e5opf e5ops e5or.  e1ord e1org eo5r6h eo1t e1pa e8pee e6p5e6g ep5ent
+e1p2f e1pi 5epid e6pidem e1pl 5epos e6pos.  ep4p3a e1pr \n{e1p"a} e1q
+e1ra.  er5aal 8eraba e5rabel er5a6ben e5rabi er3abs er3ach era5e
+era5k6l er3all er3amt e3rand e3rane er3ans e5ranz.  e1rap er3arc
+e3rari er3a6si e1rat erat3s er3auf e3raum 3erbse er1c e1re 4e5re.
+er3eck er5egg er5e2h 2erei e3rei.  e8reine er5einr 6eren.  e4r3enm
+4erer.  e6r5erm er5ero er5erst e4r3erz er3ess \n{5erf"ul} er8gan.
+5ergebn er2g5h \n{5erg"anz} \n{5erh"ohu} 2e1ri eri5ak e6r5iat e4r3ind
+e6r5i6n5i6 er5ins e6r5int er5itio er1kl \n{3erkl"a} \n{5erl"os.}
+ermen6s er6nab 3ernst 6e1ro.  e1rod er1o2f e1rog 6e3roi ero8ide e3rol
+e1rom e1ron e3rop8 e2r1or e1ros e1rot er5ox ersch4 5erstat er6t5ein
+er2t1h er5t6her 2e1ru eruf4s3 e4r3uhr er3ums e5rus 5erwerb e1ry er5zwa
+er3zwu \n{er"a8m} \n{er5"as} \n{er"o8} \n{e3r"os.} \n{e6r1"u2b} e1sa
+esa8b e8sap e6s5a6v e1sc esch4l ese1a es5ebe eserve5 e8sh es5ill
+es3int es4kop e2sl eso8b e1sp espei6s5 es2po es2pu 5essenz e6stabs
+e6staf e6st5ak est3ar e8stob e1str est5res es3ur e2sz \n{e1s"u} e1ta
+et8ag etari5e eta8ta e1te eten6te et5hal e5thel e1ti 1etn e1to e1tr
+et3rec e8tscha et8se et6tei et2th et2t1r e1tu etu1s et8zent et8zw
+\n{e1t"a} \n{e1t"o} \n{e1t"u} eu1a2 eu1e eue8rei eu5fe euin5 euk2
+e1um.  eu6nio e5unter eu1o6 eu5p 3europ eu1sp eu5str eu8zo e1v eval6s
+eve5r6en ever4i e1w e2wig ex1or 1exp 1extr ey3er.  e1z \n{e1"a2}
+\n{e5"o8} \n{e1"u} e8\3es \c{e8\9es} fa6ch5i fade8 fa6del fa5el.
+fal6lo falt8e fa1na fan4gr 6fanl 6fap far6ba far4bl far6r5a 2f1art
+fa1sc fau8str fa3y 2f1b2 6f1c 2f1d 1fe 2f1eck fe6dr feh6lei f6eim
+8feins f5eis fel5en 8feltern 8femp fe5rant 4ferd.  ferri8 fe8stof
+fe6str fe6stum fe8tag fet6ta fex1 2ff f1fa f6f5arm f5fe ffe5in ffe6la
+ffe8ler ff1f f1fla ff3lei ff4lie ff8sa ff6s5ta 2f1g2 fgewen6 4f1h 1fi
+fid4 fi3ds fieb4 fi1la fi8lei fil4m5a f8in.  fi1na 8finf fi8scho fi6u
+6f1j 2f1k2 f8lanz fl8e 4f3lein 8flib 4fling f2lix 6f3lon 5flop 1flor
+\n{5f8l"ac} \n{3fl"ot} 2f1m 2f1n 1fo foh1 f2on fo6na 2f1op fo5ra
+for8mei for8str for8th for6t5r fo5ru 6f5otte 2f1p8 f1q fr6 f5ram
+1f8ran f8ra\3 \c{f8ra\9} f8re.  frei1 5frei.  f3reic f3rest f1rib
+8f1ric 6frig 1fris fro8na \n{fr"as5t} 2fs f1sc f2s1er f5str
+\n{fs3t"at} 2ft f1tak f1te ft5e6h ftere6 ft1h f1ti f5to f1tr ft5rad
+ft1sc ft2so f1tu ftwi3d4 ft1z 1fu 6f5ums 6funf fun4ka fu8\3end
+\c{fu8\9end} 6f1v 2f1w 2f1z \n{1f"a} \n{f"a1c} \n{8f"arm} \n{6f"aug}
+\n{f"a8\3} \n{\c{f"a8\9}} \n{f"ode3} \n{8f"of} \n{3f"or} \n{1f"u}
+\n{f"un4f3u} 1ga ga6bl 6gabw 8gabz g3a4der ga8ho ga5isc 4gak ga1la
+6g5amt ga1na gan5erb gan6g5a ga5nj 6ganl 8gansc 6garb 2g1arc 2g1arm
+ga5ro 6g3arti ga8sa ga8sc ga6stre 2g1atm 6g5auf gau5fr g5aus 2g1b g5c
+6gd g1da 1ge ge1a2 ge6an ge8at.  ge1e2 ge6es gef2 8geff ge1g2l ge1im
+4g3eise geist5r gel8bra gelt8s \n{ge5l"o} ge8nin gen3k 6g5entf
+\n{ge3n"a} ge1or ge1ra ge6rab ger8au \n{8gerh"o} ger8ins ge1ro 6g5erz.
+\n{ge1r"a} \n{ge1r"u} ge1s ges2p ge5unt 4g3ex3 2g1f8 2g1g g1ha 6g1hei
+5ghel.  g5henn 6g1hi g1ho 1ghr \n{g1h"o} 1gi gi5la gi8me.  gi1na
+4g3ins gi3str g1j 2g1k 8gl.  1glad g5lag glan4z3 1glas 6glass 5glaub
+g3lauf 1gle.  g5leb 3gleic g3lein 5gleis 1glem 2gler 8g3leu gli8a
+g2lie 3glied 1g2lik 1g2lim g6lio 1gloa 5glom 1glon 1glop g1los g4loss
+g5luf 1g2ly \n{1gl"u} 2g1m gn8 6gn.  1gna 8gnach 2gnah g1nas g8neu
+g2nie g3nis 1gno 8gnot 1go goe1 8gof 2gog 5gogr 6g5oh goni5e 6gonist
+go1ra 8gord 2g1p2 g1q 1gr4 g5rahm gra8m gra4s3t 6g1rec gre6ge 4g3reic
+g5reit 8grenn gri4e g5riem 5grif 2grig g5ring 6groh 2grot gro6\3
+\c{gro6\9} 4grut 2gs gs1ab g5sah gs1ak gs1an gs8and gs1ar gs1au g1sc
+gs1ef g5seil gs5ein g2s1er gs1in g2s1o gso2r gs1pr g2s1u 2g1t g3te
+g2t1h 1gu gu5as gu2e 2gue.  6gued 4g3uh 8gums 6g5unt gu1s gut3h gu2tu
+4g1v 2g1w gy1n g1z \n{1g"a} \n{8g"a8m} \n{6g"arm} \n{1g"o} \n{1g"u}
+\n{6g"ub} 1haa hab8r ha8del hade4n 8hae ha5el.  haf6tr 2hal.  ha1la
+hal4b5a 6hale 8han.  ha1na han6dr han6ge.  2hani h5anth 6hanz 6harb
+h3arbe h3arme ha5ro ha2t1h h1atm hau6san ha8\3 \c{ha8\9} h1b2 h1c h1d
+he2bl he3cho h3echt he5d6s 5heft h5e6he.  hei8ds h1eif 2hein he3ism
+he5ist.  heit8s3 hek6ta hel8lau 8helt he6mer 1hemm 6h1emp hen5end
+hen5klo hen6tri he2nu 8heo he8q her3ab he5rak her3an 4herap her3au
+h3erbi he1ro he8ro8b he4r3um her6z5er he4spe he1st heta6 het5am he5th
+heu3sc he1xa hey5e h1f2 h1g hgol8 h1h h1iat hie6r5i hi5kt hil1a2
+hil4fr hi5nak hin4ta hi2nu hi5ob hirn5e hir6ner hi1sp hi1th hi5tr
+5hitz h1j h6jo h1k2 hlabb4 hla4ga hla6gr h5lai hl8am h1las h1la\3
+\c{h1la\9} hl1c h1led h3lein h5ler.  h2lif h2lim h8linf hl5int h2lip
+h2lit h4lor h3lose \n{h1l"as} hme5e h2nee h2nei hn3eig h2nel hne8n
+hne4p3f hn8erz h6netz h2nip h2nit h1nol hn5sp h2nuc h2nud h2nul hoch1
+1hoh hoh8lei 2hoi ho4l3ar 1holz h2on ho1ra 6horg 5horn.  ho3sl hos1p
+ho4spi h1p hpi6 h1q 6hr h1rai h8rank h5raum hr1c hrcre8 h1red h3reg
+h8rei.  h4r3erb h8rert hrg2 h1ric hr5ins h2rom hr6t5erl hr2t1h hr6t5ra
+hr8tri h6rum hr1z hs3ach h6s5amt h1sc h6s5ec h6s5erl hs8erle h4sob
+h1sp h8spa\3 \c{h8spa\9} h8spel hs6po h4spun h1str h4s3tum hs3und
+\n{h1s"u} h5ta.  h5tab ht3ac ht1ak ht3ang h5tanz ht1ar ht1at h5taub
+h1te h2t1ec ht3eff ht3ehe h4t3eif h8teim h4t3ein ht3eis h6temp h8tentf
+hte8ren \n{h6terf"u} h8tergr h4t3erh h6t5ersc h8terst h8tese h8tess
+h2t1eu h4t3ex ht1he ht5hu h1ti ht5rak hts3ah ht1sc ht6sex ht8sk ht8so
+h1tu htz8 \n{h5t"um} hub5l hu6b5r huh1l h5uhr.  huld5a6 hu8lent
+\n{hu8l"a} h5up.  h1v h5weib h3weis h1z \n{h"a8kl} \n{h"al8s}
+\n{h"ama8tu8} \n{h"a8sche.} \n{h"at1s} \n{h"au4s3c} \n{2h"o.}
+\n{2h"oe} \n{8h"oi} \n{h"o6s} \n{h"os5c} \n{h"uhne6} \n{h"ul4s3t}
+\n{h"utte8re} i5adn i1af i5ak.  i1al.  i1al1a i1alb i1ald i5alei i1alf
+i1alg i3alh i1alk i1all i1alp i1alr i1als i1alt i1alv i5alw i3alz
+i1an.  ia5na i3and ian8e ia8ne8b i1ang i3ank i5ann i1ant i1anz i6apo
+i1ar.  ia6rab i5arr i1as.  i1asm i1ass i5ast.  i1at.  i5ats i1au i5azz
+i6b5eig i6b5eis ib2le i4blis i6brig i6b5unt \n{i6b"ub} i1che ich5ei
+i6cherb i1chi ich5ins ich1l ich3m ich1n i1cho icht5an icht3r i1chu
+ich1w ick6s5te ic5l i1d id3arm 3ideal ide8na 3ideol \n{ide5r"o} i6diot
+id5rec id1t ie1a ie6b5ar iebe4s3 ie2bl ieb1r ie8bra ie4bre \n{ie8b"a}
+ie2dr ie1e8 ie6f5ad ief5f ie2f1l ie4fro ief1t i1ei ie4l3ec ie8lei
+ie4lek i3ell i1en.  i1end ien6e i3enf i5enn ien6ne.  i1enp i1enr
+i5ensa ien8stal i5env i1enz ie5o ier3a4b ie4rap i2ere ie4rec ie6r5ein
+ie6r5eis ier8er i3ern.  ie8rum ie8rund ie6s5che ie6tau ie8tert ie5the
+ie6t5ri i1ett ie5un iex5 2if i1fa if5ang i6fau if1fr if5lac i5f6lie
+i1fre ift5a if6t5r ig3art 2ige i8gess ig5he i5gla ig2ni i5go ig3rot
+ig3s2p i1ha i8ham i8hans i1he i1hi ih1n ih1r i1hu i8hum ih1w 8i1i ii2s
+ii2t i1j i1k i6kak i8kerz i6kes ik4ler i6k5unt 2il i5lac i1lag il3ans
+i5las i1lau il6auf i1le ile8h i8lel il2fl il3ipp il6l5enn i1lo ilt8e
+i1lu \n{i1l"a} i8mart imb2 i8mele i8mid imme6l5a i1mu \n{i1m"a}
+\n{i5m"o} ina5he i1nat in1au inau8s 8ind.  in4d3an 5index ind2r 3indus
+i5nec i2n1ei i8nerw 3infek 1info 5ingeni ing5s6o 5inhab ini5er.  5inj
+\n{in8k"at} in8nan i1no inoi8d in3o4ku in5sau in1sp 5inspe 5instit
+5instru ins4ze 5intere 5interv in3the in5t2r i5ny \n{in"a2} \n{i1n"ar}
+\n{in1"as} \n{in"o8} \n{in5"od} \n{i1n"os} 2io io1a8 io1c iode4 io2di
+ioi8 i1ol.  i1om.  i1on.  i5onb ion2s1 i1ont i5ops i5o8pt i1or.
+i3oral io3rat i5orc i1os.  i1ot.  i1o8x 2ip i1pa i1pi i1p2l i1pr i1q
+i1ra ir6bl i1re i1ri ir8me8d ir2m1o2 ir8nak i1ro ir5rho ir6schl
+ir6sch5r i5rus i5ry \n{i5r"a} i1sa i8samt i6sar i2s1au i8scheh i8schei
+isch5m isch3r \n{isch"a8} is8ele ise3ra i4s3erh is3err isi6de i8sind
+is4kop ison5e is6por i8s5tum i5sty \n{i5s"o} i1ta it5ab.  i2t1a2m
+i8tax i1te i8tersc i1thi i1tho i5thr \n{it8h"a} i1ti i8ti8d iti6kl
+itmen4 i1to i8tof it3ran it3rau i1tri itri5o it1sc it2se it5spa it8tru
+i1tu it6z5erg it6z1w \n{i1t"a} \n{it"a6r5e} \n{it"at2} \n{it"ats5}
+\n{i1t"u} i1u iu6r 2i1v i6vad iva8tin i8vei i6v5ene i8verh i2vob i8vur
+i1w iwi2 i5xa i1xe i1z ize8n i8zir i6z5w \n{i"a8m} \n{i1"a6r}
+\n{i5"at.} \n{i5"av} \n{i1"o8} \n{i"u8} i6\35ers \c{i6\95ers} ja5la
+je2t3r 6jm 5jo jo5as jo1ra jou6l ju5cha jugen4 jugend5 jung5s6 ju1s
+\n{3j"a} 1ka 8kachs 8kakz ka1la kal5d kam5t ka1na 2kanl 8kapf ka6pl
+ka5r6a 6k3arbe ka1ro kar6p5f 4k3arti 8karz \n{ka1r"a} kasi5e ka6teb
+kat8ta kauf6s kau3t2 2k1b 2k1c 4k1d kehr6s kehrs5a 8keic 2k1eig 6k5ein
+6k5eis ke6lar ke8leis ke8lo 8kemp k5ente.  k3entf 8k5ents 6kentz ke1ra
+k5erlau 2k1f8 2k1g 2k1h ki5fl 8kik king6s5 6kinh ki5os ki5sp ki5th
+\n{8ki8"o} 2k1k2 kl8 1kla 8klac k5lager kle4br k3leib 3kleid kle5isc
+4k3leit k3lek 6k5ler.  5klet 2klic 8klig k2lim k2lin 5klip 5klop k3lor
+\n{1kl"a} 2k1m kmani5e kn8 6kner k2ni \n{kn"a8} 1k2o ko1a2 ko6de.
+ko1i koi8t ko6min ko1op ko1or ko6pht ko3ra kor6d5er ko5ru ko5t6sc k3ou
+3kow 6k5ox 2k1p2 k1q 1kr8 4k3rad 2k1rec 4k3reic kre5ie 2krib 6krig
+2krip 6kroba 2ks k1sa k6sab ksal8s k8samt k6san k1sc k2s1ex k5spat
+k5spe k8spil ks6por k1spr kst8 k2s1uf 2k1t kta8l kt5a6re k8tein kte8re
+k2t1h k8tinf kt3rec kt1s 1ku ku1ch kuck8 k3uhr ku5ie kum2s1 kunfts5
+kun2s kunst3 ku8rau ku4ro kurz1 ku1st 4kusti ku1ta ku8\3 \c{ku8\9}
+6k1v 2k1w ky5n 2k1z \n{1k"a} \n{k"a4m} \n{4k3"ami} \n{k"ase5} \n{1k"o}
+\n{k"o1c} \n{k"o1s} \n{1k"u} \n{k"u1c} \n{k"ur6sc} \n{k"u1s} 1la.
+8labf 8labh lab2r 2l1abs lach3r la8dr 5ladu 8ladv 6laff laf5t la2gn
+5laken 8lamb la6mer 5lampe.  2l1amt la1na 1land lan4d3a lan4d3r lan4gr
+8lanme 6lann 8lanw \n{6lan"a} 8lappa lap8pl lap6pr l8ar.  la5ra lar4af
+la8rag la8ran la6r5a6s l3arbe la8rei 6larm.  la8sa la1sc la8sta lat8i
+6l5atm 4lauss 4lauto 1law 2lb l8bab l8bauf l8bede l4b3ins l5blo
+lbst5an lbst3e 8lc l1che l8chert l1chi lch3m l5cho lch5w 6ld l4d3ei
+ld1re \n{l6d"ub} le2bl le8bre lecht6s5 led2r 6leff le4gas 1lehr lei6br
+le8inf 8leinn 5leistu 4lektr le6l5ers lemo2 8lemp l8en.  8lends
+6lendun le8nend len8erw 6l5ents 4l3entw 4lentz 8lenzy 8leoz 6lepi
+le6pip 8lepo 1ler l6er.  8lerbs 6l5erde le8reis le8rend le4r3er 4l3erg
+l8ergr 6lerkl 6l5erzie \n{8ler"o} 8lesel lesi5e le3sko le3tha let1s
+5leuc 4leuro leu4s3t le5xe 6lexp l1f 2l1g lgend8 l8gh lglie3 lglied6
+6l1h 1li li1ar li1as 2lick li8dr li1en lien6n li8ers li8ert 2lie\3
+\c{2lie\9} 3lig li8ga8b li1g6n li1l8a 8limb li1na 4l3indu lings5
+4l3inh 6linj link4s3 4linkt 2lint 8linv lion5s6t 4lipp 5lipt 4lisam
+livi5e 6l1j 6l1k l8keim l8kj lk2l lko8f lkor8 lk2sa lk2se 6ll l1la
+ll3a4be l8labt ll8anl ll1b ll1c ll1d6 l1le l4l3eim l6l5eise ller3a
+l4leti l5lip l1lo ll3ort ll5ov ll6spr llte8 l1lu ll3urg \n{l1l"a}
+\n{l5l"u} \n{l6l"ub} 2l1m l6m5o6d 6ln l1na l1no 8lobl lo6br 3loch.
+l5o4fen 5loge.  5lohn 4l3ohr 1lok l2on 4l3o4per lo1ra 2l1ord 6lorg
+4lort lo1ru 1los.  lo8sei 3losig lo6ve lowi5 6l1p lp2f l8pho l8pn
+lp4s3te l2pt l1q 8l1r 2ls l1sa l6sarm l1sc l8sec l6s5erg l4s3ers l8sh
+l5s6la l1sp ls4por ls2pu l1str l8suni \n{l1s"u} 2l1t lt5amp l4t3ein
+l5ten l6t5eng l6t5erp l4t3hei lt3her l2t1ho l6t5i6b lti1l \n{l8tr"o}
+lt1sc lt6ser lt4s3o lt5ums lu8br lu2dr lu1en8 8lu8fe luft3a luf8tr
+lu6g5r 2luh l1uhr lu5it 5luk 2l1umf 2l1umw 1lun 6l5u6nio 4l3unte lu5ol
+4lurg 6lurs l3urt lu4sto lu3str lu6st5re lu8su lu6tal lu6t5e6g lu8terg
+lu3the lu6t5or lu2t1r lu6\35 \c{lu6\95} l1v lve5r6u 2l1w 1ly lya6
+6lymp ly1no l8zess l8zo8f l3zwei lz5wu \n{3l"and} \n{l"a5on}
+\n{l"a6sc} \n{l"at1s} \n{5l"auf} \n{2l"aug} \n{l"au6s5c} \n{l"a5v}
+\n{l1"ol} \n{1l"os} \n{l"o1\36t} \n{\c{l"o1\96t}} \n{6l1"ube} 1ma
+8mabg ma5chan mad2 ma5el 4magg mag8n ma1la ma8lau mal5d 8malde mali5e
+malu8 ma8lut 2m1amp 3man mand2 man3ds 8mangr mani5o 8m5anst 6mappa
+4m3arbe mar8kr ma1r4o mar8schm 3mas ma1sc \n{ma1t"o} 4m5auf ma5yo 2m1b
+mb6r 2m1c 2m1d \n{md6s"a} 1me me1ch me5isc 5meld mel8sa 8memp me5nal
+men4dr men8schl men8schw 8mentsp me1ra mer4gl me1ro 3mes me6s5ei me1th
+me8\3 \c{me8\9} 2m1f6 2m1g 2m1h 1mi mi1a mi6ale mi1la 2m1imm mi1na
+\n{mi5n"u} mi4s3an mit1h mi5t6ra 3mitt mitta8 mi6\35 \c{mi6\95} 6mj
+2m1k8 2m1l 2m1m m6mad m6m5ak m8menth m8mentw mme6ra m2mn mm5sp mm5ums
+mmut5s \n{m8m"an} m1n8 m5ni 1mo mo5ar mo4dr 8mof mo8gal mo4kla mol5d
+m2on mon8do mo4n3od mont8a 6m5ony mopa6 mo1ra mor8d5a mo1sc mo1sp 5mot
+moy5 2mp m1pa mpfa6 mpf3l mphe6 m1pi mpin6 m1pl mp2li m2plu mpo8ste
+m1pr \n{mpr"a5} mp8th mput6 mpu5ts \n{m1p"o} 8m1q 2m1r 2ms ms5au m1sc
+msch4l ms6po m3spri m1str 2m1t mt1ar m8tein m2t1h mt6se \n{mt8s"a}
+mu5e 6m5uh mumi1 1mun mun6dr muse5e mu1ta 2m1v mvol2 mvoll3 2m1w 1my
+2m1z \n{m"a6kl} \n{1m"an} \n{m"a1s} \n{m"a5tr} \n{m"au4s3c} \n{3m"a\3}
+\n{\c{3m"a\9}} \n{m"ob2} \n{6m"ol} \n{1m"u} \n{5m"un} \n{3m"ut} 1na.
+n5ab.  8nabn n1abs n1abz \n{na6b"a} na2c nach3e 3nacht 1nae na5el
+n1afr 1nag 1n2ah na8ha na8ho 1nai 6nair na4kol n1akt nal1a 8naly 1nama
+na4mer na1mn n1amp 8n1amt 5nanc nan6ce n1and n6and.  2n1ang 1nani
+1nann n1ans 8nanw 5napf.  1n2ar.  na2ra 2n1arc n8ard 1nari n8ark
+6n1arm 5n6ars 2n1art n8arv 6natm nat6s5e 1naue 4nauf n3aug 5naui n5auk
+na5um 6nausb 6nauto 1nav 2nax 3naz 1na\3 \c{1na\9} n1b2 nbau5s n1c
+nche5e nch5m 2n1d nda8d n2d1ak nd5ans n2d1ei nde8lac ndel6sa n8derhi
+nde4se nde8stal n2dj ndnis5 n6d5or6t nd3rec nd3rot nd8samt nd6sau
+ndt1h n8dumd 1ne ne5as ne2bl 6n5ebn 2nec 5neei ne5en ne1g4l 2negy
+4n1ein 8neis 4n3e4lem 8nemb 2n1emp nen1a 6n5energ nen3k 8nentb
+4n3en3th 8nentl 8n5entn 8n5ents ne1ra ne5r8al ne8ras 8nerbi 6n5erde.
+nere5i6d nerfor6 \n{6n5erh"o} \n{8nerl"o} 2n1err n8ers.  6n5ertra
+2n1erz nesi3e net1h neu4ra neu5sc 8neu\3 \c{8neu\9} n1f nf5f nf2l
+nflei8 nf5lin nft8st n8g5ac ng5d ng8en nge8ram ngg2 ng1h n6glic ng3rip
+ng8ru ng2se4 ng2si n2g1um n1gy \n{n8g"al} n1h nhe6r5e 1ni ni1bl
+\n{ni5ch"a} ni8dee n6ie ni1en nie6s5te niet5h ni8etn 4n3i6gel n6ik
+ni1la 2n1imp ni5na 2n1ind 8ninf 6n5inh ni8nit 6n5inn 2n1ins 4n1int
+n6is ni3str ni1th ni1tr n1j n6ji n8kad nk5ans n1ke n8kerla n1ki nk5inh
+\n{n5kl"o} n1k2n n8k5not nk3rot \n{n8kr"u} nk5spo nk6t5r n8kuh
+\n{n6k"ub} n5l6 nli4mi n1m nmen4s n1na n8nerg nni5o n1no nn4t3ak nnt1h
+nnu1e n1ny \n{n1n"a} \n{n1n"o} \n{n1n"u} no5a no4b3la 4n3obs 2nobt
+noche8 no6die no4dis no8ia no5isc 6n5o6leu no4mal noni6er 2n1onk n1ony
+4n3o4per 6nopf 6nopti no3ra no4ram nor6da 4n1org 2n1ort n6os no1st
+8nost.  no8tan no8ter noty6pe 6n5ox n1p2 n1q n1r \n{nr"os3} 6ns n1sac
+ns3ang n1sc n8self n8s5erf n8serg n6serk ns5erw n8sint n1s2pe n1spr
+n6s5tat.  n5s6te.  n6stob n1str n1ta n4t3a4go nt5anh nt3ark nt3art
+n1te nt3eis nte5n6ar nte8nei nter3a nte6rei nt1ha nt6har n3ther nt5hie
+n3thus n1ti nti1c n8tinh nti1t ntlo6b ntmen8 n1to nt3o4ti n1tr ntra5f
+ntra5ut nt8rea nt3rec nt8rep n4t3rin nt8rop n4t3rot \n{n4tr"u} nt1s
+nts6an nt2sk n1tu nt1z \n{n1t"a} \n{n1t"o} \n{n8t"ol} \n{n1t"u} 1nu
+nu1a nu5el nu5en 4n1uhr nu5ie 8numl 6n5ums 6n5umw 2n1und 6nuni 6n5unr
+2n1unt 2nup 2nu6r n5uri nu3skr nu5ta n1v 8n1w 1nys n1za n6zab n2z1ar
+n6zaus nzi4ga n8zof n6z5unt n1zw n6zwir \n{1n"ac} \n{5n"ae} \n{5n"ai}
+\n{n8"al} \n{n"a6m} \n{n"a6re} \n{n5"arz} \n{5n"aus} \n{n1"ol}
+\n{1n"ot} \n{n5"oz} \n{5n"u.} \n{6n1"u2b} \n{5n"u\3} \n{\c{5n"u\9}}
+o5ab.  oa2l o8ala o1a2m o1an ob1ac obe4ra o6berh 5o4bers o4beru
+obe6ser 1obj o1bl o2bli ob5sk 3obst.  ob8sta obst5re ob5sz o1che
+oche8b o8chec o3chi och1l och3m ocho8f o3chro och3to o3chu och1w o1d
+o2d1ag od2dr ode5i ode6n5e od1tr o5e6b o5e6der.  oe8du o1ef o1e2l
+o1e2p o1er.  o5e8x o1fa of8fan 1offi of8fin of6f5la o5fla o1fr 8o1g
+og2n o1ha o1he o6h5eis o1hi ohl1a oh1le oh4l3er 5ohm.  oh2ni o1ho
+oh1re oh1ru o1hu oh1w o1hy \n{o1h"a} o5ia o1id.  o8idi oi8dr o5ids
+o5isch.  oiset6 o1ism o3ist.  o5i6tu o1j o1k ok2l ok3lau \n{o8kl"a}
+1okta o1la old5am old5r o1le ole5in ole1r ole3u ol6gl ol2kl olk4s1
+ol8lak ol8lauf.  ol6lel ol8less o1lo ol1s ol6sk o1lu oly1e2 5olym
+o2mab om6an o8mau ombe4 o8merz om5sp o1mu o8munt \n{o1m"a} \n{o1m"o}
+o1na ona8m on1ax on8ent o6n5erb 8oni oni5er.  on1k on6n5a6b o1no ono1c
+o4nokt 1ons onts8 \n{o1n"a} oo8f 1oog oo2pe oo2sa o1pa 3o4pera o3pfli
+opf3lo opf3r o1pi o1pl o2pli o5p6n op8pa op6pl o1pr o3p4ter 1opti
+\n{o1p"a} \n{o5p"o} o1q o1ra.  o3rad o8radd 1oram o6rang o5ras o8rauf
+or5cha or4d3a4m or8dei or8deu 1ordn or4dos o1re o5re.  ore2h o8r5ein
+ore5isc or6enn or8fla or8fli 1orga 5orgel.  or2gl o1ri 5o6rient or8nan
+\n{or8n"a} o1ro or1r2h or6t5an or8tau or8tere o1rus o1ry \n{o1r"a}
+\n{or1"u2} o1sa osa3i 6ose o8serk o1sk o6ske o6ski os2kl os2ko os2kr
+osni5e o2s1o2d o3s4per o4stam o6stau o3stra ost3re osu6 o6s5ur o5s6ze
+o1ta ot3auf o6taus o1te o6terw o1th othe5u o2th1r o1ti o1to oto1a
+ot1re o1tri o1tro ot1sc o3tsu ot6t5erg ot2t3h ot2t5r \n{ot8t"o} o1tu
+ou3e ouf1 ou5f6l o5u6gr ou5ie ou6rar ou1t6a o1v o1wa o1we o6wer.  o1wi
+owid6 o1wo o5wu o1xe oy5al.  oy1e oy1i o5yo o1z oza2r 1o2zea ozo3is
+\n{o"o8} o\35elt \c{o\95elt} o\31t \c{o\91t} 3paa pa6ce 5pad pag2 1pak
+pa1la pa8na8t pani5el pa4nor pan1s2 1pap pap8s pa8rei par8kr paro8n
+par5o6ti part8e 5partei 3partn pas6sep pa4tha 1pau 6paug pau3sc p1b
+8p5c 4p1d 1pe 4peic pe5isc 2pek pen3k pen8to8 p8er pe1ra pere6 per5ea
+per5eb pe4rem 2perr per8ran 3pers 4persi \n{pe3r"u} pe4sta pet2s
+p2f1ec p4fei pf1f pf2l 5pflanz pf8leg pf3lei 2pft pf3ta p1g 1ph 2ph.
+2p1haf 6phb 8phd 6p5heit ph5eme 6phg phi6e 8phk 6phn p5holl pht2
+ph3tha 4ph3the phu6 6phz pi1en pi5err pi1la pi1na 5pinse pioni8e 1pis
+pi1s2k pi1th p1k pl8 5pla p2lau 4plei p3lein 2pler 6p5les 2plig p6lik
+6p5ling p2liz plo8min 6p1m p1n 1p2o 8poh 5pol po8lan poly1 po3ny po1ra
+2porn por4t3h \n{po5r"o} 5poti p1pa p6p5ei ppe6la pp5f p2p1h p1pi pp1l
+ppp6 pp5ren pp1s \n{p5p"o} pr6 3preis 1pres 2p3rig 5prinz 1prob 1prod
+5prog pro8pt pro6t5a prote5i 8pro\3 \c{8pro\9} \n{pr"a3l} \n{1pr"as}
+\n{pr"ate4} \n{1pr"uf} p5schl 2pst 1p2sy p1t p8to8d pt1s 5p6ty 1pu
+pu1b2 2puc pu2dr puf8fr 6p5uh pun8s pu8rei pu5s6h pu1ta p1v p3w 5py
+py5l p1z \n{p"a6der} \n{p5"a6m} \n{p"a8nu} \n{8p"ar} \n{p"at5h}
+\n{p"at1s} qu6 1qui 8rabk ra6bla 3rable ra2br r1abt 6rabz ra4dan ra2dr
+5rafal ra4f3er ra5gla ra2g3n 6raha ral5am 5rald 4ralg ra8lins 2rall
+ral5t 8ramei r3anal r6and ran8der ran4dr 8ranf 6ranga 5rangi ran8gli
+r3angr rans5pa 8ranw r8anz.  ra5or 6rapf ra5pl rap6s5er 2r1arb 1rarh
+r1arm ra5ro 2r1art 6r1arz ra8tei ra6t5he 6ratl ra4t3ro r5atta raue4n
+6raus.  r5austa rau8tel raut5s ray1 r1b rb5lass r6bler rb4lie rbon6n
+r8brecht \n{rb6s5t"a} r8ces r1che rch1l rch3m rch3re rch3tr rch1w 8rd
+r1da r8dachs r8dap rda5ro rde5ins rdio5 r8dir rd3ost r1dr r8drau 1re.
+re1ak 3reakt re3als re6am.  re1as 4reben re6bl rech5a r8edi re3er
+8reff 3refl 2reh 5reha r4ei.  reich6s5 8reier 6reign re5imp 4r3eina
+6r3einb 6reing 6r5einn 6reinr 4r3eins r3eint reli3e 8r5elt 6rempf
+2remt ren5a6b ren8gl r3enni 1reno 5rente 4r3enth 8rentl 4r3entw 8rentz
+ren4zw re1on requi5 1rer rer4bl 6rerbs 4r3erd \n{8rerh"o} 8rerkl
+4r3erla \n{8rerl"o} 4r3erns \n{6r5ern"a} rer5o 6r5erreg r5ertr r5erwec
+\n{r5er"o} re2sa re8schm 2ress re5u8ni 6rewo 2r1ex r1f r8ferd rf4lie
+8r1g r8gah rge4bl rge5na rgest4 rg6ne r2gni2 r8gob r4g3ret rg8sel r1h8
+r2hy 5rhyt ri1ar ri5cha rid2g r2ie rieg4s5 ri8ei ri1el ri6ele ri1en
+ri3er.  ri5ers.  ri6fan ri8fer ri8fr 1r2ig ri8kn ri5la \n{rim"a8}
+ri1na r8inde rin4ga rin6gr 1rinn 6rinner rino1 r8insp 4rinst
+\n{ri1n"a} ri5o6ch ri1o2d ri3o6st 2r1ir r2is ri3sko ri8spr \n{ri8st"u}
+ri5sv r2it 6r5i6tal ri5tr ri6ve.  8r1j 6rk r1ke rkehrs5 r1ki r3klin
+r1k2n rk3str rk4t3an rk6to r6kuh \n{rk"a4s3t} r1l r5li rline5a 6r1m
+r6manl rma4p r4m3aph r8minf r8mob rm5sa 2rn r1na rna8be r5ne rn2ei
+r6neif r6nex r6nh rn1k r1no r6n5oc rn1sp \n{r1n"a} \n{r1n"u} ro6bern
+6robs ro1ch 3rock.  ro5de ro1e 4rofe ro8hert 1rohr ro5id ro1in ro5isc
+6rolym r2on 6roog ro6phan r3ort ro1s2p ro5s6w ro4tau ro1tr ro6ts 5rout
+r1p rpe8re rp2f r2ps r2pt r1q 2rr r1ra r1re rrer6 rr6hos \n{r5rh"o}
+r1ri r1ro rro8f rr8or rror5a r1ru r3ry \n{r1r"a} \n{r1r"o} \n{r1r"u}
+2r1s r6sab r4sanf rse6e rse5na r2sh r6ska r6ski rs2kl r8sko r2sl rs2p
+r6stauf r8sterw r8stran rswi3d4 r2sz 2r1t rt3art r8taut r5tei rt5eige
+r8tepe r4t3erh r8terla r4t3hei r5t6hu r4t3int rt5reif rt1sc rt6ser
+rt6s5o rt6s5u rt5und r8turt rube6 ru1en 1r4uf ruf4st ru1ie 2r1umg
+2r1uml 2rums run8der run4d5r 6rundz 6runf 8runs 2r1unt 2r1ur r6us
+ru6sta ru3str ru6tr 1ruts r1v rven1 rvi2c r1w r1x r1za rz5ac r6z5al
+r8z1ar r8zerd r6z5erf rz8erh rz4t3h r8zum \n{r"a4ste} \n{r"au8sc}
+\n{r1"of} \n{5r"ohr} \n{r"o5le} \n{3r"oll} \n{5r"omis} \n{r1"or}
+\n{r"o2sc} \n{3r"ump} 1sa.  1saa s3a4ben sa2bl 2s1abs 6s1abt 6sabw
+3sack.  6s3a4der 1saf sa1fa 4s1aff sa5fr 1sag 1sai sa1i2k1 4s1akt 1sal
+sa1la 4s3alpi 6salter salz3a 1sam s5anb san2c 1sand s5angeh 6sanl
+2s1ans 6s3antr 8s1anw s1ap s6aph 8sapo sap5p6 s8ar.  2s1arb 3sarg
+s1arm sa5ro 2s1art 6s1arz 1sas 1sat sat8a 2s1atl sa8tom 3s8aue s5auff
+sau5i s6aur 2s1aus 5s6ause 2s1b2 2sca s4ce 8sch.  3scha.  5schade
+3schaf 3schal sch5ame 8schanc 8schb 1sche 6schef 8schex 2schf 2schg
+2schh 1schi 2schk 5schlag 5schlu \n{6schm"a\3} \n{\c{6schm"a\9}}
+6schna\3 \c{6schna\9} 1scho 6schord 6schp 3schri 8schric 8schrig
+8schrou 6schs 2scht sch3ta sch3tr 1schu 8schunt 6schv 2schz \n{5sch"o}
+\n{5sch"u} 2sco scre6 6scu 2s1d 1se se5an se1ap se6ben se5ec see5i6g
+se3erl 8seff se6han se8hi \n{se8h"o} 6s5eid.  2s1eig s8eil 5sein.
+sei5n6e 6s5einh 3s8eit 3sel.  se4lar selb4 6s3e4lem se8lerl 2s1emp
+sen3ac se5nec 6s5ents 4sentz s8er.  se8reim ser5inn \n{8serm"a}
+8s5erzi \n{6ser"of} se1um 8sexa 6sexp 2s1f2 sfal8ler 2s3g2 sge5b2 s1h
+s8hew 5s6hip 5s4hop 1si 2siat si1b sicht6s 6s5i6dee siege6s5 si1en
+si5err si1f2 si1g2n si6g5r si8kau sik1i si4kin si2kl \n{si8k"u} si1la
+sil6br si1na 2s1inf sin5gh 2s1inh sinne6s5 2s1ins si5ru si5str 4s1j
+s1k2 6sk.  2skau skel6c skelch5 s6kele 1s2ki.  3s4kin.  s6kiz s8kj
+6skn 2skow 3skrib 3skrip 2sku \n{8sk"u} s1l s8lal slei3t s4low 2s1m
+s1n 6sna 6snot 1so so1ch 2s1odo so4dor 6s5o4fen solo3 s2on so5of 4sope
+so1ra 2s1ord 4sorga sou5c so3un 4s3ox sp2 8spaa 5spal 1span 2spap
+s2pec s4peis 1spek s6perg 4spers s6pes 2s1pf 8sphi \n{1s2ph"a} 1spi
+spi4e 6s5pig 6spinse 2spis 2spla 2spol 5s6pom 6s5pos 6spoti 1spra
+3s8prec 6spreis 5spring 6sprob 1spru s2pul 1s2pur 6spy \n{5sp"an}
+\n{1sp"u} s1q 2s1r 2s1s2 sse8nu ssini6s ssoi6r 2st.  1sta 4stafe 2stag
+sta3la 6stale 4stalg 8stalk 8stamt 6st5anf 4stans 6stanw 6starb sta4te
+6staus 2stb 6stc 6std 1ste 4steil 3s2tel st3elb 8stemb 6steppi 8stese
+8stesse 6stf 2stg 2sth st1ha st3hei s8t1hi st1ho st5hu 1sti sti4el
+4stigm sti3na 6stind 4stinf sti8r 2stk 2stl 2stm 1sto 6stoll.  4st3ope
+6stopf.  6stord 6stp 5stra.  4strai 3s4tral 6s5traum 3stra\3
+\c{3stra\9} 3strec 6s3tref 8streib 5streif 6streno 6stres 6strev
+5s6tria 6strig 5strik 8strisi 3s4troa s8troma st5rose 4struf 3strum
+\n{6str"ag} 2st1s6 2stt 1stu stu5a 4stuc 2stue 8stun.  2stv 2stw s2tyl
+6stz \n{1st"a} \n{8st"ag} \n{1st"o} \n{1st"u} \n{8st"uch} \n{4st"ur.}
+1su su2b1 3suc su1e su2fe su8mar 6sumfa 8sumk 2s1unt sup1p2 6s5u6ran
+6surte 2s1v 2s1w 1sy 8syl.  sy5la syn1 sy2na syne4 s1z s4zend 5s6zene.
+8szu \n{1s"a} \n{6s5"and} \n{6s"augi} \n{6s"au\3} \n{\c{6s"au\9}}
+\n{5s"om} \n{2s1"u2b} \n{1s"uc} \n{s"u8di} \n{1s"un} \n{5s"u\3}
+\n{\c{5s"u\9}} taats3 4tab.  taba6k ta8ban tab2l ta6bre 4tabs t3absc
+8tabz 6t3acht ta6der 6tadr tad6s tad2t 1tafe4 1tag ta6ga6 ta8gei
+tage4s tag6s5t tah8 tahl3 tai6ne.  ta5ir.  tak8ta tal3au 1tale ta8leng
+tal5ert 6t5a6mer 6tamp tampe6 2t1amt tan5d6a tan8dr tands5a tani5e
+6tanl 2tanr t3ans 8t5antr tanu6 t5anw 8tanwa tan8zw ta8rau 6tarbe
+1tari 2tark 2t1arm ta1ro 2tart t3arti 6tarz ta1sc ta6sien ta8stem
+ta8sto t5aufb 4taufn 8taus.  5tause 8tausf 6tausg t5ausl 2t1b2 2t1c
+t6chu 2t1d te2am tea4s te8ben 5techn 4teff te4g3re te6hau 2tehe te4hel
+2t1ehr te5id.  teig5l 6teign tei8gr 1teil 4teinh t5einhe 4teis t5eisen
+8teiw te8lam te4lar 4telek 8telem te6man te6n5ag ten8erw ten5k tens4p
+ten8tro 4t3entw 8tentz te6pli 5teppi ter5a6b te3ral ter5au 8terbar
+t5erbe.  6terben 8terbs 4t3erbt t5erde.  ter5ebe ter5ein te8rers terf4
+\n{8terh"o} \n{6terkl"a} ter8nor ter6re.  t8erscha t5e6sel te8stau
+t3euro te1xa tex3e 8texp tex6ta 2t1f2 2t1g2 2th.  th6a 5tha.  2thaa
+6t1hab 6t5haf t5hah 8thak 3thal.  6thals 6t3hand 2t1hau 1the.  3t4hea
+t1heb t5heil t3heit t3helf 1theo 5therap 5therf 6t5herz 1thes 1thet
+5thi.  2t1hil t3him 8thir 3this t5hj 2th1l 2th1m th1n t5hob t5hof
+4tholz 6thopti 1thr6 4ths t1hum 1thy \n{4t1h"a} \n{2t1h"o} \n{t1h"u}
+ti1a2m ti1b tie6fer ti1en ti8gerz tig3l ti8kin ti5lat 1tilg t1ind
+tin4k3l ti3spa ti5str 5tite ti5tr ti8vel ti8vr 2t1j 2t1k2 2t1l tl8a
+2t1m8 2t1n 3tobe 8tobj to3cha 5tocht 8tock tode4 to8del to8du to1e
+6t5o6fen to1in toi6r 5toll.  to8mene t2ons 2t1ony to4per 5topf.  6topt
+to1ra to1s to6ska tos2l 2toti to1tr t8ou 2t1p2 6t1q tr6 tra5cha
+tra8far traf5t 1trag tra6gl tra6gr t3rahm 1trai t6rans tra3sc tra6st
+3traue t4re.  2trec t3rech t8reck 6t1red t8ree 4t1reg 3treib 4treif
+8t3reis 8trepo tre6t5r t3rev 4t3rez 1trib t6rick tri6er 2trig t8rink
+tri6o5d trizi5 tro1a 3troc trocke6 troi8d tro8man.  tro3ny 5tropf
+6t5rosa t5ro\3 \c{t5ro\9} 5trub 5trup trut5 \n{1tr"ag} \n{6t1r"oh}
+\n{5tr"ub} \n{tr"u3bu} \n{t1r"uc} \n{t1r"us} 2ts ts1ab t1sac tsa8d
+ts1ak t6s5alt ts1an ts1ar ts3auf t3schr \n{t5sch"a} tse6e tsee5i
+tsein6s ts3ent ts1er t8serf t4serk t8sh 5t6sik t4s3int ts5ort.
+t5s6por t6sprei t1st t6s5tanz ts1th t6stit t4s3tor 1t2sua t2s1uf
+t8sum.  t2s1u8n t2s1ur 2t1t tt5eif tte6sa tt1ha tt8ret tt1sc tt8ser
+tt5s6z 1tuc tuch5a 1tu1e 6tuh t5uhr tu1i tu6it 1tumh 6t5umr 1tums
+8tumt 6tund 6tunf 2t1unt tu5ra tu6rau tu6re.  tu4r3er 2t1v 2t1w 1ty1
+ty6a ty8la 8tym 6ty6o 2tz tz5al tz1an tz1ar t8zec tzeh6 tzehn5 t6z5ei.
+t6zor t4z3um \n{t6z"au} \n{5t"ag} \n{6t"ah} \n{t5"alt} \n{t8"an}
+\n{t"are8} \n{8t"a8st} \n{6t"au\3} \n{\c{6t"au\9}} \n{t5"offen}
+\n{8t"o8k} \n{1t"on} \n{4t"ub} \n{t6"u5ber.} \n{5t"uch} \n{1t"ur.}
+u3al.  u5alb u5alf u3alh u5alk u3alp u3an.  ua5na u3and u5ans u5ar.
+ua6th u1au ua1y u2bab ubi5er.  u6b5rit ubs2k \n{u5b"o} \n{u8b"ub} 2uc
+u1che u6ch5ec u1chi uch1l uch3m uch5n uch1r uch5to ucht5re u1chu uch1w
+uck1a uck5in u1d ud4a u1ei u6ela uene8 u6ep u1er uer1a ue8rerl uer5o
+u8esc u2est u8ev u1fa u2f1ei u4f3ent u8ferh uf1fr uf1l uf1ra uf1re
+\n{uf1r"a} \n{uf1r"u} uf1s2p uf1st uft1s u8gabt u8gad u6gap ugeb8 u8gn
+ugo3s4 u1ha u1he u1hi uh1le u1ho uh1re u1hu uh1w \n{u1h"a} \n{u1h"o}
+6ui ui5en u1ig u3ins uin8tes u5isch.  u1j 6uk u1ke u1ki u1kl u8klu
+u1k6n u5ky u1la uld8se u1le ul8lac ul6lau ul6le6l ul6lo ulni8 u1lo
+ulo6i ult6a ult8e u1lu ul2vr \n{u1l"a} \n{u1l"o} 3umfan 5umlau umo8f
+um8pho u1mu umu8s \n{u5m"o} u1n1a un2al un6at unau2 6und.  5undein
+un4d3um 3undzw \n{und"u8} \n{un8d"ub} une2b un1ec une2h un3eis 3unfal
+\n{1unf"a} 5ungea \n{3ungl"u} ung2s1 \n{un8g"a} 1u2nif un4it un8kro
+unk5s u1no unpa2 uns2p unvol4 unvoll5 u5os.  u1pa u1pi u1p2l u1pr
+up4s3t up2t1a u1q u1ra ur5abs ura8d ur5ah u6rak ur3alt u6rana u6r5ans
+u8rap ur5a6ri u8ratt u1re ur3eig ur8gri u1ri ur5ins 3urlau urmen6
+ur8nan u1ro 3ursac ur8sau ur8sei ur4sk 3urtei u1ru uru5i6 uru6r u1ry
+ur2za \n{ur6z"a} \n{ur5"a6m} \n{u5r"o} \n{u1r"u} \n{ur"uck3} u1sa
+usa4gi u2s1ar u2s1au u8schec usch5wi u2s1ei use8kel u8sl u4st3a4b
+us3tau u3s4ter u2s1uf u8surn ut1ac u1tal uta8m u1tan ut1ar u1tas ut1au
+u1te u8teic u4tent u8terf u6terin u4t3hei ut5ho ut1hu u1ti utine5
+uti6q u1to uto5c u1tr ut1sa ut1s6p ut6stro u1tu utz5w u1u u1v uve5n
+\n{uve3r4"a} u1w u1xe u5ya uy5e6 u1yi u2z1eh u8zerh \n{u5"o} u\3e6n
+\c{u\9e6n} u\3en5e \c{u\9en5e} 8vanb 6vang 6varb var8d va6t5a va8tei
+va2t1r 2v1b 6v5c 6vd 1ve 6ve5g6 ver1 ver5b verb8l ve2re2 verg8 ve2ru8
+ve1s ve2s3p ve3xe 2v1f 2v1g 6v5h vi6el vie6w5 vi1g4 vi8leh vil6le.
+8vint vi1ru vi1tr 2v1k 2v1l 2v1m 4v5n 8vo8f voi6le vol8lend vol8li
+v2or1 vo2re vo8rin vo2ro 2v1p 8vra v6re 2v1s 2v1t 2v1v 4v3w 2v1z
+waffe8 wa6g5n 1wah wah8n wa5la wal8din wal6ta wan4dr 5ware wa8ru
+war4za 1was w5c w1d 5wech we6fl 1weg we8geng weg5h weg3l we2g1r
+weh6r5er 5weise weit3r wel2t welt3r we6rat 8werc 5werdu wer4fl 5werk.
+wer4ka wer8ku wer4ta wer8term we2sp we8stend we6steu we8str
+\n{we8st"o} wet8ta wich6s5t 1wid wi2dr wiede4 wieder5 wik6 wim6ma
+win4d3r 5wirt wisch5l 1wj 6wk 2w1l 8w1n wo1c woche6 wol6f wor6t5r 6ws2
+w1sk 6w5t 5wunde.  wun6gr wu1sc wu2t1 6w5w wy5a \n{w"arme5} \n{w"a1sc}
+1xag x1ak x3a4men 8xamt x1an 8x1b x1c 1xe.  x3e4g 1xen xe1ro x1erz
+1xes 8xf x1g 8x1h 1xi 8xid xi8so 4xiste x1k 6x1l x1m 8xn 1xo 8x5o6d
+8x3p2 x1r x1s6 8x1t x6tak x8terf x2t1h 1xu xu1e x5ul 6x3w x1z 5ya.
+y5an.  y5ank y1b y1c y6cha y4chia y1d yen6n y5ern y1g y5h y5in y1j
+y1k2 y1lak yl1al yla8m y5lax y1le y1lo y5lu y8mn ym1p2 y3mu y1na yno2d
+yn1t y1on.  y1o4p y5ou ypo1 y1pr y8ps y1r yri3e yr1r2 y1s ys5iat ys8ty
+y1t y3w y1z \n{y"a8m} z5a6b zab5l 8za6d 1zah za5is 4z3ak 6z1am 5zange.
+8zanl 2z1ara 6z5as z5auf 3zaun 2z1b 6z1c 6z1d 1ze ze4dik 4z3eff 8zein
+zei4ta zei8ters ze6la ze8lec zel8th 4zemp 6z5engel zen8zin \n{8zerg"a}
+zer8i ze1ro zers8 zerta8 zer8tab zer8tag 8zerz ze8ste zeu6gr 2z1ex
+2z1f8 z1g 4z1h 1zi zi1en zi5es.  4z3imp zi1na 6z5inf 6z5inni zin6s5er
+8zinsuf zist5r zi5th zi1tr 6z1j 2z1k 2z1l 2z1m 6z1n 1zo zo6gl 4z3oh
+zo1on zor6na8 4z1p z5q 6z1r 2z1s8 2z1t z4t3end z4t3hei z8thi 1zu zu3al
+zu1b4 zu1f2 6z5uhr zun2a 8zunem zunf8 8zungl zu1o zup8fi zu1s8 zu1z
+2z1v zw8 z1wal 5zweck zwei3s z1wel z1wer z6werg 8z5wes 1zwi zwi1s
+6z1wo 1zy 2z1z zz8a zzi1s \n{1z"a} \n{1z"o} \n{6z"ol.} \n{z"o1le}
+\n{1z"u} \n{2z1"u2b} \n{"a1a6} \n{"ab1l} \n{"a1che} \n{"a3chi}
+\n{"ach8sc} \n{"ach8sp} \n{"a5chu} \n{"ack5a} \n{"ad1a} \n{"ad5era}
+\n{"a6d5ia} \n{"a1e} \n{"a5fa} \n{"af1l} \n{"aft6s} \n{"ag1h}
+\n{"ag3le} \n{"a6g5nan} \n{"ag5str} \n{"a1he} \n{"a1hi} \n{"ah1le}
+\n{"ah5ne} \n{1"ahnl} \n{"ah1re} \n{"ah5ri} \n{"ah1ru} \n{"a1hu}
+\n{"ah1w} \n{6"ai} \n{"a1isc} \n{"a6ische} \n{"a5ism} \n{"a5j}
+\n{"a1k} \n{"al1c} \n{"a1le} \n{"a8lei} \n{"al6schl} \n{"ami1e}
+\n{"am8n} \n{"am8s} \n{"a5na} \n{5"anderu} \n{"ane5i8} \n{"ang3l}
+\n{"ank5l} \n{"a1no} \n{"an6s5c} \n{"a1pa} \n{"ap6s5c} \n{3"aq}
+\n{"ar1c} \n{"a1re} \n{"are8m} \n{5"argern} \n{"ar6gl} \n{"a1ri}
+\n{3"armel} \n{"a1ro} \n{"art6s5} \n{"a1ru} \n{3"arztl} \n{"a5r"o}
+\n{"a6s5chen} \n{"asen8s} \n{"as1th} \n{"ata8b} \n{"a1te} \n{"ateri4}
+\n{"ater5it} \n{"a6thy} \n{"a1ti} \n{3"atk} \n{"a1to} \n{"at8schl}
+\n{"ats1p} \n{"a5tu} \n{"aub1l} \n{"au1e} \n{1"aug} \n{"au8ga}
+\n{"au5i} \n{"a1um.} \n{"a1us.} \n{1"au\3} \n{\c{1"au\9}} \n{"a1z}
+\n{"o1b} \n{"o1che} \n{"o5chi} \n{"och8stei} \n{"och8str} \n{"ocht6}
+\n{5"o6dem} \n{5"offn} \n{"o1he} \n{"oh1l8} \n{"oh1re} \n{"o1hu}
+\n{"o1is} \n{"o1ke} \n{1"o2ko} \n{1"ol.} \n{"ol6k5l} \n{"ol8pl}
+\n{"o1mu} \n{"o5na} \n{"onig6s3} \n{"o1no} \n{"o5o6t} \n{"opf3l}
+\n{"op6s5c} \n{"o1re} \n{"or8gli} \n{"o1ri} \n{"or8tr} \n{"o1ru}
+\n{5"osterr} \n{"o1te} \n{"o5th} \n{"o1ti} \n{"o1tu} \n{"o1v} \n{"o1w}
+\n{"owe8} \n{"o2z} \n{"ub6e2} \n{3"u4ber1} \n{"ub1l} \n{"ub1r}
+\n{5"u2bu} \n{"u1che} \n{"u1chi} \n{"u8ch3l} \n{"uch6s5c} \n{"u8ck}
+\n{"uck1a} \n{"uck5ers} \n{"ud1a2} \n{"u6deu} \n{"udi8t} \n{"u2d1o4}
+\n{"ud5s6} \n{"uge4l5a} \n{"ug1l} \n{"uh5a} \n{"u1he} \n{"u8heh}
+\n{"u6h5erk} \n{"uh1le} \n{"uh1re} \n{"uh1ru} \n{"u1hu} \n{"uh1w}
+\n{"u3k} \n{"u1le} \n{"ul4l5a} \n{"ul8lo} \n{"ul4ps} \n{"ul6s5c}
+\n{"u1lu} \n{"un8da} \n{"un8fei} \n{"unk5l} \n{"un8za} \n{"un6zw}
+\n{"u5pi} \n{"u1re} \n{"u8rei} \n{"ur8fl} \n{"ur8fr} \n{"ur8geng}
+\n{"u1ri} \n{"u1ro} \n{"ur8sta} \n{"ur8ster} \n{"u1ru} \n{"use8n}
+\n{"u8sta} \n{"u8stes} \n{"u6s5tete} \n{"u3ta} \n{"u1te} \n{"u1ti}
+\n{"ut8tr} \n{"u1tu} \n{"ut8zei} \n{"u1v} \31a8 \c{\91a8} 5\3a.
+\c{5\9a.} \38as \c{\98as} \31b8 \c{\91b8} \31c \c{\91c} \31d \c{\91d}
+1\3e \c{1\9e} \35ec \c{\95ec} 8\3e8g \c{8\9e8g} 8\3e8h \c{8\9e8h}
+2\31ei \c{2\91ei} 8\3em \c{8\9em} \31f8 \c{\91f8} \31g \c{\91g} \31h
+\c{\91h} 1\3i \c{1\9i} \31k \c{\91k} \31l \c{\91l} \31m \c{\91m}
+\3mana8 \c{\9mana8} \31n \c{\91n} \31o \c{\91o} \31p8 \c{\91p8} \35q
+\c{\95q} \31r \c{\91r} \31s2 \c{\91s2} \3st8 \c{\9st8} \31ta \c{\91ta}
+\31te \c{\91te} \3t3hei \c{\9t3hei} \31ti \c{\91ti} \35to \c{\95to}
+\31tr \c{\91tr} 1\3u8 \c{1\9u8} 6\35um \c{6\95um} \31v \c{\91v} \31w
+\c{\91w} \31z \c{\91z}
+}%
+\endgroup
+\relax\endinput
+%
+% -----------------------------------------------------------------
+%
+% =============== Additional Documentation ===============
+%
+%
+% Older Versions of German Hyphenation Patterns:
+% ----------------------------------------------
+%
+% All older versions of `ghyphen.tex' distributed as
+%
+%       ghyphen.tex/germhyph.tex   as of 1986/11/01
+%       ghyphen.min/ghyphen.max    as of 1988/10/10
+%       ghyphen3.tex               as of 1990/09/27 & 1991/02/13
+%       ghyph31.tex                as of 1994/02/13
+%
+% are out of date and it is recommended to replace them
+% with the new version `dehypht.tex' as of 1999/03/03.
+%
+% If you are using `ghyphen.min' (a minor version of `ghyphen')
+% because of limited trie memory space, try this version and if
+% the space is exceeded get a newer TeX implementation with
+% larger or configurable trie memory sizes.
+%
+%
+%
+% Trie Memory Requirements/Space for Hyphenation Patterns:
+% --------------------------------------------------------
+%
+% To load this set of german hyphenation patterns the parameters
+% of TeX has to have at least these values:
+%
+% TeX 3.x:
+%    IniTeX:    trie_size >= 9733    trie_op_size >= 207
+%    VirTeX:    trie_size >= 8375    trie_op_size >= 207
+%
+% TeX 2.x:
+%    IniTeX:    trie_size >= 8675    trie_op_size >= 198
+%    VirTeX:    trie_size >= 7560    trie_op_size >= 198
+%
+% If you want to load more than one set of hyphenation patterns
+% (in TeX 3.x), the parameters have to be set to a value larger
+% than or equal to the sum of all required values for each set.
+%
+%
+% Setting Trie Memory Parameters:
+% -------------------------------
+%
+% Some implementations allow the user to change the default value
+% of a set of the internal TeX parameters including the trie memory
+% size parameter specifying the used memory for the hyphenation
+% patterns.
+% 
+% Web2c 7.x (Source), teTeX 0.9 (Unix, Amiga), fpTeX (Win32)
+% and newer:
+%   The used memory size of the true is usually set high enough.
+%   If needed set the size of the trie using the keyword `trie_size'
+%   in the configuration file `texmf/web2c/texmf.cnf'.  For details
+%   see the included documentation.
+%
+% emTeX (OS/2, MS-DOS, Windows 3.x/9x/NT):
+%   You can set the used memory size of the trie using the
+%   `-mt<number>' option on the command line or in the
+%   TEXOPTIONS environment variable.
+%
+% PasTeX (Amiga):
+%   The values for the parameters can be set using the keywords
+%   `triesize', `itriesize' and `trieopsize' in the configuration
+%   file.
+%
+% others (binaries only):
+%   See the documentation of the implementation if it is possible
+%   and how to change these values without recompilation.
+%
+% others (with sources)
+%   If the trie memory is too small, you have to recompile TeX
+%   using larger values for `trie_size' and `trie_op_size'.
+%   Modify the change file `tex.ch' and recompile TeX.
+%   For details see the documentation included in the sources.
+%
+%
+%
+% Necessary Settings in TeX macro files:
+% --------------------------------------
+%
+% \lefthyphenmin, \righthyphenmin:
+%   You can set both parameters to 2.
+%
+% \lccode <char>:
+%   To get correct hyphenation points within words containing
+%   umlauts or \ss, it's necessary to assign values > 0 to the
+%   appropriate \lccode <char> positions.
+%
+% These changes are _not_ done when reading this file and have to
+% be included in the language switching mechanism as is done in,
+% for example, `german.sty' (\lccode change for ^^Y = \ss in OT1,
+% \left-/\righthyphenmin settings).
+%
+%
+%% \CharacterTable
+%%  {Upper-case    \A\B\C\D\E\F\G\H\I\J\K\L\M\N\O\P\Q\R\S\T\U\V\W\X\Y\Z
+%%   Lower-case    \a\b\c\d\e\f\g\h\i\j\k\l\m\n\o\p\q\r\s\t\u\v\w\x\y\z
+%%   Digits        \0\1\2\3\4\5\6\7\8\9
+%%   Exclamation   \!     Double quote  \"     Hash (number) \#
+%%   Dollar        \$     Percent       \%     Ampersand     \&
+%%   Acute accent  \'     Left paren    \(     Right paren   \)
+%%   Asterisk      \*     Plus          \+     Comma         \,
+%%   Minus         \-     Point         \.     Solidus       \/
+%%   Colon         \:     Semicolon     \;     Less than     \<
+%%   Equals        \=     Greater than  \>     Question mark \?
+%%   Commercial at \@     Left bracket  \[     Backslash     \\
+%%   Right bracket \]     Circumflex    \^     Underscore    \_
+%%   Grave accent  \`     Left brace    \{     Vertical bar  \|
+%%   Right brace   \}     Tilde         \~}
+%%
+\endinput
+%% 
+%% End of file `dehypht.tex'.

src/vendormodules/textutil/ithyph.tex

@@ -0,0 +1,223 @@
+
+%%%%%%%%%%%%%%%%%%%% file ithyph.tex
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%  file ithyph.tex  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Prepared by Claudio Beccari   e-mail  beccari@polito.it
+%
+%                                       Dipartimento di Elettronica
+%                                       Politecnico di Torino
+%                                       Corso Duca degli Abruzzi, 24
+%                                       10129 TORINO
+%
+% Copyright  1998, 2001 Claudio Beccari
+%
+% This program can be redistributed and/or modified under the terms
+% of the LaTeX Project Public License Distributed from CTAN
+% archives in directory macros/latex/base/lppl.txt; either
+% version 1 of the License, or any later version.
+%
+% \versionnumber{4.8d}   \versiondate{2001/11/21}
+%
+% These hyphenation patterns for the Italian language are supposed to comply
+% with the Reccomendation UNI 6461 on hyphenation issued by the Italian
+% Standards Institution (Ente Nazionale di Unificazione UNI).  No guarantee
+% or declaration of fitness to any particular purpose is given and any
+% liability is disclaimed.
+%
+% See comments and loading instructions at the end of the file after the
+% \endinput line
+%
+{\lccode`\'=`\'      % Apostrophe has its own lccode so that it is treated
+                     % as a letter
+                     %>> 1998/04/14 inserted grouping
+                     %
+%\lccode23=23        % Compound word mark is a letter in encoding T1
+%\def\W{^^W}         % ^^W =\char23 = \char"17 =\char'27
+%
+\patterns{
+.a3p2n               % After the Garzanti dictionary: a-pnea, a-pnoi-co,...
+.anti1  .anti3m2n
+.bio1
+.ca4p3s
+.circu2m1
+.di2s3cine
+%.e2x
+.fran2k3
+.free3
+.narco1
+.opto1
+.orto3p2
+.para1
+.poli3p2
+.pre1
+.p2s
+%.ri1a2   .ri1e2    .re1i2  .ri1o2  .ri1u2
+.sha2re3
+.tran2s3c .tran2s3d .tran2s3f .tran2s3l .tran2s3n .tran2s3p .tran2s3r .tran2s3t
+.su2b3lu   .su2b3r
+.wa2g3n
+.wel2t1
+a1ia a1ie  a1io  a1iu a1uo a1ya 2at.
+e1iu e2w
+o1ia o1ie  o1io  o1iu
+%u1u
+%
+%1\W0a2 1\W0e2 1\W0i2 1\W0o2 1\W0u2
+'2
+1b   2bb   2bc   2bd  2bf  2bm  2bn  2bp  2bs  2bt  2bv
+     b2l   b2r   2b.  2b'. 2b''
+1c   2cb   2cc   2cd  2cf  2ck  2cm  2cn  2cq  2cs  2ct  2cz
+     2chh  c2h   2chb ch2r 2chn c2l  c2r  2c.  2c'. 2c'' .c2
+1d   2db   2dd   2dg  2dl  2dm  2dn  2dp  d2r  2ds  2dt  2dv  2dw
+     2d.   2d'.  2d'' .d2
+1f   2fb   2fg   2ff  2fn  f2l  f2r  2fs  2ft  2f.  2f'. 2f''
+1g   2gb   2gd   2gf  2gg  g2h  g2l  2gm  g2n  2gp  g2r  2gs  2gt
+     2gv   2gw   2gz  2gh2t     2g.  2g'. 2g''
+1h   2hb   2hd   2hh  hi3p2n    h2l  2hm  2hn  2hr  2hv  2h.  2h'.  2h''
+1j   2j.   2j'.  2j''
+1k   2kg   2kf   k2h  2kk  k2l  2km  k2r  2ks  2kt  2k.  2k'. 2k''
+1l   2lb   2lc   2ld  2l3f2     2lg  l2h  2lk  2ll  2lm  2ln  2lp
+     2lq   2lr   2ls  2lt  2lv  2lw  2lz  2l.  2l'. 2l''
+1m   2mb   2mc   2mf  2ml  2mm  2mn  2mp  2mq  2mr  2ms  2mt  2mv  2mw
+     2m.   2m'.  2m''
+1n   2nb   2nc   2nd  2nf  2ng  2nk  2nl  2nm  2nn  2np  2nq  2nr
+     2ns   2nt   2nv  2nz  n2g3n     2nheit.   2n.  2n'  2n''
+1p   2pd   p2h   p2l  2pn  3p2ne 2pp p2r  2ps  3p2sic 2pt  2pz  2p.  2p'. 2p''
+1q   2qq   2q.   2q'. 2q''
+1r   2rb   2rc   2rd  2rf  r2h  2rg  2rk  2rl  2rm  2rn  2rp
+     2rq   2rr   2rs  2rt  rt2s3 2rv 2rx  2rw  2rz  2r.  2r'. 2r''
+1s2  2shm  2s3s  s4s3m 2s3p2n   2stb 2stc 2std 2stf 2stg 2stm 2stn
+     2stp  2sts  2stt 2stv 2sz  4s.  4s'. 4s''
+1t   2tb   2tc   2td  2tf  2tg  t2h  t2l  2tm  2tn  2tp  t2r  2ts
+     3t2sch      2tt  2tv  2tw  t2z  2tzk 2tzs 2t.  2t'. 2t''
+1v   2vc   v2l   v2r  2vv  2v.  2v'. 2v''
+1w   w2h   wa2r  2w1y 2w.  2w'. 2w''
+1x   2xt   2xw   2x.   2x'. 2x''
+y1ou y1i
+1z   2zb   2zd   2zl  2zn  2zp  2zt  2zs  2zv  2zz  2z.  2z'. 2z''  .z2
+}}                          % Pattern end
+
+\endinput
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Information %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
+                           LOADING THESE PATTERNS
+
+These patterns, as well  as  those  for  any  other  language, do not become
+effective until they are loaded in a special form into a format  file;  this
+task  is  performed  by  the  TeX  initializer;  any  TeX system has its own
+initializer with its special way  of  being activated.  Before loading these
+patterns, then, it is necessary to read very carefully the instructions that
+come with your TeX system.
+
+Here I describe how to load the  patterns with the freeware TeX system named
+MiKTeX version 2.x for Windows 9x, NT, 2000,  XP;  with  minor  changes  the
+whole  procedure  is applicable with other TeX systems, but the details must
+be deduced from your TeX system documentation at the section/chapter "How to
+build or to rebuild a format file".
+
+With MikTeX:
+
+a) copy this file and replace  the existing file ithyph.tex in the directory
+   \texmf\tex\generic\hyphen if the existing one has an older  version  date
+   and number.
+b) select Start|Programs|MiKTeX|MiKTeX options.
+c) in  the  Language tab add a check mark to the line concerning the Italian
+   language.
+d) in the Geneal tab click "Update format files".
+e) That's all!  
+
+For the activation of these  patterns  with the specific Italian typesetting
+features, use the babel package as this:
+
+\documentclass{article} % Or whatever other class
+\usepackage[italian]{babel}
+...
+\begin{document}
+...
+\end{document}
+
+
+                           ON ITALIAN HYPHENATION
+
+I have been working on patterns for the Italian language since 1987; in 1992
+I published
+
+C. Beccari, "Computer aided hyphenation for Italian and Modern
+      Latin", TUG vol. 13, n. 1, pp. 23-33 (1992)
+
+which contained a set of patterns that allowed hyphenation for both  Italian
+and  Latin;  a  slightly  modified  version of the patterns published in the
+above paper is contained in LAHYPH.TEX available on the CTAN archives.
+
+From  the  above  patterns  I  extracted  the  minimum  set  necessary   for
+hyphenating  Italian  that  was made available on the CTAN archives with the
+name ITHYPH.tex the version number  3.5  on  the  16th of August 1994.  
+
+The  original  pattern  set  required  37  ops;  being interested in a local
+version of TeX/LaTeX  capable  of  dealing  with  half  a dozen languages, I
+wanted to reduce memory occupation and therefore the number of ops.
+
+Th new version (4.0 released  in  1996)  of  ITHYPH.TEX is much simpler than
+version 3.5 and requires just 29 ops while  it  retains  all  the  power  of
+version  3.5;  it  contains  many  more new patterns that allow to hyphenate
+unusual words that generally have  a  root borrowed from a foreign language.
+Updated versions 4.x contain minor  additions  and  the  number  of  ops  is
+increased to 30 (version 4.7 of 1998/06/01).
+
+This new pattern set has been tested  with the same set of difficult Italian
+words that was used to test version 3.5 and it yields the  same  results  (a
+part  a  minor  change  that was deliberately introduced so as to reduce the
+typographical hyphenation  with  hyathi,  since  hyphenated  hyathi  are not
+appreciated by Italian readers).   A  new  enlarged  word  set  for  testing
+purposes  gets correct hyphen points that were missed or wrongly placed with
+version 3.5, although no error had  been reported, because such words are of
+very specialized nature and are seldom used.
+
+As the previous version, this new set  of  patterns  does  not  contain  any
+accented  character  so  that  the hyphenation algorithm behaves properly in
+both cases, that is with cm  and  with dc/ec fonts.  With LaTeXe terminology
+the difference is between OT1 and T1 encodings;  with  the  former  encoding
+fonts  do  not  contain  accented characters, while with the latter accented
+characters are present and sequences  such  as  \`a map directly to slot "E0
+that contains "agrave".
+
+Of course if you use dc/ec fonts (or any other real or virtual font with  T1
+encoding)  you get the full power of the hyphenation algorithm, while if you
+use cm fonts (or any other real or virtual font with OT1 encoding) you  miss
+some  possible  break  points;  this  is  not a big inconvenience in Italian
+because:
+
+1) The Regulation UNI 6015 on  accents  specifies  that  compulsory  accents
+   appear  only  on the ending vowel of oxitone words; this means that it is
+   almost indifferent to have or  to  miss  the dc/ec fonts because the only
+   difference consists in how TeX evaluates the end of the word; in practice
+   if you have these special facilities you get "qua-li-t\`a", while if  you
+   miss them, you get "qua-lit\`a" (assuming that \righthyphenmin > 1).
+
+2)  Optional  accents are so rare in Italian, that if you absolutely want to
+   use  them  in  those  rare  instances,  and  you  miss  the  T1  encoding
+   facilities, you should also provide  explicit discretionary hyphens as in
+   "s\'e\-gui\-to".
+
+There is no explicit  hyphenation  exception  list  because  these  patterns
+proved  to  hyphenate correctly a very large set of words suitably chosen in
+order to test them in the most heavy circumstances; these patterns were used
+in the preparation of a number of books and no errors were discovered.
+
+Nevertheless if you frequently use  technical terms that you want hyphenated
+differently  from  what  is  normally  done  (for  example  if  you   prefer
+etymological  hyphenation  of  prefixed  and/or  suffixed  words) you should
+insert a specific hyphenation  list  in  the  preamble of your document, for
+example:
+
+\hyphenation{su-per-in-dut-to-re su-per-in-dut-to-ri}
+
+Should you find any word that gets hyphenated in a wrong way, please, AFTER
+CHECKING ON A RELIABLE MODERN DICTIONARY, report to the author, preferably
+by e-mail.
+
+
+                       Happy multilingual typesetting !

src/vendormodules/textutil/patch-0.1.tm

@@ -0,0 +1,180 @@
+# patch.tcl --
+#
+#	Application of a diff -ruN patch to a directory tree.
+#
+# Copyright (c) 2019 Christian Gollwitzer <auriocus@gmx.de>
+# with tweaks by Andreas Kupries
+# - Factored patch parsing into a helper
+# - Replaced `puts` with report callback.
+
+package require Tcl 8.5
+package provide textutil::patch 0.1
+
+# # ## ### ##### ######## ############# #####################
+
+namespace eval ::textutil::patch {
+    namespace export apply
+    namespace ensemble create
+}
+
+# # ## ### ##### ######## ############# #####################
+
+proc ::textutil::patch::apply {dir striplevel patch reportcmd} {
+    set patchdict [Parse $dir $striplevel $patch]
+
+    # Apply, now that we have parsed the patch.
+    dict for {fn hunks} $patchdict {
+	Report apply $fn
+	if {[catch {open $fn} fd]} {
+	    set orig {}
+	} else {
+	    set orig [split [read $fd] \n]
+	}
+	close $fd
+
+	set patched $orig
+
+	set fail false
+	set already_applied false
+	set hunknr 1
+	foreach hunk $hunks {
+	    dict with hunk {
+		set oldend [expr {$oldstart+[llength $oldcode]-1}]
+		set newend [expr {$newstart+[llength $newcode]-1}]
+		# check if the hunk matches
+		set origcode [lrange $orig $oldstart $oldend]
+		if {$origcode ne $oldcode} {
+		    set fail true
+		    # check if the patch is already applied
+		    set origcode_applied [lrange $orig $newstart $newend]
+		    if {$origcode_applied eq $newcode} {
+			set already_applied true
+			Report fail-already $fn $hunknr
+		    } else {
+			Report fail $fn $hunknr $oldcode $origcode
+		    }
+		    break
+		}
+		# apply patch
+		set patched [list \
+				 {*}[lrange $patched 0 $newstart-1] \
+				 {*}$newcode \
+				 {*}[lrange $orig $oldend+1 end]]
+	    }
+	    incr hunknr
+	}
+
+	if {!$fail} {
+	    # success - write the result back
+	    set fd [open $fn w]
+	    puts -nonewline $fd [join $patched \n]
+	    close $fd
+	}
+    }
+
+    return
+}
+
+# # ## ### ##### ######## ############# #####################
+
+proc ::textutil::patch::Report args {
+    upvar 1 reportcmd reportcmd
+    uplevel #0 [list {*}$reportcmd {*}$args]
+    ##
+    # apply        $fname
+    # fail-already $fname $hunkno
+    # fail         $fname $hunkno $expected $seen
+    ##
+}
+
+proc ::textutil::patch::Parse {dir striplevel patch} {
+    set patchlines [split $patch \n]
+    set inhunk false
+    set oldcode {}
+    set newcode {}
+    set n [llength $patchlines]
+
+    set patchdict {}
+    for {set lineidx 0} {$lineidx < $n} {incr lineidx} {
+	set line [lindex $patchlines $lineidx]
+	if {[string match ---* $line]} {
+	    # a diff block starts. Current line should be
+	    # --- oldfile date time TZ
+	    # Next line should be
+	    # +++ newfile date time TZ
+	    set in $line
+	    incr lineidx
+	    set out [lindex $patchlines $lineidx]
+
+	    if {![string match ---* $in] || ![string match +++* $out]} {
+		#puts $in
+		#puts $out
+		return -code error "Patch not in unified diff format, line $lineidx $in $out"
+	    }
+
+	    # the quoting is compatible with list
+	    lassign $in  -> oldfile
+	    lassign $out -> newfile
+
+	    set fntopatch [file join $dir {*}[lrange [file split $oldfile] $striplevel end]]
+	    set inhunk false
+	    #puts "Found diffline for $fntopatch"
+	    continue
+	}
+
+	# state machine for parsing the hunks
+	set typechar [string index $line 0]
+	set codeline [string range $line 1 end]
+	switch $typechar {
+	    @ {
+		if {![regexp {@@\s+\-(\d+),(\d+)\s+\+(\d+),(\d+)\s+@@} $line \
+			  -> oldstart oldlen newstart newlen]} {
+		    return code -error "Erroneous hunk in line $lindeidx, $line"
+		}
+		# adjust line numbers for 0-based indexing
+		incr oldstart -1
+		incr newstart -1
+		#puts "New hunk"
+		set newcode {}
+		set oldcode {}
+		set inhunk true
+	    }
+	    - { # line only in old code
+		if {$inhunk} {
+		    lappend oldcode $codeline
+		}
+	    }
+	    + { # line only in new code
+		if {$inhunk} {
+		    lappend newcode $codeline
+		}
+	    }
+	    " " { # common line
+		if {$inhunk} {
+		    lappend oldcode $codeline
+		    lappend newcode $codeline
+		}
+	    }
+	    default {
+		# puts "Junk: $codeline";
+		continue
+	    }
+	}
+	# test if the hunk is complete
+	if {[llength $oldcode]==$oldlen && [llength $newcode]==$newlen} {
+	    set hunk [dict create \
+			  oldcode $oldcode \
+			  newcode $newcode \
+			  oldstart $oldstart \
+			  newstart $newstart]
+	    #puts "hunk complete: $hunk"
+	    set inhunk false
+	    dict lappend patchdict $fntopatch $hunk
+	}
+    }
+
+    return $patchdict
+}
+
+# # ## ### ##### ######## ############# #####################
+return

src/vendormodules/textutil/repeat-0.7.tm

@@ -0,0 +1,91 @@
+# repeat.tcl --
+#
+#	Emulation of string repeat for older
+#	revisions of Tcl.
+#
+# Copyright (c) 2000      by Ajuba Solutions.
+# Copyright (c) 2001-2006 by Andreas Kupries <andreas_kupries@users.sourceforge.net>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id: repeat.tcl,v 1.1 2006/04/21 04:42:28 andreas_kupries Exp $
+
+# ### ### ### ######### ######### #########
+## Requirements
+
+package require Tcl 8.2
+
+namespace eval ::textutil::repeat {}
+
+# ### ### ### ######### ######### #########
+
+namespace eval ::textutil::repeat {
+    variable HaveBuiltin [expr {![catch {string repeat a 1}]}]
+}
+
+if {0} {
+    # Problems with the deactivated code:
+    # - Linear in 'num'.
+    # - Tests for 'string repeat' in every call!
+    #   (Ok, just the variable, still a test every call)
+    # - Fails for 'num == 0' because of undefined 'str'.
+
+    proc textutil::repeat::StrRepeat { char num } {
+	variable HaveBuiltin
+	if { $HaveBuiltin == 0 } then {
+	    for { set i 0 } { $i < $num } { incr i } {
+		append str $char
+	    }
+	} else {
+	    set str [ string repeat $char $num ]
+	}
+	return $str
+    }
+}
+
+if {$::textutil::repeat::HaveBuiltin} {
+    proc ::textutil::repeat::strRepeat {char num} {
+	return [string repeat $char $num]
+    }
+
+    proc ::textutil::repeat::blank {n} {
+	return [string repeat " " $n]
+    }
+} else {
+    proc ::textutil::repeat::strRepeat {char num} {
+	if {$num <= 0} {
+	    # No replication required
+	    return ""
+	} elseif {$num == 1} {
+	    # Quick exit for recursion
+	    return $char
+	} elseif {$num == 2} {
+	    # Another quick exit for recursion
+	    return $char$char
+	} elseif {0 == ($num % 2)} {
+	    # Halving the problem results in O (log n) complexity.
+	    set result [strRepeat $char [expr {$num / 2}]]
+	    return "$result$result"
+	} else {
+	    # Uneven length, reduce problem by one
+	    return "$char[strRepeat $char [incr num -1]]"
+	}
+    }
+
+    proc ::textutil::repeat::blank {n} {
+	return [strRepeat " " $n]
+    }
+}
+
+# ### ### ### ######### ######### #########
+## Data structures
+
+namespace eval ::textutil::repeat {
+    namespace export strRepeat blank
+}
+
+# ### ### ### ######### ######### #########
+## Ready
+
+package provide textutil::repeat 0.7

src/vendormodules/textutil/split-0.8.tm

@@ -0,0 +1,176 @@
+# split.tcl --
+#
+#	Various ways of splitting a string.
+#
+# Copyright (c) 2000      by Ajuba Solutions.
+# Copyright (c) 2000      by Eric Melski <ericm@ajubasolutions.com>
+# Copyright (c) 2001      by Reinhard Max <max@suse.de>
+# Copyright (c) 2003      by Pat Thoyts <patthoyts@users.sourceforge.net>
+# Copyright (c) 2001-2006 by Andreas Kupries <andreas_kupries@users.sourceforge.net>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# 
+# RCS: @(#) $Id: split.tcl,v 1.7 2006/04/21 04:42:28 andreas_kupries Exp $
+
+# ### ### ### ######### ######### #########
+## Requirements
+
+package require Tcl 8.2
+
+namespace eval ::textutil::split {}
+
+########################################################################
+# This one was written by Bob Techentin (RWT in Tcl'ers Wiki):
+# http://www.techentin.net
+# mailto:techentin.robert@mayo.edu
+#
+# Later, he send me an email stated that I can use it anywhere, because
+# no copyright was added, so the code is defacto in the public domain.
+#
+# You can found it in the Tcl'ers Wiki here:
+# http://mini.net/cgi-bin/wikit/460.html
+#
+# Bob wrote:
+# If you need to split string into list using some more complicated rule
+# than builtin split command allows, use following function. It mimics
+# Perl split operator which allows regexp as element separator, but,
+# like builtin split, it expects string to split as first arg and regexp
+# as second (optional) By default, it splits by any amount of whitespace. 
+# Note that if you add parenthesis into regexp, parenthesed part of separator
+# would be added into list as additional element. Just like in Perl. -- cary 
+#
+# Speed improvement by Reinhard Max:
+# Instead of repeatedly copying around the not yet matched part of the
+# string, I use [regexp]'s -start option to restrict the match to that
+# part. This reduces the complexity from something like O(n^1.5) to
+# O(n). My test case for that was:
+# 
+# foreach i {1 10 100 1000 10000} {
+#     set s [string repeat x $i]
+#     puts [time {splitx $s .}]
+# }
+#
+
+if {[package vsatisfies [package provide Tcl] 8.3]} {
+
+    proc ::textutil::split::splitx {str {regexp {[\t \r\n]+}}} {
+        # Bugfix 476988
+        if {[string length $str] == 0} {
+            return {}
+        }
+        if {[string length $regexp] == 0} {
+            return [::split $str ""]
+        }
+	if {[regexp $regexp {}]} {
+	    return -code error \
+		"splitting on regexp \"$regexp\" would cause infinite loop"
+	}
+
+        set list  {}
+        set start 0
+        while {[regexp -start $start -indices -- $regexp $str match submatch]} {
+            foreach {subStart subEnd} $submatch break
+            foreach {matchStart matchEnd} $match break
+            incr matchStart -1
+            incr matchEnd
+            lappend list [string range $str $start $matchStart]
+            if {$subStart >= $start} {
+                lappend list [string range $str $subStart $subEnd]
+            }
+            set start $matchEnd
+        }
+        lappend list [string range $str $start end]
+        return $list
+    }
+
+} else {    
+    # For tcl <= 8.2 we do not have regexp -start...
+    proc ::textutil::split::splitx [list str [list regexp "\[\t \r\n\]+"]] {
+
+        if {[string length $str] == 0} {
+            return {}
+        }
+        if {[string length $regexp] == 0} {
+            return [::split $str {}]
+        }
+	if {[regexp $regexp {}]} {
+	    return -code error \
+		"splitting on regexp \"$regexp\" would cause infinite loop"
+	}
+
+        set list  {}
+        while {[regexp -indices -- $regexp $str match submatch]} {
+            lappend list [string range $str 0 [expr {[lindex $match 0] -1}]]
+            if {[lindex $submatch 0] >= 0} {
+                lappend list [string range $str [lindex $submatch 0] \
+                                  [lindex $submatch 1]]
+            }
+            set str [string range $str [expr {[lindex $match 1]+1}] end]
+        }
+        lappend list $str
+        return $list
+    }
+    
+}
+
+#
+# splitn --
+#
+# splitn splits the string $str into chunks of length $len.  These
+# chunks are returned as a list.
+#
+# If $str really contains a ByteArray object (as retrieved from binary
+# encoded channels) splitn must honor this by splitting the string
+# into chunks of $len bytes.
+#
+# It is an error to call splitn with a nonpositive $len.
+#
+# If splitn is called with an empty string, it returns the empty list.
+#
+# If the length of $str is not an entire multiple of the chunk length,
+# the last chunk in the generated list will be shorter than $len.
+#
+# The implementation presented here was given by Bryan Oakley, as
+# part of a ``contest'' I staged on c.l.t in July 2004.  I selected
+# this version, as it does not rely on runtime generated code, is
+# very fast for chunk size one, not too bad in all the other cases,
+# and uses [split] or [string range] which have been around for quite
+# some time.
+#
+# -- Robert Suetterlin (robert@mpe.mpg.de)
+#
+proc ::textutil::split::splitn {str {len 1}} {
+
+    if {$len <= 0} {
+        return -code error "len must be > 0"
+    }
+
+    if {$len == 1} {
+        return [split $str {}]
+    }
+
+    set result [list]
+    set max [string length $str]
+    set i 0
+    set j [expr {$len -1}]
+    while {$i < $max} {
+        lappend result [string range $str $i $j]
+        incr i $len
+        incr j $len
+    }
+
+    return $result
+}
+
+# ### ### ### ######### ######### #########
+## Data structures
+
+namespace eval ::textutil::split {
+    namespace export splitx splitn
+}
+
+# ### ### ### ######### ######### #########
+## Ready
+
+package provide textutil::split 0.8

src/vendormodules/textutil/string-0.8.tm

@@ -0,0 +1,144 @@
+# string.tcl --
+#
+#	Utilities for manipulating strings, words, single lines,
+#	paragraphs, ...
+#
+# Copyright (c) 2000      by Ajuba Solutions.
+# Copyright (c) 2000      by Eric Melski <ericm@ajubasolutions.com>
+# Copyright (c) 2002      by Joe English <jenglish@users.sourceforge.net>
+# Copyright (c) 2001-2014 by Andreas Kupries <andreas_kupries@users.sourceforge.net>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# 
+# RCS: @(#) $Id: string.tcl,v 1.2 2008/03/22 16:03:11 mic42 Exp $
+
+# ### ### ### ######### ######### #########
+## Requirements
+
+package require Tcl 8.2
+
+namespace eval ::textutil::string {}
+
+# ### ### ### ######### ######### #########
+## API implementation
+
+# @c Removes the last character from the given <a string>.
+#
+# @a string: The string to manipulate.
+#
+# @r The <a string> without its last character.
+#
+# @i chopping
+
+proc ::textutil::string::chop {string} {
+    return [string range $string 0 [expr {[string length $string]-2}]]
+}
+
+# @c Removes the first character from the given <a string>.
+# @c Convenience procedure.
+#
+# @a string: string to manipulate.
+#
+# @r The <a string> without its first character.
+#
+# @i tail
+
+proc ::textutil::string::tail {string} {
+    return [string range $string 1 end]
+}
+
+# @c Capitalizes first character of the given <a string>.
+# @c Complementary procedure to <p ::textutil::uncap>.
+#
+# @a string: string to manipulate.
+#
+# @r The <a string> with its first character capitalized.
+#
+# @i capitalize
+
+proc ::textutil::string::cap {string} {
+    return [string toupper [string index $string 0]][string range $string 1 end]
+}
+
+# @c unCapitalizes first character of the given <a string>.
+# @c Complementary procedure to <p ::textutil::cap>.
+#
+# @a string: string to manipulate.
+#
+# @r The <a string> with its first character uncapitalized.
+#
+# @i uncapitalize
+
+proc ::textutil::string::uncap {string} {
+    return [string tolower [string index $string 0]][string range $string 1 end]
+}
+
+# @c Capitalizes first character of each word of the given <a sentence>.
+#
+# @a sentence: string to manipulate.
+#
+# @r The <a sentence> with the first character of each word capitalized.
+#
+# @i capitalize
+
+proc ::textutil::string::capEachWord {sentence} {
+    regsub -all {\S+} [string map {\\ \\\\ \$ \\$} $sentence] {[string toupper [string index & 0]][string range & 1 end]} cmd
+    return [subst -nobackslashes -novariables $cmd]
+}
+
+# Compute the longest string which is common to all strings given to
+# the command, and at the beginning of said strings, i.e. a prefix. If
+# only one argument is specified it is treated as a list of the
+# strings to look at. If more than one argument is specified these
+# arguments are the strings to be looked at. If only one string is
+# given, in either form, the string is returned, as it is its own
+# longest common prefix.
+
+proc ::textutil::string::longestCommonPrefix {args} {
+    return [longestCommonPrefixList $args]
+}
+
+proc ::textutil::string::longestCommonPrefixList {list} {
+    if {[llength $list] <= 1} {
+	return [lindex $list 0]
+    }
+
+    set list [lsort $list]
+    set min [lindex $list 0]
+    set max [lindex $list end]
+
+    # Min and max are the two strings which are most different. If
+    # they have a common prefix, it will also be the common prefix for
+    # all of them.
+
+    # Fast bailouts for common cases.
+
+    set n [string length $min]
+    if {$n == 0} {return ""}
+    if {0 == [string compare $min $max]} {return $min}
+
+    set prefix ""
+    set i 0
+    while {[string index $min $i] == [string index $max $i]} {
+	append prefix [string index $min $i]
+	if {[incr i] > $n} {break}
+    }
+    set prefix
+}
+
+# ### ### ### ######### ######### #########
+## Data structures
+
+namespace eval ::textutil::string {
+    # Export the imported commands
+
+    namespace export chop tail cap uncap capEachWord
+    namespace export longestCommonPrefix
+    namespace export longestCommonPrefixList
+}
+
+# ### ### ### ######### ######### #########
+## Ready
+
+package provide textutil::string 0.8

src/vendormodules/textutil/tabify-0.7.tm

@@ -0,0 +1,289 @@
+#
+# As the author of the procs 'tabify2' and 'untabify2' I suggest that the
+# comments explaining their behaviour be kept in this file.
+# 1) Beginners in any programming language (I am new to Tcl so I know what I
+#    am talking about) can profit enormously from studying 'correct' code.
+#    Of course comments will help a lot in this regard.
+# 2) Many problems newbies face can be solved by directing them towards
+#    available libraries - after all, libraries have been written to solve
+#    recurring problems. Then they can just use them, or have a closer look
+#    to see and to discover how things are done the 'Tcl way'.
+# 3) And if ever a proc from a library should be less than perfect, having
+#    comments explaining the behaviour of the code will surely help.
+#
+# This said, I will welcome any error reports or suggestions for improvements
+# (especially on the 'doing things the Tcl way' aspect).
+#
+# Use of these sources is licensed under the same conditions as is Tcl.
+#
+# June 2001, Helmut Giese (hgiese@ratiosoft.com)
+#
+# ----------------------------------------------------------------------------
+#
+# The original procs 'tabify' and 'untabify' each work with complete blocks
+# of $num spaces ('num' holding the tab size). While this is certainly useful
+# in some circumstances, it does not reflect the way an editor works:
+# 	Counting columns from 1, assuming a tab size of 8 and entering '12345'
+#   followed by a tab, you expect to advance to column 9. Your editor might
+#   put a tab into the file or 3 spaces, depending on its configuration.
+#	Now, on 'tabifying' you will expect to see those 3 spaces converted to a
+#	tab (and on the other hand expect the tab *at this position* to be
+#	converted to 3 spaces).
+#
+#	This behaviour is mimicked by the new procs 'tabify2' and 'untabify2'.
+#   Both have one feature in common: They accept multi-line strings (a whole
+#   file if you want to) but in order to make life simpler for the programmer,
+#   they split the incoming string into individual lines and hand each line to
+#   a proc that does the real work.
+#
+#   One design decision worth mentioning here:
+#      A single space is never converted to a tab even if its position would
+#      allow to do so.
+#   Single spaces occur very often, say in arithmetic expressions like
+#   [expr (($a + $b) * $c) < $d]. If we didn't follow the above rule we might
+#   need to replace one or more of them to tabs. However if the tab size gets
+#   changed, this expression would be formatted quite differently - which is
+#   probably not a good idea.
+#
+#   'untabifying' on the other hand might need to replace a tab with a single
+#   space: If the current position requires it, what else to do?
+#   As a consequence those two procs are unsymmetric in this aspect, but I
+#   couldn't think of a better solution. Could you?
+#
+# ----------------------------------------------------------------------------
+#
+
+# ### ### ### ######### ######### #########
+## Requirements
+
+package require Tcl 8.2
+package require textutil::repeat
+
+namespace eval ::textutil::tabify {}
+
+# ### ### ### ######### ######### #########
+## API implementation
+
+namespace eval ::textutil::tabify {
+    namespace import -force ::textutil::repeat::strRepeat
+}
+
+proc ::textutil::tabify::tabify { string { num 8 } } {
+    return [string map [list [MakeTabStr $num] \t] $string]
+}
+
+proc ::textutil::tabify::untabify { string { num 8 } } {
+    return [string map [list \t [MakeTabStr $num]] $string]
+}
+
+proc ::textutil::tabify::MakeTabStr { num } {
+    variable TabStr
+    variable TabLen
+
+    if { $TabLen != $num } then {
+	set TabLen $num
+	set TabStr [strRepeat " " $num]
+    }
+
+    return $TabStr
+}
+
+# ----------------------------------------------------------------------------
+#
+# tabifyLine: Works on a single line of text, replacing 'spaces at correct
+# 		positions' with tabs. $num is the requested tab size.
+#		Returns the (possibly modified) line.
+#
+# 'spaces at correct positions': Only spaces which 'fill the space' between
+# an arbitrary position and the next tab stop can be replaced. 
+# Example: With tab size 8, spaces at positions 11 - 13 will *not* be replaced,
+#          because an expansion of a tab at position 11 will jump up to 16.
+# See also the comment at the beginning of this file why single spaces are
+# *never* replaced by a tab.
+#
+# The proc works backwards, from the end of the string up to the beginning:
+#	- Set the position to start the search from ('lastPos') to 'end'.
+#	- Find the last occurrence of ' ' in 'line' with respect to 'lastPos'
+#         ('currPos' below). This is a candidate for replacement.
+#       - Find to 'currPos' the following tab stop using the expression
+#           set nextTab [expr ($currPos + $num) - ($currPos % $num)]
+#         and get the previous tab stop as well (this will be the starting 
+#         point for the next iteration).
+#	- The ' ' at 'currPos' is only a candidate for replacement if
+#	  1) it is just one position before a tab stop *and*
+#	  2) there is at least one space at its left (see comment above on not
+#	     touching an isolated space).
+#	  Continue, if any of these conditions is not met.
+#	- Determine where to put the tab (that is: how many spaces to replace?)
+#	  by stepping up to the beginning until
+#		-- you hit a non-space or
+#		-- you are at the previous tab position
+#	- Do the replacement and continue.
+#
+# This algorithm only works, if $line does not contain tabs. Otherwise our 
+# interpretation of any position beyond the tab will be wrong. (Imagine you 
+# find a ' ' at position 4 in $line. If you got 3 leading tabs, your *real*
+# position might be 25 (tab size of 8). Since in real life some strings might 
+# already contain tabs, we test for it (and eventually call untabifyLine).
+#
+
+proc ::textutil::tabify::tabifyLine { line num } {
+    if { [string first \t $line] != -1 } { 		
+	# assure array 'Spaces' is set up 'comme il faut'
+	checkArr $num
+	# remove existing tabs
+	set line [untabifyLine $line $num]
+    }
+
+    set lastPos end
+
+    while { $lastPos > 0 } {
+	set currPos [string last " " $line $lastPos]
+	if { $currPos == -1 } {
+	    # no more spaces
+	    break;
+	}
+
+	set nextTab [expr {($currPos + $num) - ($currPos % $num)}]
+	set prevTab [expr {$nextTab - $num}]
+
+	# prepare for next round: continue at 'previous tab stop - 1'
+	set lastPos [expr {$prevTab - 1}]
+
+	if { ($currPos + 1) != $nextTab } {
+	    continue			;# crit. (1)
+	}
+
+	if { [string index $line [expr {$currPos - 1}]] != " " } {
+	    continue			;# crit. (2)
+	}
+
+	# now step backwards while there are spaces
+	for {set pos [expr {$currPos - 2}]} {$pos >= $prevTab} {incr pos -1} {
+	    if { [string index $line $pos] != " " } {
+		break;
+	    }
+	}
+
+	# ... and replace them
+	set line [string replace $line [expr {$pos + 1}] $currPos \t]
+    }
+    return $line
+}
+
+#
+# Helper proc for 'untabifyLine': Checks if all needed elements of array
+# 'Spaces' exist and creates the missing ones if needed.
+#
+
+proc ::textutil::tabify::checkArr { num } {
+    variable TabLen2
+    variable Spaces
+
+    if { $num > $TabLen2 } {
+	for { set i [expr {$TabLen2 + 1}] } { $i <= $num } { incr i } {
+	    set Spaces($i) [strRepeat " " $i]
+	}
+	set TabLen2 $num
+    }
+}
+
+
+# untabifyLine: Works on a single line of text, replacing tabs with enough
+#		spaces to get to the next tab position.
+#		Returns the (possibly modified) line.
+#
+# The procedure is straight forward:
+#	- Find the next tab.
+#	- Calculate the next tab position following it.
+#	- Delete the tab and insert as many spaces as needed to get there.
+#
+
+proc ::textutil::tabify::untabifyLine { line num } {
+    variable Spaces
+
+    set currPos 0
+    while { 1 } {
+	set currPos [string first \t $line $currPos]
+	if { $currPos == -1 } {
+	    # no more tabs
+	    break
+	}
+
+	# how far is the next tab position ?
+	set dist [expr {$num - ($currPos % $num)}]
+	# replace '\t' at $currPos with $dist spaces
+	set line [string replace $line $currPos $currPos $Spaces($dist)]
+
+	# set up for next round (not absolutely necessary but maybe a trifle
+	# more efficient)
+	incr currPos $dist
+    }
+    return $line
+}
+
+# tabify2: Replace all 'appropriate' spaces as discussed above with tabs.
+#	'string' might hold any number of lines, 'num' is the requested tab size.
+#	Returns (possibly modified) 'string'.
+#
+proc ::textutil::tabify::tabify2 { string { num 8 } } {
+
+    # split string into individual lines
+    set inLst [split $string \n]
+
+    # now work on each line
+    set outLst [list]
+    foreach line $inLst {
+	lappend outLst [tabifyLine $line $num]
+    }
+
+    # return all as one string
+    return [join $outLst \n]
+}
+
+
+# untabify2: Replace all tabs with the appropriate number of spaces.
+#	'string' might hold any number of lines, 'num' is the requested tab size.
+#	Returns (possibly modified) 'string'.
+#
+proc ::textutil::tabify::untabify2 { string { num 8 } } {
+
+    # assure array 'Spaces' is set up 'comme il faut'
+    checkArr $num
+
+    set inLst [split $string \n]
+
+    set outLst [list]
+    foreach line $inLst {
+	lappend outLst [untabifyLine $line $num]
+    }
+
+    return [join $outLst \n]
+}
+
+
+
+# ### ### ### ######### ######### #########
+## Data structures
+
+namespace eval ::textutil::tabify {
+    variable TabLen  8
+    variable TabStr  [strRepeat " " $TabLen]
+
+    namespace export tabify untabify tabify2 untabify2
+    
+    # The proc 'untabify2' uses the following variables for efficiency.
+    # Since a tab can be replaced by one up to 'tab size' spaces, it is handy
+    # to have the appropriate 'space strings' available. This is the use of
+    # the array 'Spaces', where 'Spaces(n)' contains just 'n' spaces.
+    # The variable 'TabLen2' remembers the biggest tab size used.
+
+    variable  TabLen2 0
+    variable  Spaces
+    array set Spaces {0 ""}
+}
+
+# ### ### ### ######### ######### #########
+## Ready
+
+package provide textutil::tabify 0.7

src/vendormodules/textutil/trim-0.7.tm

@@ -0,0 +1,112 @@
+# trim.tcl --
+#
+#	Various ways of trimming a string.
+#
+# Copyright (c) 2000      by Ajuba Solutions.
+# Copyright (c) 2000      by Eric Melski <ericm@ajubasolutions.com>
+# Copyright (c) 2001-2006 by Andreas Kupries <andreas_kupries@users.sourceforge.net>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# 
+# RCS: @(#) $Id: trim.tcl,v 1.5 2006/04/21 04:42:28 andreas_kupries Exp $
+
+# ### ### ### ######### ######### #########
+## Requirements
+
+package require Tcl 8.2
+
+namespace eval ::textutil::trim {}
+
+# ### ### ### ######### ######### #########
+## API implementation
+
+proc ::textutil::trim::trimleft {text {trim "[ \t]+"}} {
+    regsub -line -all -- [MakeStr $trim left] $text {} text
+    return $text
+}
+
+proc ::textutil::trim::trimright {text {trim "[ \t]+"}} {
+    regsub -line -all -- [MakeStr $trim right] $text {} text
+    return $text
+}
+
+proc ::textutil::trim::trim {text {trim "[ \t]+"}} {
+    regsub -line -all -- [MakeStr $trim left]  $text {} text
+    regsub -line -all -- [MakeStr $trim right] $text {} text
+    return $text
+}
+
+
+
+# @c Strips <a prefix> from <a text>, if found at its start.
+#
+# @a text: The string to check for <a prefix>.
+# @a prefix: The string to remove from <a text>.
+#
+# @r The <a text>, but without <a prefix>.
+#
+# @i remove, prefix
+
+proc ::textutil::trim::trimPrefix {text prefix} {
+    if {[string first $prefix $text] == 0} {
+	return [string range $text [string length $prefix] end]
+    } else {
+	return $text
+    }
+}
+
+
+# @c Removes the Heading Empty Lines of <a text>.
+#
+# @a text: The text block to manipulate.
+#
+# @r The <a text>, but without heading empty lines.
+#
+# @i remove, empty lines
+
+proc ::textutil::trim::trimEmptyHeading {text} {
+    regsub -- "^(\[ \t\]*\n)*" $text {} text
+    return $text
+}
+
+# ### ### ### ######### ######### #########
+## Helper commands. Internal
+
+proc ::textutil::trim::MakeStr { string pos }  {
+    variable StrU
+    variable StrR
+    variable StrL
+
+    if { "$string" != "$StrU" } {
+        set StrU $string
+        set StrR "(${StrU})\$"
+        set StrL "^(${StrU})"
+    }
+    if { "$pos" == "left" } {
+        return $StrL
+    }
+    if { "$pos" == "right" } {
+        return $StrR
+    }
+
+    return -code error "Panic, illegal position key \"$pos\""
+}
+
+# ### ### ### ######### ######### #########
+## Data structures
+
+namespace eval ::textutil::trim {	    
+    variable StrU "\[ \t\]+"
+    variable StrR "(${StrU})\$"
+    variable StrL "^(${StrU})"
+
+    namespace export \
+	    trim trimright trimleft \
+	    trimPrefix trimEmptyHeading
+}
+
+# ### ### ### ######### ######### #########
+## Ready
+
+package provide textutil::trim 0.7

src/vendormodules/textutil/wcswidth-35.1.tm

@@ -0,0 +1,772 @@
+###
+# This file is automatically generated by the build/build.tcl file
+# based on information in the following database:
+# http://www.unicode.org/Public/UCD/latest/ucd/EastAsianWidth.txt
+#
+# (This is the 35th edition, thus version 35 for our package)
+#
+# Author: Sean Woods <yoda@etoyoc.com>
+###
+package provide textutil::wcswidth 35.1
+proc ::textutil::wcswidth_type char {
+  if {$char == 161} { return A }
+  if {$char == 164} { return A }
+  if {$char == 167} { return A }
+  if {$char == 168} { return A }
+  if {$char == 170} { return A }
+  if {$char == 173} { return A }
+  if {$char == 174} { return A }
+  if {$char == 176} { return A }
+  if {$char == 177} { return A }
+  if {$char >= 178 && $char <= 179 } { return A }
+  if {$char == 180} { return A }
+  if {$char >= 182 && $char <= 183 } { return A }
+  if {$char == 184} { return A }
+  if {$char == 185} { return A }
+  if {$char == 186} { return A }
+  if {$char >= 188 && $char <= 190 } { return A }
+  if {$char == 191} { return A }
+  if {$char == 198} { return A }
+  if {$char == 208} { return A }
+  if {$char == 215} { return A }
+  if {$char == 216} { return A }
+  if {$char >= 222 && $char <= 225 } { return A }
+  if {$char == 230} { return A }
+  if {$char >= 232 && $char <= 234 } { return A }
+  if {$char >= 236 && $char <= 237 } { return A }
+  if {$char == 240} { return A }
+  if {$char >= 242 && $char <= 243 } { return A }
+  if {$char == 247} { return A }
+  if {$char >= 248 && $char <= 250 } { return A }
+  if {$char == 252} { return A }
+  if {$char == 254} { return A }
+  if {$char == 257} { return A }
+  if {$char == 273} { return A }
+  if {$char == 275} { return A }
+  if {$char == 283} { return A }
+  if {$char >= 294 && $char <= 295 } { return A }
+  if {$char == 299} { return A }
+  if {$char >= 305 && $char <= 307 } { return A }
+  if {$char == 312} { return A }
+  if {$char >= 319 && $char <= 322 } { return A }
+  if {$char == 324} { return A }
+  if {$char >= 328 && $char <= 331 } { return A }
+  if {$char == 333} { return A }
+  if {$char >= 338 && $char <= 339 } { return A }
+  if {$char >= 358 && $char <= 359 } { return A }
+  if {$char == 363} { return A }
+  if {$char == 462} { return A }
+  if {$char == 464} { return A }
+  if {$char == 466} { return A }
+  if {$char == 468} { return A }
+  if {$char == 470} { return A }
+  if {$char == 472} { return A }
+  if {$char == 474} { return A }
+  if {$char == 476} { return A }
+  if {$char == 593} { return A }
+  if {$char == 609} { return A }
+  if {$char == 708} { return A }
+  if {$char == 711} { return A }
+  if {$char >= 713 && $char <= 715 } { return A }
+  if {$char == 717} { return A }
+  if {$char == 720} { return A }
+  if {$char >= 728 && $char <= 731 } { return A }
+  if {$char == 733} { return A }
+  if {$char == 735} { return A }
+  if {$char >= 768 && $char <= 879 } { return A }
+  if {$char >= 913 && $char <= 929 } { return A }
+  if {$char >= 931 && $char <= 937 } { return A }
+  if {$char >= 945 && $char <= 961 } { return A }
+  if {$char >= 963 && $char <= 969 } { return A }
+  if {$char == 1025} { return A }
+  if {$char >= 1040 && $char <= 1103 } { return A }
+  if {$char == 1105} { return A }
+  if {$char >= 4352 && $char <= 4447 } { return W }
+  if {$char == 8208} { return A }
+  if {$char >= 8211 && $char <= 8213 } { return A }
+  if {$char == 8214} { return A }
+  if {$char == 8216} { return A }
+  if {$char == 8217} { return A }
+  if {$char == 8220} { return A }
+  if {$char == 8221} { return A }
+  if {$char >= 8224 && $char <= 8226 } { return A }
+  if {$char >= 8228 && $char <= 8231 } { return A }
+  if {$char == 8240} { return A }
+  if {$char >= 8242 && $char <= 8243 } { return A }
+  if {$char == 8245} { return A }
+  if {$char == 8251} { return A }
+  if {$char == 8254} { return A }
+  if {$char == 8308} { return A }
+  if {$char == 8319} { return A }
+  if {$char >= 8321 && $char <= 8324 } { return A }
+  if {$char == 8361} { return H }
+  if {$char == 8364} { return A }
+  if {$char == 8451} { return A }
+  if {$char == 8453} { return A }
+  if {$char == 8457} { return A }
+  if {$char == 8467} { return A }
+  if {$char == 8470} { return A }
+  if {$char >= 8481 && $char <= 8482 } { return A }
+  if {$char == 8486} { return A }
+  if {$char == 8491} { return A }
+  if {$char >= 8531 && $char <= 8532 } { return A }
+  if {$char >= 8539 && $char <= 8542 } { return A }
+  if {$char >= 8544 && $char <= 8555 } { return A }
+  if {$char >= 8560 && $char <= 8569 } { return A }
+  if {$char == 8585} { return A }
+  if {$char >= 8592 && $char <= 8596 } { return A }
+  if {$char >= 8597 && $char <= 8601 } { return A }
+  if {$char >= 8632 && $char <= 8633 } { return A }
+  if {$char == 8658} { return A }
+  if {$char == 8660} { return A }
+  if {$char == 8679} { return A }
+  if {$char == 8704} { return A }
+  if {$char >= 8706 && $char <= 8707 } { return A }
+  if {$char >= 8711 && $char <= 8712 } { return A }
+  if {$char == 8715} { return A }
+  if {$char == 8719} { return A }
+  if {$char == 8721} { return A }
+  if {$char == 8725} { return A }
+  if {$char == 8730} { return A }
+  if {$char >= 8733 && $char <= 8736 } { return A }
+  if {$char == 8739} { return A }
+  if {$char == 8741} { return A }
+  if {$char >= 8743 && $char <= 8748 } { return A }
+  if {$char == 8750} { return A }
+  if {$char >= 8756 && $char <= 8759 } { return A }
+  if {$char >= 8764 && $char <= 8765 } { return A }
+  if {$char == 8776} { return A }
+  if {$char == 8780} { return A }
+  if {$char == 8786} { return A }
+  if {$char >= 8800 && $char <= 8801 } { return A }
+  if {$char >= 8804 && $char <= 8807 } { return A }
+  if {$char >= 8810 && $char <= 8811 } { return A }
+  if {$char >= 8814 && $char <= 8815 } { return A }
+  if {$char >= 8834 && $char <= 8835 } { return A }
+  if {$char >= 8838 && $char <= 8839 } { return A }
+  if {$char == 8853} { return A }
+  if {$char == 8857} { return A }
+  if {$char == 8869} { return A }
+  if {$char == 8895} { return A }
+  if {$char == 8978} { return A }
+  if {$char >= 8986 && $char <= 8987 } { return W }
+  if {$char == 9001} { return W }
+  if {$char == 9002} { return W }
+  if {$char >= 9193 && $char <= 9196 } { return W }
+  if {$char == 9200} { return W }
+  if {$char == 9203} { return W }
+  if {$char >= 9312 && $char <= 9371 } { return A }
+  if {$char >= 9372 && $char <= 9449 } { return A }
+  if {$char >= 9451 && $char <= 9471 } { return A }
+  if {$char >= 9472 && $char <= 9547 } { return A }
+  if {$char >= 9552 && $char <= 9587 } { return A }
+  if {$char >= 9600 && $char <= 9615 } { return A }
+  if {$char >= 9618 && $char <= 9621 } { return A }
+  if {$char >= 9632 && $char <= 9633 } { return A }
+  if {$char >= 9635 && $char <= 9641 } { return A }
+  if {$char >= 9650 && $char <= 9651 } { return A }
+  if {$char == 9654} { return A }
+  if {$char == 9655} { return A }
+  if {$char >= 9660 && $char <= 9661 } { return A }
+  if {$char == 9664} { return A }
+  if {$char == 9665} { return A }
+  if {$char >= 9670 && $char <= 9672 } { return A }
+  if {$char == 9675} { return A }
+  if {$char >= 9678 && $char <= 9681 } { return A }
+  if {$char >= 9698 && $char <= 9701 } { return A }
+  if {$char == 9711} { return A }
+  if {$char >= 9725 && $char <= 9726 } { return W }
+  if {$char >= 9733 && $char <= 9734 } { return A }
+  if {$char == 9737} { return A }
+  if {$char >= 9742 && $char <= 9743 } { return A }
+  if {$char >= 9748 && $char <= 9749 } { return W }
+  if {$char == 9756} { return A }
+  if {$char == 9758} { return A }
+  if {$char == 9792} { return A }
+  if {$char == 9794} { return A }
+  if {$char >= 9800 && $char <= 9811 } { return W }
+  if {$char >= 9824 && $char <= 9825 } { return A }
+  if {$char >= 9827 && $char <= 9829 } { return A }
+  if {$char >= 9831 && $char <= 9834 } { return A }
+  if {$char >= 9836 && $char <= 9837 } { return A }
+  if {$char == 9839} { return A }
+  if {$char == 9855} { return W }
+  if {$char == 9875} { return W }
+  if {$char >= 9886 && $char <= 9887 } { return A }
+  if {$char == 9889} { return W }
+  if {$char >= 9898 && $char <= 9899 } { return W }
+  if {$char >= 9917 && $char <= 9918 } { return W }
+  if {$char == 9919} { return A }
+  if {$char >= 9924 && $char <= 9925 } { return W }
+  if {$char >= 9926 && $char <= 9933 } { return A }
+  if {$char == 9934} { return W }
+  if {$char >= 9935 && $char <= 9939 } { return A }
+  if {$char == 9940} { return W }
+  if {$char >= 9941 && $char <= 9953 } { return A }
+  if {$char == 9955} { return A }
+  if {$char >= 9960 && $char <= 9961 } { return A }
+  if {$char == 9962} { return W }
+  if {$char >= 9963 && $char <= 9969 } { return A }
+  if {$char >= 9970 && $char <= 9971 } { return W }
+  if {$char == 9972} { return A }
+  if {$char == 9973} { return W }
+  if {$char >= 9974 && $char <= 9977 } { return A }
+  if {$char == 9978} { return W }
+  if {$char >= 9979 && $char <= 9980 } { return A }
+  if {$char == 9981} { return W }
+  if {$char >= 9982 && $char <= 9983 } { return A }
+  if {$char == 9989} { return W }
+  if {$char >= 9994 && $char <= 9995 } { return W }
+  if {$char == 10024} { return W }
+  if {$char == 10045} { return A }
+  if {$char == 10060} { return W }
+  if {$char == 10062} { return W }
+  if {$char >= 10067 && $char <= 10069 } { return W }
+  if {$char == 10071} { return W }
+  if {$char >= 10102 && $char <= 10111 } { return A }
+  if {$char >= 10133 && $char <= 10135 } { return W }
+  if {$char == 10160} { return W }
+  if {$char == 10175} { return W }
+  if {$char >= 11035 && $char <= 11036 } { return W }
+  if {$char == 11088} { return W }
+  if {$char == 11093} { return W }
+  if {$char >= 11094 && $char <= 11097 } { return A }
+  if {$char >= 11904 && $char <= 11929 } { return W }
+  if {$char >= 11931 && $char <= 12019 } { return W }
+  if {$char >= 12032 && $char <= 12245 } { return W }
+  if {$char >= 12272 && $char <= 12283 } { return W }
+  if {$char == 12288} { return F }
+  if {$char >= 12289 && $char <= 12291 } { return W }
+  if {$char == 12292} { return W }
+  if {$char == 12293} { return W }
+  if {$char == 12294} { return W }
+  if {$char == 12295} { return W }
+  if {$char == 12296} { return W }
+  if {$char == 12297} { return W }
+  if {$char == 12298} { return W }
+  if {$char == 12299} { return W }
+  if {$char == 12300} { return W }
+  if {$char == 12301} { return W }
+  if {$char == 12302} { return W }
+  if {$char == 12303} { return W }
+  if {$char == 12304} { return W }
+  if {$char == 12305} { return W }
+  if {$char >= 12306 && $char <= 12307 } { return W }
+  if {$char == 12308} { return W }
+  if {$char == 12309} { return W }
+  if {$char == 12310} { return W }
+  if {$char == 12311} { return W }
+  if {$char == 12312} { return W }
+  if {$char == 12313} { return W }
+  if {$char == 12314} { return W }
+  if {$char == 12315} { return W }
+  if {$char == 12316} { return W }
+  if {$char == 12317} { return W }
+  if {$char >= 12318 && $char <= 12319 } { return W }
+  if {$char == 12320} { return W }
+  if {$char >= 12321 && $char <= 12329 } { return W }
+  if {$char >= 12330 && $char <= 12333 } { return W }
+  if {$char >= 12334 && $char <= 12335 } { return W }
+  if {$char == 12336} { return W }
+  if {$char >= 12337 && $char <= 12341 } { return W }
+  if {$char >= 12342 && $char <= 12343 } { return W }
+  if {$char >= 12344 && $char <= 12346 } { return W }
+  if {$char == 12347} { return W }
+  if {$char == 12348} { return W }
+  if {$char == 12349} { return W }
+  if {$char == 12350} { return W }
+  if {$char >= 12353 && $char <= 12438 } { return W }
+  if {$char >= 12441 && $char <= 12442 } { return W }
+  if {$char >= 12443 && $char <= 12444 } { return W }
+  if {$char >= 12445 && $char <= 12446 } { return W }
+  if {$char == 12447} { return W }
+  if {$char == 12448} { return W }
+  if {$char >= 12449 && $char <= 12538 } { return W }
+  if {$char == 12539} { return W }
+  if {$char >= 12540 && $char <= 12542 } { return W }
+  if {$char == 12543} { return W }
+  if {$char >= 12549 && $char <= 12591 } { return W }
+  if {$char >= 12593 && $char <= 12686 } { return W }
+  if {$char >= 12688 && $char <= 12689 } { return W }
+  if {$char >= 12690 && $char <= 12693 } { return W }
+  if {$char >= 12694 && $char <= 12703 } { return W }
+  if {$char >= 12704 && $char <= 12730 } { return W }
+  if {$char >= 12736 && $char <= 12771 } { return W }
+  if {$char >= 12784 && $char <= 12799 } { return W }
+  if {$char >= 12800 && $char <= 12830 } { return W }
+  if {$char >= 12832 && $char <= 12841 } { return W }
+  if {$char >= 12842 && $char <= 12871 } { return W }
+  if {$char >= 12872 && $char <= 12879 } { return A }
+  if {$char == 12880} { return W }
+  if {$char >= 12881 && $char <= 12895 } { return W }
+  if {$char >= 12896 && $char <= 12927 } { return W }
+  if {$char >= 12928 && $char <= 12937 } { return W }
+  if {$char >= 12938 && $char <= 12976 } { return W }
+  if {$char >= 12977 && $char <= 12991 } { return W }
+  if {$char >= 12992 && $char <= 13054 } { return W }
+  if {$char >= 13056 && $char <= 13311 } { return W }
+  if {$char >= 13312 && $char <= 19893 } { return W }
+  if {$char >= 19894 && $char <= 19903 } { return W }
+  if {$char >= 19968 && $char <= 40943 } { return W }
+  if {$char >= 40944 && $char <= 40959 } { return W }
+  if {$char >= 40960 && $char <= 40980 } { return W }
+  if {$char == 40981} { return W }
+  if {$char >= 40982 && $char <= 42124 } { return W }
+  if {$char >= 42128 && $char <= 42182 } { return W }
+  if {$char >= 43360 && $char <= 43388 } { return W }
+  if {$char >= 44032 && $char <= 55203 } { return W }
+  if {$char >= 57344 && $char <= 63743 } { return A }
+  if {$char >= 63744 && $char <= 64109 } { return W }
+  if {$char >= 64110 && $char <= 64111 } { return W }
+  if {$char >= 64112 && $char <= 64217 } { return W }
+  if {$char >= 64218 && $char <= 64255 } { return W }
+  if {$char >= 65024 && $char <= 65039 } { return A }
+  if {$char >= 65040 && $char <= 65046 } { return W }
+  if {$char == 65047} { return W }
+  if {$char == 65048} { return W }
+  if {$char == 65049} { return W }
+  if {$char == 65072} { return W }
+  if {$char >= 65073 && $char <= 65074 } { return W }
+  if {$char >= 65075 && $char <= 65076 } { return W }
+  if {$char == 65077} { return W }
+  if {$char == 65078} { return W }
+  if {$char == 65079} { return W }
+  if {$char == 65080} { return W }
+  if {$char == 65081} { return W }
+  if {$char == 65082} { return W }
+  if {$char == 65083} { return W }
+  if {$char == 65084} { return W }
+  if {$char == 65085} { return W }
+  if {$char == 65086} { return W }
+  if {$char == 65087} { return W }
+  if {$char == 65088} { return W }
+  if {$char == 65089} { return W }
+  if {$char == 65090} { return W }
+  if {$char == 65091} { return W }
+  if {$char == 65092} { return W }
+  if {$char >= 65093 && $char <= 65094 } { return W }
+  if {$char == 65095} { return W }
+  if {$char == 65096} { return W }
+  if {$char >= 65097 && $char <= 65100 } { return W }
+  if {$char >= 65101 && $char <= 65103 } { return W }
+  if {$char >= 65104 && $char <= 65106 } { return W }
+  if {$char >= 65108 && $char <= 65111 } { return W }
+  if {$char == 65112} { return W }
+  if {$char == 65113} { return W }
+  if {$char == 65114} { return W }
+  if {$char == 65115} { return W }
+  if {$char == 65116} { return W }
+  if {$char == 65117} { return W }
+  if {$char == 65118} { return W }
+  if {$char >= 65119 && $char <= 65121 } { return W }
+  if {$char == 65122} { return W }
+  if {$char == 65123} { return W }
+  if {$char >= 65124 && $char <= 65126 } { return W }
+  if {$char == 65128} { return W }
+  if {$char == 65129} { return W }
+  if {$char >= 65130 && $char <= 65131 } { return W }
+  if {$char >= 65281 && $char <= 65283 } { return F }
+  if {$char == 65284} { return F }
+  if {$char >= 65285 && $char <= 65287 } { return F }
+  if {$char == 65288} { return F }
+  if {$char == 65289} { return F }
+  if {$char == 65290} { return F }
+  if {$char == 65291} { return F }
+  if {$char == 65292} { return F }
+  if {$char == 65293} { return F }
+  if {$char >= 65294 && $char <= 65295 } { return F }
+  if {$char >= 65296 && $char <= 65305 } { return F }
+  if {$char >= 65306 && $char <= 65307 } { return F }
+  if {$char >= 65308 && $char <= 65310 } { return F }
+  if {$char >= 65311 && $char <= 65312 } { return F }
+  if {$char >= 65313 && $char <= 65338 } { return F }
+  if {$char == 65339} { return F }
+  if {$char == 65340} { return F }
+  if {$char == 65341} { return F }
+  if {$char == 65342} { return F }
+  if {$char == 65343} { return F }
+  if {$char == 65344} { return F }
+  if {$char >= 65345 && $char <= 65370 } { return F }
+  if {$char == 65371} { return F }
+  if {$char == 65372} { return F }
+  if {$char == 65373} { return F }
+  if {$char == 65374} { return F }
+  if {$char == 65375} { return F }
+  if {$char == 65376} { return F }
+  if {$char == 65377} { return H }
+  if {$char == 65378} { return H }
+  if {$char == 65379} { return H }
+  if {$char >= 65380 && $char <= 65381 } { return H }
+  if {$char >= 65382 && $char <= 65391 } { return H }
+  if {$char == 65392} { return H }
+  if {$char >= 65393 && $char <= 65437 } { return H }
+  if {$char >= 65438 && $char <= 65439 } { return H }
+  if {$char >= 65440 && $char <= 65470 } { return H }
+  if {$char >= 65474 && $char <= 65479 } { return H }
+  if {$char >= 65482 && $char <= 65487 } { return H }
+  if {$char >= 65490 && $char <= 65495 } { return H }
+  if {$char >= 65498 && $char <= 65500 } { return H }
+  if {$char >= 65504 && $char <= 65505 } { return F }
+  if {$char == 65506} { return F }
+  if {$char == 65507} { return F }
+  if {$char == 65508} { return F }
+  if {$char >= 65509 && $char <= 65510 } { return F }
+  if {$char == 65512} { return H }
+  if {$char >= 65513 && $char <= 65516 } { return H }
+  if {$char >= 65517 && $char <= 65518 } { return H }
+  if {$char == 65533} { return A }
+  if {$char >= 94176 && $char <= 94177 } { return W }
+  if {$char >= 94208 && $char <= 100337 } { return W }
+  if {$char >= 100352 && $char <= 101106 } { return W }
+  if {$char >= 110592 && $char <= 110847 } { return W }
+  if {$char >= 110848 && $char <= 110878 } { return W }
+  if {$char >= 110960 && $char <= 111355 } { return W }
+  if {$char == 126980} { return W }
+  if {$char == 127183} { return W }
+  if {$char >= 127232 && $char <= 127242 } { return A }
+  if {$char >= 127248 && $char <= 127277 } { return A }
+  if {$char >= 127280 && $char <= 127337 } { return A }
+  if {$char >= 127344 && $char <= 127373 } { return A }
+  if {$char == 127374} { return W }
+  if {$char >= 127375 && $char <= 127376 } { return A }
+  if {$char >= 127377 && $char <= 127386 } { return W }
+  if {$char >= 127387 && $char <= 127404 } { return A }
+  if {$char >= 127488 && $char <= 127490 } { return W }
+  if {$char >= 127504 && $char <= 127547 } { return W }
+  if {$char >= 127552 && $char <= 127560 } { return W }
+  if {$char >= 127568 && $char <= 127569 } { return W }
+  if {$char >= 127584 && $char <= 127589 } { return W }
+  if {$char >= 127744 && $char <= 127776 } { return W }
+  if {$char >= 127789 && $char <= 127797 } { return W }
+  if {$char >= 127799 && $char <= 127868 } { return W }
+  if {$char >= 127870 && $char <= 127891 } { return W }
+  if {$char >= 127904 && $char <= 127946 } { return W }
+  if {$char >= 127951 && $char <= 127955 } { return W }
+  if {$char >= 127968 && $char <= 127984 } { return W }
+  if {$char == 127988} { return W }
+  if {$char >= 127992 && $char <= 127994 } { return W }
+  if {$char >= 127995 && $char <= 127999 } { return W }
+  if {$char >= 128000 && $char <= 128062 } { return W }
+  if {$char == 128064} { return W }
+  if {$char >= 128066 && $char <= 128252 } { return W }
+  if {$char >= 128255 && $char <= 128317 } { return W }
+  if {$char >= 128331 && $char <= 128334 } { return W }
+  if {$char >= 128336 && $char <= 128359 } { return W }
+  if {$char == 128378} { return W }
+  if {$char >= 128405 && $char <= 128406 } { return W }
+  if {$char == 128420} { return W }
+  if {$char >= 128507 && $char <= 128511 } { return W }
+  if {$char >= 128512 && $char <= 128591 } { return W }
+  if {$char >= 128640 && $char <= 128709 } { return W }
+  if {$char == 128716} { return W }
+  if {$char >= 128720 && $char <= 128722 } { return W }
+  if {$char >= 128747 && $char <= 128748 } { return W }
+  if {$char >= 128756 && $char <= 128761 } { return W }
+  if {$char >= 129296 && $char <= 129342 } { return W }
+  if {$char >= 129344 && $char <= 129392 } { return W }
+  if {$char >= 129395 && $char <= 129398 } { return W }
+  if {$char == 129402} { return W }
+  if {$char >= 129404 && $char <= 129442 } { return W }
+  if {$char >= 129456 && $char <= 129465 } { return W }
+  if {$char >= 129472 && $char <= 129474 } { return W }
+  if {$char >= 129488 && $char <= 129535 } { return W }
+  if {$char >= 131072 && $char <= 173782 } { return W }
+  if {$char >= 173783 && $char <= 173823 } { return W }
+  if {$char >= 173824 && $char <= 177972 } { return W }
+  if {$char >= 177973 && $char <= 177983 } { return W }
+  if {$char >= 177984 && $char <= 178205 } { return W }
+  if {$char >= 178206 && $char <= 178207 } { return W }
+  if {$char >= 178208 && $char <= 183969 } { return W }
+  if {$char >= 183970 && $char <= 183983 } { return W }
+  if {$char >= 183984 && $char <= 191456 } { return W }
+  if {$char >= 191457 && $char <= 194559 } { return W }
+  if {$char >= 194560 && $char <= 195101 } { return W }
+  if {$char >= 195102 && $char <= 195103 } { return W }
+  if {$char >= 195104 && $char <= 196605 } { return W }
+  if {$char >= 196608 && $char <= 262141 } { return W }
+  if {$char >= 917760 && $char <= 917999 } { return A }
+  if {$char >= 983040 && $char <= 1048573 } { return A }
+  if {$char >= 1048576 && $char <= 1114109 } { return A }
+  return N
+}
+proc ::textutil::wcswidth_char char {
+  if {$char >= 4352 && $char <= 4447 } { return 2 }
+  if {$char >= 8986 && $char <= 8987 } { return 2 }
+  if {$char == 9001} { return 2 }
+  if {$char == 9002} { return 2 }
+  if {$char >= 9193 && $char <= 9196 } { return 2 }
+  if {$char == 9200} { return 2 }
+  if {$char == 9203} { return 2 }
+  if {$char >= 9725 && $char <= 9726 } { return 2 }
+  if {$char >= 9748 && $char <= 9749 } { return 2 }
+  if {$char >= 9800 && $char <= 9811 } { return 2 }
+  if {$char == 9855} { return 2 }
+  if {$char == 9875} { return 2 }
+  if {$char == 9889} { return 2 }
+  if {$char >= 9898 && $char <= 9899 } { return 2 }
+  if {$char >= 9917 && $char <= 9918 } { return 2 }
+  if {$char >= 9924 && $char <= 9925 } { return 2 }
+  if {$char == 9934} { return 2 }
+  if {$char == 9940} { return 2 }
+  if {$char == 9962} { return 2 }
+  if {$char >= 9970 && $char <= 9971 } { return 2 }
+  if {$char == 9973} { return 2 }
+  if {$char == 9978} { return 2 }
+  if {$char == 9981} { return 2 }
+  if {$char == 9989} { return 2 }
+  if {$char >= 9994 && $char <= 9995 } { return 2 }
+  if {$char == 10024} { return 2 }
+  if {$char == 10060} { return 2 }
+  if {$char == 10062} { return 2 }
+  if {$char >= 10067 && $char <= 10069 } { return 2 }
+  if {$char == 10071} { return 2 }
+  if {$char >= 10133 && $char <= 10135 } { return 2 }
+  if {$char == 10160} { return 2 }
+  if {$char == 10175} { return 2 }
+  if {$char >= 11035 && $char <= 11036 } { return 2 }
+  if {$char == 11088} { return 2 }
+  if {$char == 11093} { return 2 }
+  if {$char >= 11904 && $char <= 11929 } { return 2 }
+  if {$char >= 11931 && $char <= 12019 } { return 2 }
+  if {$char >= 12032 && $char <= 12245 } { return 2 }
+  if {$char >= 12272 && $char <= 12283 } { return 2 }
+  if {$char == 12288} { return 2 }
+  if {$char >= 12289 && $char <= 12291 } { return 2 }
+  if {$char == 12292} { return 2 }
+  if {$char == 12293} { return 2 }
+  if {$char == 12294} { return 2 }
+  if {$char == 12295} { return 2 }
+  if {$char == 12296} { return 2 }
+  if {$char == 12297} { return 2 }
+  if {$char == 12298} { return 2 }
+  if {$char == 12299} { return 2 }
+  if {$char == 12300} { return 2 }
+  if {$char == 12301} { return 2 }
+  if {$char == 12302} { return 2 }
+  if {$char == 12303} { return 2 }
+  if {$char == 12304} { return 2 }
+  if {$char == 12305} { return 2 }
+  if {$char >= 12306 && $char <= 12307 } { return 2 }
+  if {$char == 12308} { return 2 }
+  if {$char == 12309} { return 2 }
+  if {$char == 12310} { return 2 }
+  if {$char == 12311} { return 2 }
+  if {$char == 12312} { return 2 }
+  if {$char == 12313} { return 2 }
+  if {$char == 12314} { return 2 }
+  if {$char == 12315} { return 2 }
+  if {$char == 12316} { return 2 }
+  if {$char == 12317} { return 2 }
+  if {$char >= 12318 && $char <= 12319 } { return 2 }
+  if {$char == 12320} { return 2 }
+  if {$char >= 12321 && $char <= 12329 } { return 2 }
+  if {$char >= 12330 && $char <= 12333 } { return 2 }
+  if {$char >= 12334 && $char <= 12335 } { return 2 }
+  if {$char == 12336} { return 2 }
+  if {$char >= 12337 && $char <= 12341 } { return 2 }
+  if {$char >= 12342 && $char <= 12343 } { return 2 }
+  if {$char >= 12344 && $char <= 12346 } { return 2 }
+  if {$char == 12347} { return 2 }
+  if {$char == 12348} { return 2 }
+  if {$char == 12349} { return 2 }
+  if {$char == 12350} { return 2 }
+  if {$char >= 12353 && $char <= 12438 } { return 2 }
+  if {$char >= 12441 && $char <= 12442 } { return 2 }
+  if {$char >= 12443 && $char <= 12444 } { return 2 }
+  if {$char >= 12445 && $char <= 12446 } { return 2 }
+  if {$char == 12447} { return 2 }
+  if {$char == 12448} { return 2 }
+  if {$char >= 12449 && $char <= 12538 } { return 2 }
+  if {$char == 12539} { return 2 }
+  if {$char >= 12540 && $char <= 12542 } { return 2 }
+  if {$char == 12543} { return 2 }
+  if {$char >= 12549 && $char <= 12591 } { return 2 }
+  if {$char >= 12593 && $char <= 12686 } { return 2 }
+  if {$char >= 12688 && $char <= 12689 } { return 2 }
+  if {$char >= 12690 && $char <= 12693 } { return 2 }
+  if {$char >= 12694 && $char <= 12703 } { return 2 }
+  if {$char >= 12704 && $char <= 12730 } { return 2 }
+  if {$char >= 12736 && $char <= 12771 } { return 2 }
+  if {$char >= 12784 && $char <= 12799 } { return 2 }
+  if {$char >= 12800 && $char <= 12830 } { return 2 }
+  if {$char >= 12832 && $char <= 12841 } { return 2 }
+  if {$char >= 12842 && $char <= 12871 } { return 2 }
+  if {$char == 12880} { return 2 }
+  if {$char >= 12881 && $char <= 12895 } { return 2 }
+  if {$char >= 12896 && $char <= 12927 } { return 2 }
+  if {$char >= 12928 && $char <= 12937 } { return 2 }
+  if {$char >= 12938 && $char <= 12976 } { return 2 }
+  if {$char >= 12977 && $char <= 12991 } { return 2 }
+  if {$char >= 12992 && $char <= 13054 } { return 2 }
+  if {$char >= 13056 && $char <= 13311 } { return 2 }
+  if {$char >= 13312 && $char <= 19893 } { return 2 }
+  if {$char >= 19894 && $char <= 19903 } { return 2 }
+  if {$char >= 19968 && $char <= 40943 } { return 2 }
+  if {$char >= 40944 && $char <= 40959 } { return 2 }
+  if {$char >= 40960 && $char <= 40980 } { return 2 }
+  if {$char == 40981} { return 2 }
+  if {$char >= 40982 && $char <= 42124 } { return 2 }
+  if {$char >= 42128 && $char <= 42182 } { return 2 }
+  if {$char >= 43360 && $char <= 43388 } { return 2 }
+  if {$char >= 44032 && $char <= 55203 } { return 2 }
+  if {$char >= 63744 && $char <= 64109 } { return 2 }
+  if {$char >= 64110 && $char <= 64111 } { return 2 }
+  if {$char >= 64112 && $char <= 64217 } { return 2 }
+  if {$char >= 64218 && $char <= 64255 } { return 2 }
+  if {$char >= 65040 && $char <= 65046 } { return 2 }
+  if {$char == 65047} { return 2 }
+  if {$char == 65048} { return 2 }
+  if {$char == 65049} { return 2 }
+  if {$char == 65072} { return 2 }
+  if {$char >= 65073 && $char <= 65074 } { return 2 }
+  if {$char >= 65075 && $char <= 65076 } { return 2 }
+  if {$char == 65077} { return 2 }
+  if {$char == 65078} { return 2 }
+  if {$char == 65079} { return 2 }
+  if {$char == 65080} { return 2 }
+  if {$char == 65081} { return 2 }
+  if {$char == 65082} { return 2 }
+  if {$char == 65083} { return 2 }
+  if {$char == 65084} { return 2 }
+  if {$char == 65085} { return 2 }
+  if {$char == 65086} { return 2 }
+  if {$char == 65087} { return 2 }
+  if {$char == 65088} { return 2 }
+  if {$char == 65089} { return 2 }
+  if {$char == 65090} { return 2 }
+  if {$char == 65091} { return 2 }
+  if {$char == 65092} { return 2 }
+  if {$char >= 65093 && $char <= 65094 } { return 2 }
+  if {$char == 65095} { return 2 }
+  if {$char == 65096} { return 2 }
+  if {$char >= 65097 && $char <= 65100 } { return 2 }
+  if {$char >= 65101 && $char <= 65103 } { return 2 }
+  if {$char >= 65104 && $char <= 65106 } { return 2 }
+  if {$char >= 65108 && $char <= 65111 } { return 2 }
+  if {$char == 65112} { return 2 }
+  if {$char == 65113} { return 2 }
+  if {$char == 65114} { return 2 }
+  if {$char == 65115} { return 2 }
+  if {$char == 65116} { return 2 }
+  if {$char == 65117} { return 2 }
+  if {$char == 65118} { return 2 }
+  if {$char >= 65119 && $char <= 65121 } { return 2 }
+  if {$char == 65122} { return 2 }
+  if {$char == 65123} { return 2 }
+  if {$char >= 65124 && $char <= 65126 } { return 2 }
+  if {$char == 65128} { return 2 }
+  if {$char == 65129} { return 2 }
+  if {$char >= 65130 && $char <= 65131 } { return 2 }
+  if {$char >= 65281 && $char <= 65283 } { return 2 }
+  if {$char == 65284} { return 2 }
+  if {$char >= 65285 && $char <= 65287 } { return 2 }
+  if {$char == 65288} { return 2 }
+  if {$char == 65289} { return 2 }
+  if {$char == 65290} { return 2 }
+  if {$char == 65291} { return 2 }
+  if {$char == 65292} { return 2 }
+  if {$char == 65293} { return 2 }
+  if {$char >= 65294 && $char <= 65295 } { return 2 }
+  if {$char >= 65296 && $char <= 65305 } { return 2 }
+  if {$char >= 65306 && $char <= 65307 } { return 2 }
+  if {$char >= 65308 && $char <= 65310 } { return 2 }
+  if {$char >= 65311 && $char <= 65312 } { return 2 }
+  if {$char >= 65313 && $char <= 65338 } { return 2 }
+  if {$char == 65339} { return 2 }
+  if {$char == 65340} { return 2 }
+  if {$char == 65341} { return 2 }
+  if {$char == 65342} { return 2 }
+  if {$char == 65343} { return 2 }
+  if {$char == 65344} { return 2 }
+  if {$char >= 65345 && $char <= 65370 } { return 2 }
+  if {$char == 65371} { return 2 }
+  if {$char == 65372} { return 2 }
+  if {$char == 65373} { return 2 }
+  if {$char == 65374} { return 2 }
+  if {$char == 65375} { return 2 }
+  if {$char == 65376} { return 2 }
+  if {$char >= 65504 && $char <= 65505 } { return 2 }
+  if {$char == 65506} { return 2 }
+  if {$char == 65507} { return 2 }
+  if {$char == 65508} { return 2 }
+  if {$char >= 65509 && $char <= 65510 } { return 2 }
+  if {$char >= 94176 && $char <= 94177 } { return 2 }
+  if {$char >= 94208 && $char <= 100337 } { return 2 }
+  if {$char >= 100352 && $char <= 101106 } { return 2 }
+  if {$char >= 110592 && $char <= 110847 } { return 2 }
+  if {$char >= 110848 && $char <= 110878 } { return 2 }
+  if {$char >= 110960 && $char <= 111355 } { return 2 }
+  if {$char == 126980} { return 2 }
+  if {$char == 127183} { return 2 }
+  if {$char == 127374} { return 2 }
+  if {$char >= 127377 && $char <= 127386 } { return 2 }
+  if {$char >= 127488 && $char <= 127490 } { return 2 }
+  if {$char >= 127504 && $char <= 127547 } { return 2 }
+  if {$char >= 127552 && $char <= 127560 } { return 2 }
+  if {$char >= 127568 && $char <= 127569 } { return 2 }
+  if {$char >= 127584 && $char <= 127589 } { return 2 }
+  if {$char >= 127744 && $char <= 127776 } { return 2 }
+  if {$char >= 127789 && $char <= 127797 } { return 2 }
+  if {$char >= 127799 && $char <= 127868 } { return 2 }
+  if {$char >= 127870 && $char <= 127891 } { return 2 }
+  if {$char >= 127904 && $char <= 127946 } { return 2 }
+  if {$char >= 127951 && $char <= 127955 } { return 2 }
+  if {$char >= 127968 && $char <= 127984 } { return 2 }
+  if {$char == 127988} { return 2 }
+  if {$char >= 127992 && $char <= 127994 } { return 2 }
+  if {$char >= 127995 && $char <= 127999 } { return 2 }
+  if {$char >= 128000 && $char <= 128062 } { return 2 }
+  if {$char == 128064} { return 2 }
+  if {$char >= 128066 && $char <= 128252 } { return 2 }
+  if {$char >= 128255 && $char <= 128317 } { return 2 }
+  if {$char >= 128331 && $char <= 128334 } { return 2 }
+  if {$char >= 128336 && $char <= 128359 } { return 2 }
+  if {$char == 128378} { return 2 }
+  if {$char >= 128405 && $char <= 128406 } { return 2 }
+  if {$char == 128420} { return 2 }
+  if {$char >= 128507 && $char <= 128511 } { return 2 }
+  if {$char >= 128512 && $char <= 128591 } { return 2 }
+  if {$char >= 128640 && $char <= 128709 } { return 2 }
+  if {$char == 128716} { return 2 }
+  if {$char >= 128720 && $char <= 128722 } { return 2 }
+  if {$char >= 128747 && $char <= 128748 } { return 2 }
+  if {$char >= 128756 && $char <= 128761 } { return 2 }
+  if {$char >= 129296 && $char <= 129342 } { return 2 }
+  if {$char >= 129344 && $char <= 129392 } { return 2 }
+  if {$char >= 129395 && $char <= 129398 } { return 2 }
+  if {$char == 129402} { return 2 }
+  if {$char >= 129404 && $char <= 129442 } { return 2 }
+  if {$char >= 129456 && $char <= 129465 } { return 2 }
+  if {$char >= 129472 && $char <= 129474 } { return 2 }
+  if {$char >= 129488 && $char <= 129535 } { return 2 }
+  if {$char >= 131072 && $char <= 173782 } { return 2 }
+  if {$char >= 173783 && $char <= 173823 } { return 2 }
+  if {$char >= 173824 && $char <= 177972 } { return 2 }
+  if {$char >= 177973 && $char <= 177983 } { return 2 }
+  if {$char >= 177984 && $char <= 178205 } { return 2 }
+  if {$char >= 178206 && $char <= 178207 } { return 2 }
+  if {$char >= 178208 && $char <= 183969 } { return 2 }
+  if {$char >= 183970 && $char <= 183983 } { return 2 }
+  if {$char >= 183984 && $char <= 191456 } { return 2 }
+  if {$char >= 191457 && $char <= 194559 } { return 2 }
+  if {$char >= 194560 && $char <= 195101 } { return 2 }
+  if {$char >= 195102 && $char <= 195103 } { return 2 }
+  if {$char >= 195104 && $char <= 196605 } { return 2 }
+  if {$char >= 196608 && $char <= 262141 } { return 2 }
+  return 1
+}
+
+proc ::textutil::wcswidth {string} {
+  set width 0
+  set len [string length $string]
+  foreach c [split $string {}] {
+    scan $c %c char
+    set n [::textutil::wcswidth_char $char]
+    if {$n < 0} {
+      return -1
+    }
+    incr width $n
+  }
+  return $width
+}
+