bootsupport sync

src/bootsupport/lib/control/control.tcl

@@ -4,7 +4,7 @@
 #	"control".  It provides commands that govern the flow of
 #	control of a program.
 
-package require Tcl 8.2
+package require Tcl 8.5 9
 
 namespace eval ::control {
     namespace export assert control do no-op rswitch
@@ -20,5 +20,5 @@ namespace eval ::control {
 	lappend ::auto_path $home
     }
 
-    package provide [namespace tail [namespace current]] 0.1.3
+    package provide [namespace tail [namespace current]] 0.1.4
 }

src/bootsupport/lib/control/pkgIndex.tcl

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

src/bootsupport/lib/fileutil/decode.tcl

@@ -0,0 +1,207 @@
+# -*- tcl -*-
+# ### ### ### ######### ######### #########
+## Copyright (c) 2008-2009 ActiveState Software Inc., Andreas Kupries
+##                    2016 Andreas Kupries
+## BSD License
+##
+# Package to help the writing of file decoders. Provides generic
+# low-level support commands.
+
+package require Tcl 8.5 9
+
+namespace eval ::fileutil::decode {
+    namespace export mark go rewind at
+    namespace export byte short-le long-le nbytes skip
+    namespace export unsigned match recode getval
+    namespace export clear get put putloc setbuf
+}
+
+# ### ### ### ######### ######### #########
+##
+
+proc ::fileutil::decode::open {fname} {
+    variable chan
+    set chan [::open $fname r]
+    fconfigure $chan \
+	-translation binary \
+	-encoding    binary \
+	-eofchar     {}
+    return
+}
+
+proc ::fileutil::decode::close {} {
+    variable chan
+    ::close $chan
+}
+
+# ### ### ### ######### ######### #########
+##
+
+proc ::fileutil::decode::mark {} {
+    variable chan
+    variable mark
+    set mark [tell $chan]
+    return
+}
+
+proc ::fileutil::decode::go {to} {
+    variable chan
+    seek $chan $to start
+    return
+}
+
+proc ::fileutil::decode::rewind {} {
+    variable chan
+    variable mark
+    if {$mark == {}} {
+	return -code error \
+	    -errorcode {FILE DECODE NO MARK} \
+	    "No mark to rewind to"
+    }
+    seek $chan $mark start
+    set mark {}
+    return
+}
+
+proc ::fileutil::decode::at {} {
+    variable chan
+    return [tell $chan]
+}
+
+# ### ### ### ######### ######### #########
+##
+
+proc ::fileutil::decode::byte {} {
+    variable chan
+    variable mask 0xff
+    variable val [read $chan 1]
+    binary scan $val c val
+    return
+}
+
+proc ::fileutil::decode::short-le {} {
+    variable chan
+    variable mask 0xffff
+    variable val [read $chan 2]
+    binary scan $val s val
+    return
+}
+
+proc ::fileutil::decode::long-le {} {
+    variable chan
+    variable mask 0xffffffff
+    variable val [read $chan 4]
+    binary scan $val i val
+    return
+}
+
+proc ::fileutil::decode::nbytes {n} {
+    variable chan
+    variable mask {}
+    variable val [read $chan $n]
+    return
+}
+
+proc ::fileutil::decode::skip {n} {
+    variable chan
+    #read $chan $n
+    seek $chan $n current
+    return
+}
+
+# ### ### ### ######### ######### #########
+##
+
+proc ::fileutil::decode::unsigned {} {
+    variable val
+    if {$val >= 0} return
+    variable mask
+    if {$mask eq {}} {
+	return -code error \
+	    -errorcode {FILE DECODE ILLEGAL UNSIGNED} \
+	    "Unsigned not possible here"
+    }
+    set val [format %u [expr {$val & $mask}]]
+    return
+}
+
+proc ::fileutil::decode::match {eval} {
+    variable val
+
+    #puts "Match: Expected $eval, Got: [format 0x%08x $val]"
+
+    if {$val == $eval} {return 1}
+    rewind
+    return 0
+}
+
+proc ::fileutil::decode::recode {cmdpfx} {
+    variable val
+    lappend cmdpfx $val
+    set val [uplevel 1 $cmdpfx]
+    return
+}
+
+proc ::fileutil::decode::getval {} {
+    variable val
+    return $val
+}
+
+# ### ### ### ######### ######### #########
+##
+
+proc ::fileutil::decode::clear {} {
+    variable buf {}
+    return
+}
+
+proc ::fileutil::decode::get {} {
+    variable buf
+    return $buf
+}
+
+proc ::fileutil::decode::setbuf {list} {
+    variable buf $list
+    return
+}
+
+proc ::fileutil::decode::put {name} {
+    variable buf
+    variable val
+    lappend buf $name $val
+    return
+}
+
+proc ::fileutil::decode::putloc {name} {
+    variable buf
+    variable chan
+    lappend buf $name [tell $chan]
+    return
+}
+
+# ### ### ### ######### ######### #########
+##
+
+namespace eval ::fileutil::decode {
+    # Stream to read from
+    variable chan {}
+
+    # Last value read from the stream, or modified through decoder
+    # operations.
+    variable val  {}
+
+    # Remembered location in the stream
+    variable mark {}
+
+    # Buffer for accumulating structured results
+    variable buf  {}
+
+    # Mask for trimming a value to unsigned.
+    # Size-dependent
+    variable mask {}
+}
+
+# ### ### ### ######### ######### #########
+## Ready
+package provide fileutil::decode 0.2.2
+return

src/bootsupport/lib/fileutil/fileutil.tcl

@@ -9,9 +9,9 @@
 # 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 require Tcl 8.5 9
 package require cmdline
-package provide fileutil 1.16.1
+package provide fileutil 1.16.2
 
 namespace eval ::fileutil {
     namespace export \
@@ -196,237 +196,55 @@ proc ::fileutil::FADD {filename} {
     return
 }
 
-# The next three helper commands for fileutil::find depend strongly on
+# Tcl 8.5+.
-# the version of Tcl, and partially on the platform.
+# We have to check readability of "current" on our own, glob
-
+# changed to error out instead of returning nothing.
-# 1. The -directory and -types switches were added to glob in Tcl
-#    8.3. This means that we have to emulate them for Tcl 8.2.
-#
-# 2. In Tcl 8.3 using -types f will return only true files, but not
-#    links to files. This changed in 8.4+ where links to files are
-#    returned as well. So for 8.3 we have to handle the links
-#    separately (-types l) and also filter on our own.
-#    Note that Windows file links are hard links which are reported by
-#    -types f, but not -types l, so we can optimize that for the two
-#    platforms.
-#
-#    Note further that we have to handle broken links on our own. They
-#    are not returned by glob yet we want them in the output.
-#
-# 3. In Tcl 8.3 we also have a crashing bug in glob (SIGABRT, "stat on
-#    a known file") when trying to perform 'glob -types {hidden f}' on
-#    a directory without e'x'ecute permissions. We code around by
-#    testing if we can cd into the directory (stat might return enough
-#    information too (mode), but possibly also not portable).
-#
-#    For Tcl 8.2 and 8.4+ glob simply delivers an empty result
-#    (-nocomplain), without crashing. For them this command is defined
-#    so that the bytecode compiler removes it from the bytecode.
-#
-#    This bug made the ACCESS helper necessary.
-#    We code around the problem by testing if we can cd into the
-#    directory (stat might return enough information too (mode), but
-#    possibly also not portable).
-
-if {[package vsatisfies [package present Tcl] 8.5]} {
-    # Tcl 8.5+.
-    # We have to check readability of "current" on our own, glob
-    # changed to error out instead of returning nothing.
-
-    proc ::fileutil::ACCESS {args} {}
-
-    proc ::fileutil::GLOBF {current} {
-	if {![file readable $current] ||
-	    [BadLink $current]} {
-	    return {}
-	}
-
-	set res [lsort -unique [concat \
-		     [glob -nocomplain -directory $current -types f          -- *] \
-		     [glob -nocomplain -directory $current -types {hidden f} -- *]]]
-
-	# Look for broken links (They are reported as neither file nor directory).
-	foreach l [lsort -unique [concat \
-		       [glob -nocomplain -directory $current -types l          -- *] \
-		       [glob -nocomplain -directory $current -types {hidden l} -- *]]] {
-	    if {[file isfile      $l]} continue
-	    if {[file isdirectory $l]} continue
-	    lappend res $l
-	}
-	return [lsort -unique $res]
-    }
-
-    proc ::fileutil::GLOBD {current} {
-	if {![file readable $current] ||
-	    [BadLink $current]} {
-	    return {}
-	}
-
-	lsort -unique [concat \
-	   [glob -nocomplain -directory $current -types d          -- *] \
-	   [glob -nocomplain -directory $current -types {hidden d} -- *]]
-    }
-
-    proc ::fileutil::BadLink {current} {
-	if {[file type $current] ne "link"} { return no }
 
-	set dst [file join [file dirname $current] [file readlink $current]]
+proc ::fileutil::ACCESS {args} {}
-
-	if {![file exists   $dst] ||
-	    ![file readable $dst]} {
-	    return yes
-	}
 
-	return no
+proc ::fileutil::GLOBF {current} {
+    if {![file readable $current] ||
+	[BadLink $current]} {
+	return {}
     }
-} elseif {[package vsatisfies [package present Tcl] 8.4]} {
-    # Tcl 8.4+.
-    # (Ad 1) We have -directory, and -types,
-    # (Ad 2) Links are returned for -types f/d if they refer to files/dirs.
-    # (Ad 3) No bug to code around
-
-    proc ::fileutil::ACCESS {args} {}
-
-    proc ::fileutil::GLOBF {current} {
-	set res [lsort -unique [concat \
-		    [glob -nocomplain -directory $current -types f          -- *] \
-		    [glob -nocomplain -directory $current -types {hidden f} -- *]]]
 
-	# Look for broken links (They are reported as neither file nor directory).
+    set res [lsort -unique [concat \
-	foreach l [lsort -unique [concat \
+				[glob -nocomplain -directory $current -types f          -- *] \
-		       [glob -nocomplain -directory $current -types l          -- *] \
+				[glob -nocomplain -directory $current -types {hidden f} -- *]]]
-		       [glob -nocomplain -directory $current -types {hidden l} -- *]]] {
-	    if {[file isfile      $l]} continue
-	    if {[file isdirectory $l]} continue
-	    lappend res $l
-	}
-	return [lsort -unique $res]
-    }
 
-    proc ::fileutil::GLOBD {current} {
+    # Look for broken links (They are reported as neither file nor directory).
-	lsort -unique [concat \
+    foreach l [lsort -unique [concat \
-	    [glob -nocomplain -directory $current -types d          -- *] \
+				  [glob -nocomplain -directory $current -types l          -- *] \
-	    [glob -nocomplain -directory $current -types {hidden d} -- *]]
+				  [glob -nocomplain -directory $current -types {hidden l} -- *]]] {
+	if {[file isfile      $l]} continue
+	if {[file isdirectory $l]} continue
+	lappend res $l
     }
+    return [lsort -unique $res]
+}
 
-} elseif {[package vsatisfies [package present Tcl] 8.3]} {
+proc ::fileutil::GLOBD {current} {
-    # 8.3.
+    if {![file readable $current] ||
-    # (Ad 1) We have -directory, and -types,
+	[BadLink $current]} {
-    # (Ad 2) Links are NOT returned for -types f/d, collect separately.
+	return {}
-    #        No symbolic file links on Windows.
-    # (Ad 3) Bug to code around.
-
-    proc ::fileutil::ACCESS {current} {
-	if {[catch {
-	    set h [pwd] ; cd $current ; cd $h
-	}]} {return -code continue}
-	return
     }
 
-    if {[string equal $::tcl_platform(platform) windows]} {
+    lsort -unique [concat \
-	proc ::fileutil::GLOBF {current} {
+		       [glob -nocomplain -directory $current -types d          -- *] \
-	    concat \
+		       [glob -nocomplain -directory $current -types {hidden d} -- *]]
-		[glob -nocomplain -directory $current -types f          -- *] \
+}
-		[glob -nocomplain -directory $current -types {hidden f} -- *]]
-	}
-    } else {
-	proc ::fileutil::GLOBF {current} {
-	    set l [concat \
-		       [glob -nocomplain -directory $current -types f          -- *] \
-		       [glob -nocomplain -directory $current -types {hidden f} -- *]]
-
-	    foreach x [concat \
-			   [glob -nocomplain -directory $current -types l          -- *] \
-			   [glob -nocomplain -directory $current -types {hidden l} -- *]] {
-		if {[file isdirectory $x]} continue
-		# We have now accepted files, links to files, and broken links.
-		lappend l $x
-	    }
-
-	    return $l
-	}
-    }
 
-    proc ::fileutil::GLOBD {current} {
+proc ::fileutil::BadLink {current} {
-	set l [concat \
+    if {[file type $current] ne "link"} { return no }
-		   [glob -nocomplain -directory $current -types d          -- *] \
-		   [glob -nocomplain -directory $current -types {hidden d} -- *]]
 
-	foreach x [concat \
+    set dst [file join [file dirname $current] [file readlink $current]]
-		       [glob -nocomplain -directory $current -types l          -- *] \
-		       [glob -nocomplain -directory $current -types {hidden l} -- *]] {
-	    if {![file isdirectory $x]} continue
-	    lappend l $x
-	}
 
-	return $l
+    if {![file exists   $dst] ||
+	![file readable $dst]} {
+	return yes
     }
-} else {
-    # 8.2.
-    # (Ad 1,2,3) We do not have -directory, nor -types. Full emulation required.
-
-    proc ::fileutil::ACCESS {args} {}
-
-    if {[string equal $::tcl_platform(platform) windows]} {
-	# Hidden files cannot be handled by Tcl 8.2 in glob. We have
-	# to punt.
-
-	proc ::fileutil::GLOBF {current} {
-	    set current \\[join [split $current {}] \\]
-	    set res {}
-	    foreach x [glob -nocomplain -- [file join $current *]] {
-		if {[file isdirectory $x]} continue
-		if {[catch {file type $x}]} continue
-		# We have now accepted files, links to files, and
-		# broken links. We may also have accepted a directory
-		# as well, if the current path was inaccessible. This
-		# however will cause 'file type' to throw an error,
-		# hence the second check.
-		lappend res $x
-	    }
-	    return $res
-	}
-
-	proc ::fileutil::GLOBD {current} {
-	    set current \\[join [split $current {}] \\]
-	    set res {}
-	    foreach x [glob -nocomplain -- [file join $current *]] {
-		if {![file isdirectory $x]} continue
-		lappend res $x
-	    }
-	    return $res
-	}
-    } else {
-	# Hidden files on Unix are dot-files. We emulate the switch
-	# '-types hidden' by using an explicit pattern.
-
-	proc ::fileutil::GLOBF {current} {
-	    set current \\[join [split $current {}] \\]
-	    set res {}
-	    foreach x [glob -nocomplain -- [file join $current *] [file join $current .*]] {
-		if {[file isdirectory $x]} continue
-		if {[catch {file type $x}]} continue
-		# We have now accepted files, links to files, and
-		# broken links. We may also have accepted a directory
-		# as well, if the current path was inaccessible. This
-		# however will cause 'file type' to throw an error,
-		# hence the second check.
-
-		lappend res $x
-	    }
-	    return $res
-	}
 
-	proc ::fileutil::GLOBD {current} {
+    return no
-	    set current \\[join [split $current {}] \\]
-	    set res {}
-	    foreach x [glob -nocomplain -- $current/* [file join $current .*]] {
-		if {![file isdirectory $x]} continue
-		lappend res $x
-	    }
-	    return $res
-	}
-    }
 }
 
 # ::fileutil::findByPattern --
@@ -1459,56 +1277,50 @@ proc ::fileutil::foreachLine {var filename cmd} {
 # Errors:
 #	Both of "-r" and "-t" cannot be specified.
 
-if {[package vsatisfies [package provide Tcl] 8.3]} {
+proc ::fileutil::touch {args} {
-    namespace eval ::fileutil {
+    # Don't bother catching errors, just let them propagate up
-	namespace export touch
-    }
-
-    proc ::fileutil::touch {args} {
-        # Don't bother catching errors, just let them propagate up
 
-        set options {
+    set options {
-            {a          "set the atime only"}
+        {a          "set the atime only"}
-            {m          "set the mtime only"}
+        {m          "set the mtime only"}
-            {c          "do not create non-existant files"}
+        {c          "do not create non-existant files"}
-            {r.arg  ""  "use time from ref_file"}
+        {r.arg  ""  "use time from ref_file"}
-            {t.arg  -1  "use specified time"}
+        {t.arg  -1  "use specified time"}
-        }
+    }
-        set usage ": [lindex [info level 0] 0]\
+    set usage ": [lindex [info level 0] 0]\
                       \[options] filename ...\noptions:"
-        array set params [::cmdline::getoptions args $options $usage]
+    array set params [::cmdline::getoptions args $options $usage]
-
-        # process -a and -m options
-        set set_atime [set set_mtime "true"]
-        if {  $params(a) && ! $params(m)} {set set_mtime "false"}
-        if {! $params(a) &&   $params(m)} {set set_atime "false"}
-
-        # process -r and -t
-        set has_t [expr {$params(t) != -1}]
-        set has_r [expr {[string length $params(r)] > 0}]
-        if {$has_t && $has_r} {
-            return -code error "Cannot specify both -r and -t"
-        } elseif {$has_t} {
-            set atime [set mtime $params(t)]
-        } elseif {$has_r} {
-            file stat $params(r) stat
-            set atime $stat(atime)
-            set mtime $stat(mtime)
-        } else {
-            set atime [set mtime [clock seconds]]
-        }
 
-        # do it
+    # process -a and -m options
-        foreach filename $args {
+    set set_atime [set set_mtime "true"]
-            if {! [file exists $filename]} {
+    if {  $params(a) && ! $params(m)} {set set_mtime "false"}
-                if {$params(c)} {continue}
+    if {! $params(a) &&   $params(m)} {set set_atime "false"}
-                close [open $filename w]
+
-            }
+    # process -r and -t
-            if {$set_atime} {file atime $filename $atime}
+    set has_t [expr {$params(t) != -1}]
-            if {$set_mtime} {file mtime $filename $mtime}
+    set has_r [expr {[string length $params(r)] > 0}]
+    if {$has_t && $has_r} {
+        return -code error "Cannot specify both -r and -t"
+    } elseif {$has_t} {
+        set atime [set mtime $params(t)]
+    } elseif {$has_r} {
+        file stat $params(r) stat
+        set atime $stat(atime)
+        set mtime $stat(mtime)
+    } else {
+        set atime [set mtime [clock seconds]]
+    }
+
+    # do it
+    foreach filename $args {
+        if {! [file exists $filename]} {
+            if {$params(c)} {continue}
+            close [open $filename w]
         }
-        return
+        if {$set_atime} {file atime $filename $atime}
+        if {$set_mtime} {file mtime $filename $mtime}
     }
+    return
 }
 
 # ::fileutil::fileType --
@@ -1921,7 +1733,7 @@ proc ::fileutil::MakeTempDir {config} {
 	if {[catch {
 	    file mkdir $path
 	    if {$::tcl_platform(platform) eq "unix"} {
-		file attributes $path -permissions 0700
+		file attributes $path -permissions 0o700
 	    }
 	}]} continue
 

src/bootsupport/lib/fileutil/multi.tcl

@@ -0,0 +1,28 @@
+# ### ### ### ######### ######### #########
+##
+# (c) 2007 Andreas Kupries.
+
+# Multi file operations. Singleton based on the multiop processor.
+
+# ### ### ### ######### ######### #########
+## Requisites
+
+package require fileutil::multi::op
+
+# ### ### ### ######### ######### #########
+## API & Implementation
+
+namespace eval ::fileutil {}
+
+# Create the multiop processor object and make its do method the main
+# command of this package.
+::fileutil::multi::op ::fileutil::multi::obj
+
+proc ::fileutil::multi {args} {
+    return [uplevel 1 [linsert $args 0 ::fileutil::multi::obj do]]
+}
+
+# ### ### ### ######### ######### #########
+## Ready
+
+package provide fileutil::multi 0.2

src/bootsupport/lib/fileutil/multiop.tcl

@@ -0,0 +1,645 @@
+# ### ### ### ######### ######### #########
+##
+# (c) 2007-2008 Andreas Kupries.
+
+# DSL allowing the easy specification of multi-file copy and/or move
+# and/or deletion operations. Alternate names would be scatter/gather
+# processor, or maybe even assembler.
+
+# Examples:
+# (1) copy
+#     into [installdir_of tls]
+#     from c:/TDK/PrivateOpenSSL/bin
+#     the  *.dll
+#
+# (2) move
+#     from /sources
+#     into /scratch
+#     the  *
+#     but not *.html
+#  (Alternatively: except for *.html)
+#
+# (3) into /scratch
+#     from /sources
+#     move
+#     as   pkgIndex.tcl
+#     the  index
+#
+# (4) in /scratch
+#     remove
+#     the *.txt
+
+# The language is derived from the parts of TclApp's option language
+# dealing with files and their locations, yet not identical. In parts
+# simplified, in parts more capable, keyword names were changed
+# throughout.
+
+# Language commands
+
+# From the examples
+#
+# into        DIR           : Specify destination directory.
+# in          DIR           : See 'into'.
+# from        DIR           : Specify source directory.
+# the         PATTERN (...) : Specify files to operate on.
+# but not     PATTERN       : Specify exceptions to 'the'.
+# but exclude PATTERN       : Specify exceptions to 'the'.
+# except for  PATTERN       : See 'but not'.
+# as          NAME          : New name for file.
+# move                      : Move files.
+# copy                      : Copy files.
+# remove                    : Delete files.
+#
+# Furthermore
+#
+# reset     : Force to defaults.
+# cd    DIR : Change destination to subdirectory.
+# up        : Change destination to parent directory.
+# (         : Save a copy of the current state.
+# )         : Restore last saved state and make it current.
+
+# The main active element is the command 'the'. In other words, this
+# command not only specifies the files to operate on, but also
+# executes the operation as defined in the current state. All other
+# commands modify the state to set the operation up, and nothing
+# else. To allow for a more natural syntax the active command also
+# looks ahead for the commands 'as', 'but', and 'except', and executes
+# them, like qualifiers, so that they take effect as if they had been
+# written before. The command 'but' and 'except use identical
+# constructions to handle their qualifiers, i.e. 'not' and 'for'.
+
+# Note that the fact that most commands just modify the state allows
+# us to use more off forms as specifications instead of just natural
+# language sentences For example the example 2 can re-arranged into:
+#
+# (5) from /sources
+#     into /scratch
+#     but not *.html
+#     move
+#     the  *
+#
+# and the result is still a valid specification.
+
+# Further note that the information collected by 'but', 'except', and
+# 'as' is automatically reset after the associated 'the' was
+# executed. However no other state is reset in that manner, allowing
+# the user to avoid repetitions of unchanging information. Lets us for
+# example merge the examples 2 and 3. The trivial merge is:
+
+# (6) move
+#     into /scratch
+#     from /sources
+#     the  *
+#     but not *.html not index
+#     move
+#     into /scratch
+#     from /sources
+#     the  index
+#     as   pkgIndex.tcl
+#
+# With less repetitions
+#
+# (7) move
+#     into /scratch
+#     from /sources
+#     the  *
+#     but not *.html not index
+#     the  index
+#     as   pkgIndex.tcl
+
+# I have not yet managed to find a suitable syntax to specify when to
+# add a new extension to the moved/copied files, or have to strip all
+# extensions, a specific extension, or even replace extensions.
+
+# Other possibilities to muse about: Load the patterns for 'not'/'for'
+# from a file ... Actually, load the whole exceptions from a file,
+# with its contents a proper interpretable word list. Which makes it
+# general processing of include files.
+
+# ### ### ### ######### ######### #########
+## Requisites
+
+# This processor uses the 'wip' word list interpreter as its
+# foundation.
+
+package require fileutil      ; # File testing
+package require snit          ; # OO support
+package require struct::stack ; # Context stack
+package require wip           ; # DSL execution core
+
+# ### ### ### ######### ######### #########
+## API & Implementation
+
+snit::type ::fileutil::multi::op {
+    # ### ### ### ######### ######### #########
+    ## API
+
+    constructor {args} {} ; # create processor
+
+    # ### ### ### ######### ######### #########
+    ## API - Implementation.
+
+    constructor {args} {
+	install stack using struct::stack ${selfns}::stack
+	$self wip_setup
+
+	# Mapping dsl commands to methods.
+	defdva \
+	    reset  Reset	(    Push	)       Pop	\
+	    into   Into		in   Into	from    From	\
+	    cd     ChDir	up   ChUp	as      As	\
+	    move   Move		copy Copy	remove  Remove	\
+	    but    But		not  Exclude	the     The	\
+	    except Except	for  Exclude    exclude Exclude \
+	    to     Into         ->   Save       the-set TheSet  \
+	    recursive Recursive recursively Recursive           \
+	    for-win     ForWindows   for-unix   ForUnix         \
+	    for-windows ForWindows   expand     Expand          \
+	    invoke Invoke strict Strict !strict NotStrict \
+	    files  Files  links  Links  all Everything    \
+	    dirs   Directories directories Directories    \
+	    state? QueryState from? QueryFrom into? QueryInto \
+	    excluded? QueryExcluded as? QueryAs type? QueryType \
+	    recursive? QueryRecursive operation? QueryOperation \
+	    strict? QueryStrict !recursive NotRecursive
+
+	$self Reset
+	runl $args
+	return
+    }
+
+    destructor {
+	$mywip destroy
+	return
+    }
+
+    method do {args} {
+	return [runl $args]
+    }
+
+    # ### ### ### ######### ######### #########
+    ## DSL Implementation
+    wip::dsl
+
+    # General reset of processor state
+    method Reset {} {
+	$stack clear
+	set base     ""
+	set alias    ""
+	set op       ""
+	set recursive 0
+	set src      ""
+	set excl     ""
+	set types    {}
+	set strict   0
+	return
+    }
+
+    # Stack manipulation
+    method Push {} {
+	$stack push [list $base $alias $op $opcmd $recursive $src $excl $types $strict]
+	return
+    }
+
+    method Pop {} {
+	if {![$stack size]} {
+	    return -code error {Stack underflow}
+	}
+	foreach {base alias op opcmd recursive src excl types strict} [$stack pop] break
+	return
+    }
+
+    # Destination directory
+    method Into {dir} {
+	if {$dir eq ""} {set dir [pwd]}
+	if {$strict && ![fileutil::test $dir edr msg {Destination directory}]} {
+	    return -code error $msg
+	}
+	set base $dir
+	return
+    }
+
+    method ChDir {dir} { $self Into [file join    $base $dir] ; return }
+    method ChUp  {}    { $self Into [file dirname $base]      ; return }
+
+    # Detail
+    method As {fname} {
+	set alias [ForceRelative $fname]
+	return
+    }
+
+    # Operations
+    method Move   {} { set op move   ; return }
+    method Copy   {} { set op copy   ; return }
+    method Remove {} { set op remove ; return }
+    method Expand {} { set op expand ; return }
+
+    method Invoke {cmdprefix} {
+	set op    invoke
+	set opcmd $cmdprefix
+	return
+    }
+
+    # Operation qualifier
+    method Recursive    {} { set recursive 1 ; return }
+    method NotRecursive {} { set recursive 0 ; return }
+
+    # Source directory
+    method From {dir} {
+	if {$dir eq ""} {set dir [pwd]}
+	if {![fileutil::test $dir edr msg {Source directory}]} {
+	    return -code error $msg
+	}
+	set src $dir
+	return
+    }
+
+    # Exceptions
+    method But    {} { run_next_while {not exclude} ; return }
+    method Except {} { run_next_while {for}         ; return }
+
+    method Exclude {pattern} {
+	lappend excl $pattern
+	return
+    }
+
+    # Define the files to operate on, and perform the operation.
+    method The {pattern} {
+	run_next_while {as but except exclude from into in to files dirs directories links all}
+
+	switch -exact -- $op {
+	    invoke {Invoke [Resolve [Remember [Exclude [Expand $src  $pattern]]]]}
+	    move   {Move   [Resolve [Remember [Exclude [Expand $src  $pattern]]]]}
+	    copy   {Copy   [Resolve [Remember [Exclude [Expand $src  $pattern]]]]}
+	    remove {Remove          [Remember [Exclude [Expand $base $pattern]]] }
+	    expand {                 Remember [Exclude [Expand $base $pattern]]  }
+	}
+
+	# Reset the per-pattern flags of the resolution context back
+	# to their defaults, for the next pattern.
+
+	set alias    {}
+	set excl     {}
+	set recursive 0
+	return
+    }
+
+    # Like 'The' above, except that the fileset is taken from the
+    # specified variable. Semi-complementary to 'Save' below.
+    # Exclusion data and recursion info do not apply for this, this is
+    # already implicitly covered by the set, when it was generated.
+
+    method TheSet {varname} {
+	# See 'Save' for the levels we jump here.
+	upvar 5 $varname var
+
+	run_next_while {as from into in to}
+
+	switch -exact -- $op {
+	    invoke {Invoke [Resolve $var]}
+	    move   {Move   [Resolve $var]}
+	    copy   {Copy   [Resolve $var]}
+	    remove {Remove          $var }
+	    expand {
+		return -code error "Expansion does not make sense\
+                                    when we already have a set of files."
+	    }
+	}
+
+	# Reset the per-pattern flags of the resolution context back
+	# to their defaults, for the next pattern.
+
+	set alias    {}
+	return
+    }
+
+    # Save the last expansion result to a variable for use by future commands.
+
+    method Save {varname} {
+	# Levels to jump. Brittle.
+	# 5: Caller
+	# 4:   object do ...
+	# 3:     runl
+	# 2:       wip::runl
+	# 1:         run_next
+	# 0: Here
+	upvar 5 $varname v
+	set v $lastexpansion
+	return
+    }
+
+    # Platform conditionals ...
+
+    method ForUnix {} {
+	global tcl_platform
+	if {$tcl_platform(platform) eq "unix"} return
+	# Kill the remaining code. This effectively aborts processing.
+	replacel {}
+	return
+    }
+
+    method ForWindows {} {
+	global tcl_platform
+	if {$tcl_platform(platform) eq "windows"} return
+	# Kill the remaining code. This effectively aborts processing.
+	replacel {}
+	return
+    }
+
+    # Strictness
+
+    method Strict {} {
+	set strict 1
+	return
+    }
+
+    method NotStrict {} {
+	set strict 0
+	return
+    }
+
+    # Type qualifiers
+
+    method Files {} {
+	set types files
+	return
+    }
+
+    method Links {} {
+	set types links
+	return
+    }
+
+    method Directories {} {
+	set types dirs
+	return
+    }
+
+    method Everything {} {
+	set types {}
+	return
+    }
+
+    # State interogation
+
+    method QueryState {} {
+	return [list \
+		    from      $src \
+		    into      $base \
+		    as        $alias \
+		    op        $op \
+		    excluded  $excl \
+		    recursive $recursive \
+		    type      $types \
+		    strict    $strict \
+		   ]
+    }
+    method QueryExcluded {} {
+	return $excl
+    }
+    method QueryFrom {} {
+	return $src
+    }
+    method QueryInto {} {
+	return $base
+    }
+    method QueryAs {} {
+	return $alias
+    }
+    method QueryOperation {} {
+	return $op
+    }
+    method QueryRecursive {} {
+	return $recursive
+    }
+    method QueryType {} {
+	return $types
+    }
+    method QueryStrict {} {
+	return $strict
+    }
+
+    # ### ### ### ######### ######### #########
+    ## DSL State
+
+    component stack       ; # State stack     - ( )
+    variable  base     "" ; # Destination dir - into, in, cd, up
+    variable  alias    "" ; # Detail          - as
+    variable  op       "" ; # Operation       - move, copy, remove, expand, invoke
+    variable  opcmd    "" ; # Command prefix for invoke.
+    variable  recursive 0 ; # Op. qualifier: recursive expansion?
+    variable  src      "" ; # Source dir      - from
+    variable  excl     "" ; # Excluded files  - but not|exclude, except for
+    # incl                ; # Included files  - the (immediate use)
+    variable types     {} ; # Limit glob/find to specific types (f, l, d).
+    variable strict    0  ; # Strictness of into/Expand
+
+    variable lastexpansion "" ; # Area for last expansion result, for 'Save' to take from.
+
+    # ### ### ### ######### ######### #########
+    ## Internal -- Path manipulation helpers.
+
+    proc ForceRelative {path} {
+	set pathtype [file pathtype $path]
+	switch -exact -- $pathtype {
+	    relative {
+		return $path
+	    }
+	    absolute {
+		# Chop off the first element in the path, which is the
+		# root, either '/' or 'x:/'. If this was the only
+		# element assume an empty path.
+
+		set path [lrange [file split $path] 1 end]
+		if {![llength $path]} {return {}}
+		return [eval [linsert $path 0 file join]]
+	    }
+	    volumerelative {
+		return -code error {Unable to handle volumerelative path, yet}
+	    }
+	}
+
+	return -code error \
+	    "file pathtype returned unknown type \"$pathtype\""
+    }
+
+    proc ForceAbsolute {path} {
+	return [file join [pwd] $path]
+    }
+
+    # ### ### ### ######### ######### #########
+    ## Internal - Operation execution helpers
+
+    proc Invoke {files} {
+	upvar 1 base base src src opcmd opcmd
+	uplevel #0 [linsert $opcmd end $src $base $files]
+	return
+    }
+
+    proc Move {files} {
+	upvar 1 base base src src
+
+	foreach {s d} $files {
+	    set s [file join $src  $s]
+	    set d [file join $base $d]
+
+	    file mkdir [file dirname $d]
+	    file rename -force $s $d
+	}
+	return
+    }
+
+    proc Copy {files} {
+	upvar 1 base base src src
+
+	foreach {s d} $files {
+	    set s [file join $src  $s]
+	    set d [file join $base $d]
+
+	    file mkdir [file dirname $d]
+	    if {
+		[file isdirectory $s] &&
+		[file exists      $d] &&
+		[file isdirectory $d]
+	    } {
+		# Special case: source and destination are
+		# directories, and the latter exists. This puts the
+		# source under the destination, and may even prevent
+		# copying at all. The semantics of the operation is
+		# that the source is the destination. We avoid the
+		# trouble by copying the contents of the source,
+		# instead of the directory itself.
+		foreach path [glob -directory $s *] {
+		    file copy -force $path $d
+		}
+	    } else {
+		file copy -force $s $d
+	    }
+	}
+	return
+    }
+
+    proc Remove {files} {
+	upvar 1 base base
+
+	foreach f $files {
+	    file delete -force [file join $base $f]
+	}
+	return
+    }
+
+    # ### ### ### ######### ######### #########
+    ## Internal -- Resolution helper commands
+
+    typevariable tmap -array {
+	files {f TFile}
+	links {l TLink}
+	dirs  {d TDir}
+	{}    {{} {}}
+    }
+
+    proc Expand {dir pattern} {
+	upvar 1 recursive recursive strict strict types types tmap tmap
+	# FUTURE: struct::list filter ...
+
+	set files {}
+	if {$recursive} {
+	    # Recursion through the entire directory hierarchy, save
+	    # all matching paths.
+
+	    set filter [lindex $tmap($types) 1]
+	    if {$filter ne ""} {
+		set filter [myproc $filter]
+	    }
+
+	    foreach f [fileutil::find $dir $filter] {
+		if {![string match $pattern [file tail $f]]} continue
+		lappend files [fileutil::stripPath $dir $f]
+	    }
+	} else {
+	    # No recursion, just scan the whole directory for matching paths.
+	    # check for specific types integrated.
+
+	    set filter [lindex $tmap($types) 0]
+	    if {$filter ne ""} {
+		foreach f [glob -nocomplain -directory $dir -types $filter -- $pattern] {
+		    lappend files [fileutil::stripPath $dir $f]
+		}
+	    } else {
+		foreach f [glob -nocomplain -directory $dir -- $pattern] {
+		    lappend files [fileutil::stripPath $dir $f]
+		}
+	    }
+	}
+
+	if {[llength $files]} {return $files}
+	if {!$strict}         {return {}}
+
+	return -code error \
+	    "No files matching pattern \"$pattern\" in directory \"$dir\""
+    }
+
+    proc TFile {f} {file isfile $f}
+    proc TDir  {f} {file isdirectory $f}
+    proc TLink {f} {expr {[file type $f] eq "link"}}
+
+    proc Exclude {files} {
+	upvar 1 excl excl
+
+	# FUTURE: struct::list filter ...
+	set res {}
+	foreach f $files {
+	    if {[IsExcluded $f $excl]} continue
+	    lappend res $f
+	}
+	return $res
+    }
+
+    proc IsExcluded {f patterns} {
+	foreach p $patterns {
+	    if {[string match $p $f]} {return 1}
+	}
+	return 0
+    }
+
+    proc Resolve {files} {
+	upvar 1 alias alias
+	set res {}
+	foreach f $files {
+
+	    # Remember alias for processing and auto-invalidate to
+	    # prevent contamination of the next file.
+
+	    set thealias $alias
+	    set alias    ""
+
+	    if {$thealias eq ""} {
+		set d $f
+	    } else {
+		set d [file dirname $f]
+		if {$d eq "."} {
+		    set d $thealias
+		} else {
+		    set d [file join $d $thealias]
+		}
+	    }
+
+	    lappend res $f $d
+	}
+	return $res
+    }
+
+    proc Remember {files} {
+	upvar 1 lastexpansion lastexpansion
+	set lastexpansion $files
+	return $files
+    }
+
+    ##
+    # ### ### ### ######### ######### #########
+}
+
+# ### ### ### ######### ######### #########
+## Ready
+
+package provide fileutil::multi::op 0.5.4

src/bootsupport/lib/fileutil/paths.tcl

@@ -12,7 +12,7 @@
 # ### ### ### ######### ######### #########
 ## Requisites
 
-package require Tcl 8.4
+package require Tcl 8.5 9
 package require snit
 
 # ### ### ### ######### ######### #########
@@ -70,5 +70,5 @@ snit::type ::fileutil::paths {
 # ### ### ### ######### ######### #########
 ## Ready
 
-package provide fileutil::paths 1
+package provide fileutil::paths 1.1
 return

src/bootsupport/lib/fileutil/pkgIndex.tcl

@@ -0,0 +1,7 @@
+if {![package vsatisfies [package provide Tcl] 8.5 9]} {return}
+package ifneeded fileutil 1.16.2 [list source [file join $dir fileutil.tcl]]
+package ifneeded fileutil::traverse  0.7   [list source [file join $dir traverse.tcl]]
+package ifneeded fileutil::multi     0.2   [list source [file join $dir multi.tcl]]
+package ifneeded fileutil::multi::op 0.5.4 [list source [file join $dir multiop.tcl]]
+package ifneeded fileutil::decode    0.2.2 [list source [file join $dir decode.tcl]]
+package ifneeded fileutil::paths     1.1   [list source [file join $dir paths.tcl]]

src/bootsupport/lib/fileutil/traverse.tcl

@@ -7,10 +7,10 @@
 # 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.3
+package require Tcl 8.5 9
 
 # OO core
-if {[package vsatisfies [package present Tcl] 8.5]} {
+if {[package vsatisfies [package present Tcl] 8.5 9]} {
     # Use new Tcl 8.5a6+ features to specify the allowed packages.
     # We can use anything above 1.3. This means v2 as well.
     package require snit 1.3-
@@ -336,169 +336,58 @@ snit::type ::fileutil::traverse {
 # ### ### ### ######### ######### #########
 ##
 
-# The next three helper commands for the traverser depend strongly on
+# Tcl 8.5+.
-# the version of Tcl, and partially on the platform.
+# We have to check readability of "current" on our own, glob
+# changed to error out instead of returning nothing.
 
-# 1. In Tcl 8.3 using -types f will return only true files, but not
+proc ::fileutil::traverse::ACCESS {args} {return 1}
-#    links to files. This changed in 8.4+ where links to files are
-#    returned as well. So for 8.3 we have to handle the links
-#    separately (-types l) and also filter on our own.
-#    Note that Windows file links are hard links which are reported by
-#    -types f, but not -types l, so we can optimize that for the two
-#    platforms.
-#
-# 2. In Tcl 8.3 we also have a crashing bug in glob (SIGABRT, "stat on
-#    a known file") when trying to perform 'glob -types {hidden f}' on
-#    a directory without e'x'ecute permissions. We code around by
-#    testing if we can cd into the directory (stat might return enough
-#    information too (mode), but possibly also not portable).
-#
-#    For Tcl 8.2 and 8.4+ glob simply delivers an empty result
-#    (-nocomplain), without crashing. For them this command is defined
-#    so that the bytecode compiler removes it from the bytecode.
-#
-#    This bug made the ACCESS helper necessary.
-#    We code around the problem by testing if we can cd into the
-#    directory (stat might return enough information too (mode), but
-#    possibly also not portable).
-
-if {[package vsatisfies [package present Tcl] 8.5]} {
-    # Tcl 8.5+.
-    # We have to check readability of "current" on our own, glob
-    # changed to error out instead of returning nothing.
-
-    proc ::fileutil::traverse::ACCESS {args} {return 1}
-
-    proc ::fileutil::traverse::GLOBF {current} {
-	if {![file readable $current] ||
-	    [BadLink $current]} {
-	    return {}
-	}
-
-	set res [lsort -unique [concat \
-		     [glob -nocomplain -directory $current -types f          -- *] \
-		     [glob -nocomplain -directory $current -types {hidden f} -- *]]]
-
-	# Look for broken links (They are reported as neither file nor directory).
-	foreach l [lsort -unique [concat \
-		       [glob -nocomplain -directory $current -types l          -- *] \
-		       [glob -nocomplain -directory $current -types {hidden l} -- *]]] {
-	    if {[file isfile      $l]} continue
-	    if {[file isdirectory $l]} continue
-	    lappend res $l
-	}
-	return [lsort -unique $res]
-    }
 
-    proc ::fileutil::traverse::GLOBD {current} {
+proc ::fileutil::traverse::GLOBF {current} {
-	if {![file readable $current] ||
+    if {![file readable $current] ||
-	    [BadLink $current]} {
+	[BadLink $current]} {
-	    return {}
+	return {}
-	}
-
-	lsort -unique [concat \
-	   [glob -nocomplain -directory $current -types d          -- *] \
-	   [glob -nocomplain -directory $current -types {hidden d} -- *]]
     }
 
-    proc ::fileutil::traverse::BadLink {current} {
+    set res [lsort -unique [concat \
-	if {[file type $current] ne "link"} { return no }
+				[glob -nocomplain -directory $current -types f          -- *] \
-
+				[glob -nocomplain -directory $current -types {hidden f} -- *]]]
-	set dst [file join [file dirname $current] [file readlink $current]]
+
-
+    # Look for broken links (They are reported as neither file nor directory).
-	if {![file exists   $dst] ||
+    foreach l [lsort -unique [concat \
-	    ![file readable $dst]} {
+				  [glob -nocomplain -directory $current -types l          -- *] \
-	    return yes
+				  [glob -nocomplain -directory $current -types {hidden l} -- *]]] {
-	}
+	if {[file isfile      $l]} continue
-
+	if {[file isdirectory $l]} continue
-	return no
+	lappend res $l
     }
+    return [lsort -unique $res]
+}
 
-} elseif {[package vsatisfies [package present Tcl] 8.4]} {
+proc ::fileutil::traverse::GLOBD {current} {
-    # Tcl 8.4+.
+    if {![file readable $current] ||
-    # (Ad 1) We have -directory, and -types,
+	[BadLink $current]} {
-    # (Ad 2) Links are returned for -types f/d if they refer to files/dirs.
+	return {}
-    # (Ad 3) No bug to code around
-
-    proc ::fileutil::traverse::ACCESS {args} {return 1}
-
-    proc ::fileutil::traverse::GLOBF {current} {
-	set res [concat \
-		     [glob -nocomplain -directory $current -types f          -- *] \
-		     [glob -nocomplain -directory $current -types {hidden f} -- *]]
-
-	# Look for broken links (They are reported as neither file nor directory).
-	foreach l [concat \
-		       [glob -nocomplain -directory $current -types l          -- *] \
-		       [glob -nocomplain -directory $current -types {hidden l} -- *] ] {
-	    if {[file isfile      $l]} continue
-	    if {[file isdirectory $l]} continue
-	    lappend res $l
-	}
-	return $res
     }
 
-    proc ::fileutil::traverse::GLOBD {current} {
+    lsort -unique [concat \
-	concat \
+		       [glob -nocomplain -directory $current -types d          -- *] \
-	    [glob -nocomplain -directory $current -types d          -- *] \
+		       [glob -nocomplain -directory $current -types {hidden d} -- *]]
-	    [glob -nocomplain -directory $current -types {hidden d} -- *]
+}
-    }
 
-} else {
+proc ::fileutil::traverse::BadLink {current} {
-    # 8.3.
+    if {[file type $current] ne "link"} { return no }
-    # (Ad 1) We have -directory, and -types,
-    # (Ad 2) Links are NOT returned for -types f/d, collect separately.
-    #        No symbolic file links on Windows.
-    # (Ad 3) Bug to code around.
-
-    proc ::fileutil::traverse::ACCESS {current} {
-	if {[catch {
-	    set h [pwd] ; cd $current ; cd $h
-	}]} {return 0}
-	return 1
-    }
 
-    if {[string equal $::tcl_platform(platform) windows]} {
+    set dst [file join [file dirname $current] [file readlink $current]]
-	proc ::fileutil::traverse::GLOBF {current} {
-	    concat \
-		[glob -nocomplain -directory $current -types f          -- *] \
-		[glob -nocomplain -directory $current -types {hidden f} -- *]]
-	}
-    } else {
-	proc ::fileutil::traverse::GLOBF {current} {
-	    set l [concat \
-		       [glob -nocomplain -directory $current -types f          -- *] \
-		       [glob -nocomplain -directory $current -types {hidden f} -- *]]
-
-	    foreach x [concat \
-			   [glob -nocomplain -directory $current -types l          -- *] \
-			   [glob -nocomplain -directory $current -types {hidden l} -- *]] {
-		if {[file isdirectory $x]} continue
-		# We have now accepted files, links to files, and broken links.
-		lappend l $x
-	    }
 
-	    return $l
+    if {![file exists   $dst] ||
-	}
+	![file readable $dst]} {
+	return yes
     }
 
-    proc ::fileutil::traverse::GLOBD {current} {
+    return no
-	set l [concat \
-		   [glob -nocomplain -directory $current -types d          -- *] \
-		   [glob -nocomplain -directory $current -types {hidden d} -- *]]
-
-	foreach x [concat \
-		       [glob -nocomplain -directory $current -types l          -- *] \
-		       [glob -nocomplain -directory $current -types {hidden l} -- *]] {
-	    if {![file isdirectory $x]} continue
-	    lappend l $x
-	}
-
-	return $l
-    }
 }
 
 # ### ### ### ######### ######### #########
 ## Ready
 
-package provide fileutil::traverse 0.6
+package provide fileutil::traverse 0.7

src/bootsupport/lib/snit/pkgIndex.tcl

@@ -0,0 +1,6 @@
+if {[package vsatisfies [package provide Tcl] 8.5 9]} {
+    package ifneeded snit 2.3.3 \
+        [list source [file join $dir snit2.tcl]]
+}
+
+package ifneeded snit 1.4.2 [list source [file join $dir snit.tcl]]

src/bootsupport/lib/snit/snit.tcl

@@ -0,0 +1,32 @@
+#-----------------------------------------------------------------------
+# TITLE:
+#	snit.tcl
+#
+# AUTHOR:
+#	Will Duquette
+#
+# DESCRIPTION:
+#       Snit's Not Incr Tcl, a simple object system in Pure Tcl.
+#
+#       Snit 1.x Loader 
+#
+#       Copyright (C) 2003-2006 by William H. Duquette
+#       This code is licensed as described in license.txt.
+#
+#-----------------------------------------------------------------------
+
+package require Tcl 8.5 9
+
+# Define the snit namespace and save the library directory
+
+namespace eval ::snit:: {
+    set library [file dirname [info script]]
+}
+
+source [file join $::snit::library main1.tcl]
+
+# Load the library of Snit validation types.
+
+source [file join $::snit::library validate.tcl]
+
+package provide snit 1.4.2

src/bootsupport/lib/snit/snit2.tcl

@@ -0,0 +1,32 @@
+#-----------------------------------------------------------------------
+# TITLE:
+#	snit2.tcl
+#
+# AUTHOR:
+#	Will Duquette
+#
+# DESCRIPTION:
+#       Snit's Not Incr Tcl, a simple object system in Pure Tcl.
+#
+#       Snit 2.x Loader
+#
+#       Copyright (C) 2003-2006 by William H. Duquette
+#       This code is licensed as described in license.txt.
+#
+#-----------------------------------------------------------------------
+
+package require Tcl 8.5 9
+
+# Define the snit namespace and save the library directory
+
+namespace eval ::snit:: {
+    set library [file dirname [info script]]
+}
+
+# Load the kernel.
+source [file join $::snit::library main2.tcl]
+
+# Load the library of Snit validation types.
+source [file join $::snit::library validate.tcl]
+
+package provide snit 2.3.3

src/bootsupport/lib/snit/validate.tcl

@@ -0,0 +1,720 @@
+#-----------------------------------------------------------------------
+# TITLE:
+#    validate.tcl
+#
+# AUTHOR:
+#    Will Duquette
+#
+# DESCRIPTION:
+#    Snit validation types.
+#
+#-----------------------------------------------------------------------
+
+namespace eval ::snit:: { 
+    namespace export \
+        boolean \
+        double \
+        enum \
+        fpixels \
+        integer \
+        listtype \
+        pixels \
+        stringtype \
+        window
+}
+
+#-----------------------------------------------------------------------
+# snit::boolean
+
+snit::type ::snit::boolean {
+    #-------------------------------------------------------------------
+    # Type Methods
+
+    typemethod validate {value} {
+        if {![string is boolean -strict $value]} {
+            return -code error -errorcode INVALID \
+   "invalid boolean \"$value\", should be one of: 1, 0, true, false, yes, no, on, off"
+
+        }
+
+        return $value
+    }
+
+    #-------------------------------------------------------------------
+    # Constructor
+
+    # None needed; no options
+
+    #-------------------------------------------------------------------
+    # Public Methods
+
+    method validate {value} {
+        $type validate $value
+    }
+}
+
+#-----------------------------------------------------------------------
+# snit::double
+
+snit::type ::snit::double {
+    #-------------------------------------------------------------------
+    # Options
+
+    # -min value
+    #
+    # Minimum value
+
+    option -min -default "" -readonly 1
+
+    # -max value
+    #
+    # Maximum value
+
+    option -max -default "" -readonly 1
+
+    #-------------------------------------------------------------------
+    # Type Methods
+
+    typemethod validate {value} {
+        if {![string is double -strict $value]} {
+            return -code error -errorcode INVALID \
+                "invalid value \"$value\", expected double"
+        }
+
+        return $value
+    }
+
+    #-------------------------------------------------------------------
+    # Constructor
+
+    constructor {args} {
+        # FIRST, get the options
+        $self configurelist $args
+
+        if {"" != $options(-min) && 
+            ![string is double -strict $options(-min)]} {
+            return -code error \
+                "invalid -min: \"$options(-min)\""
+        }
+
+        if {"" != $options(-max) && 
+            ![string is double -strict $options(-max)]} {
+            return -code error \
+                "invalid -max: \"$options(-max)\""
+        }
+
+        if {"" != $options(-min) &&
+            "" != $options(-max) && 
+            $options(-max) < $options(-min)} {
+            return -code error "-max < -min"
+        }
+    }
+
+    #-------------------------------------------------------------------
+    # Public Methods
+
+    # Fixed method for the snit::double type.
+    # WHD, 6/7/2010.
+    method validate {value} {
+        $type validate $value
+
+        if {("" != $options(-min) && $value < $options(-min))       ||
+            ("" != $options(-max) && $value > $options(-max))} {
+
+            set msg "invalid value \"$value\", expected double"
+
+            if {"" != $options(-min) && "" != $options(-max)} {
+                append msg " in range $options(-min), $options(-max)"
+            } elseif {"" != $options(-min)} {
+                append msg " no less than $options(-min)"
+            } elseif {"" != $options(-max)} {
+                append msg " no greater than $options(-max)"
+            }
+        
+            return -code error -errorcode INVALID $msg
+        }
+
+        return $value
+    }
+}
+
+#-----------------------------------------------------------------------
+# snit::enum
+
+snit::type ::snit::enum {
+    #-------------------------------------------------------------------
+    # Options
+
+    # -values list
+    #
+    # Valid values for this type
+
+    option -values -default {} -readonly 1
+
+    #-------------------------------------------------------------------
+    # Type Methods
+
+    typemethod validate {value} {
+        # No -values specified; it's always valid
+        return $value
+    }
+
+    #-------------------------------------------------------------------
+    # Constructor
+
+    constructor {args} {
+        $self configurelist $args
+
+        if {[llength $options(-values)] == 0} {
+            return -code error \
+                "invalid -values: \"\""
+        }
+    }
+
+    #-------------------------------------------------------------------
+    # Public Methods
+
+    method validate {value} {
+        if {[lsearch -exact $options(-values) $value] == -1} {
+            return -code error -errorcode INVALID \
+    "invalid value \"$value\", should be one of: [join $options(-values) {, }]"
+        }
+        
+        return $value
+    }
+}
+
+#-----------------------------------------------------------------------
+# snit::fpixels
+
+snit::type ::snit::fpixels {
+    #-------------------------------------------------------------------
+    # Options
+
+    # -min value
+    #
+    # Minimum value
+
+    option -min -default "" -readonly 1
+
+    # -max value
+    #
+    # Maximum value
+
+    option -max -default "" -readonly 1
+
+    #-------------------------------------------------------------------
+    # Instance variables
+
+    variable min ""  ;# -min, no suffix
+    variable max ""  ;# -max, no suffix
+
+    #-------------------------------------------------------------------
+    # Type Methods
+
+    typemethod validate {value} {
+        if {[catch {winfo fpixels . $value} dummy]} {
+            return -code error -errorcode INVALID \
+                "invalid value \"$value\", expected fpixels"
+        }
+
+        return $value
+    }
+
+    #-------------------------------------------------------------------
+    # Constructor
+
+    constructor {args} {
+        # FIRST, get the options
+        $self configurelist $args
+
+        if {"" != $options(-min) && 
+            [catch {winfo fpixels . $options(-min)} min]} {
+            return -code error \
+                "invalid -min: \"$options(-min)\""
+        }
+
+        if {"" != $options(-max) && 
+            [catch {winfo fpixels . $options(-max)} max]} {
+            return -code error \
+                "invalid -max: \"$options(-max)\""
+        }
+
+        if {"" != $min &&
+            "" != $max && 
+            $max < $min} {
+            return -code error "-max < -min"
+        }
+    }
+
+    #-------------------------------------------------------------------
+    # Public Methods
+
+    method validate {value} {
+        $type validate $value
+        
+        set val [winfo fpixels . $value]
+
+        if {("" != $min && $val < $min) ||
+            ("" != $max && $val > $max)} {
+
+            set msg "invalid value \"$value\", expected fpixels"
+
+            if {"" != $min && "" != $max} {
+                append msg " in range $options(-min), $options(-max)"
+            } elseif {"" != $min} {
+                append msg " no less than $options(-min)"
+            }
+        
+            return -code error -errorcode INVALID $msg
+        }
+
+        return $value
+    }
+}
+
+#-----------------------------------------------------------------------
+# snit::integer
+
+snit::type ::snit::integer {
+    #-------------------------------------------------------------------
+    # Options
+
+    # -min value
+    #
+    # Minimum value
+
+    option -min -default "" -readonly 1
+
+    # -max value
+    #
+    # Maximum value
+
+    option -max -default "" -readonly 1
+
+    #-------------------------------------------------------------------
+    # Type Methods
+
+    typemethod validate {value} {
+        if {![string is integer -strict $value]} {
+            return -code error -errorcode INVALID \
+                "invalid value \"$value\", expected integer"
+        }
+
+        return $value
+    }
+
+    #-------------------------------------------------------------------
+    # Constructor
+
+    constructor {args} {
+        # FIRST, get the options
+        $self configurelist $args
+
+        if {"" != $options(-min) && 
+            ![string is integer -strict $options(-min)]} {
+            return -code error \
+                "invalid -min: \"$options(-min)\""
+        }
+
+        if {"" != $options(-max) && 
+            ![string is integer -strict $options(-max)]} {
+            return -code error \
+                "invalid -max: \"$options(-max)\""
+        }
+
+        if {"" != $options(-min) &&
+            "" != $options(-max) && 
+            $options(-max) < $options(-min)} {
+            return -code error "-max < -min"
+        }
+    }
+
+    #-------------------------------------------------------------------
+    # Public Methods
+
+    method validate {value} {
+        $type validate $value
+
+        if {("" != $options(-min) && $value < $options(-min))       ||
+            ("" != $options(-max) && $value > $options(-max))} {
+
+            set msg "invalid value \"$value\", expected integer"
+
+            if {"" != $options(-min) && "" != $options(-max)} {
+                append msg " in range $options(-min), $options(-max)"
+            } elseif {"" != $options(-min)} {
+                append msg " no less than $options(-min)"
+            }
+        
+            return -code error -errorcode INVALID $msg
+        }
+
+        return $value
+    }
+}
+
+#-----------------------------------------------------------------------
+# snit::list
+
+snit::type ::snit::listtype {
+    #-------------------------------------------------------------------
+    # Options
+
+    # -type type
+    #
+    # Specifies a value type
+
+    option -type -readonly 1
+
+    # -minlen len
+    #
+    # Minimum list length
+
+    option -minlen -readonly 1 -default 0
+
+    # -maxlen len
+    #
+    # Maximum list length
+
+    option -maxlen -readonly 1
+
+    #-------------------------------------------------------------------
+    # Type Methods
+
+    typemethod validate {value} {
+        if {[catch {llength $value} result]} {
+            return -code error -errorcode INVALID \
+                "invalid value \"$value\", expected list"
+        }
+
+        return $value
+    }
+
+    #-------------------------------------------------------------------
+    # Constructor
+    
+    constructor {args} {
+        # FIRST, get the options
+        $self configurelist $args
+
+        if {"" != $options(-minlen) && 
+            (![string is integer -strict $options(-minlen)] ||
+             $options(-minlen) < 0)} {
+            return -code error \
+                "invalid -minlen: \"$options(-minlen)\""
+        }
+
+        if {"" == $options(-minlen)} {
+            set options(-minlen) 0
+        }
+
+        if {"" != $options(-maxlen) && 
+            ![string is integer -strict $options(-maxlen)]} {
+            return -code error \
+                "invalid -maxlen: \"$options(-maxlen)\""
+        }
+
+        if {"" != $options(-maxlen) && 
+            $options(-maxlen) < $options(-minlen)} {
+            return -code error "-maxlen < -minlen"
+        }
+    }
+
+
+    #-------------------------------------------------------------------
+    # Methods
+
+    method validate {value} {
+        $type validate $value
+
+        set len [llength $value]
+
+        if {$len < $options(-minlen)} {
+            return -code error -errorcode INVALID \
+              "value has too few elements; at least $options(-minlen) expected"
+        } elseif {"" != $options(-maxlen)} {
+            if {$len > $options(-maxlen)} {
+                return -code error -errorcode INVALID \
+         "value has too many elements; no more than $options(-maxlen) expected"
+            }
+        }
+
+        # NEXT, check each value
+        if {"" != $options(-type)} {
+            foreach item $value {
+                set cmd $options(-type)
+                lappend cmd validate $item
+                uplevel \#0 $cmd
+            }
+        }
+        
+        return $value
+    }
+}
+
+#-----------------------------------------------------------------------
+# snit::pixels
+
+snit::type ::snit::pixels {
+    #-------------------------------------------------------------------
+    # Options
+
+    # -min value
+    #
+    # Minimum value
+
+    option -min -default "" -readonly 1
+
+    # -max value
+    #
+    # Maximum value
+
+    option -max -default "" -readonly 1
+
+    #-------------------------------------------------------------------
+    # Instance variables
+
+    variable min ""  ;# -min, no suffix
+    variable max ""  ;# -max, no suffix
+
+    #-------------------------------------------------------------------
+    # Type Methods
+
+    typemethod validate {value} {
+        if {[catch {winfo pixels . $value} dummy]} {
+            return -code error -errorcode INVALID \
+                "invalid value \"$value\", expected pixels"
+        }
+
+        return $value
+    }
+
+    #-------------------------------------------------------------------
+    # Constructor
+
+    constructor {args} {
+        # FIRST, get the options
+        $self configurelist $args
+
+        if {"" != $options(-min) && 
+            [catch {winfo pixels . $options(-min)} min]} {
+            return -code error \
+                "invalid -min: \"$options(-min)\""
+        }
+
+        if {"" != $options(-max) && 
+            [catch {winfo pixels . $options(-max)} max]} {
+            return -code error \
+                "invalid -max: \"$options(-max)\""
+        }
+
+        if {"" != $min &&
+            "" != $max && 
+            $max < $min} {
+            return -code error "-max < -min"
+        }
+    }
+
+    #-------------------------------------------------------------------
+    # Public Methods
+
+    method validate {value} {
+        $type validate $value
+        
+        set val [winfo pixels . $value]
+
+        if {("" != $min && $val < $min) ||
+            ("" != $max && $val > $max)} {
+
+            set msg "invalid value \"$value\", expected pixels"
+
+            if {"" != $min && "" != $max} {
+                append msg " in range $options(-min), $options(-max)"
+            } elseif {"" != $min} {
+                append msg " no less than $options(-min)"
+            }
+        
+            return -code error -errorcode INVALID $msg
+        }
+
+        return $value
+    }
+}
+
+#-----------------------------------------------------------------------
+# snit::stringtype
+
+snit::type ::snit::stringtype {
+    #-------------------------------------------------------------------
+    # Options
+
+    # -minlen len
+    #
+    # Minimum list length
+
+    option -minlen -readonly 1 -default 0
+
+    # -maxlen len
+    #
+    # Maximum list length
+
+    option -maxlen -readonly 1
+
+    # -nocase 0|1
+    #
+    # globs and regexps are case-insensitive if -nocase 1.
+
+    option -nocase -readonly 1 -default 0
+
+    # -glob pattern
+    #
+    # Glob-match pattern, or ""
+
+    option -glob -readonly 1
+
+    # -regexp regexp
+    #
+    # Regular expression to match
+    
+    option -regexp -readonly 1
+    
+    #-------------------------------------------------------------------
+    # Type Methods
+
+    typemethod validate {value} {
+        # By default, any string (hence, any Tcl value) is valid.
+        return $value
+    }
+
+    #-------------------------------------------------------------------
+    # Constructor
+    
+    constructor {args} {
+        # FIRST, get the options
+        $self configurelist $args
+
+        # NEXT, validate -minlen and -maxlen
+        if {"" != $options(-minlen) && 
+            (![string is integer -strict $options(-minlen)] ||
+             $options(-minlen) < 0)} {
+            return -code error \
+                "invalid -minlen: \"$options(-minlen)\""
+        }
+
+        if {"" == $options(-minlen)} {
+            set options(-minlen) 0
+        }
+
+        if {"" != $options(-maxlen) && 
+            ![string is integer -strict $options(-maxlen)]} {
+            return -code error \
+                "invalid -maxlen: \"$options(-maxlen)\""
+        }
+
+        if {"" != $options(-maxlen) && 
+            $options(-maxlen) < $options(-minlen)} {
+            return -code error "-maxlen < -minlen"
+        }
+
+        # NEXT, validate -nocase
+        if {[catch {snit::boolean validate $options(-nocase)} result]} {
+            return -code error "invalid -nocase: $result"
+        }
+
+        # Validate the glob
+        if {"" != $options(-glob) && 
+            [catch {string match $options(-glob) ""} dummy]} {
+            return -code error \
+                "invalid -glob: \"$options(-glob)\""
+        }
+
+        # Validate the regexp
+        if {"" != $options(-regexp) && 
+            [catch {regexp $options(-regexp) ""} dummy]} {
+            return -code error \
+                "invalid -regexp: \"$options(-regexp)\""
+        }
+    }
+
+
+    #-------------------------------------------------------------------
+    # Methods
+
+    method validate {value} {
+        # Usually we'd call [$type validate $value] here, but
+        # as it's a no-op, don't bother.
+
+        # FIRST, validate the length.
+        set len [string length $value]
+
+        if {$len < $options(-minlen)} {
+            return -code error -errorcode INVALID \
+              "too short: at least $options(-minlen) characters expected"
+        } elseif {"" != $options(-maxlen)} {
+            if {$len > $options(-maxlen)} {
+                return -code error -errorcode INVALID \
+         "too long: no more than $options(-maxlen) characters expected"
+            }
+        }
+
+        # NEXT, check the glob match, with or without case.
+        if {"" != $options(-glob)} {
+            if {$options(-nocase)} {
+                set result [string match -nocase $options(-glob) $value]
+            } else {
+                set result [string match $options(-glob) $value]
+            }
+            
+            if {!$result} {
+                return -code error -errorcode INVALID \
+                    "invalid value \"$value\""
+            }
+        }
+        
+        # NEXT, check regexp match with or without case
+        if {"" != $options(-regexp)} {
+            if {$options(-nocase)} {
+                set result [regexp -nocase -- $options(-regexp) $value]
+            } else {
+                set result [regexp -- $options(-regexp) $value]
+            }
+            
+            if {!$result} {
+                return -code error -errorcode INVALID \
+                    "invalid value \"$value\""
+            }
+        }
+        
+        return $value
+    }
+}
+
+#-----------------------------------------------------------------------
+# snit::window
+
+snit::type ::snit::window {
+    #-------------------------------------------------------------------
+    # Type Methods
+
+    typemethod validate {value} {
+        if {![winfo exists $value]} {
+            return -code error -errorcode INVALID \
+                "invalid value \"$value\", value is not a window"
+        }
+
+        return $value
+    }
+
+    #-------------------------------------------------------------------
+    # Constructor
+
+    # None needed; no options
+
+    #-------------------------------------------------------------------
+    # Public Methods
+
+    method validate {value} {
+        $type validate $value
+    }
+}

src/bootsupport/lib/struct/disjointset.tcl

@@ -17,7 +17,7 @@
 #   - https://dl.acm.org/citation.cfm?doid=364099.364331
 #
 
-package require Tcl 8.6
+package require Tcl 8.6 9
 
 # Initialize the disjointset structure namespace. Note that any
 # missing parent namespace (::struct) will be automatically created as
@@ -381,5 +381,5 @@ namespace eval ::struct {
     namespace export disjointset
 }
 
-package provide struct::disjointset 1.1
+package provide struct::disjointset 1.2
 return

src/bootsupport/lib/struct/graph.tcl

@@ -9,7 +9,7 @@
 
 # @mdgen EXCLUDE: graph_c.tcl
 
-package require Tcl 8.4
+package require Tcl 8.5 9
 
 namespace eval ::struct::graph {}
 
@@ -33,7 +33,6 @@ proc ::struct::graph::LoadAccelerator {key} {
     switch -exact -- $key {
 	critcl {
 	    # Critcl implementation of graph 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::graph_critcl]]
 	}
@@ -175,4 +174,4 @@ namespace eval ::struct {
     namespace export graph
 }
 
-package provide struct::graph 2.4.3
+package provide struct::graph 2.4.4

src/bootsupport/lib/struct/graph1.tcl

@@ -2151,4 +2151,4 @@ namespace eval ::struct {
     namespace import -force graph::graph
     namespace export graph
 }
-package provide struct::graph 1.2.1
+package provide struct::graph 1.2.2

src/bootsupport/lib/struct/graph_c.tcl

@@ -11,8 +11,8 @@
 
 package require critcl
 # @sak notprovided struct_graphc
-package provide struct_graphc 2.4.3
+package provide struct_graphc 2.4.4
-package require Tcl 8.2
+package require Tcl 8.5 9
 
 namespace eval ::struct {
     # Supporting code for the main command.
@@ -55,7 +55,7 @@ namespace eval ::struct {
 	Tcl_CmdInfo ci;
 
 	if ((objc != 4) && (objc != 2) && (objc != 1)) {
-	    Tcl_WrongNumArgs (interp, 1, objv, USAGE);
+	    Tcl_WrongNumArgs (interp, 1, objv, USAGE); /* OK tcl9 */
 	    return TCL_ERROR;
 	}
 
@@ -74,11 +74,11 @@ namespace eval ::struct {
 	    Tcl_IncrRefCount (fqn);
 
 	    if (!Tcl_StringMatch (Tcl_GetString (fqn), "::")) {
-		Tcl_AppendToObj (fqn, "::", -1);
+		Tcl_AppendToObj (fqn, "::", -1); /* OK tcl9 */
 	    }
-	    Tcl_AppendToObj (fqn, name, -1);
+	    Tcl_AppendToObj (fqn, name, -1); /* OK tcl9 */
 	} else {
-	    fqn = Tcl_NewStringObj (name, -1);
+	    fqn = Tcl_NewStringObj (name, -1); /* OK tcl9 */
 	    Tcl_IncrRefCount (fqn);
 	}
 
@@ -88,9 +88,9 @@ namespace eval ::struct {
 	    Tcl_Obj* err;
 
 	    err = Tcl_NewObj ();
-	    Tcl_AppendToObj    (err, "command \"", -1);
+	    Tcl_AppendToObj    (err, "command \"", -1); /* OK tcl9 */
 	    Tcl_AppendObjToObj (err, fqn);
-	    Tcl_AppendToObj    (err, "\" already exists, unable to create graph", -1);
+	    Tcl_AppendToObj    (err, "\" already exists, unable to create graph", -1); /* OK tcl9 */
 
 	    Tcl_DecrRefCount (fqn);
 	    Tcl_SetObjResult (interp, err);
@@ -115,7 +115,7 @@ namespace eval ::struct {
 	    if (Tcl_GetIndexFromObj (interp, type, types, "type", 0, &srctype) != TCL_OK) {
 		Tcl_DecrRefCount (fqn);
 		Tcl_ResetResult  (interp);
-		Tcl_WrongNumArgs (interp, 1, objv, USAGE);
+		Tcl_WrongNumArgs (interp, 1, objv, USAGE); /* OK tcl9 */
 		return TCL_ERROR;
 	    }
 
@@ -144,9 +144,9 @@ namespace eval ::struct {
 	    g = g_new ();
 	}
 
-	g->cmd = Tcl_CreateObjCommand (interp, Tcl_GetString (fqn),
+	g->cmd = Tcl_CreateObjCommand2 (interp, Tcl_GetString (fqn),
-                                       g_objcmd, (ClientData) g,
+					g_objcmd, (ClientData) g,
-                                       gg_delete);
+					gg_delete);
 
 	Tcl_SetObjResult (interp, fqn);
 	Tcl_DecrRefCount (fqn);

src/bootsupport/lib/struct/graph_tcl.tcl

@@ -8,7 +8,7 @@
 # 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
+package require Tcl 8.5 9
 package require struct::list
 package require struct::set
 

src/bootsupport/lib/struct/graphops.tcl

@@ -13,7 +13,7 @@
 # ### ### ### ######### ######### #########
 ## Requisites
 
-package require Tcl 8.6
+package require Tcl 8.6 9
 
 package require struct::disjointset ; # Used by kruskal -- 8.6 required
 package require struct::prioqueue   ; # Used by kruskal, prim
@@ -3784,4 +3784,4 @@ namespace eval ::struct::graph::op {
     #namespace export ...
 }
 
-package provide struct::graph::op 0.11.3
+package provide struct::graph::op 0.11.4

src/bootsupport/lib/struct/list.tcl

@@ -13,7 +13,7 @@
 #
 #----------------------------------------------------------------------
 
-package require Tcl 8.4
+package require Tcl 8.5 9
 package require cmdline
 
 namespace eval ::struct { namespace eval list {} }
@@ -1831,4 +1831,4 @@ namespace eval ::struct {
     namespace import -force list::list
     namespace export list
 }
-package provide struct::list 1.8.5
+package provide struct::list 1.8.6

src/bootsupport/lib/struct/list.test.tcl

@@ -330,7 +330,7 @@ proc ::struct::list::test::main {} {
 
 	# In 8.6+ assign is the native lassign and it does nothing gracefully,
 	# per TIP 323, making assign-4.4 not an error anymore.
-	test assign-4.4 {assign method} {!tcl8.6plus} {
+    test assign-4.4 {assign method} tcl8.5only {
 		catch {assign {foo bar}} msg ; set msg
 	} $err
 
@@ -630,40 +630,20 @@ proc ::struct::list::test::main {} {
 
 	interp alias {} repeat {} ::struct::list::list repeat
 
-	if {[package vcompare [package provide Tcl] 8.5] < 0} {
-		# 8.4
-		set err [tcltest::wrongNumArgs {::struct::list::Lrepeat} {positiveCount value args} 0]
-	} elseif {![package vsatisfies [package provide Tcl] 8.6]} {
-		# 8.5+
-		#set err [tcltest::wrongNumArgs {lrepeat} {positiveCount value ?value ...?} 0]
-		set err [tcltest::wrongNumArgs {::struct::list::Lrepeat} {positiveCount value ?value ...?} 0]
-	} else {
-		# 8.6+
-		set err [tcltest::wrongNumArgs {::struct::list::Lrepeat} {count ?value ...?} 1]
-	}
 	test repeat-4.1 {repeat command} {
 		catch {repeat} msg
 		set msg
-	} $err
+	} [tcltest::byConstraint [list \
+            tcl8.6plus [tcltest::wrongNumArgs {::struct::list::Lrepeat} {count ?value ...?} 1] \
+            tcl8.5only [tcltest::wrongNumArgs {::struct::list::Lrepeat} {positiveCount value ?value ...?} 0]]]
 
 
-	if {[package vcompare [package provide Tcl] 8.5] < 0} {
-		# 8.4
-		set err [tcltest::wrongNumArgs {::struct::list::Lrepeat} {positiveCount value args} 1]
-	} elseif {![package vsatisfies [package provide Tcl] 8.6]} {
-		# 8.5+
-		#set err [tcltest::wrongNumArgs {lrepeat} {positiveCount value ?value ...?} 1]
-		set err [tcltest::wrongNumArgs {::struct::list::Lrepeat} {positiveCount value ?value ...?} 1]
-	} else {
-		# 8.6+
-		set err [tcltest::wrongNumArgs {::struct::list::Lrepeat} {count ?value ...?} 1]
-	}
 	# In 8.6+ repeat is the native lrepeat and it does nothing gracefully,
 	# per TIP 323, making repeat-4.2 not an error anymore.
-	test repeat-4.2 {repeat command} {!tcl8.6plus} {
+	test repeat-4.2 {repeat command} tcl8.5only {
 		catch {repeat a} msg
 		set msg
-	} $err
+	} [tcltest::wrongNumArgs {::struct::list::Lrepeat} {positiveCount value ?value ...?} 1]
 
 	test repeat-4.3 {repeat command} {
 		catch {repeat a b} msg
@@ -672,22 +652,18 @@ proc ::struct::list::test::main {} {
 
 	# In 8.6+ repeat is the native lrepeat and it does nothing gracefully,
 	# per TIP 323, making repeat-4.2 not an error anymore.
-	test repeat-4.4 {repeat command} {!tcl8.6plus} {
+	test repeat-4.4 {repeat command} tcl8.5only {
 		catch {repeat 0 b} msg
 		set msg
 	} {must have a count of at least 1}
 
-	if {![package vsatisfies [package provide Tcl] 8.6]} {
-		# before 8.6
-		set err {must have a count of at least 1}
-	} else {
-		# 8.6+, native lrepeat changed error message.
-		set err {bad count "-1": must be integer >= 0}
-	}
 	test repeat-4.5 {repeat command} {
 		catch {repeat -1 b} msg
 		set msg
-	} $err
+	} [tcltest::byConstraint {
+            tcl8.6plus {bad count "-1": must be integer >= 0}
+            tcl8.5only {must have a count of at least 1}
+        }]
 
 	test repeat-4.6 {repeat command} {
 		repeat 1 b c
@@ -1289,4 +1265,4 @@ proc ::struct::list::test::main {} {
 	}
 }
 
-package provide struct::list::test 1.8.4 
+package provide struct::list::test 1.8.5

src/bootsupport/lib/struct/map.tcl

@@ -13,7 +13,7 @@
 # ### ### ### ######### ######### #########
 ## Requisites
 
-package require Tcl 8.4
+package require Tcl 8.5 9
 package require snit
 
 # ### ### ### ######### ######### #########
@@ -100,5 +100,5 @@ snit::type ::struct::map::I {
 # ### ### ### ######### ######### #########
 ## Ready
 
-package provide struct::map 1
+package provide struct::map 1.1
 return

src/bootsupport/lib/struct/matrix.tcl

@@ -10,7 +10,7 @@
 # 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 require Tcl 8.5 9
 package require textutil::wcswidth	;# TermWidth, for _columnwidth and related places
 
 namespace eval ::struct {}
@@ -1605,8 +1605,8 @@ proc ::struct::matrix::_link {name args} {
 	}
     }
 
-    trace variable array wu [list ::struct::matrix::MatTraceIn  $variable $name]
+    trace add variable array {write unset} [list ::struct::matrix::MatTraceIn  $variable $name]
-    trace variable data  w  [list ::struct::matrix::MatTraceOut $variable $name]
+    trace add variable data  write  [list ::struct::matrix::MatTraceOut $variable $name]
     return
 }
 
@@ -2212,8 +2212,8 @@ proc ::struct::matrix::_unlink {name avar} {
     upvar #0 $avar    array
     variable ${name}::data
 
-    trace vdelete array wu [list ::struct::matrix::MatTraceIn  $avar $name]
+    trace remove variable array {write unset} [list ::struct::matrix::MatTraceIn  $avar $name]
-    trace vdelete date  w  [list ::struct::matrix::MatTraceOut $avar $name]
+    trace remove variable data  write  [list ::struct::matrix::MatTraceOut $avar $name]
 
     unset link($avar)
     return
@@ -2485,7 +2485,7 @@ proc ::struct::matrix::MatTraceIn {avar name var idx op} {
     # 2. An individual element was unset:  Set the corresponding cell to the empty string.
     #    See SF Tcllib Bug #532791.
 
-    if {(![string compare $op u]) && ($idx == {})} {
+    if {(![string compare $op unset]) && ($idx == {})} {
 	# Possibility 1: Array was destroyed
 	$name unlink $avar
 	return
@@ -2505,7 +2505,7 @@ proc ::struct::matrix::MatTraceIn {avar name var idx op} {
     # Use standard method to propagate the change.
     # => Get automatically index checks, cache updates, ...
 
-    if {![string compare $op u]} {
+    if {![string compare $op unset]} {
 	# Unset possibility 2: Element was unset.
 	# Note: Setting the cell to the empty string will
 	# invoke MatTraceOut for this array and thus try
@@ -2803,4 +2803,4 @@ namespace eval ::struct {
     namespace import -force matrix::matrix
     namespace export matrix
 }
-package provide struct::matrix 2.1
+package provide struct::matrix 2.2

src/bootsupport/lib/struct/pkgIndex.tcl

@@ -1,29 +1,25 @@
-if {![package vsatisfies [package provide Tcl] 8.2]} {return}
+if {![package vsatisfies [package provide Tcl] 8.5 9]} {return}
-package ifneeded struct            2.1   [list source [file join $dir struct.tcl]]
+package ifneeded struct            2.2   [list source [file join $dir struct.tcl]]
-package ifneeded struct            1.4   [list source [file join $dir struct1.tcl]]
+package ifneeded struct            1.5   [list source [file join $dir struct1.tcl]]
 
-package ifneeded struct::queue     1.4.5 [list source [file join $dir queue.tcl]]
+package ifneeded struct::queue     1.4.6 [list source [file join $dir queue.tcl]]
-package ifneeded struct::stack     1.5.3 [list source [file join $dir stack.tcl]]
+package ifneeded struct::stack     1.5.4 [list source [file join $dir stack.tcl]]
-package ifneeded struct::tree      2.1.2 [list source [file join $dir tree.tcl]]
+package ifneeded struct::tree      2.1.3 [list source [file join $dir tree.tcl]]
-package ifneeded struct::pool      1.2.3 [list source [file join $dir pool.tcl]]
+package ifneeded struct::pool      1.2.4 [list source [file join $dir pool.tcl]]
-package ifneeded struct::record    1.2.2 [list source [file join $dir record.tcl]]
+package ifneeded struct::record    1.2.3 [list source [file join $dir record.tcl]]
-package ifneeded struct::set       2.2.3 [list source [file join $dir sets.tcl]]
+package ifneeded struct::set       2.2.4 [list source [file join $dir sets.tcl]]
-package ifneeded struct::prioqueue 1.4   [list source [file join $dir prioqueue.tcl]]
+package ifneeded struct::prioqueue 1.5   [list source [file join $dir prioqueue.tcl]]
-package ifneeded struct::skiplist  1.3   [list source [file join $dir skiplist.tcl]]
+package ifneeded struct::skiplist  1.4   [list source [file join $dir skiplist.tcl]]
 
-package ifneeded struct::graph     1.2.1 [list source [file join $dir graph1.tcl]]
+package ifneeded struct::graph     1.2.2 [list source [file join $dir graph1.tcl]]
-package ifneeded struct::tree      1.2.2 [list source [file join $dir tree1.tcl]]
+package ifneeded struct::tree      1.2.3 [list source [file join $dir tree1.tcl]]
 
-if {![package vsatisfies [package provide Tcl] 8.4]} {return}
+package ifneeded struct::list        1.8.6  [list source [file join $dir list.tcl]]
-package ifneeded struct::list        1.8.5  [list source [file join $dir list.tcl]]
+package ifneeded struct::list::test  1.8.5  [list source [file join $dir list.test.tcl]]
-package ifneeded struct::list::test  1.8.4  [list source [file join $dir list.test.tcl]]
+package ifneeded struct::graph     2.4.4  [list source [file join $dir graph.tcl]]
-package ifneeded struct::graph     2.4.3  [list source [file join $dir graph.tcl]]
+package ifneeded struct::map       1.1    [list source [file join $dir map.tcl]]
-package ifneeded struct::map       1      [list source [file join $dir map.tcl]]
 
-if {![package vsatisfies [package provide Tcl] 8.5]} {return}
+package ifneeded struct::matrix    2.2 [list source [file join $dir matrix.tcl]]
 
-package ifneeded struct::matrix    2.1 [list source [file join $dir matrix.tcl]]
+package ifneeded struct::disjointset 1.2 [list source [file join $dir disjointset.tcl]]
-
+package ifneeded struct::graph::op 0.11.4 [list source [file join $dir graphops.tcl]]
-if {![package vsatisfies [package provide Tcl] 8.6]} {return}
-package ifneeded struct::disjointset 1.1 [list source [file join $dir disjointset.tcl]]
-package ifneeded struct::graph::op 0.11.3 [list source [file join $dir graphops.tcl]]

src/bootsupport/lib/struct/pool.tcl

@@ -59,7 +59,7 @@ namespace eval ::struct::pool {
 
 # A small helper routine to generate structured errors
 
-if {[package vsatisfies [package present Tcl] 8.5]} {
+if {[package vsatisfies [package present Tcl] 8.5 9]} {
     # Tcl 8.5+, have expansion operator and syntax. And option -level.
     proc ::struct::pool::Error {error args} {
 	variable Errors
@@ -712,4 +712,4 @@ namespace eval ::struct {
     namespace import -force pool::pool
     namespace export pool
 }
-package provide struct::pool 1.2.3
+package provide struct::pool 1.2.4

src/bootsupport/lib/struct/prioqueue.tcl

@@ -11,7 +11,7 @@
 #
 # RCS: @(#) $Id: prioqueue.tcl,v 1.10 2008/09/04 04:35:02 andreas_kupries Exp $
 
-package require Tcl 8.2
+package require Tcl 8.5 9
 
 namespace eval ::struct {}
 
@@ -532,4 +532,4 @@ namespace eval ::struct {
     namespace export prioqueue
 }
 
-package provide struct::prioqueue 1.4
+package provide struct::prioqueue 1.5

src/bootsupport/lib/struct/queue.tcl

@@ -12,7 +12,7 @@
 
 # @mdgen EXCLUDE: queue_c.tcl
 
-package require Tcl 8.4
+package require Tcl 8.5 9
 namespace eval ::struct::queue {}
 
 # ### ### ### ######### ######### #########
@@ -35,16 +35,12 @@ proc ::struct::queue::LoadAccelerator {key} {
     switch -exact -- $key {
 	critcl {
 	    # Critcl implementation of queue 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::queue_critcl]]
 	}
 	tcl {
 	    variable selfdir
-	    if {
+	    if {![catch {package require TclOO 0.6.1-}]} {
-		[package vsatisfies [package provide Tcl] 8.5] &&
-		![catch {package require TclOO 0.6.1-}]
-	    } {
 		source [file join $selfdir queue_oo.tcl]
 	    } else {
 		source [file join $selfdir queue_tcl.tcl]
@@ -184,4 +180,4 @@ namespace eval ::struct {
     namespace export queue
 }
 
-package provide struct::queue 1.4.5
+package provide struct::queue 1.4.6

src/bootsupport/lib/struct/queue_c.tcl

@@ -14,7 +14,7 @@
 package require critcl
 # @sak notprovided struct_queuec
 package provide struct_queuec 1.3.1
-package require Tcl 8.4
+package require Tcl 8.5 9
 
 namespace eval ::struct {
     # Supporting code for the main command.
@@ -93,7 +93,7 @@ namespace eval ::struct {
 #define USAGE "?name?"
 
       if ((objc != 2) && (objc != 1)) {
-        Tcl_WrongNumArgs (interp, 1, objv, USAGE);
+        Tcl_WrongNumArgs (interp, 1, objv, USAGE); /* OK tcl9 */
         return TCL_ERROR;
       }
 
@@ -112,11 +112,11 @@ namespace eval ::struct {
         Tcl_IncrRefCount (fqn);
 
         if (!Tcl_StringMatch (Tcl_GetString (fqn), "::")) {
-          Tcl_AppendToObj (fqn, "::", -1);
+          Tcl_AppendToObj (fqn, "::", -1); /* OK tcl9 */
         }
-        Tcl_AppendToObj (fqn, name, -1);
+        Tcl_AppendToObj (fqn, name, -1); /* OK tcl9 */
       } else {
-        fqn = Tcl_NewStringObj (name, -1);
+        fqn = Tcl_NewStringObj (name, -1); /* OK tcl9 */
         Tcl_IncrRefCount (fqn);
       }
       Tcl_ResetResult (interp);
@@ -127,9 +127,9 @@ namespace eval ::struct {
         Tcl_Obj* err;
 
         err = Tcl_NewObj ();
-        Tcl_AppendToObj    (err, "command \"", -1);
+        Tcl_AppendToObj    (err, "command \"", -1); /* OK tcl9 */
         Tcl_AppendObjToObj (err, fqn);
-        Tcl_AppendToObj    (err, "\" already exists, unable to create queue", -1);
+        Tcl_AppendToObj    (err, "\" already exists, unable to create queue", -1); /* OK tcl9 */
 
         Tcl_DecrRefCount (fqn);
         Tcl_SetObjResult (interp, err);
@@ -137,9 +137,9 @@ namespace eval ::struct {
       }
 
       qd = qu_new();
-      qd->cmd = Tcl_CreateObjCommand (interp, Tcl_GetString (fqn),
+      qd->cmd = Tcl_CreateObjCommand2 (interp, Tcl_GetString (fqn),
-				      qums_objcmd, (ClientData) qd,
+				       qums_objcmd, (ClientData) qd,
-				      QDdeleteCmd);
+				       QDdeleteCmd);
 
       Tcl_SetObjResult (interp, fqn);
       Tcl_DecrRefCount (fqn);

src/bootsupport/lib/struct/queue_oo.tcl

@@ -10,7 +10,7 @@
 # 
 # RCS: @(#) $Id: queue_oo.tcl,v 1.2 2010/09/10 17:31:04 andreas_kupries Exp $
 
-package require Tcl   8.5
+package require Tcl   8.5 9
 package require TclOO 0.6.1- ; # This includes 1 and higher.
 
 # Cleanup first

src/bootsupport/lib/struct/queue_tcl.tcl

@@ -92,7 +92,7 @@ proc ::struct::queue::queue_tcl {args} {
 # Results:
 #	Varies based on command to perform
 
-if {[package vsatisfies [package provide Tcl] 8.5]} {
+if {[package vsatisfies [package provide Tcl] 8.5 9]} {
     # In 8.5+ we can do an ensemble for fast dispatch.
 
     proc ::struct::queue::QueueProc {name cmd args} {

src/bootsupport/lib/struct/record.tcl

@@ -826,5 +826,5 @@ namespace eval ::struct {
     namespace export record
 }
 
-package provide struct::record 1.2.2
+package provide struct::record 1.2.3
 return

src/bootsupport/lib/struct/sets.tcl

@@ -15,7 +15,7 @@
 
 # @mdgen EXCLUDE: sets_c.tcl
 
-package require Tcl 8.2
+package require Tcl 8.5 9
 
 namespace eval ::struct::set {}
 
@@ -38,8 +38,6 @@ proc ::struct::set::LoadAccelerator {key} {
     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]]
 	}
@@ -186,4 +184,4 @@ namespace eval ::struct {
     namespace export set
 }
 
-package provide struct::set 2.2.3
+package provide struct::set 2.2.4

src/bootsupport/lib/struct/sets_c.tcl

@@ -9,14 +9,12 @@
 # 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.4
+package require Tcl 8.5 9
 
 namespace eval ::struct {
     # Supporting code for the main command.
@@ -58,7 +56,7 @@ namespace eval ::struct {
 	int m;
 
         if (objc < 2) {
-            Tcl_WrongNumArgs (interp, objc, objv, "cmd ?arg ...?");
+            Tcl_WrongNumArgs (interp, objc, objv, "cmd ?arg ...?"); /* OK tcl9 */
             return TCL_ERROR;
         } else if (Tcl_GetIndexFromObj (interp, objv [1], methods, "option",
             0, &m) != TCL_OK) {

src/bootsupport/lib/struct/sets_tcl.tcl

@@ -13,7 +13,7 @@
 #
 #----------------------------------------------------------------------
 
-package require Tcl 8.0
+package require Tcl 8.5 9
 
 namespace eval ::struct::set {
     # Only export one command, the one used to instantiate a new tree

src/bootsupport/lib/struct/skiplist.tcl

@@ -434,4 +434,4 @@ namespace eval ::struct {
     namespace import -force skiplist::skiplist
     namespace export skiplist
 }
-package provide struct::skiplist 1.3
+package provide struct::skiplist 1.4

src/bootsupport/lib/struct/stack.tcl

@@ -12,7 +12,7 @@
 
 # @mdgen EXCLUDE: stack_c.tcl
 
-package require Tcl 8.4
+package require Tcl 8.5 9
 namespace eval ::struct::stack {}
 
 # ### ### ### ######### ######### #########
@@ -35,16 +35,12 @@ proc ::struct::stack::LoadAccelerator {key} {
     switch -exact -- $key {
 	critcl {
 	    # Critcl implementation of stack 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::stack_critcl]]
 	}
 	tcl {
 	    variable selfdir
-	    if {
+	    if {![catch {package require TclOO 0.6.1-} mx]} {
-		[package vsatisfies [package provide Tcl] 8.5] &&
-		![catch {package require TclOO 0.6.1-} mx]
-	    } {
 		source [file join $selfdir stack_oo.tcl]
 	    } else {
 		source [file join $selfdir stack_tcl.tcl]
@@ -184,4 +180,4 @@ namespace eval ::struct {
     namespace export stack
 }
 
-package provide struct::stack 1.5.3
+package provide struct::stack 1.5.4

src/bootsupport/lib/struct/stack_c.tcl

@@ -14,7 +14,7 @@
 package require critcl
 # @sak notprovided struct_stackc
 package provide struct_stackc 1.3.1
-package require Tcl 8.4
+package require Tcl 8.5 9
 
 namespace eval ::struct {
     # Supporting code for the main command.
@@ -98,7 +98,7 @@ namespace eval ::struct {
 #define USAGE "?name?"
 
       if ((objc != 2) && (objc != 1)) {
-        Tcl_WrongNumArgs (interp, 1, objv, USAGE);
+        Tcl_WrongNumArgs (interp, 1, objv, USAGE); /* OK tcl9 */
         return TCL_ERROR;
       }
 
@@ -117,11 +117,11 @@ namespace eval ::struct {
         Tcl_IncrRefCount (fqn);
 
         if (!Tcl_StringMatch (Tcl_GetString (fqn), "::")) {
-          Tcl_AppendToObj (fqn, "::", -1);
+          Tcl_AppendToObj (fqn, "::", -1); /* OK tcl9 */
         }
-        Tcl_AppendToObj (fqn, name, -1);
+        Tcl_AppendToObj (fqn, name, -1); /* OK tcl9 */
       } else {
-        fqn = Tcl_NewStringObj (name, -1);
+        fqn = Tcl_NewStringObj (name, -1); /* OK tcl9 */
         Tcl_IncrRefCount (fqn);
       }
       Tcl_ResetResult (interp);
@@ -132,9 +132,9 @@ namespace eval ::struct {
         Tcl_Obj* err;
 
         err = Tcl_NewObj ();
-        Tcl_AppendToObj    (err, "command \"", -1);
+        Tcl_AppendToObj    (err, "command \"", -1); /* OK tcl9 */
         Tcl_AppendObjToObj (err, fqn);
-        Tcl_AppendToObj    (err, "\" already exists, unable to create stack", -1);
+        Tcl_AppendToObj    (err, "\" already exists, unable to create stack", -1); /* OK tcl9 */
 
         Tcl_DecrRefCount (fqn);
         Tcl_SetObjResult (interp, err);
@@ -142,9 +142,9 @@ namespace eval ::struct {
       }
 
       sd = st_new();
-      sd->cmd = Tcl_CreateObjCommand (interp, Tcl_GetString (fqn),
+      sd->cmd = Tcl_CreateObjCommand2 (interp, Tcl_GetString (fqn),
-				      stms_objcmd, (ClientData) sd,
+				       stms_objcmd, (ClientData) sd,
-				      SDdeleteCmd);
+				       SDdeleteCmd);
 
       Tcl_SetObjResult (interp, fqn);
       Tcl_DecrRefCount (fqn);

src/bootsupport/lib/struct/stack_oo.tcl

@@ -9,7 +9,7 @@
 # 
 # RCS: @(#) $Id: stack_oo.tcl,v 1.4 2010/09/10 17:31:04 andreas_kupries Exp $
 
-package require Tcl   8.5
+package require Tcl   8.5 9
 package require TclOO 0.6.1- ; # This includes 1 and higher.
 
 # Cleanup first

src/bootsupport/lib/struct/stack_tcl.tcl

@@ -86,7 +86,7 @@ proc ::struct::stack::stack_tcl {args} {
 # Results:
 #	Varies based on command to perform
 
-if {[package vsatisfies [package provide Tcl] 8.5]} {
+if {[package vsatisfies [package provide Tcl] 8.5 9]} {
     # In 8.5+ we can do an ensemble for fast dispatch.
 
     proc ::struct::stack::StackProc {name cmd args} {
@@ -393,7 +393,7 @@ proc ::struct::stack::I::pop {name {count 1}} {
 # Results:
 #	None.
 
-if {[package vsatisfies [package provide Tcl] 8.5]} {
+if {[package vsatisfies [package provide Tcl] 8.5 9]} {
 
     proc ::struct::stack::I::push {name args} {
 	if {![llength $args]} {

src/bootsupport/lib/struct/struct.tcl

@@ -1,4 +1,4 @@
-package require Tcl 8.2
+package require Tcl 8.5 9
 package require struct::graph     2.0
 package require struct::queue     1.2.1
 package require struct::stack     1.2.1
@@ -9,10 +9,10 @@ package require struct::record    1.2.1
 package require struct::list      1.4
 package require struct::set       2.1
 package require struct::prioqueue 1.3
-package require struct::skiplist  1.3
+package require struct::skiplist  1.4
 
 namespace eval ::struct {
     namespace export *
 }
 
-package provide struct 2.1
+package provide struct 2.2

src/bootsupport/lib/struct/struct1.tcl

@@ -1,5 +1,5 @@
-package require Tcl 8.2
+package require Tcl 8.5 9
-package require struct::graph     1.2.1
+package require struct::graph     1.2.2
 package require struct::queue     1.2.1
 package require struct::stack     1.2.1
 package require struct::tree      1.2.1
@@ -8,10 +8,10 @@ package require struct::pool      1.2.1
 package require struct::record    1.2.1
 package require struct::list      1.4
 package require struct::prioqueue 1.3
-package require struct::skiplist  1.3
+package require struct::skiplist  1.4
 
 namespace eval ::struct {
     namespace export *
 }
 
-package provide struct 1.4
+package provide struct 1.5

src/bootsupport/lib/struct/tree.tcl

@@ -11,7 +11,7 @@
 
 # @mdgen EXCLUDE: tree_c.tcl
 
-package require Tcl 8.2
+package require Tcl 8.5 9
 package require struct::list
 
 namespace eval ::struct::tree {}
@@ -36,7 +36,6 @@ proc ::struct::tree::LoadAccelerator {key} {
     switch -exact -- $key {
 	critcl {
 	    # Critcl implementation of tree 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::tree_critcl]]
 	}
@@ -180,4 +179,4 @@ namespace eval ::struct {
     namespace export tree
 }
 
-package provide struct::tree 2.1.2
+package provide struct::tree 2.1.3

src/bootsupport/lib/struct/tree1.tcl

@@ -9,7 +9,7 @@
 #
 # RCS: @(#) $Id: tree1.tcl,v 1.5 2005/10/04 17:15:05 andreas_kupries Exp $
 
-package require Tcl 8.2
+package require Tcl 8.5 9
 
 namespace eval ::struct {}
 
@@ -1482,4 +1482,4 @@ namespace eval ::struct {
     namespace import -force tree::tree
     namespace export tree
 }
-package provide struct::tree 1.2.2
+package provide struct::tree 1.2.3

src/bootsupport/lib/struct/tree_c.tcl

@@ -8,13 +8,11 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: tree_c.tcl,v 1.6 2008/03/25 07:15:34 andreas_kupries Exp $
 
 package require critcl
 # @sak notprovided struct_treec
 package provide struct_treec 2.1.1
-package require Tcl 8.2
+package require Tcl 8.5 9
 
 namespace eval ::struct {
     # Supporting code for the main command.
@@ -100,7 +98,7 @@ namespace eval ::struct {
 #define USAGE "?name ?=|:=|as|deserialize source??"
 
       if ((objc != 4) && (objc != 2) && (objc != 1)) {
-        Tcl_WrongNumArgs (interp, 1, objv, USAGE);
+        Tcl_WrongNumArgs (interp, 1, objv, USAGE); /* OK tcl9 */
         return TCL_ERROR;
       }
 
@@ -119,11 +117,11 @@ namespace eval ::struct {
         Tcl_IncrRefCount (fqn);
 
         if (!Tcl_StringMatch (Tcl_GetString (fqn), "::")) {
-          Tcl_AppendToObj (fqn, "::", -1);
+          Tcl_AppendToObj (fqn, "::", -1); /* OK tcl9 */
         }
-        Tcl_AppendToObj (fqn, name, -1);
+        Tcl_AppendToObj (fqn, name, -1); /* OK tcl9 */
       } else {
-        fqn = Tcl_NewStringObj (name, -1);
+        fqn = Tcl_NewStringObj (name, -1); /* OK tcl9 */
         Tcl_IncrRefCount (fqn);
       }
       Tcl_ResetResult (interp);
@@ -134,9 +132,9 @@ namespace eval ::struct {
         Tcl_Obj* err;
 
         err = Tcl_NewObj ();
-        Tcl_AppendToObj    (err, "command \"", -1);
+        Tcl_AppendToObj    (err, "command \"", -1); /* OK tcl9 */
         Tcl_AppendObjToObj (err, fqn);
-        Tcl_AppendToObj    (err, "\" already exists, unable to create tree", -1);
+        Tcl_AppendToObj    (err, "\" already exists, unable to create tree", -1); /* OK tcl9 */
 
         Tcl_DecrRefCount (fqn);
         Tcl_SetObjResult (interp, err);
@@ -159,7 +157,7 @@ namespace eval ::struct {
                                  0, &srctype) != TCL_OK) {
           Tcl_DecrRefCount (fqn);
           Tcl_ResetResult (interp);
-          Tcl_WrongNumArgs (interp, 1, objv, USAGE);
+          Tcl_WrongNumArgs (interp, 1, objv, USAGE); /* OK tcl9 */
           return TCL_ERROR;
         }
 
@@ -188,9 +186,9 @@ namespace eval ::struct {
         td = t_new ();
       }
 
-      td->cmd = Tcl_CreateObjCommand (interp, Tcl_GetString (fqn),
+      td->cmd = Tcl_CreateObjCommand2 (interp, Tcl_GetString (fqn),
-                                      tms_objcmd, (ClientData) td,
+				       tms_objcmd, (ClientData) td,
-                                      TDdeleteCmd);
+				       TDdeleteCmd);
 
       Tcl_SetObjResult (interp, fqn);
       Tcl_DecrRefCount (fqn);

src/bootsupport/lib/struct/tree_tcl.tcl

@@ -9,7 +9,7 @@
 #
 # RCS: @(#) $Id: tree_tcl.tcl,v 1.5 2009/06/22 18:21:59 andreas_kupries Exp $
 
-package require Tcl 8.2
+package require Tcl 8.5 9
 package require struct::list
 
 namespace eval ::struct::tree {

src/bootsupport/lib/term/ansi/code.tcl

@@ -50,7 +50,7 @@ namespace eval ::term::ansi::code {
 # ### ### ### ######### ######### #########
 ## Ready
 
-package provide term::ansi::code 0.2
+package provide term::ansi::code 0.3
 
 ##
 # ### ### ### ######### ######### #########

src/bootsupport/lib/term/ansi/code/attr.tcl

@@ -102,7 +102,7 @@ namespace eval ::term::ansi::code::attr {
 # ### ### ### ######### ######### #########
 ## Ready
 
-package provide term::ansi::code::attr 0.1
+package provide term::ansi::code::attr 0.2
 
 ##
 # ### ### ### ######### ######### #########

src/bootsupport/lib/term/ansi/code/ctrl.tcl

@@ -266,7 +266,7 @@ namespace eval ::term::ansi::code::ctrl {
 # ### ### ### ######### ######### #########
 ## Ready
 
-package provide term::ansi::code::ctrl 0.3
+package provide term::ansi::code::ctrl 0.4
 
 ##
 # ### ### ### ######### ######### #########

src/bootsupport/lib/term/ansi/code/macros.tcl

@@ -87,7 +87,7 @@ namespace eval ::term::ansi::code::macros {
 # ### ### ### ######### ######### #########
 ## Ready
 
-package provide term::ansi::code::macros 0.1
+package provide term::ansi::code::macros 0.2
 
 ##
 # ### ### ### ######### ######### #########

src/bootsupport/lib/term/ansi/ctrlunix.tcl

@@ -85,7 +85,7 @@ namespace eval ::term::ansi::ctrl::unix {
 # ### ### ### ######### ######### #########
 ## Ready
 
-package provide term::ansi::ctrl::unix 0.1.1
+package provide term::ansi::ctrl::unix 0.1.2
 
 ##
 # ### ### ### ######### ######### #########

src/bootsupport/lib/term/ansi/send.tcl

@@ -5,7 +5,7 @@
 # ### ### ### ######### ######### #########
 ## Requirements
 
-package require Tcl 8.4
+package require Tcl 8.5 9
 package require term::send
 package require term::ansi::code::ctrl
 
@@ -86,7 +86,7 @@ namespace eval ::term::ansi::send {
 # ### ### ### ######### ######### #########
 ## Ready
 
-package provide term::ansi::send 0.2
+package provide term::ansi::send 0.3
 
 ##
 # ### ### ### ######### ######### #########

src/bootsupport/lib/term/bind.tcl

@@ -126,7 +126,7 @@ snit::type ::term::receive::bind {
 # ### ### ### ######### ######### #########
 ## Ready
 
-package provide term::receive::bind 0.1
+package provide term::receive::bind 0.2
 
 ##
 # ### ### ### ######### ######### #########

src/bootsupport/lib/term/imenu.tcl

@@ -196,7 +196,7 @@ namespace eval ::term::interact::menu {
     term::ansi::send::import       vt
 }
 
-package provide term::interact::menu 0.1
+package provide term::interact::menu 0.2
 
 ##
 # ### ### ### ######### ######### #########

src/bootsupport/lib/term/ipager.tcl

@@ -200,7 +200,7 @@ namespace eval ::term::interact::pager {
     term::ansi::send::import       vt
 }
 
-package provide term::interact::pager 0.1
+package provide term::interact::pager 0.2
 
 ##
 # ### ### ### ######### ######### #########

src/bootsupport/lib/term/pkgIndex.tcl

@@ -1,13 +1,13 @@
-if {![package vsatisfies [package provide Tcl] 8.4]} return
+if {![package vsatisfies [package provide Tcl] 8.5 9]} return
-package ifneeded term                     0.1 [list source [file join $dir term.tcl]]
+package ifneeded term                     0.2 [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         0.3 [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::attr   0.2 [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::ctrl   0.4 [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::code::macros 0.2 [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::ctrl::unix   0.1.2 [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::ansi::send         0.3 [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::menu     0.2 [list source [file join $dir imenu.tcl]]
-package ifneeded term::interact::pager    0.1 [list source [file join $dir ipager.tcl]]
+package ifneeded term::interact::pager    0.2 [list source [file join $dir ipager.tcl]]
-package ifneeded term::receive            0.1 [list source [file join $dir receive.tcl]]
+package ifneeded term::receive            0.2 [list source [file join $dir receive.tcl]]
-package ifneeded term::receive::bind      0.1 [list source [file join $dir bind.tcl]]
+package ifneeded term::receive::bind      0.2 [list source [file join $dir bind.tcl]]
-package ifneeded term::send               0.1 [list source [file join $dir send.tcl]]
+package ifneeded term::send               0.2 [list source [file join $dir send.tcl]]

src/bootsupport/lib/term/receive.tcl

@@ -54,7 +54,7 @@ namespace eval ::term::receive {
 # ### ### ### ######### ######### #########
 ## Ready
 
-package provide term::receive 0.1
+package provide term::receive 0.2
 
 ##
 # ### ### ### ######### ######### #########

src/bootsupport/lib/term/send.tcl

@@ -28,7 +28,7 @@ namespace eval ::term::send {
 # ### ### ### ######### ######### #########
 ## Ready
 
-package provide term::send 0.1
+package provide term::send 0.2
 
 ##
 # ### ### ### ######### ######### #########

src/bootsupport/lib/term/term.tcl

@@ -13,7 +13,7 @@ namespace eval ::term {}
 # ### ### ### ######### ######### #########
 ## Ready
 
-package provide term 0.1
+package provide term 0.2
 
 ##
 # ### ### ### ######### ######### #########

src/bootsupport/modules/fauxlink-0.1.0.tm

@@ -66,6 +66,16 @@
 # "my-program-files#++server+c+Program%20Files.fxlnk"
 #If we needed the old-style literal %20 it would become
 # "my-program-files#++server+c+Program%2520Files.fxlnk"
+#
+# The file:// scheme on windows supposedly *does* decode %xx (for use in a browser)
+# e.g
+# pfiles#file%3a++++localhost+c+Program%2520files 
+# The browser will work with literal spaces too though - so it could just as well be:
+# pfiles#file%3a++++localhost+c+Program%20files 
+#windows may default to using explorer.exe instead of a browser for file:// urls though
+#and explorer doesn't want the literal %20.  It probably depends what API the file:// url is to be passed to?
+#in a .url shortcut either literal space or %20 will work ie %xx values are decoded 
+
 
 
 #*** !doctools

src/bootsupport/modules/include_modules.config

@@ -14,7 +14,6 @@ set bootsupport_modules [list\
     src/vendormodules debug\
     src/vendormodules dictutils\
     src/vendormodules fauxlink\
-    src/vendormodules fileutil\
     src/vendormodules http\
     src/vendormodules md5\
     src/vendormodules metaface\

src/bootsupport/modules/punk-0.1.tm

@@ -213,6 +213,13 @@ namespace eval punk {
     proc objclone {obj} {
         append obj2 $obj {}
     }
+    proc set_clone {varname obj} {
+        #maintenance: also punk::lib::set_clone
+        #e.g used by repl's codeinterp. Maintains internal rep, easier to call e.g interp eval code [list punk::set_clone varnmame $val]
+        append obj2 $obj {}
+        uplevel 1 [list set $varname $obj2]
+    }
+
     interp alias "" strlen "" ::punk::strlen 
     interp alias "" str_len "" ::punk::strlen
     interp alias "" objclone "" ::punk::objclone
@@ -2122,7 +2129,7 @@ namespace eval punk {
                             }
                             {@V\*@*} - {@v\*@*} {
                                 #dict value glob - return values 
-                                set active_key_type "dict"
+                                set active_key_type dict
                                 set keyglob [string range $index 4 end]
                                 append script [tstr -return string -allowcommands {
                                     if {[catch {dict size $leveldata}]} {
@@ -2132,7 +2139,7 @@ namespace eval punk {
                                 if {$get_not} {
                                     lappend INDEX_OPERATIONS globvalue-get-values-not
                                     append script \n [string map [list <keyglob> $keyglob] {
-                                        # set active_key_type "dict" index_operation: globvalue-get-values-not"
+                                        # set active_key_type "dict" ;# index_operation: globvalue-get-values-not
                                         set assigned [list]
                                         tcl::dict::for {k v} $leveldata {
                                             if {![string match <keyglob> $v]} {
@@ -2144,7 +2151,7 @@ namespace eval punk {
                                 } else {
                                     lappend INDEX_OPERATIONS  globvalue-get-values
                                     append script \n [string map [list <keyglob> $keyglob] {
-                                        # set active_key_type "dict" index_operation: globvalue-get-value
+                                        # set active_key_type "dict" ;#index_operation: globvalue-get-value
                                         set assigned [dict values $leveldata <keyglob>]
                                     }]
                                 }
@@ -2166,7 +2173,7 @@ namespace eval punk {
                                 } else {
                                     lappend INDEX_OPERATIONS  globkeyvalue-get-pairs
                                     append script \n [string map [list <keyvalglob> $keyvalglob] {
-                                        # set active_key_type "dict" index_operation: globkeyvalue-get-pairs-not"
+                                        # set active_key_type "dict" ;# index_operation: globkeyvalue-get-pairs-not
                                         set assigned [dict create]
                                         tcl::dict::for {k v} $leveldata {
                                             if {[string match <keyvalglob> $k] || [string match <keyvalglob> $v]} {
@@ -4952,17 +4959,14 @@ namespace eval punk {
             } else {
                 #tags ?
                 #debug.punk.pipe {>>raw commandline: [concat $rhs $segment_members_filled]} 5
-                if 0 {
+                if {false} {
-
-                    
-
                     #set s [list uplevel 1 [concat $rhs $segment_members_filled]]
                     if {![info exists pscript]} {
                         upvar ::_pipescript pscript
                     }
                     if {![info exists pscript]} {
                         #set pscript $s
-                    set pscript [funcl::o_of_n 1 $segment_members]
+                        set pscript [funcl::o_of_n 1 $segment_members]
                     } else {
                         #set pscript [string map [list <p> $pscript] {uplevel 1 [concat $rhs $segment_members_filled [<p>]]}]
                         #set snew "set pipe_$i \[uplevel 1 \[list $rhs $segment_members_filled "
@@ -4972,6 +4976,7 @@ namespace eval punk {
 
                     }
                 }
+
                 set cmdlist_result [uplevel 1 $segment_members_filled]
                 #set d [_multi_bind_result $returnvarspec [punk::K $segment_members_filled [unset segment_members_filled]]]
                 set d [_multi_bind_result $returnvarspec [lindex [list $cmdlist_result [unset cmdlist_result]] 0 ]]
@@ -7321,16 +7326,22 @@ namespace eval punk {
 
 
         if {$topic in [list tcl]} {
-            if {[punk::lib::system::has_script_var_bug]} {
+            if {[punk::lib::system::has_tclbug_script_var]} {
-                append warningblock \n "minor warning: punk::lib::system::has_script_var_bug returned true! (string rep for list variable in script generated when script changed)"
+                append warningblock \n "minor warning: punk::lib::system::has_tclbug_script_var returned true! (string rep for list variable in script generated when script changed)"
             }
-            if {[punk::lib::system::has_safeinterp_compile_bug]} {
+            if {[punk::lib::system::has_tclbug_safeinterp_compile]} {
                 set indent "    "
-                append warningblock \n "[a+ web-red]warning: punk::lib::system::has_safeinterp_compile_bug returned true!" \n
+                append warningblock \n "[a+ web-red]warning: punk::lib::system::has_tclbug_safeinterp returned true!" \n
                 append warningblock "${indent}(ensemble commands not compiled in safe interps - heavy performance impact in safe interps)" \n
                 append warningblock "${indent}see https://core.tcl-lang.org/tcl/tktview/1095bf7f75"
                 append warningblock [a]
             }
+            if {[punk::lib::system::has_tclbug_list_quoting_emptyjoin]} {
+                set indent "    "
+                append warningblock \n "[a+ web-red]warning: punk::lib::system::has_tclbug_list_quoting returned true!" \n
+                append warningblock "${indent}lists elements not properly quoted in some cases. e.g 'list {*}[lindex {etc #foo} 1] {*}[list]' (#foo not braced)" \n
+                append warningblock "${indent}see https://core.tcl-lang.org/tcl/tktview/e38dce74e2"
+            }
         }
 
         set text ""

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

@@ -201,6 +201,7 @@
 #[para] packages used by punk::args
 #[list_begin itemized]
 package require Tcl 8.6-
+#optional? punk::trie
 #*** !doctools
 #[item] [package {Tcl 8.6-}]
 
@@ -293,6 +294,7 @@ tcl::namespace::eval punk::args {
             -validate_without_ansi 0\
             -strip_ansi 0\
             -nocase 0\
+            -choiceprefix 1\
             -multiple 0\
         ] 
         set valspec_defaults [tcl::dict::create\
@@ -301,8 +303,12 @@ tcl::namespace::eval punk::args {
             -allow_ansi 1\
             -validate_without_ansi 0\
             -strip_ansi 0\
+            -nocase 0\
+            -choiceprefix 1\
             -multiple 0\
         ]
+        #we need a -choiceprefix default even though it often doesn't apply so we can look it up to display in Help if there are -choices
+        #default to 1 for convenience
 
         #checks with no default 
         #-minlen -maxlen -range
@@ -415,11 +421,11 @@ tcl::namespace::eval punk::args {
                                 -anyopts {
                                     set opt_any $v
                                 }
-                                -minlen - -maxlen - -range - -choices - -choicelabels {
+                                -minlen - -maxlen - -range - -choices - -choicelabels - -choiceprefix {
                                     #review - only apply to certain types?
                                     tcl::dict::set optspec_defaults $k $v
                                 }
-                                -nominlen - -nomaxlen - -norange - -nochoices - -nochoicelabels {
+                                -nominlen - -nomaxlen - -norange - -nochoices - -nochoicelabels - -nocase {
                                     if {$v} {
                                         tcl::dict::unset optspec_defaults $k
                                     }
@@ -459,7 +465,7 @@ tcl::namespace::eval punk::args {
                                     tcl::dict::set optspec_defaults $k $v
                                 }
                                 default {
-                                    set known   {   -any -anyopts -minlen -maxlen -range -choices -choicelabels\
+                                    set known   {   -any -anyopts -minlen -maxlen -range -choices -choicelabels -choiceprefix -nocase\
                                                     -nominlen -nomaxlen -norange -nochoices -nochoicelabels\
                                                     -type -optional -allow_ansi -validate_without_ansi -strip_ansi -multiple\
                                                 }
@@ -479,7 +485,7 @@ tcl::namespace::eval punk::args {
                                 -maxvalues {
                                     set val_max $v
                                 }
-                                -minlen - -maxlen - -range - -choices - -choicelabels {
+                                -minlen - -maxlen - -range - -choices - -choicelabels - -choiceprefix - -nocase {
                                     #review - only apply to certain types?
                                     tcl::dict::set valspec_defaults $k $v
                                 }
@@ -520,7 +526,7 @@ tcl::namespace::eval punk::args {
                                 }
                                 default {
                                     set known   {   -min -minvalues -max -maxvalues\
-                                                    -minlen -maxlen -range -choices -choicelabels\
+                                                    -minlen -maxlen -range -choices -choicelabels -choiceprefix -nocase\
                                                     -nominlen -nomaxlen -norange -nochoices -nochoicelabels\
                                                     -type -optional -allow_ansi -validate_without_ansi -strip_ansi -multiple\
                                                 }
@@ -596,12 +602,12 @@ tcl::namespace::eval punk::args {
                             }
                         }
                     }
-                    -default - -solo - -range - -choices - -choicelabels - -minlen - -maxlen - -nocase - -optional - -multiple - -validate_without_ansi - -allow_ansi - -strip_ansi - -help - -ARGTYPE {
+                    -default - -solo - -range - -choices - -choiceprefix - -choicelabels - -choiceprefix - -minlen - -maxlen - -nocase - -optional - -multiple - -validate_without_ansi - -allow_ansi - -strip_ansi - -help - -ARGTYPE {
                         #review -solo 1 vs -type none ?
                         tcl::dict::set spec_merged $spec $specval
                     }
                     default {
-                        set known_argspecs [list -default -type -range -choices -nocase -optional -multiple -validate_without_ansi -allow_ansi -strip_ansi -help]
+                        set known_argspecs [list -default -type -range -choices -choiceprefix -nocase -optional -multiple -validate_without_ansi -allow_ansi -strip_ansi -help]
                         error "punk::args::get_dict - unrecognised key '$spec' in specifications for argument '$argname' Known option specification keys: $known_argspecs"
                     }
                 }
@@ -752,7 +758,28 @@ tcl::namespace::eval punk::args {
                 #set greencheck [a+ web-limegreen]\u2713[a]
                 set greencheck [a+ brightgreen]\u2713[a]
 
-                foreach arg [dict get $spec_dict opt_names] {
+                if {![catch {package require punk::trie}]} {
+                    set opt_names_display [list]
+                    set trie [punk::trie::trieclass new {*}[dict get $spec_dict opt_names]]
+                    set idents [dict get [$trie shortest_idents ""] scanned]
+                    $trie destroy
+                    set M "\x1b\[32m" ;#mark in green 
+                    set RST "\x1b\[m"
+                    foreach c [dict get $spec_dict opt_names] {
+                        set id [dict get $idents $c]
+                        if {$id eq $c} {
+                            lappend opt_names_display $M$c$RST
+                        } else {
+                            set idlen [string length $id]
+                            lappend opt_names_display "$M[string range $c 0 $idlen-1]$RST[string range $c $idlen end]" 
+                        }
+                    } 
+                } else {
+                    set opt_names_display [dict get $spec_dict opt_names]
+                }
+
+
+                foreach argshow $opt_names_display arg [dict get $spec_dict opt_names] {
                     set arginfo [dict get $spec_dict arg_info $arg]
                     if {[dict exists $arginfo -default]} {
                         #set default $c_default[dict get $arginfo -default]
@@ -763,14 +790,47 @@ tcl::namespace::eval punk::args {
                     set help [punk::lib::dict_getdef $arginfo -help ""]
                     if {[dict exists $arginfo -choices]} {
                         if {$help ne ""} {append help \n}
-                        append help "Choices: [dict get $arginfo -choices]"
+                        if {[dict get $arginfo -nocase]} {
+                            set casemsg " (case insensitive)"
+                        } else {
+                            set casemsg " (case sensitive)"
+                        }
+                        if {[dict get $arginfo -choiceprefix]} {
+                            set prefixmsg " (choice prefix allowed)"
+                        } else {
+                            set prefixmsg ""
+                        }
+                        append help "Choices$prefixmsg$casemsg"
+                        if {[catch {package require punk::trie}]} {
+                            append help "\n    " [join [dict get $arginfo -choices] "\n    "]
+                        } else {
+                            if {[catch {
+                                set trie [punk::trie::trieclass new {*}[dict get $arginfo -choices]]
+                                set idents [dict get [$trie shortest_idents ""] scanned]
+                                $trie destroy
+                                set M "\x1b\[32m" ;#mark in green 
+                                set RST "\x1b\[m"
+                                foreach c [dict get $arginfo -choices] {
+                                    set id [dict get $idents $c]
+                                    if {$id eq $c} {
+                                        append help "\n    " "$M$c$RST"
+                                    } else {
+                                        set idlen [string length $id]
+                                        append help "\n    " "$M[string range $c 0 $idlen-1]$RST[string range $c $idlen end]" 
+                                    }
+                                } 
+                            } errM]} {
+                                puts stderr "prefix marking failed\n$errM" 
+                                append help "\n    " [join [dict get $arginfo -choices] "\n    "]
+                            }
+                        }
                     }
                     if {[punk::lib::dict_getdef $arginfo -multiple 0]} {
                         set multiple $greencheck 
                     } else {
                         set multiple ""
                     }
-                    $t add_row [list $arg [dict get $arginfo -type] $default $multiple $help]
+                    $t add_row [list $argshow [dict get $arginfo -type] $default $multiple $help]
                     if {$arg eq $badarg} {
                         $t configure_row [expr {[$t row_count]-1}] -ansibase $c_badarg
                     }
@@ -785,7 +845,40 @@ tcl::namespace::eval punk::args {
                     set help [punk::lib::dict_getdef $arginfo -help ""]
                     if {[dict exists $arginfo -choices]} {
                         if {$help ne ""} {append help \n}
-                        append help "Choices: [dict get $arginfo -choices]"
+                        if {[dict get $arginfo -nocase]} {
+                            set casemsg " (case insensitive)"
+                        } else {
+                            set casemsg " (case sensitive)"
+                        }
+                        if {[dict get $arginfo -choiceprefix]} {
+                            set prefixmsg " (choice prefix allowed)"
+                        } else {
+                            set prefixmsg ""
+                        }
+                        append help "Choices$prefixmsg$casemsg"
+                        if {[catch {package require punk::trie}]} {
+                            append help "\n    " [join [dict get $arginfo -choices] "\n    "]
+                        } else {
+                            if {[catch {
+                                set trie [punk::trie::trieclass new {*}[dict get $arginfo -choices]]
+                                set idents [dict get [$trie shortest_idents ""] scanned]
+                                $trie destroy
+                                set M "\x1b\[32m" ;#mark in green 
+                                set RST "\x1b\[m"
+                                foreach c [dict get $arginfo -choices] {
+                                    set id [dict get $idents $c]
+                                    if {$id eq $c} {
+                                        append help "\n    " "$M$c$RST"
+                                    } else {
+                                        set idlen [string length $id]
+                                        append help "\n    " "$M[string range $c 0 $idlen-1]$RST[string range $c $idlen end]" 
+                                    }
+                                } 
+                            } errM]} {
+                                puts stderr "prefix marking failed\n$errM" 
+                                append help "\n    " [join [dict get $arginfo -choices] "\n    "]
+                            }
+                        }
                     }
                     if {[punk::lib::dict_getdef $arginfo -multiple 0]} {
                         set multiple $greencheck 
@@ -1429,20 +1522,38 @@ tcl::namespace::eval punk::args {
                 }
                 if {$has_choices} {
                     #todo -choicelabels
-                    set choices [tcl::dict::get $thisarg -choices]
+                    set choices         [tcl::dict::get $thisarg -choices]
-                    set nocase  [tcl::dict::get $thisarg -nocase]
+                    set choiceprefix    [tcl::dict::get $thisarg -choiceprefix]
+                    set nocase          [tcl::dict::get $thisarg -nocase]
                     foreach e $vlist e_check $vlist_check {
                         if {$nocase} {
-                            set casemsg "(case insensitive)"
+                            set casemsg " (case insensitive)"
                             set choices_test [tcl::string::tolower $choices]
                             set v_test [tcl::string::tolower $e_check]
                         } else {
-                            set casemsg "(case sensitive)"
+                            set casemsg " (case sensitive)"
                             set v_test $e_check
                             set choices_test $choices
                         }
-                        if {$v_test ni $choices_test} {
+                        set choice_ok 0
-                            arg_error "Option $argname for [Get_caller] must be one of the listed values $choices $casemsg. Received: '$e'" $argspecs $argname
+                        if {$choiceprefix} {
+                            if {![catch {tcl::prefix::match $choices_test $v_test} chosen]} {
+                                set choice_ok 1
+                                #can we handle empty string as a choice? It should just work - REVIEW/test
+                                set choice [lsearch -inline -nocase $choices $chosen] ;#map possibly lcased choice back to original case in choices list
+                                if {[tcl::dict::get $thisarg -ARGTYPE] eq "option"} {
+                                    tcl::dict::set opts         $argname $choice 
+                                } else {
+                                    tcl::dict::set values_dict  $argname $choice 
+                                }
+                            }
+                            set prefixmsg " (or a unique prefix of a value)"
+                        } else {
+                            set prefixmsg ""
+                            set choice_ok [expr {$v_test in $choices_test}]
+                        }
+                        if {!$choice_ok} {
+                            arg_error "Option $argname for [Get_caller] must be one of the listed values:\n    [join $choices "\n    "]\n$casemsg$prefixmsg. Received: '$e'" $argspecs $argname
                         }
                     }
                 }

src/bootsupport/modules/punk/config-0.1.tm

@@ -362,10 +362,11 @@ tcl::namespace::eval punk::config {
 
     proc configure {args} {
         set argd [punk::args::get_dict {
-
+            *values -min 1 -max 1
-            whichconfig -type string -choices {startup running}
+            whichconfig -type string -choices {startup running stop}
         } $args]
 
+        return "unimplemented - $argd"
     }
 
     proc show {whichconfig {globfor *}} {

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

@@ -44,6 +44,7 @@
 #[list_begin itemized]
 
 package require Tcl 8.6-
+package require Thread  ;#tsv required to sync is_raw
 package require punk::ansi
 #*** !doctools
 #[item] [package {Tcl 8.6-}]
@@ -84,7 +85,12 @@ namespace eval punk::console {
     variable previous_stty_state_stdin ""
     variable previous_stty_state_stdout ""
     variable previous_stty_state_stderr ""
-    variable is_raw 0
+
+    #variable is_raw 0
+    if {![tsv::exists console is_raw]} {
+        tsv::set console is_raw 0
+    }
+    
     variable input_chunks_waiting
     if {![info exists input_chunks_waiting(stdin)]} {
         set input_chunks_waiting(stdin) [list]
@@ -183,7 +189,8 @@ namespace eval punk::console {
         #NOTE - the is_raw is only being set in current interp - but the channel is shared.
         #this is problematic with the repl thread being separate. - must be a tsv?  REVIEW
         proc enableRaw {{channel stdin}} {
-            variable is_raw 
+            #variable is_raw 
+
             variable previous_stty_state_$channel
             set sttycmd [auto_execok stty]
             if {[set previous_stty_state_$channel] eq ""} {
@@ -193,21 +200,21 @@ namespace eval punk::console {
             }
 
             exec {*}$sttycmd raw -echo <@$channel
-            set is_raw 1
+            tsv::set console is_raw 1
             return [dict create previous [set previous_stty_state_$channel]]
         }
         proc disableRaw {{channel stdin}} {
-            variable is_raw
+            #variable is_raw
             variable previous_stty_state_$channel
             set sttycmd [auto_execok stty]
             if {[set previous_stty_state_$channel] ne ""} {
                 exec {*}$sttycmd [set previous_stty_state_$channel]
                 set previous_stty_state_$channel ""
-                set is_raw 0
+                tsv::set console is_raw 0
                 return restored
             }
             exec {*}$sttycmd -raw echo <@$channel
-            set is_raw 0
+            tsv::set console is_raw 0
             return done
         }
         proc enableVirtualTerminal {{channels {input output}}} {
@@ -249,11 +256,11 @@ namespace eval punk::console {
         
     }
     proc mode {{raw_or_line query}} {
-        variable is_raw
+        #variable is_raw
         variable ansi_available
         set raw_or_line [string tolower $raw_or_line]
         if {$raw_or_line eq "query"} {
-            if {$is_raw} {
+            if {[tsv::get console is_raw]} {
                 return "raw"
             } else {
                 return "line"
@@ -493,7 +500,7 @@ namespace eval punk::console {
             }
 
                 proc [namespace parent]::enableRaw {{channel stdin}} {
-                    variable is_raw
+                    #variable is_raw
                     variable previous_stty_state_$channel
 
                     if {[package provide twapi] ne ""} {
@@ -506,7 +513,7 @@ namespace eval punk::console {
                         #set newmode [dict merge $oldmode [dict create -lineinput 0 -echoinput 0]]
                         set newmode [twapi::get_console_input_mode]
 
-                        set is_raw 1
+                        tsv::set console 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]]
@@ -516,7 +523,7 @@ namespace eval punk::console {
                         }
 
                         exec {*}$sttycmd raw -echo <@$channel
-                        set is_raw 1
+                        tsv::set console 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 {
@@ -528,7 +535,7 @@ namespace eval punk::console {
                 #could be we were missing a step in reopening stdin and console configuration?
 
                 proc [namespace parent]::disableRaw {{channel stdin}} {
-                    variable is_raw
+                    #variable is_raw
                     variable previous_stty_state_$channel
 
                     if {[package provide twapi] ne ""} {
@@ -537,7 +544,7 @@ namespace eval punk::console {
                         # 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
+                        tsv::set console is_raw 0
                         return [list stdin [list from $oldmode to $newmode]]
                     } elseif {[set sttycmd [auto_execok stty]] ne ""} {
                         #stty can return info on windows - but doesn't seem to be able to set anything.
@@ -550,7 +557,7 @@ namespace eval punk::console {
                             return restored
                         }
                         exec {*}$sttycmd -raw echo <@$channel
-                        set is_raw 0
+                        tsv::set console 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"]]
@@ -634,7 +641,7 @@ namespace eval punk::console {
             puts -nonewline $output $query;flush $output
 
             #todo - test and save rawstate so we don't disableRaw if console was already raw
-            if {!$::punk::console::is_raw} {
+            if {![tsv::get console is_raw]} {
                 set was_raw 0
                 punk::console::enableRaw
             } else {
@@ -1378,7 +1385,7 @@ namespace eval punk::console {
 
     #todo - compare speed with get_cursor_pos - work out why the big difference
     proc test_cursor_pos {} {
-        if {!$::punk::console::is_raw} {
+        if {![tsv::get console is_raw]} {
             set was_raw 0
             enableRaw
         } else {

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

@@ -1065,56 +1065,65 @@ namespace eval punk::du {
             #note - with this design, we can't glob for all except dotfiles - this is for cross-platform consistency and efficiency (Review).
             #dotfiles aren't considered hidden on all platforms
             #some sort of antiglob is a possible enhancement and more consistent with the view that leading dot should be treated as any other filename character in this context.
-            if {$opt_glob eq "*"} {
+            if {"windows" eq $::tcl_platform(platform)} {
-                #Note - glob operations seem to be faster than looped tests like 'file isdirectory' & 'file readlink' 
+                if {$opt_glob eq "*"} {
-                #set parent [lindex $folders $folderidx]
+                    #Note - glob operations seem to be faster than looped tests like 'file isdirectory' & 'file readlink' 
-                set hdirs  [glob -nocomplain -dir $folderpath -types {hidden d}  * .*]
+                    #set parent [lindex $folders $folderidx]
-                #set hdirs {}
+                    set hdirs  [glob -nocomplain -dir $folderpath -types {hidden d}  * .*]
-                set dirs   [glob -nocomplain -dir $folderpath -types d           * .*]
+                    set dirs   [glob -nocomplain -dir $folderpath -types d           * .*]
-
+
-                set hlinks [glob -nocomplain -dir $folderpath -types {hidden l}  * .*]
+                    set hlinks [glob -nocomplain -dir $folderpath -types {hidden l}  * .*]
-                #set hlinks {}
+                    set links  [glob -nocomplain -dir $folderpath -types l           * .*] ;#links may have dupes - we don't care. punk::lib::struct_set_diff_unique 
-                set links  [glob -nocomplain -dir $folderpath -types l           * .*] ;#links may have dupes - we don't care. struct::set difference will remove (?)
-                #set links  [lsort -unique [concat $hlinks $links[unset links]]]
-
-                set hfiles [glob -nocomplain -dir $folderpath -types {hidden f}  * .*]
-                #set hfiles {}
-                set files  [glob -nocomplain -dir $folderpath -types f           * .*]
-                #set files  {}
-            } else {
-                set hdirs  [glob -nocomplain -dir $folderpath -types {hidden d}   $opt_glob]
-                set dirs   [glob -nocomplain -dir $folderpath -types d            $opt_glob]
 
-                set hlinks [glob -nocomplain -dir $folderpath -types {hidden l}   $opt_glob]
+                    set hfiles [glob -nocomplain -dir $folderpath -types {hidden f}  * .*]
-                set links  [glob -nocomplain -dir $folderpath -types l            $opt_glob] ;#links may have dupes - we don't care. struct::set difference will remove (?)
+                    set files  [glob -nocomplain -dir $folderpath -types f           * .*]
+                } else {
+                    set hdirs  [glob -nocomplain -dir $folderpath -types {hidden d}   $opt_glob]
+                    set dirs   [glob -nocomplain -dir $folderpath -types d            $opt_glob]
+
+                    set hlinks [glob -nocomplain -dir $folderpath -types {hidden l}   $opt_glob]
+                    set links  [glob -nocomplain -dir $folderpath -types l            $opt_glob] ;#links may have dupes - we don't care. punk::lib::struct_set_diff_unique 
+
+                    set hfiles [glob -nocomplain -dir $folderpath -types {hidden f}   $opt_glob]
+                    set files  [glob -nocomplain -dir $folderpath -types f            $opt_glob]
+                }
+            } else {
+                set hdirs {}
+                set hfiles {}
+                set hlinks {}
+                if {$opt_glob eq "*"} {
+                    #Note - glob operations seem to be faster than looped tests like 'file isdirectory' & 'file readlink' 
+                    #set parent [lindex $folders $folderidx]
+                    set dirs   [glob -nocomplain -dir $folderpath -types d           * .*]
+                    set links  [glob -nocomplain -dir $folderpath -types l           * .*] ;#links may have dupes - we don't care. punk::lib::struct_set_diff_unique 
+                    set files  [glob -nocomplain -dir $folderpath -types f           * .*]
+                } else {
+                    set dirs   [glob -nocomplain -dir $folderpath -types d            $opt_glob]
+                    set links  [glob -nocomplain -dir $folderpath -types l            $opt_glob] ;#links may have dupes - we don't care. punk::lib::struct_set_diff_unique 
+                    set files  [glob -nocomplain -dir $folderpath -types f            $opt_glob]
+                }
 
-                set hfiles [glob -nocomplain -dir $folderpath -types {hidden f}   $opt_glob]
-                set files  [glob -nocomplain -dir $folderpath -types f            $opt_glob]
             }
 
             #note struct::set difference produces unordered result
             #struct::set difference removes duplicates (but not always.. e.g if using tcl impl and 2nd element empty!)
-            #relying on struct::set to remove dupes is somewhat risky. It is not well documented - and behaviour of dupes in inputs is underspecified as it appears to be intended for mathematical 'sets'
+            #relying on struct::set to remove dupes is somewhat risky. 
+            #It is not well documented - and behaviour of dupes in inputs is underspecified as it appears to be intended for mathematical 'sets' ie lists without dupes 
+            #for this reason we must use the wrapper punk::lib::struct_set_diff_unique, which will use the well behaved critcl for speed if avail, but fall back to a deduping tcl version
             #remove links and . .. from directories, remove links from files
             #ideally we would like to classify links by whether they point to files vs dirs - but there are enough cross-platform differences that we will have to leave it to the caller to sort out for now.
             #struct::set will affect order: tcl vs critcl give different ordering!
-            set files [struct::set difference [concat $hfiles $files[unset files]] $links]
+            set files [punk::lib::struct_set_diff_unique [list {*}$hfiles {*}$files[unset files]]    $links]
-            set dirs  [struct::set difference [concat $hdirs $dirs[unset dirs]]    [concat $links [list [file join $folderpath .]  [file join $folderpath ..] ]]]
+            set dirs  [punk::lib::struct_set_diff_unique [list {*}$hdirs  {*}$dirs[unset dirs]  ]    [list {*}$links [file join $folderpath .]  [file join $folderpath ..]]]
-            #set links [lsort -unique [concat $links $hlinks]]
 
 
             #----
             set mdata_lists [du_get_metadata_lists $sized_types $timed_types $files $dirs $links]
 
 
-
+            set flaggedhidden [list {*}$hdirs {*}$hfiles {*}$hlinks]
-            if {"windows" eq $::tcl_platform(platform)} {
+            #unix dotted files/folders are not 'flagged' as such - it's a convention - so the client can use the same convention to decide if something is hidden
-                set flaggedhidden [concat $hdirs $hfiles $hlinks]
+            #this allows us to return less data - but more importantly - reserve flaggedhidden for systems where such a flag exists and avoid conflating the different concepts of what is hidden
-            } else {
-                #unix dotted files/folders are not 'flagged' as such - it's a convention - so the client can use the same convention to decide if something is hidden
-                #this allows us to return less data - but more importantly - reserve flaggedhidden for systems where such a flag exists and avoid conflating the different concepts of what is hidden
-                set flaggedhidden {}
-            }
 
             set vfsmounts [get_vfsmounts_in_folder $folderpath]
 
@@ -1223,21 +1232,21 @@ namespace eval punk::du {
 
             #if {[punk::mix::base::lib::path_a_above_b $folderpath "//zipfs:/"]} {}
 
-            #zipfs files also reported as links by glob - review - should we preserve this in response?
+            #todo - hidden? not returned in attributes on windows at least.
+            #zipfs files also reported as links by glob - review - should we preserve this in response? (2024 unable to duplicate)
             if {$opt_glob eq "*"} {
                 set dirs   [glob -nocomplain -dir $folderpath -types d           * .*] ;# also returns links to dirs
-                #set links  [glob -nocomplain -dir $folderpath -types l           * .*]  ;# links may have dupes - we don't care. struct::set difference will remove
+                set links  [glob -nocomplain -dir $folderpath -types l           * .*]  ;# links may have dupes - we don't care. struct::set difference will remove
-                set links [list]
                 set files  [glob -nocomplain -dir $folderpath -types f           * .*] ;# also returns links to files
             } else {
                 set dirs   [glob -nocomplain -dir $folderpath -types d           $opt_glob]
-                #set links  [glob -nocomplain -dir $folderpath -types l           $opt_glob]
+                set links  [glob -nocomplain -dir $folderpath -types l           $opt_glob]
-                set links [list]
                 set files  [glob -nocomplain -dir $folderpath -types f           $opt_glob]
             }
             #remove any links from our dirs and files collections
-            set dirs  [struct::set difference $dirs[unset dirs]    [concat $links [list [file join $folderpath .] [file join $folderpath ..] ]]]
+            #see du_dirlisting_generic re struct::set difference issues
-            set files [struct::set difference $files[unset files] $links]
+            set dirs  [punk::lib::struct_set_diff_unique $dirs[unset dirs]    [list {*}$links [file join $folderpath .] [file join $folderpath ..]]]
+            set files [punk::lib::struct_set_diff_unique $files[unset files]  $links]
 
 
             #nested vfs mount.. REVIEW - does anything need special handling?
@@ -1300,34 +1309,63 @@ namespace eval punk::du {
             }
             # -- --- --- --- --- --- --- --- --- --- --- --- --- ---
 
+            #at least some vfs on windows seem to support the -hidden attribute
+            #we are presuming glob will accept the -types hidden option for all vfs - even if it doesn't really apply REVIEW
+            #The extra globs aren't nice - but hopefully the vfs is reasonably performant (?)
             set errors [dict create]
-            if {$opt_glob eq "*"} {
+            if {"windows" eq $::tcl_platform(platform)} {
-                set dirs   [glob -nocomplain -dir $folderpath -types d           * .*] ;# also returns links to dirs
+                if {$opt_glob eq "*"} {
-                #review - how are links handled in vfs? presumably if the vfs is a full implementation they should work at least within the vfs? 
+                    set hdirs  [glob -nocomplain -dir $folderpath -types {hidden d}  * .*] 
-                set links  [glob -nocomplain -dir $folderpath -types l           * .*]  ;# links may have dupes - we don't care. struct::set difference will remove
+                    set dirs   [glob -nocomplain -dir $folderpath -types d           * .*] ;# also returns links to dirs
-                set files  [glob -nocomplain -dir $folderpath -types f           * .*] ;# also returns links to files
+                    #review - how are links handled in vfs? presumably if the vfs is a full implementation they should work at least within the vfs? 
+                    set hlinks [glob -nocomplain -dir $folderpath -types {hidden l}  * .*]
+                    set links  [glob -nocomplain -dir $folderpath -types l           * .*]  ;# links may have dupes - we don't care. struct::set difference will remove
+                    set hfiles [glob -nocomplain -dir $folderpath -types {hidden l}  * .*]
+                    set files  [glob -nocomplain -dir $folderpath -types f           * .*] ;# also returns links to files
+                } else {
+                    set hdirs  [glob -nocomplain -dir $folderpath -types {hidden d}  $opt_glob]
+                    set dirs   [glob -nocomplain -dir $folderpath -types d           $opt_glob]
+                    set hlinks [glob -nocomplain -dir $folderpath -types {hidden l}  $opt_glob]
+                    set links  [glob -nocomplain -dir $folderpath -types l           $opt_glob]
+                    set hfiles [glob -nocomplain -dir $folderpath -types {hidden f}  $opt_glob]
+                    set files  [glob -nocomplain -dir $folderpath -types f           $opt_glob]
+                }
             } else {
-                set dirs   [glob -nocomplain -dir $folderpath -types d           $opt_glob]
+                #we leave it to the ui on unix to classify dotfiles as hidden
-                set links  [glob -nocomplain -dir $folderpath -types l           $opt_glob]
+                set hdirs {}
-                set files  [glob -nocomplain -dir $folderpath -types f           $opt_glob]
+                set hfiles {}
+                set hlinks {}
+                if {$opt_glob eq "*"} {
+                    set dirs   [glob -nocomplain -dir $folderpath -types d           * .*] ;# also returns links to dirs
+                    #review - how are links handled in vfs? presumably if the vfs is a full implementation they should work at least within the vfs? 
+                    set links  [glob -nocomplain -dir $folderpath -types l           * .*]  ;# links may have dupes - we don't care. struct::set difference will remove
+                    set files  [glob -nocomplain -dir $folderpath -types f           * .*] ;# also returns links to files
+                } else {
+                    set dirs   [glob -nocomplain -dir $folderpath -types d           $opt_glob]
+                    set links  [glob -nocomplain -dir $folderpath -types l           $opt_glob]
+                    set files  [glob -nocomplain -dir $folderpath -types f           $opt_glob]
+                }
             }
             #remove any links from our dirs and files collections
-            set dirs  [struct::set difference $dirs[unset dirs]    [concat $links [list [file join $folderpath .] [file join $folderpath ..] ]]]
+            #see du_dirlisting_generic re struct::set difference issues
-            set files [struct::set difference $files[unset files] $links]
+            set dirs  [punk::lib::struct_set_diff_unique $dirs[unset dirs]    [list {*}$links [file join $folderpath .] [file join $folderpath ..] ]]
+            set files [punk::lib::struct_set_diff_unique $files[unset files] $links]
             #nested vfs mount.. REVIEW - does anything need special handling?
             set vfsmounts [get_vfsmounts_in_folder $folderpath]
 
             set mdata_lists [du_get_metadata_lists $sized_types $timed_types $files $dirs $links]
 
+            set flaggedhidden [list {*}$hdirs {*}$hfiles {*}$hlinks]
 
             set effective_opts $opts
             dict set effective_opts -with_times $timed_types
             dict set effective_opts -with_sizes $sized_types
 
-            return [list dirs $dirs vfsmounts $vfsmounts links $links files $files filesizes [dict get $mdata_lists fsizes] sizes [dict get $mdata_lists allsizes] times [dict get $mdata_lists alltimes] flaggedhidden {} flaggedsystem {} flaggedreadonly {} altname {} opts $effective_opts errors $errors]
+            return [list dirs $dirs vfsmounts $vfsmounts links $links files $files filesizes [dict get $mdata_lists fsizes] sizes [dict get $mdata_lists allsizes] times [dict get $mdata_lists alltimes] flaggedhidden $flaggedhidden flaggedsystem {} flaggedreadonly {} altname {} opts $effective_opts errors $errors]
         }
 
         #we can halve the number of round trips on unix-like systems, where 'hidden' always corresponds to dotted files
+        #but we don't classify as such anyway. (leave for UI)
         proc du_dirlisting_unix {folderpath args} {
             set defaults [dict create\
                 -glob *\
@@ -1379,6 +1417,9 @@ namespace eval punk::du {
             }
             
             #this is not consistent with standard way * works for unix folders - but it is consistent with behaviour of this facility on windows 
+            #we don't classify anything as 'flaggedhidden' on unix.
+            #it is a convention for dotfiles rather than a flag - and we'll leave the distinction for the display library 
+            #This 
             if {$opt_glob eq "*"} {
                 set dirs   [glob -nocomplain -dir $folderpath -types d           * .*] ;# also returns links to dirs
                 set links  [glob -nocomplain -dir $folderpath -types l           * .*]  ;# links may have dupes - we don't care. struct::set difference will remove
@@ -1389,8 +1430,9 @@ namespace eval punk::du {
                 set files  [glob -nocomplain -dir $folderpath -types f           $opt_glob]
             }
             #remove any links from our dirs and files collections
-            set dirs  [struct::set difference $dirs[unset dirs]    [concat $links [list [file join $folderpath .] [file join $folderpath ..] ]]]
+            #see du_dirlisting_generic re struct::set difference issues
-            set files [struct::set difference $files[unset files] $links]
+            set dirs  [punk::lib::struct_set_diff_unique $dirs[unset dirs]    [list {*}$links [file join $folderpath .] [file join $folderpath ..] ]]
+            set files [punk::lib::struct_set_diff_unique $files[unset files] $links]
             set vfsmounts [get_vfsmounts_in_folder $folderpath]
 
             set mdata_lists [du_get_metadata_lists $sized_types $timed_types $files $dirs $links]
@@ -1406,7 +1448,7 @@ namespace eval punk::du {
         #return fsizes,allsizes,alltimes metadata in same order as files,dirs,links lists - if specified in sized_types 
         proc du_get_metadata_lists {sized_types timed_types files dirs links} {
             set meta_dict [dict create]
-            set meta_types [concat $sized_types $timed_types]
+            set meta_types [list {*}$sized_types {*}$timed_types]
             #known tcl stat keys 2023 - review
             set empty_stat_dict [dict create atime {} ctime {} dev {} gid {} ino {} mode {} mtime {} nlink {} size {} type {} uid {}]
             #make sure we call file stat only once per item
@@ -1419,6 +1461,7 @@ namespace eval punk::du {
                             if {![catch {file stat $path arrstat} errM]} {
                                 dict set meta_dict $path [dict create shorttype $ft {*}[array get arrstat]]
                             } else {
+                                puts stderr "du_get_metadata_lists: file stat $path error: $errM"
                                 dict lappend errors $path "file stat error: $errM"
                                 dict set meta_dict $path [dict create shorttype $ft {*}$empty_stat_dict]
                             }
@@ -1437,6 +1480,9 @@ namespace eval punk::du {
                     if {$ft eq "f"} {
                         #subst with na if empty? 
                         lappend fsizes [dict get $pathinfo size]
+                        if {[dict get $pathinfo size] eq ""} {
+                            puts stderr "du_get_metadata_lists: fsize $path is empty!"
+                        }
                     }
                 }
                 if {$ft in $timed_types} {
@@ -1446,7 +1492,7 @@ namespace eval punk::du {
             #todo - fix . The list lengths will presumably match but have empty values if failed to stat
             if {"f" in $sized_types} {
                 if {[llength $fsizes] ne [llength $files]} {
-                    dict lappend errors $folderpath "failed to retrieve all file sizes"
+                    dict lappend errors general "failed to retrieve all file sizes"
                 }
             }
             return [dict create fsizes $fsizes allsizes $allsizes alltimes $alltimes]

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

@@ -290,7 +290,6 @@ namespace eval punk::fileline::class {
                         -showconfig    0\
                         -boundaryheader {Boundary %i% at %b%}\
                     ]
-                    set known_opts [dict keys $defaults]
                     foreach {k v} $args {
                         switch -- $k {
                             -ansi - -offset - -displaybytes - -truncatedmark - -completemark - -moremark - -continuemark - -linemaxwidth - -linebase - -limit - -boundaries - -showconfig - -boundaryheader {

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

@@ -339,6 +339,144 @@ namespace eval punk::lib {
         set has_twapi [expr {![catch {package require twapi}]}]
     }
 
+    # == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == ==
+    # Maintenance - This is the primary source for tm_version... functions
+    #             - certain packages script require these but without package dependency
+    #             - 1 punk boot script
+    #             - 2 packagetrace module
+    #             - These should be updated to sync with this
+    # == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == ==
+    proc tm_version_isvalid {versionpart} {
+        #Needs to be suitable for use with Tcl's 'package vcompare'
+        if {![catch [list package vcompare $versionpart $versionpart]]} {
+            return 1
+        } else {
+            return 0
+        }
+    }
+    proc tm_version_major {version} {
+        if {![tm_version_isvalid $version]} {
+            error "Invalid version '$version' is not a proper Tcl module version number"
+        }
+        set firstpart [lindex [split $version .] 0]
+        #check for a/b in first segment
+        if {[string is integer -strict $firstpart]} {
+            return $firstpart
+        }
+        if {[string first a $firstpart] > 0} {
+            return [lindex [split $firstpart a] 0]
+        }
+        if {[string first b $firstpart] > 0} {
+            return [lindex [split $firstpart b] 0]
+        }
+        error "tm_version_major unable to determine major version from version number '$version'"
+    }
+    proc tm_version_canonical {ver} {
+        #accepts a single valid version only - not a bounded or unbounded spec
+        if {![tm_version_isvalid $ver]} {
+            error "tm_version_canonical version '$ver' is not valid for a package version"
+        }
+        set parts [split $ver .]
+        set newparts [list]
+        foreach o $parts {
+            set trimmed [string trimleft $o 0]
+            set firstnonzero [string index $trimmed 0]
+            switch -exact -- $firstnonzero {
+                "" {
+                    lappend newparts 0
+                }
+                a - b {
+                    #e.g 000bnnnn -> bnnnnn
+                    set tailtrimmed [string trimleft [string range $trimmed 1 end] 0]
+                    if {$tailtrimmed eq ""} {
+                        set tailtrimmed 0
+                    }
+                    lappend newparts 0$firstnonzero$tailtrimmed
+                }
+                default {
+                    #digit
+                    if {[string is integer -strict $trimmed]} {
+                        #e.g 0100 -> 100
+                        lappend newparts $trimmed
+                    } else {
+                        #e.g 0100b003 -> 100b003 (still need to process tail)
+                        if {[set apos [string first a $trimmed]] > 0} {
+                            set lhs [string range $trimmed 0 $apos-1] ;#assert lhs non-empty and only digits or wouldn't be in this branch
+                            set rhs [string range $trimmed $apos+1 end] ;#assert rhs non-empty and only digits
+                            set rhs [string trimleft $rhs 0]
+                            if {$rhs eq ""} {
+                                set rhs 0
+                            }
+                            lappend newparts ${lhs}a${rhs}
+                        } elseif {[set bpos [string first b $trimmed]] > 0} {
+                            set lhs [string range $trimmed 0 $bpos-1] ;#assert lhs non-empty and only digits or wouldn't be in this branch
+                            set rhs [string range $trimmed $bpos+1 end] ;#assert rhs non-empty and only digits
+                            set rhs [string trimleft $rhs 0]
+                            if {$rhs eq ""} {
+                                set rhs 0
+                            }
+                            lappend newparts ${lhs}b${rhs}
+                        } else {
+                            #assert - shouldn't get here trimmed val should have been empty, an int or contained an a or b
+                            error "tm_version_canonical error - trimfail - unexpected"
+                        }
+                    }
+                }
+            }
+        }
+        return [join $newparts .]
+    } 
+    proc tm_version_required_canonical {versionspec} {
+        #also trim leading zero from any dottedpart?
+        #Tcl *allows* leading zeros in any of the dotted parts - but they are not significant.
+        #e.g 1.01 is equivalent to 1.1 and 01.001
+        #also 1b3 == 1b0003
+
+        if {[string trim $versionspec] eq ""} {return ""}  ;#unspecified = any version
+        set errmsg "tm_version_required_canonical - invalid version specification" 
+        if {[string first - $versionspec] < 0} {
+            #no dash  
+            #looks like a minbounded version (ie a single version with no dash)  convert to min-max form 
+            set from $versionspec
+            if {![tm_version_isvalid $from]} {
+                error "$errmsg '$versionpec'"
+            }
+            if {![catch {tm_version_major $from} majorv]} {
+                set from [tm_version_canonical $from]
+                return "${from}-[expr {$majorv +1}]"
+            } else {
+                error "$errmsg '$versionspec'"
+            }
+        } else {
+            # min- or min-max 
+            #validation and canonicalisation (strip leading zeroes from each segment, including either side of a or b)
+            set parts [split $versionspec -] ;#we expect only 2 parts
+            lassign $parts from to
+            if {![tm_version_isvalid $from]} {
+                error "$errmsg '$versionspec'"
+            }
+            set from [tm_version_canonical $from]
+            if {[llength $parts] == 2} {
+                if {$to ne ""} {
+                    if {![tm_version_isvalid $to]} {
+                        error "$errmsg '$versionspec'"
+                    }
+                    set to [tm_version_canonical $to]
+                    return $from-$to
+                } else {
+                    return $from-
+                }
+            } else {
+                error "$errmsg '$versionspec'"
+            }
+            error "tm_version_required_canonical should have already returned a canonicalised versionspec - or produced an error with reason before this point"
+        }
+    }
+    # end tm_version... functions
+    # == == == == == == == == == == == == == == == == == == == == == == == == == == == == == == ==
+
+
+
     # -- ---
     #https://stackoverflow.com/questions/17631269/whats-the-best-way-to-join-two-lists
     #DKF's 2013 recommendation of using list {*}$first {*}$second seems not to apply in 2024
@@ -1575,8 +1713,20 @@ namespace eval punk::lib {
         lremove $fromlist {*}$doomed
     }
 
+    #fix for tcl impl of struct::set::diff which doesn't dedupe
+    proc struct_set_diff_unique {A B} {
+        package require struct::set ;#require even if tcl impl - so the dependency isn't missed accidentally due to Loaded state of programmers machine.
+        if {[struct::set::Loaded] eq "tcl"} {
+            return [punk::lib::setdiff $A $B]
+        } else {
+            #use (presumably critcl) implementation for speed
+            return [struct::set difference $A $B]
+        }
+    }
+
+
     #non-dupe preserving - for consistency in dedupe behaviour we don't shortcircuit empty B
-    #consistent dedupe and order-maintenance of remaining items in A differentiate this from struct::set difference
+    #consistent dedupe and order-maintenance of remaining items in A differentiate this from struct::set difference (dedupes with critcl, doesn't with tcl implementation 2024)
     #also struct::set difference with critcl is faster
     proc setdiff {A B} {
         if {[llength $A] == 0} {return {}}
@@ -2387,7 +2537,7 @@ namespace eval punk::lib {
         set stdin_state [fconfigure stdin]
         if {[catch {
             package require punk::console
-            set console_raw [set ::punk::console::is_raw]
+            set console_raw [tsv::get console is_raw]
         } err_console]} {
             #assume normal line mode
             set console_raw 0
@@ -3032,6 +3182,11 @@ namespace eval punk::lib {
     proc objclone {obj} {
         append obj2 $obj {}
     }
+    proc set_clone {varname obj} {
+        #used by repl's codeinterp. Maintains internal rep, easier to call e.g interp eval code [list punk::set_clone varnmame $val]
+        append obj2 $obj {}
+        uplevel 1 [list set $varname $obj2]
+    }
 
 
 
@@ -3175,7 +3330,7 @@ tcl::namespace::eval punk::lib::system {
     #[para] Internal functions that are not part of the API 
     #[list_begin definitions]
 
-    proc has_script_var_bug {} {
+    proc has_tclbug_script_var {} {
         set script {set j [list spud] ; list}
         append script \n
         uplevel #0 $script
@@ -3194,7 +3349,15 @@ tcl::namespace::eval punk::lib::system {
             return false
         }
     }
-    proc has_safeinterp_compile_bug {{show 0}} {
+
+    proc has_tclbug_list_quoting_emptyjoin {} {
+        #https://core.tcl-lang.org/tcl/tktview/e38dce74e2
+        set v1 [list {*}[lindex #foo] {*}[]] ;#can return "#foo" instead of "{#foo}" under some beta 9 releases
+        set v2 [list #foo] ;#normal tcl list quoting for 1st element that looks like a comment -> "{#foo}"
+        return [expr {![string equal $v1 $v2]}]  ;#if they're not equal - we have the bug.
+    }
+
+    proc has_tclbug_safeinterp_compile {{show 0}} {
         #ensemble calls within safe interp not compiled
         namespace eval [namespace current]::testcompile {
             proc ensembletest {} {string index a 0}

src/bootsupport/modules/punk/mix/base-0.1.tm

@@ -473,13 +473,26 @@ namespace eval punk::mix::base {
             #set data [fileutil::cat -translation binary $filename] ;#no significant performance diff on windows - and doesn't handle win-illegal names
             zlib adler32 $data
         }
-        #zlib crc vie file-slurp
+        #zlib crc via file-slurp
         proc cksum_crc_file {filename} {
             package require zlib
             set data [punk::mix::util::fcat -translation binary -encoding iso8859-1 $filename]
             zlib crc $data
         }
 
+        proc cksum_md5_data {data} {
+            if {[package vsatisfies [package present md5] 2-]} {
+                return [md5::md5 -hex $data]
+            } else {
+                return [md5::md5 $data]
+            }
+        }
+        #fallback md5 via file-slurp - shouldn't be needed if have md5 2-
+        proc cksum_md5_file {filename} {
+            set data [punk::mix::util::fcat -translation binary -encoding iso8859-1 $filename]
+            cksum_md5_data $data
+        }
+
 
         #required to be able to accept relative paths
         #for full cksum - using tar could reduce number of hashes to be made..
@@ -624,7 +637,11 @@ namespace eval punk::mix::base {
                 }
                 md5 {
                     package require md5
-                    set cksum_command [list md5::md5 -hex -file]
+                    if {[package vsatisfies [package present md5] 2- ] } {
+                        set cksum_command [list md5::md5 -hex -file]
+                    } else {
+                        set cksum_comand  [list cksum_md5_file]
+                    }
                 }
                 cksum {
                     package require cksum ;#tcllib
@@ -637,7 +654,7 @@ namespace eval punk::mix::base {
                     set cksum_command [list cksum_adler32_file]
                 }
                 sha3 - sha3-256 {
-                    #todo - replace with something that doesn't call another process
+                    #todo - replace with something that doesn't call another process - only if tcllibc not available!
                     #set cksum_command [list apply {{file} {lindex [exec fossil sha3sum -256 $file] 0}}]
                     set cksum_command [list $sha3_implementation 256]
                 }
@@ -684,7 +701,7 @@ namespace eval punk::mix::base {
                     set sizeinfo "(file type $ftype - tarred size [punk::lib::format_number [file size $archivename]] bytes)"
                 }
                 set tsstart [clock millis]
-                puts -nonewline stdout "cksum_path: calculating cksum for $target $sizeinfo ... "
+                puts -nonewline stdout "cksum_path: calculating cksum using $opt_cksum_algorithm for $target $sizeinfo ... "
                 set cksum [{*}$cksum_command $archivename]
                 set tsend [clock millis]
                 set ms [expr {$tsend - $tsstart}]

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

@@ -271,7 +271,12 @@ namespace eval punk::mix::commandset::doc {
                         #this case only came up because docgen used to path munge to long filenames - but left because we know there is a limit and renaming fixes it - even if it's ugly - but still allows doc generation.
                         #review - if we're checking fname - should also test length of whole path and determine limits for tar
                         package require md5
-                        set target_docname [md5::md5 -hex [encoding convertto utf-8 $fullpath]]_overlongfilename.man
+                        if {[package vsatisfies [package present md5] 2- ] } {
+                            set md5opt "-hex"
+                        } else {
+                            set md5opt ""
+                        }
+                        set target_docname [md5::md5 {*}$md5opt [encoding convertto utf-8 $fullpath]]_overlongfilename.man
                         puts stderr "WARNING - overlong file name - renaming $fullpath"
                         puts stderr "          to                            [file dirname $fullpath]/$target_docname"
                     }

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

@@ -261,6 +261,8 @@ namespace eval punk::mix::util {
         return
     }
 
+    # review punk::lib::tm_version.. functions
+
     proc is_valid_tm_version {versionpart} {
         #Needs to be suitable for use with Tcl's 'package vcompare'
         if {![catch [list package vcompare $versionpart $versionpart]]} {

src/bootsupport/modules/punk/nav/fs-0.1.0.tm

@@ -821,9 +821,12 @@ tcl::namespace::eval punk::nav::fs {
                 set match_contents $opt_tailglob 
             }
         }
-        puts stdout "searchbase: $searchbase searchspec:$searchspec"
+        #puts stdout "searchbase: $searchbase searchspec:$searchspec"
 
-        set in_vfs 0
+
+        #file attr //cookit:/  returns {-vfs 1 -handle {}} 
+        #we will treat it differently for now - use generic handler REVIEW
+        set in_vfs 0 ;#we use this only for a vfs which is reported to have a mountpoint by vfs::filesystem info - not all that have -vfs 1 attr like cookit.
         if {[llength [package provide vfs]]} {
             foreach mount [vfs::filesystem info] {
                 if {[punk::mix::base::lib::path_a_atorbelow_b $location $mount]} {
@@ -849,22 +852,45 @@ tcl::namespace::eval punk::nav::fs {
             set listing [punk::du::lib::du_dirlisting_tclvfs $location -glob $match_contents {*}$next_opt_with_sizes {*}$next_opt_with_times]
         } else {
             set in_zipfs 0
-            if {[info commands ::tcl::zipfs::mount] ne ""} {
+            set in_cookit 1
-                if {[string match //zipfs:/* $location]} {
+            set in_other_pseudovol 1
-                    set in_zipfs 1
+            switch -glob -- $location {
+                //zipfs:/* {
+                    if {[info commands ::tcl::zipfs::mount] ne ""} {
+                        set in_zipfs 1
+                    }
+                }
+                //cookit:/* {
+                    set in_cookit 1
+                }
+                default {
+                    #handle 'other/unknown' that mounts at a volume-like path  //pseudovol:/
+                    if {[regexp {//((?:(?!:|/).)+):/.*} $location _match pseudovol]} {
+                        #pseudovol probably more than one char long
+                        #we don't really expect something like //c:/ , but anyway, it's not the same as c:/ and for all we know someone could use that as a volume name?
+                        set in_other_pseudovol 1 ;#flag so we don't use twapi - hope generic can handle it (uses tcl glob)
+                    } else {
+                        #we could use 'file attr' here to test if {-vfs 1} 
+                        #but it's an extra filesystem hit on all normal paths too (which can be expensive on some systems) 
+                        #instead for now we'll assume any reasonable vfs should have been found by vfs::filesystem::info or mounted as a pseudovolume
+                    }
+                    
                 }
-                #dict for {zmount zpath} [zipfs mount] {
-                #    if {[punk::mix::base::lib::path_a_atorbelow_b $location $zmount]} {
-                #        set in_zipfs 1
-                #        break
-                #    }
-                #}
             }
+
             if {$in_zipfs} {
                 #relative vs absolute? review - cwd valid for //zipfs:/ ??
-                set listing [punk::du::lib::du_dirlisting_zipfs $location -glob $match_contents {*}$next_opt_with_sizes {*}$next_opt_with_times]
+                set listing [punk::du::lib::du_dirlisting_zipfs     $location -glob $match_contents {*}$next_opt_with_sizes {*}$next_opt_with_times]
+            } elseif {$in_cookit} {
+                #seems to be a vfs - except it mounts on a pseudo-volume path //cookit:/ 
+                #don't use twapi
+                #could possibly use du_dirlisting_tclvfs  REVIEW
+                #files and folders are all returned with the -types hidden option for glob on windows
+                set listing [punk::du::lib::du_dirlisting_generic   $location -glob $match_contents {*}$next_opt_with_sizes {*}$next_opt_with_times]
+            } elseif {$in_other} {
+                set listing [punk::du::lib::du_dirlisting_generic   $location -glob $match_contents {*}$next_opt_with_sizes {*}$next_opt_with_times]
             } else {
-                set listing [punk::du::dirlisting $location -glob $match_contents {*}$next_opt_with_sizes {*}$next_opt_with_times]
+                set listing [punk::du::dirlisting                   $location -glob $match_contents {*}$next_opt_with_sizes {*}$next_opt_with_times]
             }
         }
 

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

@@ -155,18 +155,26 @@ tcl::namespace::eval punk::packagepreference {
                     if {[lindex $args 1] eq "-exact"} {
                         set pkg [lindex $args 2]
                         set vwant [lindex $args 3]
-                        if {[set ver [package provide $pkg]] ne ""} {
+                        if {[set ver [$COMMANDSTACKNEXT_ORIGINAL provide $pkg]] ne ""} {
-                            if {$ver eq $vwant} {
+                            #although we could shortcircuit using vsatisfies to return the ver 
-                                return $vwant
+                            #we should instead pass through to COMMANDSTACKNEXT so as not to interfere with whatever it does.
-                            } else {
+                            return [$COMMANDSTACKNEXT {*}$args]
-                                #package already provided with a different version.. we will defer to underlying implementation to return the standard error
+
-                                return [$COMMANDSTACKNEXT {*}$args]
+                            #if {$vwant eq "" || [$COMMANDSTACKNEXT vsatisfies $ver $vwant]} {
-                            }
+                            #    return $ver
+                            #} else {
+                            #    #package already provided with a different version.. we will defer to underlying implementation to return the standard error
+                            #    return [$COMMANDSTACKNEXT {*}$args]
+                            #}
                         }
                     } else {
                         set pkg [lindex $args 1]
-                        if {[set ver [package provide $pkg]] ne ""} {
+                        set vwant [lindex $args 2]
-                            return $ver
+                        if {[set ver [$COMMANDSTACKNEXT_ORIGINAL provide $pkg]] ne ""} {
+                            return [$COMMANDSTACKNEXT {*}$args]
+                            #if {$vwant eq "" || [$COMMANDSTACKNEXT vsatisfies $ver $vwant]} {
+                            #    return $ver
+                            #}
                         }
                     }
                     if {[regexp {[A-Z]} $pkg]} {

src/bootsupport/modules/punk/repl/codethread-0.1.0.tm

@@ -20,12 +20,12 @@
 #*** !doctools
 #[manpage_begin shellspy_module_punk::repl::codethread 0 0.1.0]
 #[copyright "2024"]
-#[titledesc {Module API}]  [comment {-- Name section and table of contents description --}]
+#[titledesc {Module repl codethread}]  [comment {-- Name section and table of contents description --}]
-#[moddesc {-}]             [comment {-- Description at end of page heading --}] 
+#[moddesc {codethread for repl - root interpreter}]             [comment {-- Description at end of page heading --}] 
 #[require punk::repl::codethread]
-#[keywords module]
+#[keywords module repl]
 #[description]
-#[para] -
+#[para] This is part of the infrastructure required for the punk::repl to operate 
 
 # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
 
@@ -131,11 +131,14 @@ tcl::namespace::eval punk::repl::codethread {
     #    return "ok" 
     #}
 
+    variable run_command_cache
+
     proc is_running {} {
         variable running
         return $running
     }
     proc runscript {script} {
+        
         #puts stderr "->runscript"
         variable replthread_cond 
         variable output_stdout ""
@@ -169,9 +172,18 @@ tcl::namespace::eval punk::repl::codethread {
         #set errhandle [shellfilter::stack::item_tophandle stderr]
         #interp transfer "" $errhandle code
 
-        set scope [interp eval code [list set ::punk::ns::ns_current]]
         set status [catch {
-            interp eval code [list tcl::namespace::inscope $scope $script]
+            #shennanigans to keep compiled script around after call.
+            #otherwise when $script goes out of scope - internal rep of vars set in script changes.
+            #The shimmering may be no big deal(?) - but debug/analysis using tcl::unsupported::representation becomes impossible.
+            interp eval code [list ::punk::lib::set_clone ::codeinterp::clonescript $script] ;#like objclone
+            interp eval code {
+                lappend ::codeinterp::run_command_cache $::codeinterp::clonescript
+                if {[llength $::codeinterp::run_command_cache] > 2000} {
+                    set ::codeinterp::run_command_cache [lrange $::codeinterp::run_command_cache 1750 end][unset ::codeinterp::run_command_cache]
+                }
+                tcl::namespace::inscope $::punk::ns::ns_current $::codeinterp::clonescript
+            }
         } result]
 
 

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

@@ -27,6 +27,11 @@
 #
 # path/repo functions
 #
+
+#REVIEW punk::repo required early by punk boot script to find projectdir
+#todo - split off basic find_project chain of functions to a smaller package and import as necessary here
+#Then we can reduce early dependencies in punk boot
+
 if {$::tcl_platform(platform) eq "windows"} {
     package require punk::winpath
 } else {

src/bootsupport/modules/textblock-0.1.1.tm

@@ -5280,7 +5280,7 @@ tcl::namespace::eval textblock {
                 It excludes the extra top and side join elements htlj,hlbj,vllj,vlrj"
                 *values -min 1 -max 1
                 frametype -help "name from the predefined frametypes:<ftlist>
-                or an adhoc 
+                or an adhoc "
             }]   
             append spec \n "frametype -help \"A predefined \""
             punk::args::get_dict $spec $args
@@ -6804,7 +6804,11 @@ tcl::namespace::eval textblock {
 
         if {$use_md5} {
             #package require md5 ;#already required at package load
-            set hash [md5::md5 -hex [encoding convertto utf-8 $hashables]] ;#need fast and unique to content - not cryptographic - review
+            if {[package vsatisfies [package present md5] 2- ] } {
+                set hash [md5::md5 -hex [encoding convertto utf-8 $hashables]] ;#need fast and unique to content - not cryptographic - review
+            } else {
+                set hash [md5::md5 [encoding convertto utf-8 $hashables]]
+            }
         } else {
             set hash $hashables
         }

src/bootsupport/modules/textutil-0.9.tm

@@ -16,7 +16,7 @@
 # ### ### ### ######### ######### #########
 ## Requirements
 
-package require Tcl 8.2
+package require Tcl 8.2-
 
 namespace eval ::textutil {}