vfs update

src/vfs/_config/punk_main.tcl

@@ -149,6 +149,11 @@ apply { args {
     set topdir [file dirname $normscript]
     set found_starkit_tcl 0
     set possible_lib_vfs_folders [glob -nocomplain -dir [file join $topdir lib] -type d vfs*]
+    if {$has_zipfs_attached} {
+        if {[file exists [zipfs root]/app/tcl_library]} {
+            lappend possible_lib_vfs_folders {*}[glob -nocomplain -dir [zipfs root]/app/tcl_library -type d vfs*]
+        }
+    }
     foreach test_folder $possible_lib_vfs_folders {
         #e.g <name_of_exe>/lib/vfs1.4.1
         #we don't expect multiple vfs* folders - but we will process any found and load the pkgIndex.tcl from these folders.
@@ -178,6 +183,7 @@ apply { args {
         #puts stderr [join [package names] \n]
         set original_packages [package names]
 
+        #This is what we were trying to avoid - a package require causing a scan of ::auto_path and tcl::tm::list
         if {![catch {package require starkit}]} {
             #known side-effects of starkit::startup
             #sets the ::starkit::mode variable to the way in which it was launched. One of: {starpack starkit unwrapped tclhttpd plugin service sourced}
@@ -185,9 +191,11 @@ apply { args {
             #if mode not starpack, then:
             #   - adds $::starkit::topdir/lib to the auto_path if not already present
             #
-            #In this context (vfs attached to tcl kit executable - we expect the launch mode to be 'starkit'
+            #In the context of a metakit vfs attached to tcl kit executable - we expect the launch mode to be 'starkit'
             set starkit_startmode [starkit::startup]
-            puts stderr "STARKIT MODE: $starkit_startmode"
+            #However - we may also get here for a zipfs enabled tcl with a zifps vfs attached - but which has vlerq, starkit and vfs libraries available,
+            #in which case the mode seems to be reported as 'unwrapped'
+            #puts stderr "STARKIT MODE: $starkit_startmode"
         }
         #puts "main.tcl 2)--> package name count: [llength [package names]]"
         foreach pkg [package names] {
@@ -801,53 +809,43 @@ apply { args {
         #puts stderr "main.tcl tcl::tm::list:[tcl::tm::list]"
     }
 
-    if {1 || $has_zipfs_attached} {
-        #load libunknown without triggering the existing package unknown
 
-        #maint: also in punk::repl package
-        #--------------------------------------------------------
-        set libunks [list]
-        foreach tm_path [tcl::tm::list] {
-            set punkdir [file join $tm_path punk]
-            if {![file exists $punkdir]} {continue}
-            lappend libunks {*}[glob -nocomplain -dir $punkdir -type f libunknown-*.tm]
-        }
-        set libunknown ""
-        set libunknown_version_sofar ""
-        foreach lib $libunks {
-            #expecting to be of form libunknown-<tclversion>.tm
-            set vtail [lindex [split [file tail $lib] -] 1]
-            set thisver [file rootname $vtail] ;#file rootname x.y.z.tm
-            if {$libunknown_version_sofar eq ""} {
+
+    #--------------------------------------------------------
+    #load libunknown without triggering the existing package unknown
+    #maint: also in punk::repl package
+    #--------------------------------------------------------
+    set libunks [list]
+    foreach tm_path [tcl::tm::list] {
+        set punkdir [file join $tm_path punk]
+        if {![file exists $punkdir]} {continue}
+        lappend libunks {*}[glob -nocomplain -dir $punkdir -type f libunknown-*.tm]
+    }
+    set libunknown ""
+    set libunknown_version_sofar ""
+    foreach lib $libunks {
+        #expecting to be of form libunknown-<tclversion>.tm
+        set vtail [lindex [split [file tail $lib] -] 1]
+        set thisver [file rootname $vtail] ;#file rootname x.y.z.tm
+        if {$libunknown_version_sofar eq ""} {
+            set libunknown_version_sofar $thisver
+            set libunknown $lib
+        } else {
+            if {[package vcompare $thisver $libunknown_version_sofar] == 1} {
                 set libunknown_version_sofar $thisver
                 set libunknown $lib
-            } else {
-                if {[package vcompare $thisver $libunknown_version_sofar] == 1} {
-                    set libunknown_version_sofar $thisver
-                    set libunknown $lib
-                }
             }
         }
-        if {$libunknown ne ""} {
-            source $libunknown
-            if {[catch {punk::libunknown::init -caller main.tcl} errM]} {
-                puts "error initialising punk::libunknown\n$errM"
-            }
+    }
+    if {$libunknown ne ""} {
+        source $libunknown
+        if {[catch {punk::libunknown::init -caller main.tcl} errM]} {
+            puts "error initialising punk::libunknown\n$errM"
         }
-        #--------------------------------------------------------
-
-
-        #set zr [::tcl::zipfs::root] ;#always ends with / ? - REVIEW
-        #if {[file join $zr app modules] in [tcl::tm::list]} {
-        #    #todo - better way to find latest version - without package require
-        #    set lib [file join $zr app modules punk libunknown.tm]
-        #    if {[file exists $lib]} {
-        #        source $lib
-        #        punk::libunknown::init
-        #        #package unknown {punk::libunknown::zipfs_tm_UnknownHandler punk::libunknown::zipfs_tclPkgUnknown}
-        #    }
-        #}
     }
+    #--------------------------------------------------------
+    #Now that new 'package unknown' mechanism is in place - we can use package require
+
 
     #assert arglist has had 'dev|os|os-dev etc' first arg removed if it was present.
     if {[llength $arglist] == 1 && [lindex $arglist 0] eq "tclsh"} {

src/vfs/_vfscommon.vfs/lib/app-punk/repl.tcl

@@ -49,16 +49,20 @@ repl::init -safe 0
 #flush stderr
 set replresult [repl::start stdin -title app-punk]
 
-catch {
-    puts "app-punk ifneeded: [package ifneeded app-punk 1.0]"
-}
+#catch {
+#    puts "app-punk ifneeded: [package ifneeded app-punk 1.0]"
+#}
+
 #review
 if {[string is integer -strict $replresult]} {
-    puts stdout "repl.tcl exiting with numeric code $replresult"
+    #puts stdout "repl.tcl exiting with numeric code $replresult"
     exit $replresult
 } else {
-    puts stdout "repl.tcl result $replresult"
-    flush stdout
+    if {$replresult ne ""} {
+        #puts stdout "repl.tcl result $replresult"
+        puts stdout $replresult
+        flush stdout
+    }
     exit 0
 }
 #puts "- repl app done -"

src/vfs/_vfscommon.vfs/lib/app-punkshell/punkshell.tcl

@@ -1,6 +1,7 @@
 package provide app-punkshell 1.0
 
 package require Thread
+package require punk::lib  ;#required for compat - lpop for some early Tcl 8.6 versions
 package require punk::args
 package require shellfilter
 package require punk::ansi

src/vfs/_vfscommon.vfs/modules/punk/args-0.2.tm

@@ -3036,8 +3036,11 @@ tcl::namespace::eval punk::args {
     #This mechanism gets less-than-useful results for oo methods
     #e.g {$obj}
     proc Get_caller {} {
+        set depth [info level]
+        set maxd [expr {min($depth,4)}]
+        set call_level [expr {-1 * $maxd}]
         #set call_level -3 ;#for get_dict call
-        set call_level -4
+        #set call_level -4
         set cmdinfo [tcl::dict::get [tcl::info::frame $call_level] cmd]
         #puts "-->$cmdinfo"
         #puts "-->[tcl::info::frame -3]"

src/vfs/_vfscommon.vfs/modules/punk/args/tclcore-0.1.0.tm

@@ -3498,7 +3498,7 @@ tcl::namespace::eval punk::args::tclcore {
                   example, in ${$B}-dictionary${$N} mode, bigBoy sorts between bigbang and bigboy,
                   and x10y sorts between x9y and x11y. Overrides the ${$B}-nocase${$N} option."
             -integer -type none -help\
-                "Convert list elements to integers and use integer comparsion."
+                "Convert list elements to integers and use integer comparison."
             -real -type none -help\
                 "Convert list elements to floating-point values and use floating comparison."
             -command -type string -help\

src/vfs/_vfscommon.vfs/modules/punk/console-0.1.1.tm

@@ -132,54 +132,359 @@ namespace eval punk::console {
 
     if {"windows" eq $::tcl_platform(platform)} {
         #accept args for all dummy/load functions so we don't have to match/update argument signatures here
+        set has_twapi [expr {! [catch {package require twapi}]}]
+
+        if {$has_twapi} {
+            #this is really enableAnsi *processing*
+            proc enableAnsi {} {
+                #output handle modes
+                #Enable virtual terminal processing (sometimes off in older windows terminals)
+                #ENABLE_PROCESSED_OUTPUT = 0x0001
+                #ENABLE_WRAP_AT_EOL_OUTPUT = 0x0002
+                #ENABLE_VIRTUAL_TERMINAL_PROCESSING = 0x0004
+                #DISABLE_NEWLINE_AUTO_RETURN = 0x0008
+                if {[catch {twapi::get_console_handle stdout} h_out]} {
+                    puts stderr "enableAnsi failed: twapi cannot get console handle for stdout"
+                    return
+                }
 
-        proc enableAnsi {args} {
-            #loopavoidancetoken (don't remove) 
-            internal::define_windows_procs
-            internal::abort_if_loop
-            tailcall enableAnsi {*}$args
-        }
-        #review what raw mode means with regard to a specific channel vs terminal as a whole
-        proc enableRaw {args} {
-            #loopavoidancetoken (don't remove) 
-            internal::define_windows_procs
-            internal::abort_if_loop
-            tailcall enableRaw {*}$args 
-        }
-        proc disableRaw {args} {
-            #loopavoidancetoken (don't remove) 
-            internal::define_windows_procs
-            internal::abort_if_loop
-            tailcall disableRaw {*}$args
-        }
-        proc enableVirtualTerminal {args} {
-            #loopavoidancetoken (don't remove) 
-            internal::define_windows_procs
-            internal::abort_if_loop
-            tailcall enableVirtualTerminal {*}$args
-        }
-        proc disableVirtualTerminal {args} {
-            #loopavoidancetoken (don't remove) 
-            internal::define_windows_procs
-            internal::abort_if_loop
-            tailcall disableVirtualTerminal {*}$args
-        }
-        set funcs [list disableAnsi enableProcessedInput disableProcessedInput]
-        foreach f $funcs {
-            proc $f {args} [string map [list %f% $f] {
-                set mybody [info body %f%]
-                internal::define_windows_procs
-                set newbody [info body %f%]
-                if {$newbody ne $mybody} {
-                    tailcall %f% {*}$args
+                set oldmode_out [twapi::GetConsoleMode $h_out]
+                set newmode_out [expr {$oldmode_out | 4}] ;#don't enable processed output too, even though it's required. keep symmetrical with disableAnsi?
+
+                twapi::SetConsoleMode $h_out $newmode_out
+
+                #what does window_input have to do with it??
+                #input handle modes
+                #ENABLE_PROCESSED_INPUT 0x0001  ;#set to zero will allow ctrl-c to be reported as keyboard input rather than as a signal
+                #ENABLE_LINE_INPUT 0x0002
+                #ENABLE_ECHO_INPUT 0x0004
+                #ENABLE_WINDOW_INPUT 0x0008  (default off when a terminal created)
+                #ENABLE_MOUSE_INPUT 0x0010
+                #ENABLE_INSERT_MODE 0X0020
+                #ENABLE_QUICK_EDIT_MODE 0x0040
+                #ENABLE_VIRTUAL_TERMINAL_INPUT 0x0200 (default off when a terminal created) (512)
+                set h_in [twapi::get_console_handle stdin]
+                set oldmode_in [twapi::GetConsoleMode $h_in]
+                set newmode_in [expr {$oldmode_in | 8}]
+                #set newmode_in [expr {$oldmode_in | 0x208}]
+
+                twapi::SetConsoleMode $h_in $newmode_in
+
+                return [list stdout [list from $oldmode_out to $newmode_out] stdin [list from $oldmode_in to $newmode_in]]
+            }
+            proc disableAnsi {} {
+                set h_out [twapi::get_console_handle stdout] 
+                set oldmode_out [twapi::GetConsoleMode $h_out]
+                set newmode_out [expr {$oldmode_out & ~4}]
+                twapi::SetConsoleMode $h_out $newmode_out
+
+                #??? review
+                set h_in [twapi::get_console_handle stdin]
+                set oldmode_in [twapi::GetConsoleMode $h_in]
+                set newmode_in [expr {$oldmode_in & ~8}]
+                twapi::SetConsoleMode $h_in $newmode_in
+
+
+                return [list stdout [list from $oldmode_out to $newmode_out] stdin [list from $oldmode_in to $newmode_in]]
+            }
+            proc enableVirtualTerminal {{channels {input output}}} {
+                set ins [list in input stdin]
+                set outs [list out output stdout stderr]
+                set known [concat $ins $outs both]
+                set directions [list]
+                foreach v $channels {
+                    if {$v in $ins} {
+                        lappend directions input
+                    } elseif {$v in $outs} {
+                        lappend directions output
+                    } elseif {$v eq "both"} {
+                        lappend directions input output
+                    }
+                    if {$v ni $known} {
+                        error "enableVirtualTerminal expected channel values to be one of '$known'. (all values mapped to input and/or output)"
+                    }
+                }
+                set channels $directions ;#don't worry about dups.
+                if {"both" in $channels} {
+                    lappend channels input output
+                }
+                set result [dict create]
+                if {"output" in $channels} {
+                    #note setting stdout makes stderr have the same settings - ie there is really only one output to configure
+                    set h_out [twapi::get_console_handle stdout] 
+                    set oldmode [twapi::GetConsoleMode $h_out]
+                    set newmode [expr {$oldmode | 4}] 
+                    twapi::SetConsoleMode $h_out $newmode
+                    dict set result output [list from $oldmode to $newmode]
+                }
+
+                if {"input" in $channels} {
+                    set h_in [twapi::get_console_handle stdin]
+                    set oldmode_in [twapi::GetConsoleMode $h_in]
+                    set newmode_in [expr {$oldmode_in | 0x200}]
+                    twapi::SetConsoleMode $h_in $newmode_in
+                    dict set result input [list from $oldmode_in to $newmode_in]
+                }
+
+                return $result
+            }
+
+            proc disableVirtualTerminal {{channels {input output}}} {
+                set ins [list in input stdin]
+                set outs [list out output stdout stderr]
+                set known [concat $ins $outs both]
+                set directions [list]
+                foreach v $channels {
+                    if {$v in $ins} {
+                        lappend directions input
+                    } elseif {$v in $outs} {
+                        lappend directions output
+                    } elseif {$v eq "both"} {
+                        lappend directions input output
+                    }
+                    if {$v ni $known} {
+                        error "disableVirtualTerminal expected channel values to be one of '$known'. (all values mapped to input and/or output)"
+                    }
+                }
+                set channels $directions ;#don't worry about dups.
+                if {"both" in $channels} {
+                    lappend channels input output
+                }
+                set result [dict create]
+                if {"output" in $channels} {
+                    #as above - configuring stdout does stderr too
+                    set h_out [twapi::get_console_handle stdout] 
+                    set oldmode [twapi::GetConsoleMode $h_out]
+                    set newmode [expr {$oldmode & ~4}] 
+                    twapi::SetConsoleMode $h_out $newmode
+                    dict set result output [list from $oldmode to $newmode]
+                }
+                if {"input" in $channels} {
+                    set h_in [twapi::get_console_handle stdin]
+                    set oldmode_in [twapi::GetConsoleMode $h_in]
+                    set newmode_in [expr {$oldmode_in & ~0x200}]
+                    twapi::SetConsoleMode $h_in $newmode_in
+                    dict set result input [list from $oldmode_in to $newmode_in]
+                }
+
+                #return [list stdout [list from $oldmode_out to $newmode_out] stdin [list from $oldmode_in to $newmode_in]]
+                return $result
+            }
+            proc enableProcessedInput {} {
+                set h_in [twapi::get_console_handle stdin]
+                set oldmode_in [twapi::GetConsoleMode $h_in]
+                set newmode_in [expr {$oldmode_in | 1}]
+                twapi::SetConsoleMode $h_in $newmode_in
+                return [list stdin [list from $oldmode_in to $newmode_in]]
+            }
+            proc disableProcessedInput {} {
+                set h_in [twapi::get_console_handle stdin]
+                set oldmode_in [twapi::GetConsoleMode $h_in]
+                set newmode_in [expr {$oldmode_in & ~1}]
+                twapi::SetConsoleMode $h_in $newmode_in
+                return [list stdin [list from $oldmode_in to $newmode_in]]
+            }
+            proc enableRaw {{channel stdin}} {
+                #variable is_raw
+                variable previous_stty_state_$channel
+
+                if {[catch {twapi::get_console_handle stdin} console_handle]} {
+                    puts stderr "enableRaw error: twapi cannot get console handle for stdin"
+                    #review. If twapi couldn't get a console handle - no point trying other mechanisms(?)
+                    return
+                }
+                #returns dictionary
+                #e.g -processedinput 1 -lineinput 1 -echoinput 1 -windowinput 0 -mouseinput 0 -insertmode 1 -quickeditmode 1 -extendedmode 1 -autoposition 0
+                set oldmode [twapi::get_console_input_mode]
+                twapi::modify_console_input_mode $console_handle -lineinput 0 -echoinput 0
+                # Turn off the echo and line-editing bits
+                #set newmode [dict merge $oldmode [dict create -lineinput 0 -echoinput 0]]
+                set newmode [twapi::get_console_input_mode]
+
+                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]]
+            }
+
+            #note: twapi GetStdHandle & GetConsoleMode & SetConsoleCombo unreliable - fails with invalid handle (somewhat intermittent.. after stdin reopened?)
+            #could be we were missing a step in reopening stdin and console configuration?
+
+            proc disableRaw {{channel stdin}} {
+                #variable is_raw
+                variable previous_stty_state_$channel
+                set ch_state [chan conf $channel]
+                if {[dict exists $ch_state -inputmode]} {
+                    chan conf $channel -inputmode normal
+                    tsv::set console is_raw 0
+                    return [list $channel [list from [dict get $ch_state -inputmode] to normal]]
+                } else {
+                    if {[catch {twapi::get_console_handle stdin} console_handle]} {
+                        #e.g tkcon/wish
+                        puts stderr "disableRaw error: twapi cannot get console handle for stdin"
+                        return ;# ???
+                    }
+                    set oldmode [twapi::get_console_input_mode]
+                    # Turn on the echo and line-editing bits
+                    twapi::modify_console_input_mode $console_handle -lineinput 1 -echoinput 1
+                    set newmode [twapi::get_console_input_mode]
+                    tsv::set console is_raw 0
+                    return [list stdin [list from $oldmode to $newmode]]
+                }
+            }
+
+        } else {
+
+            variable ps_consolemode_pid
+            variable ps_consolemode_contents
+            variable ps_pipename
+            if {![info exists ps_consolemode_contents]} {
+                #start persistent powershell consolemode_server.ps1 named pipe server
+                if {$::argv0 ne ""} {
+                    set pstooldir [file dirname [file dirname [file normalize $::argv0]]]/scriptlib/utils/pwsh
+                } else {
+                    set pstooldir [pwd]
+                }
+                #set ps_script $pstooldir/consolemode_server.ps1
+                set ps_script $pstooldir/consolemode_server_async.ps1
+                if {[file exists $ps_script]} {
+                    set fd [open $ps_script r]
+                    chan configure $fd -translation binary
+                    set ps_consoleid [pid]-[expr {int(999 * rand())+1}]
+                    set ps_consolemode_contents [string map [list "<punkshell_consoleid>" $ps_consoleid] [read $fd]]
+                    close $fd
+                    #set ps_consolemode_pipe [twapi::namedpipe_client {//./pipe/punkshell_ps_consolemode} -access write]
+                    #set ps_cmd [auto_execok pwsh.exe]
+                    set ps_cmd [auto_execok pwsh.exe]
+                    if {$ps_cmd eq ""} {
+                        set ps_cmd [auto_execok powershell.exe]
+                    }
+                    if {$ps_cmd ne ""} {
+                        set ps_consolemode_pid [exec {*}$ps_cmd -nop -nol -c $ps_consolemode_contents &]
+                        set ps_pipename {\\.\pipe\punkshell_ps_consolemode_}
+                        append ps_pipename $ps_consoleid
+                        puts stderr "twapi not present, using persistent powershell process: pipename: $ps_pipename pid: $ps_consolemode_pid"
+                        #todo -  taskkill /F /PID $ps_consolemode_pid
+                        #when?
+                        #review
+                        #if {[catch {puts "pidinfo: [::tcl::process::status $ps_consolemode_pid]"} errM]} {
+                        #    puts stderr "--- failed to get process status for $ps_consolemode_pid\n$errM"
+                        #}
+                        #set p [open {\\.\pipe\punkshell_ps_consolemode} w]
+                        #chan conf $p -buffering none -blocking 1
+                        #puts $p ""
+                        #close $p
+                    }
+                }
+
+            }
+
+
+            #enableRaw
+            proc enableRaw {{channel stdin}} {
+                #puts stderr "punk::console::enableRaw"
+                #variable is_raw
+                variable previous_stty_state_$channel
+                variable ps_consolemode_contents
+                variable ps_pipename
+
+
+                if {[info exists ps_consolemode_contents]} {
+                    #ps_pipename e.g \\.\pipe\punkwinshell_ps_consolemode_12345-1223456
+
+                    set trynum 0
+                    set wrote 0
+                    while {$trynum < 5} {
+                        incr trynum
+                        if {![catch {
+                            set pipe [open $ps_pipename w]
+                        } errMsg]} {
+                            chan conf $pipe -buffering line
+                            puts -nonewline $pipe "enableraw\r\n"
+                            #flush $pipe
+                            #after 10
+                            #close $pipe
+                            set wrote 1
+                            break
+                        } else {
+                            after 100
+                        }
+                    }
+                    if {$wrote} {
+                        tsv::set console is_raw 1
+                        #after 100
+                        close $pipe
+                    } else {
+                        puts stderr "write to $ps_pipename failed trynum: $trynum\n$errMsg"
+                    }
+                } elseif {[set sttycmd [auto_execok stty]] ne ""} {
+                    #todo - something else entirely
+                    #this approach does not work on windows
+                    #the msys/cygwin stty command is launched as a subprocess - can be used to retrieve info
+                    # but seems to be useless as far as affecting the calling process/console
+                    if {[set previous_stty_state_$channel] eq ""} {
+                        set previous_stty_state_$channel [exec {*}$sttycmd -g <@$channel]
+                    }
+
+                    exec {*}$sttycmd raw -echo <@$channel
+                    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 {
+                    error "punk::console::enableRaw Unable to use twapi or stty to set raw mode - aborting"
+                }
+            }
+
+
+            proc disableRaw {{channel stdin}} {
+                variable previous_stty_state_$channel
+                set ch_state [chan conf $channel]
+                if {[dict exists $ch_state -inputmode]} {
+                    chan conf $channel -inputmode normal
+                    tsv::set console is_raw 0
+                    return [list $channel [list from [dict get $ch_state -inputmode] to normal]]
                 } else {
-                    #error vs noop?
-                    puts stderr "Unable to set implementation for %f% - check twapi?"
+                    #tcl <= 8.6x doesn't support -inputmode
+                    if {[set sttycmd [auto_execok stty]] ne ""} {
+                        #this doesn't work on windows
+                        #It may seem to - only because running *any* external utility can exit raw mode
+                        set sttycmd [auto_execok stty]
+                        if {[set previous_stty_state_$channel] ne ""} {
+                            exec {*}$sttycmd [set previous_stty_state_$channel]
+                            set previous_stty_state_$channel ""
+                            return restored
+                        }
+                        exec {*}$sttycmd -raw echo <@$channel
+                        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"]]
+                    } else {
+                        error "punk::console::disableRaw Unable to use twapi or stty to unset raw mode - aborting"
+                    }
                 }
-            }]
+            }
+
+            #enableAnsi
+            proc enableAnsi {} {
+            }
+            #disableAnsi
+            proc enableAnsi {} {
+            }
+            #enableVirtualTerminal
+            proc enableVirtualTerminal {{channels {input output}}} {
+            }
+            #disableVirtualTerminal
+            proc disableVirtualTerminal {{channels {input output}}} {
+            }
+            #enableProcessedInput
+            #disableProcessedInput
+
         }
 
     } else {
+        #non-windows platforms
+
         proc enableAnsi {} {
             #todo?
         }
@@ -190,6 +495,13 @@ namespace eval punk::console {
         #todo - something better - the 'channel' concept may not really apply on unix, as raw mode is set for input and output modes currently - only valid to set on a readable channel?
         #on windows they can be set independently (but not with stty) - REVIEW
 
+        proc enableVirtualTerminal {{channels {input output}}} {
+
+        }
+        proc disableVirtualTerminal {args} {
+
+        }
+
         #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}} {
@@ -221,12 +533,6 @@ namespace eval punk::console {
             tsv::set console is_raw 0
             return done
         }
-        proc enableVirtualTerminal {{channels {input output}}} {
-
-        }
-        proc disableVirtualTerminal {args} {
-
-        }
     }
 
     #review - document and decide granularity required. should we enable/disable more than one at once? 
@@ -257,7 +563,6 @@ namespace eval punk::console {
         #puts -nonewline stdout \x1b\[?25l  ;#hide cursor
         puts -nonewline stdout \x1b\[?1003h\n
         enable_bracketed_paste
-        
     }
     #todo stop_application_mode {} {}
 
@@ -313,264 +618,8 @@ namespace eval punk::console {
             }
         }
         proc define_windows_procs {} {
-            package require zzzload
-            set loadstate [zzzload::pkg_require twapi]
-
-            #loadstate could also be stuck on loading? - review - zzzload not very ripe
-            #Twapi can be relatively slow to load (on some systems) - can be 1s plus in some cases - and much longer if there are disk performance issues.
-            if {$loadstate ni [list failed]} {
-                #possibly still 'loading'
-                #review zzzload usage
-                #puts stdout "=========== console loading twapi ============="
-                set loadstate [zzzload::pkg_wait twapi] ;#can return 'failed' will return version if already loaded or loaded during wait
-            }
-
-            if {$loadstate ni [list failed]} {
-                package require twapi ;#should be fast once twapi dll loaded in zzzload thread
-                set ::punk::console::has_twapi 1
-
-                #todo - move some of these to the punk::console::local sub-namespace - as they use APIs rather than in-band ANSI to do their work.
-                #enableAnsi seems like it should be directly under punk::console .. but then it seems inconsistent if other local console-mode setting functions aren't.
-                #Find a compromise to organise things somewhat sensibly..
-
-                #this is really enableAnsi *processing* 
-                proc [namespace parent]::enableAnsi {} {
-                    #output handle modes
-                    #Enable virtual terminal processing (sometimes off in older windows terminals)
-                    #ENABLE_PROCESSED_OUTPUT = 0x0001
-                    #ENABLE_WRAP_AT_EOL_OUTPUT = 0x0002
-                    #ENABLE_VIRTUAL_TERMINAL_PROCESSING = 0x0004
-                    #DISABLE_NEWLINE_AUTO_RETURN = 0x0008
-                    set h_out [twapi::get_console_handle stdout] 
-                    set oldmode_out [twapi::GetConsoleMode $h_out]
-                    set newmode_out [expr {$oldmode_out | 4}] ;#don't enable processed output too, even though it's required. keep symmetrical with disableAnsi?
-
-                    twapi::SetConsoleMode $h_out $newmode_out
-
-                    #what does window_input have to do with it??
-                    #input handle modes
-                    #ENABLE_PROCESSED_INPUT 0x0001  ;#set to zero will allow ctrl-c to be reported as keyboard input rather than as a signal
-                    #ENABLE_LINE_INPUT 0x0002
-                    #ENABLE_ECHO_INPUT 0x0004
-                    #ENABLE_WINDOW_INPUT 0x0008  (default off when a terminal created)
-                    #ENABLE_MOUSE_INPUT 0x0010
-                    #ENABLE_INSERT_MODE 0X0020
-                    #ENABLE_QUICK_EDIT_MODE 0x0040
-                    #ENABLE_VIRTUAL_TERMINAL_INPUT 0x0200 (default off when a terminal created) (512)
-                    set h_in [twapi::get_console_handle stdin]
-                    set oldmode_in [twapi::GetConsoleMode $h_in]
-                    set newmode_in [expr {$oldmode_in | 8}]
-                    #set newmode_in [expr {$oldmode_in | 0x208}]
-
-                    twapi::SetConsoleMode $h_in $newmode_in
-
-                    return [list stdout [list from $oldmode_out to $newmode_out] stdin [list from $oldmode_in to $newmode_in]]
-                }
-                proc [namespace parent]::disableAnsi {} {
-                    set h_out [twapi::get_console_handle stdout] 
-                    set oldmode_out [twapi::GetConsoleMode $h_out]
-                    set newmode_out [expr {$oldmode_out & ~4}]
-                    twapi::SetConsoleMode $h_out $newmode_out
-
-                    #??? review
-                    set h_in [twapi::get_console_handle stdin]
-                    set oldmode_in [twapi::GetConsoleMode $h_in]
-                    set newmode_in [expr {$oldmode_in & ~8}]
-                    twapi::SetConsoleMode $h_in $newmode_in
-
-
-                    return [list stdout [list from $oldmode_out to $newmode_out] stdin [list from $oldmode_in to $newmode_in]]
-                }
-
-                #
-                proc [namespace parent]::enableVirtualTerminal {{channels {input output}}} {
-                    set ins [list in input stdin]
-                    set outs [list out output stdout stderr]
-                    set known [concat $ins $outs both]
-                    set directions [list]
-                    foreach v $channels {
-                        if {$v in $ins} {
-                            lappend directions input
-                        } elseif {$v in $outs} {
-                            lappend directions output
-                        } elseif {$v eq "both"} {
-                            lappend directions input output
-                        }
-                        if {$v ni $known} {
-                            error "enableVirtualTerminal expected channel values to be one of '$known'. (all values mapped to input and/or output)"
-                        }
-                    }
-                    set channels $directions ;#don't worry about dups.
-                    if {"both" in $channels} {
-                        lappend channels input output
-                    }
-                    set result [dict create]
-                    if {"output" in $channels} {
-                        #note setting stdout makes stderr have the same settings - ie there is really only one output to configure
-                        set h_out [twapi::get_console_handle stdout] 
-                        set oldmode [twapi::GetConsoleMode $h_out]
-                        set newmode [expr {$oldmode | 4}] 
-                        twapi::SetConsoleMode $h_out $newmode
-                        dict set result output [list from $oldmode to $newmode]
-                    }
-
-                    if {"input" in $channels} {
-                        set h_in [twapi::get_console_handle stdin]
-                        set oldmode_in [twapi::GetConsoleMode $h_in]
-                        set newmode_in [expr {$oldmode_in | 0x200}]
-                        twapi::SetConsoleMode $h_in $newmode_in
-                        dict set result input [list from $oldmode_in to $newmode_in]
-                    }
-
-                    return $result
-                }
-                proc [namespace parent]::disableVirtualTerminal {{channels {input output}}} {
-                    set ins [list in input stdin]
-                    set outs [list out output stdout stderr]
-                    set known [concat $ins $outs both]
-                    set directions [list]
-                    foreach v $channels {
-                        if {$v in $ins} {
-                            lappend directions input
-                        } elseif {$v in $outs} {
-                            lappend directions output
-                        } elseif {$v eq "both"} {
-                            lappend directions input output
-                        }
-                        if {$v ni $known} {
-                            error "disableVirtualTerminal expected channel values to be one of '$known'. (all values mapped to input and/or output)"
-                        }
-                    }
-                    set channels $directions ;#don't worry about dups.
-                    if {"both" in $channels} {
-                        lappend channels input output
-                    }
-                    set result [dict create]
-                    if {"output" in $channels} {
-                        #as above - configuring stdout does stderr too
-                        set h_out [twapi::get_console_handle stdout] 
-                        set oldmode [twapi::GetConsoleMode $h_out]
-                        set newmode [expr {$oldmode & ~4}] 
-                        twapi::SetConsoleMode $h_out $newmode
-                        dict set result output [list from $oldmode to $newmode]
-                    }
-                    if {"input" in $channels} {
-                        set h_in [twapi::get_console_handle stdin]
-                        set oldmode_in [twapi::GetConsoleMode $h_in]
-                        set newmode_in [expr {$oldmode_in & ~0x200}]
-                        twapi::SetConsoleMode $h_in $newmode_in
-                        dict set result input [list from $oldmode_in to $newmode_in]
-                    }
-
-                    #return [list stdout [list from $oldmode_out to $newmode_out] stdin [list from $oldmode_in to $newmode_in]]
-                    return $result
-                }
-
-                proc [namespace parent]::enableProcessedInput {} {
-                    set h_in [twapi::get_console_handle stdin]
-                    set oldmode_in [twapi::GetConsoleMode $h_in]
-                    set newmode_in [expr {$oldmode_in | 1}]
-                    twapi::SetConsoleMode $h_in $newmode_in
-                    return [list stdin [list from $oldmode_in to $newmode_in]]
-                }
-                proc [namespace parent]::disableProcessedInput {} {
-                    set h_in [twapi::get_console_handle stdin]
-                    set oldmode_in [twapi::GetConsoleMode $h_in]
-                    set newmode_in [expr {$oldmode_in & ~1}]
-                    twapi::SetConsoleMode $h_in $newmode_in
-                    return [list stdin [list from $oldmode_in to $newmode_in]]
-                }
-
-
-
-            } else {
-            
-                puts stderr "punk::console falling back to stty because twapi load failed"
-                proc [namespace parent]::enableAnsi {} {
-                    puts stderr "punk::console::enableAnsi todo"
-                }
-                proc [namespace parent]::disableAnsi {} {
-                }
-                #?
-                proc [namespace parent]::enableVirtualTerminal {{channels {input output}}} {
-                }
-                proc [namespace parent]::disableVirtualTerminal {{channels {input output}}} {
-                }
-                proc [namespace parent]::enableProcessedInput {args} {
-
-                }
-                proc [namespace parent]::disableProcessedInput {args} {
-
-                }
-
-            }
-
-                proc [namespace parent]::enableRaw {{channel stdin}} {
-                    #variable is_raw
-                    variable previous_stty_state_$channel
-
-                    if {[package provide twapi] ne ""} {
-                        set console_handle [twapi::get_console_handle stdin]
-                        #returns dictionary
-                        #e.g -processedinput 1 -lineinput 1 -echoinput 1 -windowinput 0 -mouseinput 0 -insertmode 1 -quickeditmode 1 -extendedmode 1 -autoposition 0
-                        set oldmode [twapi::get_console_input_mode]
-                        twapi::modify_console_input_mode $console_handle -lineinput 0 -echoinput 0
-                        # Turn off the echo and line-editing bits
-                        #set newmode [dict merge $oldmode [dict create -lineinput 0 -echoinput 0]]
-                        set newmode [twapi::get_console_input_mode]
-
-                        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]]
-                    } elseif {[set sttycmd [auto_execok stty]] ne ""} {
-                        if {[set previous_stty_state_$channel] eq ""} {
-                            set previous_stty_state_$channel [exec {*}$sttycmd -g <@$channel]
-                        }
-
-                        exec {*}$sttycmd raw -echo <@$channel
-                        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 {
-                        error "punk::console::enableRaw Unable to use twapi or stty to set raw mode - aborting"
-                    }
-                }
 
-                #note: twapi GetStdHandle & GetConsoleMode & SetConsoleCombo unreliable - fails with invalid handle (somewhat intermittent.. after stdin reopened?)
-                #could be we were missing a step in reopening stdin and console configuration?
-
-                proc [namespace parent]::disableRaw {{channel stdin}} {
-                    #variable is_raw
-                    variable previous_stty_state_$channel
-
-                    if {[package provide twapi] ne ""} {
-                        set console_handle [twapi::get_console_handle stdin]
-                        set oldmode [twapi::get_console_input_mode]
-                        # Turn on the echo and line-editing bits
-                        twapi::modify_console_input_mode $console_handle -lineinput 1 -echoinput 1
-                        set newmode [twapi::get_console_input_mode]
-                        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.
-                        #review - is returned info even valid?
 
-                        set sttycmd [auto_execok stty]
-                        if {[set previous_stty_state_$channel] ne ""} {
-                            exec {*}$sttycmd [set previous_stty_state_$channel]
-                            set previous_stty_state_$channel ""
-                            return restored
-                        }
-                        exec {*}$sttycmd -raw echo <@$channel
-                        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"]]
-                    } else {
-                        error "punk::console::disableRaw Unable to use twapi or stty to unset raw mode - aborting"
-                    }
-                }
 
 
         }
@@ -1803,7 +1852,10 @@ namespace eval punk::console {
         #don't set ansi_avaliable here - we want to be able to change things, retest etc.
         if {"windows" eq "$::tcl_platform(platform)"} {
             if {[package provide twapi] ne ""} {
-                set h_out [twapi::get_console_handle stdout]
+                if {[catch {twapi::get_console_handle stdout} h_out]} {
+                    puts stderr "test_can_ansi: twapi cannot get console handle for stdout"
+                    return 0
+                }
                 set existing_mode [twapi::GetConsoleMode $h_out]
                 if {[expr {$existing_mode & 4}]} {
                     #virtual terminal processing happens to be enabled - so it's supported

src/vfs/_vfscommon.vfs/modules/punk/libunknown-0.1.tm

@@ -80,16 +80,7 @@ tcl::namespace::eval punk::libunknown {
             "Experimental set of replacements for default 'package unknown' entries."
         }]
 
-    variable epoch
-    #if {![info exists epoch]} {
-    #    set tmstate     [dict create 0 {}]
-    #    set pkgstate    [dict create 0 {}]
-    #    set tminfo  [dict create current 0 epochs $tmstate]
-    #    set pkginfo [dict create current 0 epochs $pkgstate]
-
-    #    set epoch [dict create tm $tminfo pkg $pkginfo]
-    #}
-
+    variable epoch ;#don't set - can be pre-set cooperatively
 
     variable has_package_files
     if {[catch {package files foobaz}]} {
@@ -111,6 +102,33 @@ tcl::namespace::eval punk::libunknown {
 
     #will use standard mechanism for non zipfs paths in the tm list.
     proc zipfs_tm_UnknownHandler {original name args} {
+        #------------------------------
+        #shortcircuit for builtin static libraries which have no 'package provide' info - review
+        #This occurs for example when running 'bin\runtime.cmd run src\make.tcl shell' with punk902z.exe
+        #
+        #------------------------------
+        set loaded [lsearch -inline -index 1 -nocase [info loaded] $name]
+        if {[llength $loaded] == 2 && [lindex $loaded 0] eq ""} {
+            lassign $loaded _ cased_name
+            interp create ptest
+            ptest eval [list load {} $cased_name]
+            set static_version [ptest eval [list package provide [string tolower $cased_name]]]
+            set pname [string tolower $cased_name]
+            if {$static_version eq ""} {
+                set static_version [ptest eval [list package provide $cased_name]]
+                set pname $cased_name
+            }
+            if {$static_version ne ""} {
+                if {[package vsatisfies $static_version {*}$args]} {
+                    package ifneeded $pname $static_version [list load {} $cased_name]
+                    interp delete ptest
+                    return
+                }
+            }
+            interp delete ptest
+        }
+        #------------------------------
+
         # Import the list of paths to search for packages in module form.
         # Import the pattern used to check package names in detail.
         variable epoch
@@ -1161,7 +1179,12 @@ tcl::namespace::eval punk::libunknown {
         set callerposn [lsearch $args -caller]
         if {$callerposn > -1} {
             set caller [lindex $args $callerposn+1]
-            #puts stderr "\x1b\[1\;33m punk::libunknown::init - caller:$caller\x1b\[m"
+            if {[package provide thread] ne ""} {
+                set tid [thread::id]
+            } else {
+                set tid "-"
+            }
+            #puts stderr "\x1b\[1\;33m punk::libunknown::init - caller:$caller tid:$tid\x1b\[m"
             #puts stderr "punk::libunknown::init auto_path    : $::auto_path"
             #puts stderr "punk::libunknown::init tcl::tm::list: [tcl::tm::list]"
         }
@@ -1184,17 +1207,17 @@ tcl::namespace::eval punk::libunknown {
             puts stderr "punk::libunknown::init - init while empty/unreadable tcl::tm::list and empty/unreadable ::auto_path"
         }
 
-        if {[namespace origin ::package] eq "::punk::libunknown::package"} {
-            #This is far from conclusive - there may be other renamers (e.g commandstack)
+        if {[info commands ::punk::libunknown::package] ne ""} {
+            puts stderr "punk::libunknown::init already done - unnecessary call? info frame -1: [info frame -1]"
             return
         }
+        #if {[namespace origin ::package] eq "::punk::libunknown::package"} {
+        #    #This is far from conclusive - there may be other renamers (e.g commandstack)
+        #    return
+        #}
 
 
 
-        if {[info commands ::punk::libunknown::package] ne ""} {
-            puts stderr "punk::libunknown::init already done - unnecessary call? info frame -1: [info frame -1]"
-            return
-        }
         variable epoch
         if {![info exists epoch]} {
             set tmstate     [dict create 0 {added {}}]
@@ -1222,6 +1245,7 @@ tcl::namespace::eval punk::libunknown {
         #   or suffer additional scans.. or document ??
         #ideally init should be called in each interp before any scans for packages so that the list of untracked is minimized.
         set pkgnames [package names]
+        #puts stderr "####### punk::libunknown init called with [llength $pkgnames] package names known"
         foreach p $pkgnames {
             if {[string tolower $p] in {punk::libunknown tcl::zlib tcloo tcl::oo tcl}} {
                 continue

src/vfs/_vfscommon.vfs/modules/punk/mix/templates/utility/scriptappwrappers/multishell.cmd

@@ -940,6 +940,7 @@ if {$nextshelltype ne "tcl" && $nextshelltype ne "none"} {
             #maint: keep this munging in sync with zsh/bash and perl blocks which must also do msys mangling
             if {[regexp {^cmd$|^cmd[.]exe$} $cmdword]} {
                 #need to deal with msys argument munging 
+                puts stderr "cmd call via msys detected. performing translation of /c to //C" 
                 #for now we only deal with /C or /c - todo - other cmd.exe flags?
                 #In this context we would usually only be using cmd.exe /c to launch older 'desktop' powershell to avoid spaced-argument problems - so we aren't expecting other flags 
                 set new_nextshellpath [list $cmdword]
@@ -1228,13 +1229,14 @@ if [[ "$nextshelltype" != "bash" && "$nextshelltype" != "none" ]]; then
         #do not double quote cmdpattern - or it will be treated as literal string
         if [[ "$nextshellpath" =~ $cmdpattern ]]; then
             #for now - tell the user what's going on
-            echo "cmd call via msys detected. performing translation of /c to //c and escaping backslashes in script path"
+            echo "cmd call via msys detected. performing translation of /c to //c and escaping backslashes in script path" >&2
             #flags to cmd.exe such as /c are interpreted by msys as looking like a unix path
             #review - for nextshellpath targets specified in the block for win32 - we don't expect unix paths (?)
             #what about other flags? - can we just double up all forward slashes?
             #maint: keep this munging in sync with the tcl block and perl block which must also do msys munging
             nextshellpath="${nextshellpath// \/[cC] / \/\/c }"
             # echo "new nextshellpath: ${nextshellpath}"
+            #review - 
             #don't double quote this
             script=${script//\\/\\\\}
         fi
@@ -1343,8 +1345,33 @@ if 0 {
 # -- unbalanced braces { } here *even in comments* will cause problems if there was no Tcl exit or return above
 # -- custom script should generally go below the begin_powershell_payload line
 # ## ### ### ### ### ### ### ### ### ### ### ### ### ###
-function GetScriptName { $myInvocation.ScriptName }
-$scriptname = GetScriptName
+#$MyInvocation.ScriptName should probably be considered deprecated
+# https://stackoverflow.com/questions/78511229/how-can-i-choose-between-myinvocation-scriptname-and-myinvocation-pscommandpat
+$runningscriptname = $PSCommandPath
+if (-not $MyInvocation.PSCommandPath) {
+    $callingscriptname = ''
+} else {
+    $callingscriptname = $MyInvocation.PSCommandPath
+}
+#The problem with psmodulepath
+#https://github.com/PowerShell/PowerShell/issues/18108
+# psmodulepath is shared by powershell and pwsh despite not all ps modules being compatible.
+# It is futzed with by powershell/pwsh based on detecting the child process type.
+# a psmodulepath that has been futzed with by pwsh will not work for a child powershell 5 process that isn't launched directly
+#This is inherently unfriendly to situations where an intervening process may be something else such as cmd.exe,tcl,perl etc
+# nevertheless, powershell/pwsh maintainers seem to have taken the MS-centric view of the world that such situations don't exist :/
+#
+#symptoms of these shenannigans not working include things like Get-FileHash failing in powershell desktop
+#
+#We don't know if the original console was pwsh/powershell or cmd.exe, and we need to potentially divert to powershell 5 (desktop) 
+#via tcl or perl etc - or cmd.exe
+if ($PSVersionTable.PSVersion.Major -le 5) {
+    # For Windows PowerShell, we want to remove any PowerShell 7 paths from PSModulePath
+    #snipped from https://github.com/PowerShell/DSC/pull/777/commits/af9b99a4d38e0cf1e54c4bbd89cbb6a8a8598c4e
+    #Presumably users are supposed to know not to have custom paths for powershell desktop containing a 'powershell' subfolder??
+    $env:PSModulePath = ($env:PSModulePath -split ';' | Where-Object { $_ -notlike '*\powershell\*' }) -join ';'
+}
+
 function GetDynamicParamDictionary {
     [CmdletBinding()]
     param(
@@ -1419,11 +1446,11 @@ function GetDynamicParamDictionary {
 #}
 #psmain @args
 #"Timestamp         :    {0,10:yyyy-MM-dd HH:mm:ss}"    -f $(Get-Date)   | write-host
-"Script Name       :    {0}"    -f $scriptname                          | write-host
+#"Running Script Name       :    {0}"    -f $runningscriptname                          | write-host
 "Powershell Version:    {0}"    -f $PSVersionTable.PSVersion.Major      | write-host
-"powershell args   :    {0}"    -f ($args -join ", ")                   | write-host
+#"powershell args   :    {0}"    -f ($args -join ", ")                   | write-host
 # -- --- --- ---
-$thisfileContent = Get-Content $scriptname -Raw
+$thisfileContent = Get-Content $runningscriptname -Raw
 $startTag = ": <<asadmin_start>>"
 $endTag = ": <<asadmin_end>>"
 $pattern = "(?s)`n$startTag[^`n]*`n(.*?)`n$endTag"
@@ -1522,7 +1549,7 @@ if ($match.Success) {
     }
     if (-not (("pwsh", "powershell", "") -contains $nextshell_type)) {
         #nextshell diversion exists for this platform
-        write-host "os: $os pwsh/powershell launching subshell of type: $nextshell_type shellpath: $nextshell_path on script $scriptname"
+        write-host "os: $os pwsh/powershell launching subshell of type: $nextshell_type shellpath: $nextshell_path on script $runningscriptname"
 
         # $arguments = @($($MyInvocation.MyCommand.Path))
         # $arguments += $args
@@ -1530,7 +1557,7 @@ if ($match.Success) {
         # $process = (Start-Process -FilePath $nextshell_path -ArgumentList $arguments -NoNewWindow -Wait)
         # Exit $process.ExitCode
 
-        & $nextshell_path $scriptname $args
+        & $nextshell_path $runningscriptname $args
         exit $LASTEXITCODE
     }
 }

src/vfs/_vfscommon.vfs/modules/punk/repl-0.1.2.tm

@@ -20,18 +20,6 @@ if {[dict exists $stdin_info -mode]} {
 #give up for now
 set tcl_interactive 1
 
-#if {[info commands ::tcl::zipfs::root] ne ""} {
-#    set zr [::tcl::zipfs::root]
-#    if {[file join $zr app modules] in [tcl::tm::list]} {
-#        #todo - better way to find latest version - without package require
-#        set lib [file join $zr app modules punk libunknown.tm]
-#        if {[file exists $lib]} {
-#            source $lib
-#            punk::libunknown::init
-#            #package unknown {punk::libunknown::zipfs_tm_UnknownHandler punk::libunknown::zipfs_tclPkgUnknown}
-#        }
-#    }
-#}
 #-------------------------------------------------------------------------------------
 if {[package provide punk::libunknown] eq ""} {
     #maintenance - also in src/vfs/_config/punk_main.tcl
@@ -59,7 +47,7 @@ if {[package provide punk::libunknown] eq ""} {
     }
     if {$libunknown ne ""} {
         source $libunknown
-        if {[catch {punk::libunknown::init -caller repl} errM]} {
+        if {[catch {punk::libunknown::init -caller triggered_by_repl_package_require} errM]} {
             puts "error initialising punk::libunknown\n$errM"
         }
     }
@@ -525,11 +513,11 @@ proc repl::start {inchan args} {
     set donevalue [set [namespace current]::done]
     if {[lindex $donevalue 0] eq "quit"} {
         puts "-->repl::start end $inchan $args result:'$donevalue'"
-        puts stderr "--> returning [lindex $donevalue 1]"
+        #puts stderr "repl quit --> returning [lindex $donevalue 1]"
         return [lindex $donevalue 1]
     }
     puts "-->repl::start end $inchan $args result:'$donevalue'"
-    puts stderr "__> returning 0"
+    #puts stderr "__> returning 0"
     return 0
 }
 proc repl::post_operations {} {
@@ -1408,7 +1396,6 @@ proc repl::repl_handler {inputchan prompt_config} {
         if {[dict get $original_input_conf -inputmode] eq "raw"} {
             #user or script has apparently put stdin into raw mode - update punk::console::is_raw to match
             set rawmode 1
-            #set ::punk::console::is_raw 1
             tsv::set console is_raw 1
         } else {
             #set ::punk::console::is_raw 0
@@ -1420,9 +1407,6 @@ proc repl::repl_handler {inputchan prompt_config} {
         #if it's been set to raw - assume it is deliberately done this way as the user could have alternatively called punk::mode raw or punk::console::enableVirtualTerminal
         #by not doing this automatically - we assume the caller has a reason.
     } else {
-        #JMN FIX!
-        #this returns 0 in rawmode on 8.6 after repl thread changes
-        #set rawmode [set ::punk::console::is_raw]
         set rawmode [tsv::get console is_raw]
     }
 
@@ -1811,8 +1795,6 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config
         set infoprompt      [dict get $prompt_config infoprompt]
         set debugprompt     [dict get $prompt_config debugprompt]
 
-
-        #set rawmode [set ::punk::console::is_raw]
         set rawmode [tsv::get console is_raw]
         if {!$rawmode} {
             #puts stderr "-->got [ansistring VIEW -lf 1 $stdinlines]<--"
@@ -2615,6 +2597,34 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config
                 }
                 #editbuf
 
+
+                #after any external command - raw mode as the console sees it can be disabled
+                #set it to match current state of the tsv 
+                if {[tsv::get console is_raw]} {
+                    if {$::tcl_platform(platform) eq "windows"} {
+                        #review
+                        #we are in parent process - twapi might not be loaded here - even if it is in the code interp
+                        catch {package require twapi}
+                    }
+                    set sinfo [chan configure stdin]
+                    if {[dict exists $sinfo -inputmode]} {
+                        if {[dict get $sinfo -inputmode] ne "raw"} {
+                            set re_enable_required 1
+                        } else {
+                            set re_enable_required 0
+                        }
+                    } else {
+                        # -inputmode unavailable
+                        #tcl 8.6 doesn't have -inputmode - meaning it has to call punk:console::enableRaw each time
+                        #enableRaw on windows without twapi involves launching a pwsh process - which gives a noticeable lag in keyboard input.
+                        #enableRaw on Unix involves a call to stty - which is generally fast - but still to be avoided if not required.
+                        set re_enable_required 1
+                    }
+                    #puts stderr "-here- re-enabling raw"
+                    if {$re_enable_required} {
+                        punk::console::enableRaw
+                    }
+                }
             } else {
                 #append commandstr \n
                 if {$::punk::repl::signal_control_c} {
@@ -2828,7 +2838,7 @@ namespace eval repl {
             }
             if {$libunknown ne ""} {
                 source $libunknown
-                if {[catch {punk::libunknown::init -caller "repl init_script"} errM]} {
+                if {[catch {punk::libunknown::init -caller "repl::init init_script parent interp"} errM]} {
                     puts "repl::init problem - error initialising punk::libunknown\n$errM"
                 }
                 #package require punk::lib
@@ -2858,10 +2868,10 @@ namespace eval repl {
             #thread::send to caller defined interp targets (reference?)
             #snit required for icomm
             if {[catch {package require snit} errM]} {
-                puts stdout "punk::repl::initscript lib load fail ---snit $errM"
+                #puts stdout "punk::repl::initscript: lib load fail ---snit $errM"
             }
             if {[catch {package require punk::icomm} errM]} {
-                puts stdout "punk::repl::initscript lib load fail ---icomm $errM"
+                #puts stdout "punk::repl::initscript: lib load fail ---icomm $errM"
             }
             #-----
 
@@ -2872,7 +2882,7 @@ namespace eval repl {
                     #first use can raise error being a version number e.g 0.1.0  - why?
                     lassign [tcl::chan::fifo2] ::punk::repl::codethread::repltalk replside
                     } errMsg]} {
-                puts stdout "punk::repl::initscript tcl::chan::fifo2 error: $errM"
+                puts stdout "punk::repl::initscript tcl::chan::fifo2 error: $errMsg"
             } else {
                 #experimental?
                 #puts stdout "transferring chan $replside to thread %replthread%"
@@ -3519,6 +3529,8 @@ namespace eval repl {
 
                         #-----------------------------------------------------------------------------
                         if {[package provide punk::libunknown] eq ""} {
+                            namespace eval ::punk::libunknown {}
+                            set ::punk::libunknown::epoch %lib_epoch%
                             set libunks [list]
                             foreach tm_path [tcl::tm::list] {
                                 set punkdir [file join $tm_path punk]
@@ -3543,7 +3555,7 @@ namespace eval repl {
                             }
                             if {$libunknown ne ""} {
                                 source $libunknown
-                                if {[catch {punk::libunknown::init -caller "repl init_script punk"} errM]} {
+                                if {[catch {punk::libunknown::init -caller "repl::init init_script code interp for punk"} errM]} {
                                     puts "error initialising punk::libunknown\n$errM"
                                 }
                             }

src/vfs/punk8_statictwapi.vfs/lib_tcl8/thread2.8.12/pkgIndex.tcl

@@ -0,0 +1,68 @@
+# -*- tcl -*-
+# Tcl package index file, version 1.1
+#
+
+if {![package vsatisfies [package provide Tcl] 8.4]} {
+    # Pre-8.4 Tcl interps we dont support at all.  Bye!
+    # 9.0+ Tcl interps are only supported on 32-bit platforms.
+    if {![package vsatisfies [package provide Tcl] 9.0]
+	    || ($::tcl_platform(pointerSize) != 4)} {
+	return
+    }
+}
+
+# All Tcl 8.4+ interps can [load] Thread 2.8.12
+#
+# For interps that are not thread-enabled, we still call [package ifneeded].
+# This is contrary to the usual convention, but is a good idea because we
+# cannot imagine any other version of Thread that might succeed in a
+# thread-disabled interp.  There's nothing to gain by yielding to other
+# competing callers of [package ifneeded Thread].  On the other hand,
+# deferring the error has the advantage that a script calling
+# [package require Thread] in a thread-disabled interp gets an error message
+# about a thread-disabled interp, instead of the message
+# "can't find package Thread".
+
+package ifneeded Thread 2.8.12 [list load [file join $dir thread2812.dll] [string totitle thread]]
+
+# package Ttrace uses some support machinery.
+
+# In Tcl 8.4 interps we use some older interfaces
+if {![package vsatisfies [package provide Tcl] 8.5]} {
+    package ifneeded Ttrace 2.8.12 "
+    [list proc thread_source {dir} {
+	if {[info exists ::env(TCL_THREAD_LIBRARY)] &&
+		[file readable $::env(TCL_THREAD_LIBRARY)/ttrace.tcl]} {
+	    source -encoding utf-8 $::env(TCL_THREAD_LIBRARY)/ttrace.tcl
+	} elseif {[file readable [file join $dir .. lib ttrace.tcl]]} {
+	    source -encoding utf-8 [file join $dir .. lib ttrace.tcl]
+	} elseif {[file readable [file join $dir ttrace.tcl]]} {
+	    source -encoding utf-8 [file join $dir ttrace.tcl]
+	}
+	if {[namespace which ::ttrace::update] ne ""} {
+	    ::ttrace::update
+	}
+    }]
+    [list thread_source $dir]
+    [list rename thread_source {}]"
+    return
+}
+
+# In Tcl 8.5+ interps; use [::apply]
+
+package ifneeded Ttrace 2.8.12 [list ::apply {{dir} {
+    if {[info exists ::env(TCL_THREAD_LIBRARY)] &&
+	[file readable $::env(TCL_THREAD_LIBRARY)/ttrace.tcl]} {
+	source -encoding utf-8 $::env(TCL_THREAD_LIBRARY)/ttrace.tcl
+    } elseif {[file readable [file join $dir .. lib ttrace.tcl]]} {
+	source -encoding utf-8 [file join $dir .. lib ttrace.tcl]
+    } elseif {[file readable [file join $dir ttrace.tcl]]} {
+	source -encoding utf-8 [file join $dir ttrace.tcl]
+    }
+    if {[namespace which ::ttrace::update] ne ""} {
+	::ttrace::update
+    }
+}} $dir]
+
+
+

src/vfs/punk8_statictwapi.vfs/lib_tcl8/thread2.8.12/ttrace.tcl

@@ -0,0 +1,942 @@
+#
+# ttrace.tcl --
+#
+# Copyright (C) 2003 Zoran Vasiljevic, Archiware GmbH. All Rights Reserved.
+#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# ----------------------------------------------------------------------------
+#
+# User level commands:
+#
+#   ttrace::eval           top-level wrapper (ttrace-savvy eval)
+#   ttrace::enable         activates registered Tcl command traces
+#   ttrace::disable        terminates tracing of Tcl commands
+#   ttrace::isenabled      returns true if ttrace is enabled
+#   ttrace::cleanup        bring the interp to a pristine state
+#   ttrace::update         update interp to the latest trace epoch
+#   ttrace::config         setup some configuration options
+#   ttrace::getscript      returns a script for initializing interps
+#
+# Commands used for/from trace callbacks:
+#
+#   ttrace::atenable       register callback to be done at trace enable
+#   ttrace::atdisable      register callback to be done at trace disable
+#   ttrace::addtrace       register user-defined tracer callback
+#   ttrace::addscript      register user-defined script generator
+#   ttrace::addresolver    register user-defined command resolver
+#   ttrace::addcleanup     register user-defined cleanup procedures
+#   ttrace::addentry       adds one entry into the named trace store
+#   ttrace::getentry       returns the entry value from the named store
+#   ttrace::delentry       removes the entry from the named store
+#   ttrace::getentries     returns all entries from the named store
+#   ttrace::preload        register procedures to be preloaded always
+#
+#
+# Limitations:
+#
+#   o. [namespace forget] is still not implemented
+#   o. [namespace origin cmd] breaks if cmd is not already defined
+#
+#      I left this deliberately. I didn't want to override the [namespace]
+#      command in order to avoid potential slowdown.
+#
+
+namespace eval ttrace {
+
+    # Setup some compatibility wrappers
+    if {[info commands nsv_set] != ""} {
+	variable tvers 0
+	variable mutex ns_mutex
+	variable elock [$mutex create traceepochmutex]
+	# Import the underlying API; faster than recomputing
+	interp alias {} [namespace current]::_array   {} nsv_array
+	interp alias {} [namespace current]::_incr    {} nsv_incr
+	interp alias {} [namespace current]::_lappend {} nsv_lappend
+	interp alias {} [namespace current]::_names   {} nsv_names
+	interp alias {} [namespace current]::_set     {} nsv_set
+	interp alias {} [namespace current]::_unset   {} nsv_unset
+    } elseif {![catch {
+	variable tvers [package require Thread]
+    }]} {
+	variable mutex thread::mutex
+	variable elock [$mutex create]
+	# Import the underlying API; faster than recomputing
+	interp alias {} [namespace current]::_array   {} tsv::array
+	interp alias {} [namespace current]::_incr    {} tsv::incr
+	interp alias {} [namespace current]::_lappend {} tsv::lappend
+	interp alias {} [namespace current]::_names   {} tsv::names
+	interp alias {} [namespace current]::_set     {} tsv::set
+	interp alias {} [namespace current]::_unset   {} tsv::unset
+    } else {
+	error "requires NaviServer/AOLserver or Tcl threading extension"
+    }
+
+    # Keep in sync with the Thread package
+    package provide Ttrace 2.8.12
+
+    # Package variables
+    variable resolvers ""     ; # List of registered resolvers
+    variable tracers   ""     ; # List of registered cmd tracers
+    variable scripts   ""     ; # List of registered script makers
+    variable enables   ""     ; # List of trace-enable callbacks
+    variable disables  ""     ; # List of trace-disable callbacks
+    variable preloads  ""     ; # List of procedure names to preload
+    variable enabled   0      ; # True if trace is enabled
+    variable config           ; # Array with config options
+
+    variable epoch     -1     ; # The initialization epoch
+    variable cleancnt   0     ; # Counter of registered cleaners
+
+    # Package private namespaces
+    namespace eval resolve "" ; # Commands for resolving commands
+    namespace eval trace   "" ; # Commands registered for tracing
+    namespace eval enable  "" ; # Commands invoked at trace enable
+    namespace eval disable "" ; # Commands invoked at trace disable
+    namespace eval script  "" ; # Commands for generating scripts
+
+    # Exported commands
+    namespace export unknown
+
+    # Initialize ttrace shared state
+    if {[_array exists ttrace] == 0} {
+	_set ttrace lastepoch $epoch
+	_set ttrace epochlist ""
+    }
+
+    # Initially, allow creation of epochs
+    set config(-doepochs) 1
+
+    proc eval {cmd args} {
+	enable
+	set code [catch {uplevel 1 [concat $cmd $args]} result]
+	disable
+	if {$code == 0} {
+	    if {[llength [info commands ns_ictl]]} {
+		ns_ictl save [getscript]
+	    } else {
+		thread::broadcast {
+		    package require Ttrace
+		    ttrace::update
+		}
+	    }
+	}
+	return -code $code \
+	    -errorinfo $::errorInfo -errorcode $::errorCode $result
+    }
+
+    proc config {args} {
+	variable config
+	if {[llength $args] == 0} {
+	    array get config
+	} elseif {[llength $args] == 1} {
+	    set opt [lindex $args 0]
+	    set config($opt)
+	} else {
+	    set opt [lindex $args 0]
+	    set val [lindex $args 1]
+	    set config($opt) $val
+	}
+    }
+
+    proc enable {} {
+	variable config
+	variable tracers
+	variable enables
+	variable enabled
+	incr enabled 1
+	if {$enabled > 1} {
+	    return
+	}
+	if {$config(-doepochs) != 0} {
+	    variable epoch [_newepoch]
+	}
+	set nsp [namespace current]
+	foreach enabler $enables {
+	    enable::_$enabler
+	}
+	foreach trace $tracers {
+	    if {[info commands $trace] != ""} {
+		trace add execution $trace leave ${nsp}::trace::_$trace
+	    }
+	}
+    }
+
+    proc disable {} {
+	variable enabled
+	variable tracers
+	variable disables
+	incr enabled -1
+	if {$enabled > 0} {
+	    return
+	}
+	set nsp [namespace current]
+	foreach disabler $disables {
+	    disable::_$disabler
+	}
+	foreach trace $tracers {
+	    if {[info commands $trace] != ""} {
+		trace remove execution $trace leave ${nsp}::trace::_$trace
+	    }
+	}
+    }
+
+    proc isenabled {} {
+	variable enabled
+	expr {$enabled > 0}
+    }
+
+    proc update {{from -1}} {
+	if {$from < 0} {
+	    variable epoch [_set ttrace lastepoch]
+	} else {
+	    if {[lsearch [_set ttrace epochlist] $from] < 0} {
+		error "no such epoch: $from"
+	    }
+	    variable epoch $from
+	}
+	uplevel 1 [getscript]
+    }
+
+    proc getscript {} {
+	variable preloads
+	variable epoch
+	variable scripts
+	append script [_serializensp] \n
+	append script "::namespace eval [namespace current] {" \n
+	append script "::namespace export unknown" \n
+	append script "_useepoch $epoch" \n
+	append script "}" \n
+	foreach cmd $preloads {
+	    append script [_serializeproc $cmd] \n
+	}
+	foreach maker $scripts {
+	    append script [script::_$maker]
+	}
+	return $script
+    }
+
+    proc cleanup {args} {
+	foreach cmd [info commands resolve::cleaner_*] {
+	    uplevel 1 $cmd $args
+	}
+    }
+
+    proc preload {cmd} {
+	variable preloads
+	if {[lsearch $preloads $cmd] < 0} {
+	    lappend preloads $cmd
+	}
+    }
+
+    proc atenable {cmd arglist body} {
+	variable enables
+	if {[lsearch $enables $cmd] < 0} {
+	    lappend enables $cmd
+	    set cmd [namespace current]::enable::_$cmd
+	    proc $cmd $arglist $body
+	    return $cmd
+	}
+    }
+
+    proc atdisable {cmd arglist body} {
+	variable disables
+	if {[lsearch $disables $cmd] < 0} {
+	    lappend disables $cmd
+	    set cmd [namespace current]::disable::_$cmd
+	    proc $cmd $arglist $body
+	    return $cmd
+	}
+    }
+
+    proc addtrace {cmd arglist body} {
+	variable tracers
+	if {[lsearch $tracers $cmd] < 0} {
+	    lappend tracers $cmd
+	    set tracer [namespace current]::trace::_$cmd
+	    proc $tracer $arglist $body
+	    if {[isenabled]} {
+		trace add execution $cmd leave $tracer
+	    }
+	    return $tracer
+	}
+    }
+
+    proc addscript {cmd body} {
+	variable scripts
+	if {[lsearch $scripts $cmd] < 0} {
+	    lappend scripts $cmd
+	    set cmd [namespace current]::script::_$cmd
+	    proc $cmd args $body
+	    return $cmd
+	}
+    }
+
+    proc addresolver {cmd arglist body} {
+	variable resolvers
+	if {[lsearch $resolvers $cmd] < 0} {
+	    lappend resolvers $cmd
+	    set cmd [namespace current]::resolve::$cmd
+	    proc $cmd $arglist $body
+	    return $cmd
+	}
+    }
+
+    proc addcleanup {body} {
+	variable cleancnt
+	set cmd [namespace current]::resolve::cleaner_[incr cleancnt]
+	proc $cmd args $body
+	return $cmd
+    }
+
+    proc addentry {cmd var val} {
+	variable epoch
+	_set ${epoch}-$cmd $var $val
+    }
+
+    proc delentry {cmd var} {
+	variable epoch
+	set ei $::errorInfo
+	set ec $::errorCode
+	catch {_unset ${epoch}-$cmd $var}
+	set ::errorInfo $ei
+	set ::errorCode $ec
+    }
+
+    proc getentry {cmd var} {
+	variable epoch
+	set ei $::errorInfo
+	set ec $::errorCode
+	if {[catch {_set ${epoch}-$cmd $var} val]} {
+	    set ::errorInfo $ei
+	    set ::errorCode $ec
+	    set val ""
+	}
+	return $val
+    }
+
+    proc getentries {cmd {pattern *}} {
+	variable epoch
+	_array names ${epoch}-$cmd $pattern
+    }
+
+    proc unknown {args} {
+	set cmd [lindex $args 0]
+	if {[uplevel 1 ttrace::_resolve [list $cmd]]} {
+	    set c [catch {uplevel 1 $cmd [lrange $args 1 end]} r]
+	} else {
+	    set c [catch {uplevel 1 ::tcl::unknown $args} r]
+	}
+	return -code $c -errorcode $::errorCode -errorinfo $::errorInfo $r
+    }
+
+    proc _resolve {cmd} {
+	variable resolvers
+	foreach resolver $resolvers {
+	    if {[uplevel 1 [info comm resolve::$resolver] [list $cmd]]} {
+		return 1
+	    }
+	}
+	return 0
+    }
+
+    proc _getthread {} {
+	if {[info commands ns_thread] == ""} {
+	    thread::id
+	} else {
+	    ns_thread getid
+	}
+    }
+
+    proc _getthreads {} {
+	if {[info commands ns_thread] == ""} {
+	    return [thread::names]
+	} else {
+	    foreach entry [ns_info threads] {
+		lappend threads [lindex $entry 2]
+	    }
+	    return $threads
+	}
+    }
+
+    proc _newepoch {} {
+	variable elock
+	variable mutex
+	$mutex lock $elock
+	set old [_set ttrace lastepoch]
+	set new [_incr ttrace lastepoch]
+	_lappend ttrace $new [_getthread]
+	if {$old >= 0} {
+	    _copyepoch $old $new
+	    _delepochs
+	}
+	_lappend ttrace epochlist $new
+	$mutex unlock $elock
+	return $new
+    }
+
+    proc _copyepoch {old new} {
+	foreach var [_names $old-*] {
+	    set cmd [lindex [split $var -] 1]
+	    _array reset $new-$cmd [_array get $var]
+	}
+    }
+
+    proc _delepochs {} {
+	set tlist [_getthreads]
+	set elist ""
+	foreach epoch [_set ttrace epochlist] {
+	    if {[_dropepoch $epoch $tlist] == 0} {
+		lappend elist $epoch
+	    } else {
+		_unset ttrace $epoch
+	    }
+	}
+	_set ttrace epochlist $elist
+    }
+
+    proc _dropepoch {epoch threads} {
+	set self [_getthread]
+	foreach tid [_set ttrace $epoch] {
+	    if {$tid != $self && [lsearch $threads $tid] >= 0} {
+		lappend alive $tid
+	    }
+	}
+	if {[info exists alive]} {
+	    _set ttrace $epoch $alive
+	    return 0
+	} else {
+	    foreach var [_names $epoch-*] {
+		_unset $var
+	    }
+	    return 1
+	}
+    }
+
+    proc _useepoch {epoch} {
+	if {$epoch >= 0} {
+	    set tid [_getthread]
+	    if {[lsearch [_set ttrace $epoch] $tid] == -1} {
+		_lappend ttrace $epoch $tid
+	    }
+	}
+    }
+
+    proc _serializeproc {cmd} {
+	set dargs [info args $cmd]
+	set pbody [info body $cmd]
+	set pargs ""
+	foreach arg $dargs {
+	    if {![info default $cmd $arg def]} {
+		lappend pargs $arg
+	    } else {
+		lappend pargs [list $arg $def]
+	    }
+	}
+	set nsp [namespace qual $cmd]
+	if {$nsp == ""} {
+	    set nsp "::"
+	}
+	append res [list ::namespace eval $nsp] " {" \n
+	append res [list ::proc [namespace tail $cmd] $pargs $pbody] \n
+	append res "}" \n
+    }
+
+    proc _serializensp {{nsp ""} {result _}} {
+	upvar $result res
+	if {$nsp == ""} {
+	    set nsp [namespace current]
+	}
+	append res [list ::namespace eval $nsp] " {" \n
+	foreach var [info vars ${nsp}::*] {
+	    set vname [namespace tail $var]
+	    if {[array exists $var] == 0} {
+		append res [list ::variable $vname [set $var]] \n
+	    } else {
+		append res [list ::variable $vname] \n
+		append res [list ::array set $vname [array get $var]] \n
+	    }
+	}
+	foreach cmd [info procs ${nsp}::*] {
+	    append res [_serializeproc $cmd] \n
+	}
+	append res "}" \n
+	foreach nn [namespace children $nsp] {
+	    _serializensp $nn res
+	}
+	return $res
+    }
+}
+
+#
+# The code below is ment to be run once during the application start.  It
+# provides implementation of tracing callbacks for some Tcl commands.  Users
+# can supply their own tracer implementations on-the-fly.
+#
+# The code below will create traces for the following Tcl commands:
+#    "namespace", "variable", "load", "proc" and "rename"
+#
+# Also, the Tcl object extension XOTcl 1.1.0 is handled and all XOTcl related
+# things, like classes and objects are traced (many thanks to Gustaf Neumann
+# from XOTcl for his kind help and support).
+#
+
+eval {
+
+    #
+    # Register the "load" trace. This will create the following key/value pair
+    # in the "load" store:
+    #
+    #  --- key ----              --- value ---
+    #  <path_of_loaded_image>    <name_of_the_init_proc>
+    #
+    # We normally need only the name_of_the_init_proc for being able to load
+    # the package in other interpreters, but we store the path to the image
+    # file as well.
+    #
+
+    ttrace::addtrace load {cmdline code args} {
+	if {$code != 0} {
+	    return
+	}
+	set image [lindex $cmdline 1]
+	set initp [lindex $cmdline 2]
+	if {$initp == ""} {
+	    foreach pkg [info loaded] {
+		if {[lindex $pkg 0] == $image} {
+		    set initp [lindex $pkg 1]
+		}
+	    }
+	}
+	ttrace::addentry load $image $initp
+    }
+
+    ttrace::addscript load {
+	append res "\n"
+	foreach entry [ttrace::getentries load] {
+	    set initp [ttrace::getentry load $entry]
+	    append res "::load {} $initp" \n
+	}
+	return $res
+    }
+
+    #
+    # Register the "namespace" trace. This will create the following key/value
+    # entry in "namespace" store:
+    #
+    #  --- key ----                   --- value ---
+    #  ::fully::qualified::namespace  1
+    #
+    # It will also fill the "proc" store for procedures and commands imported
+    # in this namespace with following:
+    #
+    #  --- key ----                   --- value ---
+    #  ::fully::qualified::proc       [list <ns>  "" ""]
+    #
+    # The <ns> is the name of the namespace where the command or procedure is
+    # imported from.
+    #
+
+    ttrace::addtrace namespace {cmdline code args} {
+	if {$code != 0} {
+	    return
+	}
+	set nop [lindex $cmdline 1]
+	set cns [uplevel 1 namespace current]
+	if {$cns == "::"} {
+	    set cns ""
+	}
+	switch -glob $nop {
+	    eva* {
+		set nsp [lindex $cmdline 2]
+		if {![string match "::*" $nsp]} {
+		    set nsp ${cns}::$nsp
+		}
+		ttrace::addentry namespace $nsp 1
+	    }
+	    imp* {
+		# - parse import arguments (skip opt "-force")
+		set opts [lrange $cmdline 2 end]
+		if {[string match "-fo*" [lindex $opts 0]]} {
+		    set opts [lrange $cmdline 3 end]
+		}
+		# - register all imported procs and commands
+		foreach opt $opts {
+		    if {![string match "::*" [::namespace qual $opt]]} {
+			set opt ${cns}::$opt
+		    }
+		    # - first import procs
+		    foreach entry [ttrace::getentries proc $opt] {
+			set cmd ${cns}::[::namespace tail $entry]
+			set nsp [::namespace qual $entry]
+			set done($cmd) 1
+			set entry [list 0 $nsp "" ""]
+			ttrace::addentry proc $cmd $entry
+		    }
+
+		    # - then import commands
+		    foreach entry [info commands $opt] {
+			set cmd ${cns}::[::namespace tail $entry]
+			set nsp [::namespace qual $entry]
+			if {[info exists done($cmd)] == 0} {
+			    set entry [list 0 $nsp "" ""]
+			    ttrace::addentry proc $cmd $entry
+			}
+		    }
+		}
+	    }
+	}
+    }
+
+    ttrace::addscript namespace {
+	append res \n
+	foreach entry [ttrace::getentries namespace] {
+	    append res "::namespace eval $entry {}" \n
+	}
+	return $res
+    }
+
+    #
+    # Register the "variable" trace. This will create the following key/value
+    # entry in the "variable" store:
+    #
+    #  --- key ----                   --- value ---
+    #  ::fully::qualified::variable   1
+    #
+    # The variable value itself is ignored at the time of
+    # trace/collection. Instead, we take the real value at the time of script
+    # generation.
+    #
+
+    ttrace::addtrace variable {cmdline code args} {
+	if {$code != 0} {
+	    return
+	}
+	set opts [lrange $cmdline 1 end]
+	if {[llength $opts]} {
+	    set cns [uplevel 1 namespace current]
+	    if {$cns == "::"} {
+		set cns ""
+	    }
+	    foreach {var val} $opts {
+		if {![string match "::*" $var]} {
+		    set var ${cns}::$var
+		}
+		ttrace::addentry variable $var 1
+	    }
+	}
+    }
+
+    ttrace::addscript variable {
+	append res \n
+	foreach entry [ttrace::getentries variable] {
+	    set cns [namespace qual $entry]
+	    set var [namespace tail $entry]
+	    append res "::namespace eval $cns {" \n
+	    append res "::variable $var"
+	    if {[array exists $entry]} {
+		append res "\n::array set $var [list [array get $entry]]" \n
+	    } elseif {[info exists $entry]} {
+		append res " [list [set $entry]]" \n
+	    } else {
+		append res \n
+	    }
+	    append res "}" \n
+	}
+	return $res
+    }
+
+
+    #
+    # Register the "rename" trace. It will create the following key/value pair
+    # in "rename" store:
+    #
+    #  --- key ----              --- value ---
+    #  ::fully::qualified::old  ::fully::qualified::new
+    #
+    # The "new" value may be empty, for commands that have been deleted. In
+    # such cases we also remove any traced procedure definitions.
+    #
+
+    ttrace::addtrace rename {cmdline code args} {
+	if {$code != 0} {
+	    return
+	}
+	set cns [uplevel 1 namespace current]
+	if {$cns == "::"} {
+	    set cns ""
+	}
+	set old [lindex $cmdline 1]
+	if {![string match "::*" $old]} {
+	    set old ${cns}::$old
+	}
+	set new [lindex $cmdline 2]
+	if {$new != ""} {
+	    if {![string match "::*" $new]} {
+		set new ${cns}::$new
+	    }
+	    ttrace::addentry rename $old $new
+	} else {
+	    ttrace::delentry proc $old
+	}
+    }
+
+    ttrace::addscript rename {
+	append res \n
+	foreach old [ttrace::getentries rename] {
+	    set new [ttrace::getentry rename $old]
+	    append res "::rename $old {$new}" \n
+	}
+	return $res
+    }
+
+    #
+    # Register the "proc" trace. This will create the following key/value pair
+    # in the "proc" store:
+    #
+    #  --- key ----              --- value ---
+    #  ::fully::qualified::proc  [list <epoch> <ns> <arglist> <body>]
+    #
+    # The <epoch> chages anytime one (re)defines a proc.  The <ns> is the
+    # namespace where the command was imported from. If empty, the <arglist>
+    # and <body> will hold the actual procedure definition. See the
+    # "namespace" tracer implementation also.
+    #
+
+    ttrace::addtrace proc {cmdline code args} {
+	if {$code != 0} {
+	    return
+	}
+	set cns [uplevel 1 namespace current]
+	if {$cns == "::"} {
+	    set cns ""
+	}
+	set cmd [lindex $cmdline 1]
+	if {![string match "::*" $cmd]} {
+	    set cmd ${cns}::$cmd
+	}
+	set dargs [info args $cmd]
+	set pbody [info body $cmd]
+	set pargs ""
+	foreach arg $dargs {
+	    if {![info default $cmd $arg def]} {
+		lappend pargs $arg
+	    } else {
+		lappend pargs [list $arg $def]
+	    }
+	}
+	set pdef [ttrace::getentry proc $cmd]
+	if {$pdef == ""} {
+	    set epoch -1 ; # never traced before
+	} else {
+	    set epoch [lindex $pdef 0]
+	}
+	ttrace::addentry proc $cmd [list [incr epoch] "" $pargs $pbody]
+    }
+
+    ttrace::addscript proc {
+	return {
+	    if {[info command ::tcl::unknown] == ""} {
+		rename ::unknown ::tcl::unknown
+		namespace import -force ::ttrace::unknown
+	    }
+	    if {[info command ::tcl::info] == ""} {
+		rename ::info ::tcl::info
+	    }
+	    proc ::info args {
+		set cmd [lindex $args 0]
+		set hit [lsearch -glob {commands procs args default body} $cmd*]
+		if {$hit > 1} {
+		    if {[catch {uplevel 1 ::tcl::info $args}]} {
+			uplevel 1 ttrace::_resolve [list [lindex $args 1]]
+		    }
+		    return [uplevel 1 ::tcl::info $args]
+		}
+		if {$hit == -1} {
+		    return [uplevel 1 ::tcl::info $args]
+		}
+		set cns [uplevel 1 namespace current]
+		if {$cns == "::"} {
+		    set cns ""
+		}
+		set pat [lindex $args 1]
+		if {![string match "::*" $pat]} {
+		    set pat ${cns}::$pat
+		}
+		set fns [ttrace::getentries proc $pat]
+		if {[string match $cmd* commands]} {
+		    set fns [concat $fns [ttrace::getentries xotcl $pat]]
+		}
+		foreach entry $fns {
+		    if {$cns != [namespace qual $entry]} {
+			set lazy($entry) 1
+		    } else {
+			set lazy([namespace tail $entry]) 1
+		    }
+		}
+		foreach entry [uplevel 1 ::tcl::info $args] {
+		    set lazy($entry) 1
+		}
+		array names lazy
+	    }
+	}
+    }
+
+    #
+    # Register procedure resolver. This will try to resolve the command in the
+    # current namespace first, and if not found, in global namespace.  It also
+    # handles commands imported from other namespaces.
+    #
+
+    ttrace::addresolver resolveprocs {cmd {export 0}} {
+	set cns [uplevel 1 namespace current]
+	set name [namespace tail $cmd]
+	if {$cns == "::"} {
+	    set cns ""
+	}
+	if {![string match "::*" $cmd]} {
+	    set ncmd ${cns}::$cmd
+	    set gcmd ::$cmd
+	} else {
+	    set ncmd $cmd
+	    set gcmd $cmd
+	}
+	set pdef [ttrace::getentry proc $ncmd]
+	if {$pdef == ""} {
+	    set pdef [ttrace::getentry proc $gcmd]
+	    if {$pdef == ""} {
+		return 0
+	    }
+	    set cmd $gcmd
+	} else {
+	    set cmd $ncmd
+	}
+	set epoch [lindex $pdef 0]
+	set pnsp  [lindex $pdef 1]
+	if {$pnsp != ""} {
+	    set nsp [namespace qual $cmd]
+	    if {$nsp == ""} {
+		set nsp ::
+	    }
+	    set cmd ${pnsp}::$name
+	    if {[resolveprocs $cmd 1] == 0 && [info commands $cmd] == ""} {
+		return 0
+	    }
+	    namespace eval $nsp "namespace import -force $cmd"
+	} else {
+	    uplevel 0 [list ::proc $cmd [lindex $pdef 2] [lindex $pdef 3]]
+	    if {$export} {
+		set nsp [namespace qual $cmd]
+		if {$nsp == ""} {
+		    set nsp ::
+		}
+		namespace eval $nsp "namespace export $name"
+	    }
+	}
+	variable resolveproc
+	set resolveproc($cmd) $epoch
+	return 1
+    }
+
+    #
+    # For XOTcl, the entire item introspection/tracing is delegated to XOTcl
+    # itself. The xotcl store is filled with this:
+    #
+    #  --- key ----               --- value ---
+    #  ::fully::qualified::item   <body>
+    #
+    # The <body> is the script used to generate the entire item (class,
+    # object). Note that we do not fill in this during code tracing. It is
+    # done during the script generation. In this step, only the placeholder is
+    # set.
+    #
+    # NOTE: we assume all XOTcl commands are imported in global namespace
+    #
+
+    ttrace::atenable XOTclEnabler {args} {
+	if {[info commands ::xotcl::Class] == ""} {
+	    return
+	}
+	if {[info commands ::xotcl::_creator] == ""} {
+	    ::xotcl::Class create ::xotcl::_creator -instproc create {args} {
+		set result [next]
+		if {![string match ::xotcl::_* $result]} {
+		    ttrace::addentry xotcl $result ""
+		}
+		return $result
+	    }
+	}
+	::xotcl::Class instmixin ::xotcl::_creator
+    }
+
+    ttrace::atdisable XOTclDisabler {args} {
+	if {   [info commands ::xotcl::Class] == ""
+	    || [info commands ::xotcl::_creator] == ""} {
+	    return
+	}
+	::xotcl::Class instmixin ""
+	::xotcl::_creator destroy
+    }
+
+    set resolver [ttrace::addresolver resolveclasses {classname} {
+	set cns [uplevel 1 namespace current]
+	set script [ttrace::getentry xotcl $classname]
+	if {$script == ""} {
+	    set name [namespace tail $classname]
+	    if {$cns == "::"} {
+		set script [ttrace::getentry xotcl ::$name]
+	    } else {
+		set script [ttrace::getentry xotcl ${cns}::$name]
+		if {$script == ""} {
+		    set script [ttrace::getentry xotcl ::$name]
+		}
+	    }
+	    if {$script == ""} {
+		return 0
+	    }
+	}
+	uplevel 1 [list namespace eval $cns $script]
+	return 1
+    }]
+
+    ttrace::addscript xotcl [subst -nocommands {
+	if {![catch {Serializer new} ss]} {
+	    foreach entry [ttrace::getentries xotcl] {
+		if {[ttrace::getentry xotcl \$entry] == ""} {
+		    ttrace::addentry xotcl \$entry [\$ss serialize \$entry]
+		}
+	    }
+	    \$ss destroy
+	    return {::xotcl::Class proc __unknown name {$resolver \$name}}
+	}
+    }]
+
+    #
+    # Register callback to be called on cleanup. This will trash lazily loaded
+    # procs which have changed since.
+    #
+
+    ttrace::addcleanup {
+	variable resolveproc
+	foreach cmd [array names resolveproc] {
+	    set def [ttrace::getentry proc $cmd]
+	    if {$def != ""} {
+		set new [lindex $def 0]
+		set old $resolveproc($cmd)
+		if {[info command $cmd] != "" && $new != $old} {
+		    catch {rename $cmd ""}
+		}
+	    }
+	}
+    }
+}
+
+# EOF
+return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# tab-width: 8
+# indent-tabs-mode: nil
+# End:

src/vfs/punk8win.vfs/lib_tcl8/tclparser1.9/pkgIndex.tcl

@@ -0,0 +1,2 @@
+package ifneeded parser 1.9 \
+    [list load [file join $dir tclparser19.dll]]

src/vfs/punk8win.vfs/lib_tcl8/tdbc1.1.12/pkgIndex.tcl

@@ -0,0 +1,26 @@
+# -*- tcl -*-
+# Tcl package index file, version 1.1
+#
+# Make sure that TDBC is running in a compatible version of Tcl, and
+# that TclOO is available.
+
+if {![package vsatisfies [package provide Tcl] 8.6-]} {
+    return
+}
+apply {{dir} {
+    set libraryfile [file join $dir tdbc.tcl]
+    if {![file exists $libraryfile] && [info exists ::env(TDBC_LIBRARY)]} {
+	set libraryfile [file join $::env(TDBC_LIBRARY) tdbc.tcl]
+    }
+    if {[package vsatisfies [package provide Tcl] 9.0-]} {
+	package ifneeded tdbc 1.1.12 \
+		"package require TclOO;\
+		[list load [file join $dir tcl9tdbc1112.dll] [string totitle tdbc]]\;\
+		[list source -encoding utf-8 $libraryfile]"
+    } else {
+	package ifneeded tdbc 1.1.12 \
+		"package require TclOO;\
+		[list load [file join $dir tdbc1112.dll] [string totitle tdbc]]\;\
+		[list source -encoding utf-8 $libraryfile]"
+    }
+}} $dir

src/vfs/punk8win.vfs/lib_tcl8/tdbc1.1.12/tdbc.tcl

@@ -0,0 +1,922 @@
+# tdbc.tcl --
+#
+#	Definitions of base classes from which TDBC drivers' connections,
+#	statements and result sets may inherit.
+#
+# Copyright (c) 2008 by Kevin B. Kenny
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+#
+#------------------------------------------------------------------------------
+
+package require TclOO
+
+namespace eval ::tdbc {
+    namespace export connection statement resultset
+    variable generalError [list TDBC GENERAL_ERROR HY000 {}]
+}
+
+#------------------------------------------------------------------------------
+#
+# tdbc::ParseConvenienceArgs --
+#
+#	Parse the convenience arguments to a TDBC 'execute',
+#	'executewithdictionary', or 'foreach' call.
+#
+# Parameters:
+#	argv - Arguments to the call
+#	optsVar -- Name of a variable in caller's scope that will receive
+#		   a dictionary of the supplied options
+#
+# Results:
+#	Returns any args remaining after parsing the options.
+#
+# Side effects:
+#	Sets the 'opts' dictionary to the options.
+#
+#------------------------------------------------------------------------------
+
+proc tdbc::ParseConvenienceArgs {argv optsVar} {
+
+    variable generalError
+    upvar 1 $optsVar opts
+
+    set opts [dict create -as dicts]
+    set i 0
+
+    # Munch keyword options off the front of the command arguments
+
+    foreach {key value} $argv {
+	if {[string index $key 0] eq {-}} {
+	    switch -regexp -- $key {
+		-as? {
+		    if {$value ne {dicts} && $value ne {lists}} {
+			set errorcode $generalError
+			lappend errorcode badVarType $value
+			return -code error \
+			    -errorcode $errorcode \
+			    "bad variable type \"$value\":\
+			     must be lists or dicts"
+		    }
+		    dict set opts -as $value
+		}
+		-c(?:o(?:l(?:u(?:m(?:n(?:s(?:v(?:a(?:r(?:i(?:a(?:b(?:le?)?)?)?)?)?)?)?)?)?)?)?)?) {
+		    dict set opts -columnsvariable $value
+		}
+		-- {
+		    incr i
+		    break
+		}
+		default {
+		    set errorcode $generalError
+		    lappend errorcode badOption $key
+		    return -code error \
+			-errorcode $errorcode \
+			"bad option \"$key\":\
+			must be -as or -columnsvariable"
+		}
+	    }
+	} else {
+	    break
+	}
+	incr i 2
+    }
+
+    return [lrange $argv[set argv {}] $i end]
+
+}
+
+
+
+#------------------------------------------------------------------------------
+#
+# tdbc::connection --
+#
+#	Class that represents a generic connection to a database.
+#
+#-----------------------------------------------------------------------------
+
+oo::class create ::tdbc::connection {
+
+    # statementSeq is the sequence number of the last statement created.
+    # statementClass is the name of the class that implements the
+    #	'statement' API.
+    # primaryKeysStatement is the statement that queries primary keys
+    # foreignKeysStatement is the statement that queries foreign keys
+
+    variable statementSeq primaryKeysStatement foreignKeysStatement
+
+    # The base class constructor accepts no arguments.  It sets up the
+    # machinery to do the bookkeeping to keep track of what statements
+    # are associated with the connection.  The derived class constructor
+    # is expected to set the variable, 'statementClass' to the name
+    # of the class that represents statements, so that the 'prepare'
+    # method can invoke it.
+
+    constructor {} {
+	set statementSeq 0
+	namespace eval Stmt {}
+    }
+
+    # The 'close' method is simply an alternative syntax for destroying
+    # the connection.
+
+    method close {} {
+	my destroy
+    }
+
+    # The 'prepare' method creates a new statement against the connection,
+    # giving its constructor the current statement and the SQL code to
+    # prepare.  It uses the 'statementClass' variable set by the constructor
+    # to get the class to instantiate.
+
+    method prepare {sqlcode} {
+	return [my statementCreate Stmt::[incr statementSeq] [self] $sqlcode]
+    }
+
+    # The 'statementCreate' method delegates to the constructor
+    # of the class specified by the 'statementClass' variable. It's
+    # intended for drivers designed before tdbc 1.0b10. Current ones
+    # should forward this method to the constructor directly.
+
+    method statementCreate {name instance sqlcode} {
+	my variable statementClass
+	return [$statementClass create $name $instance $sqlcode]
+    }
+
+    # Derived classes are expected to implement the 'prepareCall' method,
+    # and have it call 'prepare' as needed (or do something else and
+    # install the resulting statement)
+
+    # The 'statements' method lists the statements active against this
+    # connection.
+
+    method statements {} {
+	info commands Stmt::*
+    }
+
+    # The 'resultsets' method lists the result sets active against this
+    # connection.
+
+    method resultsets {} {
+	set retval {}
+	foreach statement [my statements] {
+	    foreach resultset [$statement resultsets] {
+		lappend retval $resultset
+	    }
+	}
+	return $retval
+    }
+
+    # The 'transaction' method executes a block of Tcl code as an
+    # ACID transaction against the database.
+
+    method transaction {script} {
+	my begintransaction
+	set status [catch {uplevel 1 $script} result options]
+	if {$status in {0 2 3 4}} {
+	    set status2 [catch {my commit} result2 options2]
+	    if {$status2 == 1} {
+		set status 1
+		set result $result2
+		set options $options2
+	    }
+	}
+	switch -exact -- $status {
+	    0 {
+		# do nothing
+	    }
+	    2 - 3 - 4 {
+		set options [dict merge {-level 1} $options[set options {}]]
+		dict incr options -level
+	    }
+	    default {
+		my rollback
+	    }
+	}
+	return -options $options $result
+    }
+
+    # The 'allrows' method prepares a statement, then executes it with
+    # a given set of substituents, returning a list of all the rows
+    # that the statement returns. Optionally, it stores the names of
+    # the columns in '-columnsvariable'.
+    # Usage:
+    #     $db allrows ?-as lists|dicts? ?-columnsvariable varName? ?--?
+    #	      sql ?dictionary?
+
+    method allrows args {
+
+	variable ::tdbc::generalError
+
+	# Grab keyword-value parameters
+
+	set args [::tdbc::ParseConvenienceArgs $args[set args {}] opts]
+
+	# Check postitional parameters
+
+	set cmd [list [self] prepare]
+	if {[llength $args] == 1} {
+	    set sqlcode [lindex $args 0]
+	} elseif {[llength $args] == 2} {
+	    lassign $args sqlcode dict
+	} else {
+	    set errorcode $generalError
+	    lappend errorcode wrongNumArgs
+	    return -code error -errorcode $errorcode \
+		"wrong # args: should be [lrange [info level 0] 0 1]\
+		 ?-option value?... ?--? sqlcode ?dictionary?"
+	}
+	lappend cmd $sqlcode
+
+	# Prepare the statement
+
+	set stmt [uplevel 1 $cmd]
+
+	# Delegate to the statement to accumulate the results
+
+	set cmd [list $stmt allrows {*}$opts --]
+	if {[info exists dict]} {
+	    lappend cmd $dict
+	}
+	set status [catch {
+	    uplevel 1 $cmd
+	} result options]
+
+	# Destroy the statement
+
+	catch {
+	    $stmt close
+	}
+
+	return -options $options $result
+    }
+
+    # The 'foreach' method prepares a statement, then executes it with
+    # a supplied set of substituents.  For each row of the result,
+    # it sets a variable to the row and invokes a script in the caller's
+    # scope.
+    #
+    # Usage:
+    #     $db foreach ?-as lists|dicts? ?-columnsVariable varName? ?--?
+    #         varName sql ?dictionary? script
+
+    method foreach args {
+
+	variable ::tdbc::generalError
+
+	# Grab keyword-value parameters
+
+	set args [::tdbc::ParseConvenienceArgs $args[set args {}] opts]
+
+	# Check postitional parameters
+
+	set cmd [list [self] prepare]
+	if {[llength $args] == 3} {
+	    lassign $args varname sqlcode script
+	} elseif {[llength $args] == 4} {
+	    lassign $args varname sqlcode dict script
+	} else {
+	    set errorcode $generalError
+	    lappend errorcode wrongNumArgs
+	    return -code error -errorcode $errorcode \
+		"wrong # args: should be [lrange [info level 0] 0 1]\
+		 ?-option value?... ?--? varname sqlcode ?dictionary? script"
+	}
+	lappend cmd $sqlcode
+
+	# Prepare the statement
+
+	set stmt [uplevel 1 $cmd]
+
+	# Delegate to the statement to iterate over the results
+
+	set cmd [list $stmt foreach {*}$opts -- $varname]
+	if {[info exists dict]} {
+	    lappend cmd $dict
+	}
+	lappend cmd $script
+	set status [catch {
+	    uplevel 1 $cmd
+	} result options]
+
+	# Destroy the statement
+
+	catch {
+	    $stmt close
+	}
+
+	# Adjust return level in the case that the script [return]s
+
+	if {$status == 2} {
+	    set options [dict merge {-level 1} $options[set options {}]]
+	    dict incr options -level
+	}
+	return -options $options $result
+    }
+
+    # The 'BuildPrimaryKeysStatement' method builds a SQL statement to
+    # retrieve the primary keys from a database. (It executes once the
+    # first time the 'primaryKeys' method is executed, and retains the
+    # prepared statement for reuse.)
+
+    method BuildPrimaryKeysStatement {} {
+
+	# On some databases, CONSTRAINT_CATALOG is always NULL and
+	# JOINing to it fails. Check for this case and include that
+	# JOIN only if catalog names are supplied.
+
+	set catalogClause {}
+	if {[lindex [set count [my allrows -as lists {
+	    SELECT COUNT(*)
+	    FROM INFORMATION_SCHEMA.TABLE_CONSTRAINTS
+	    WHERE CONSTRAINT_CATALOG IS NOT NULL}]] 0 0] != 0} {
+	    set catalogClause \
+		{AND xtable.CONSTRAINT_CATALOG = xcolumn.CONSTRAINT_CATALOG}
+	}
+	set primaryKeysStatement [my prepare "
+	     SELECT xtable.TABLE_SCHEMA AS \"tableSchema\",
+		 xtable.TABLE_NAME AS \"tableName\",
+		 xtable.CONSTRAINT_CATALOG AS \"constraintCatalog\",
+		 xtable.CONSTRAINT_SCHEMA AS \"constraintSchema\",
+		 xtable.CONSTRAINT_NAME AS \"constraintName\",
+		 xcolumn.COLUMN_NAME AS \"columnName\",
+		 xcolumn.ORDINAL_POSITION AS \"ordinalPosition\"
+	     FROM INFORMATION_SCHEMA.TABLE_CONSTRAINTS xtable
+	     INNER JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE xcolumn
+		     ON xtable.CONSTRAINT_SCHEMA = xcolumn.CONSTRAINT_SCHEMA
+		    AND xtable.TABLE_NAME = xcolumn.TABLE_NAME
+		    AND xtable.CONSTRAINT_NAME = xcolumn.CONSTRAINT_NAME
+		    $catalogClause
+	     WHERE xtable.TABLE_NAME = :tableName
+	       AND xtable.CONSTRAINT_TYPE = 'PRIMARY KEY'
+  	"]
+    }
+
+    # The default implementation of the 'primarykeys' method uses the
+    # SQL INFORMATION_SCHEMA to retrieve primary key information. Databases
+    # that might not have INFORMATION_SCHEMA must overload this method.
+
+    method primarykeys {tableName} {
+	if {![info exists primaryKeysStatement]} {
+	    my BuildPrimaryKeysStatement
+	}
+	tailcall $primaryKeysStatement allrows [list tableName $tableName]
+    }
+
+    # The 'BuildForeignKeysStatements' method builds a SQL statement to
+    # retrieve the foreign keys from a database. (It executes once the
+    # first time the 'foreignKeys' method is executed, and retains the
+    # prepared statements for reuse.)
+
+    method BuildForeignKeysStatement {} {
+
+	# On some databases, CONSTRAINT_CATALOG is always NULL and
+	# JOINing to it fails. Check for this case and include that
+	# JOIN only if catalog names are supplied.
+
+	set catalogClause1 {}
+	set catalogClause2 {}
+	if {[lindex [set count [my allrows -as lists {
+	    SELECT COUNT(*)
+	    FROM INFORMATION_SCHEMA.TABLE_CONSTRAINTS
+	    WHERE CONSTRAINT_CATALOG IS NOT NULL}]] 0 0] != 0} {
+	    set catalogClause1 \
+		{AND fkc.CONSTRAINT_CATALOG = rc.CONSTRAINT_CATALOG}
+	    set catalogClause2 \
+		{AND pkc.CONSTRAINT_CATALOG = rc.CONSTRAINT_CATALOG}
+	}
+
+	foreach {exists1 clause1} {
+	    0 {}
+	    1 { AND pkc.TABLE_NAME = :primary}
+	} {
+	    foreach {exists2 clause2} {
+		0 {}
+		1 { AND fkc.TABLE_NAME = :foreign}
+	    } {
+		set stmt [my prepare "
+	     SELECT rc.CONSTRAINT_CATALOG AS \"foreignConstraintCatalog\",
+		    rc.CONSTRAINT_SCHEMA AS \"foreignConstraintSchema\",
+		    rc.CONSTRAINT_NAME AS \"foreignConstraintName\",
+		    rc.UNIQUE_CONSTRAINT_CATALOG
+			AS \"primaryConstraintCatalog\",
+		    rc.UNIQUE_CONSTRAINT_SCHEMA AS \"primaryConstraintSchema\",
+		    rc.UNIQUE_CONSTRAINT_NAME AS \"primaryConstraintName\",
+		    rc.UPDATE_RULE AS \"updateAction\",
+		    rc.DELETE_RULE AS \"deleteAction\",
+		    pkc.TABLE_CATALOG AS \"primaryCatalog\",
+		    pkc.TABLE_SCHEMA AS \"primarySchema\",
+		    pkc.TABLE_NAME AS \"primaryTable\",
+		    pkc.COLUMN_NAME AS \"primaryColumn\",
+		    fkc.TABLE_CATALOG AS \"foreignCatalog\",
+		    fkc.TABLE_SCHEMA AS \"foreignSchema\",
+		    fkc.TABLE_NAME AS \"foreignTable\",
+		    fkc.COLUMN_NAME AS \"foreignColumn\",
+		    pkc.ORDINAL_POSITION AS \"ordinalPosition\"
+	     FROM INFORMATION_SCHEMA.REFERENTIAL_CONSTRAINTS rc
+	     INNER JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE fkc
+		     ON fkc.CONSTRAINT_NAME = rc.CONSTRAINT_NAME
+		    AND fkc.CONSTRAINT_SCHEMA = rc.CONSTRAINT_SCHEMA
+		    $catalogClause1
+	     INNER JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE pkc
+		     ON pkc.CONSTRAINT_NAME = rc.UNIQUE_CONSTRAINT_NAME
+		     AND pkc.CONSTRAINT_SCHEMA = rc.UNIQUE_CONSTRAINT_SCHEMA
+		     $catalogClause2
+		     AND pkc.ORDINAL_POSITION = fkc.ORDINAL_POSITION
+	     WHERE 1=1
+		 $clause1
+		 $clause2
+	     ORDER BY \"foreignConstraintCatalog\", \"foreignConstraintSchema\", \"foreignConstraintName\", \"ordinalPosition\"
+"]
+		dict set foreignKeysStatement $exists1 $exists2 $stmt
+	    }
+	}
+    }
+
+    # The default implementation of the 'foreignkeys' method uses the
+    # SQL INFORMATION_SCHEMA to retrieve primary key information. Databases
+    # that might not have INFORMATION_SCHEMA must overload this method.
+
+    method foreignkeys {args} {
+
+	variable ::tdbc::generalError
+
+	# Check arguments
+
+	set argdict {}
+	if {[llength $args] % 2 != 0} {
+	    set errorcode $generalError
+	    lappend errorcode wrongNumArgs
+	    return -code error -errorcode $errorcode \
+		"wrong # args: should be [lrange [info level 0] 0 1]\
+		 ?-option value?..."
+	}
+	foreach {key value} $args {
+	    if {$key ni {-primary -foreign}} {
+		set errorcode $generalError
+		lappend errorcode badOption
+		return -code error -errorcode $errorcode \
+		    "bad option \"$key\", must be -primary or -foreign"
+	    }
+	    set key [string range $key 1 end]
+	    if {[dict exists $argdict $key]} {
+		set errorcode $generalError
+		lappend errorcode dupOption
+		return -code error -errorcode $errorcode \
+		    "duplicate option \"$key\" supplied"
+	    }
+	    dict set argdict $key $value
+	}
+
+	# Build the statements that query foreign keys. There are four
+	# of them, one for each combination of whether -primary
+	# and -foreign is specified.
+
+	if {![info exists foreignKeysStatement]} {
+	    my BuildForeignKeysStatement
+	}
+	set stmt [dict get $foreignKeysStatement \
+		      [dict exists $argdict primary] \
+		      [dict exists $argdict foreign]]
+	tailcall $stmt allrows $argdict
+    }
+
+    # Derived classes are expected to implement the 'begintransaction',
+    # 'commit', and 'rollback' methods.
+
+    # Derived classes are expected to implement 'tables' and 'columns' method.
+
+}
+
+#------------------------------------------------------------------------------
+#
+# Class: tdbc::statement
+#
+#	Class that represents a SQL statement in a generic database
+#
+#------------------------------------------------------------------------------
+
+oo::class create tdbc::statement {
+
+    # resultSetSeq is the sequence number of the last result set created.
+    # resultSetClass is the name of the class that implements the 'resultset'
+    #	API.
+
+    variable resultSetClass resultSetSeq
+
+    # The base class constructor accepts no arguments.  It initializes
+    # the machinery for tracking the ownership of result sets. The derived
+    # constructor is expected to invoke the base constructor, and to
+    # set a variable 'resultSetClass' to the fully-qualified name of the
+    # class that represents result sets.
+
+    constructor {} {
+	set resultSetSeq 0
+	namespace eval ResultSet {}
+    }
+
+    # The 'execute' method on a statement runs the statement with
+    # a particular set of substituted variables.  It actually works
+    # by creating the result set object and letting that objects
+    # constructor do the work of running the statement.  The creation
+    # is wrapped in an [uplevel] call because the substitution proces
+    # may need to access variables in the caller's scope.
+
+    # WORKAROUND: Take out the '0 &&' from the next line when
+    # Bug 2649975 is fixed
+    if {0 && [package vsatisfies [package provide Tcl] 8.6]} {
+	method execute args {
+	    tailcall my resultSetCreate \
+		[namespace current]::ResultSet::[incr resultSetSeq]  \
+		[self] {*}$args
+	}
+    } else {
+	method execute args {
+	    return \
+		[uplevel 1 \
+		     [list \
+			  [self] resultSetCreate \
+			  [namespace current]::ResultSet::[incr resultSetSeq] \
+			  [self] {*}$args]]
+	}
+    }
+
+    # The 'ResultSetCreate' method is expected to be a forward to the
+    # appropriate result set constructor. If it's missing, the driver must
+    # have been designed for tdbc 1.0b9 and earlier, and the 'resultSetClass'
+    # variable holds the class name.
+
+    method resultSetCreate {name instance args} {
+	return [uplevel 1 [list $resultSetClass create \
+			       $name $instance {*}$args]]
+    }
+
+    # The 'resultsets' method returns a list of result sets produced by
+    # the current statement
+
+    method resultsets {} {
+	info commands ResultSet::*
+    }
+
+    # The 'allrows' method executes a statement with a given set of
+    # substituents, and returns a list of all the rows that the statement
+    # returns.  Optionally, it stores the names of columns in
+    # '-columnsvariable'.
+    #
+    # Usage:
+    #	$statement allrows ?-as lists|dicts? ?-columnsvariable varName? ?--?
+    #		?dictionary?
+
+
+    method allrows args {
+
+	variable ::tdbc::generalError
+
+	# Grab keyword-value parameters
+
+	set args [::tdbc::ParseConvenienceArgs $args[set args {}] opts]
+
+	# Check postitional parameters
+
+	set cmd [list [self] execute]
+	if {[llength $args] == 0} {
+	    # do nothing
+	} elseif {[llength $args] == 1} {
+	    lappend cmd [lindex $args 0]
+	} else {
+	    set errorcode $generalError
+	    lappend errorcode wrongNumArgs
+	    return -code error -errorcode $errorcode \
+		"wrong # args: should be [lrange [info level 0] 0 1]\
+		 ?-option value?... ?--? ?dictionary?"
+	}
+
+	# Get the result set
+
+	set resultSet [uplevel 1 $cmd]
+
+	# Delegate to the result set's [allrows] method to accumulate
+	# the rows of the result.
+
+	set cmd [list $resultSet allrows {*}$opts]
+	set status [catch {
+	    uplevel 1 $cmd
+	} result options]
+
+	# Destroy the result set
+
+	catch {
+	    rename $resultSet {}
+	}
+
+	# Adjust return level in the case that the script [return]s
+
+	if {$status == 2} {
+	    set options [dict merge {-level 1} $options[set options {}]]
+	    dict incr options -level
+	}
+	return -options $options $result
+    }
+
+    # The 'foreach' method executes a statement with a given set of
+    # substituents.  It runs the supplied script, substituting the supplied
+    # named variable. Optionally, it stores the names of columns in
+    # '-columnsvariable'.
+    #
+    # Usage:
+    #	$statement foreach ?-as lists|dicts? ?-columnsvariable varName? ?--?
+    #		variableName ?dictionary? script
+
+    method foreach args {
+
+	variable ::tdbc::generalError
+
+	# Grab keyword-value parameters
+
+	set args [::tdbc::ParseConvenienceArgs $args[set args {}] opts]
+
+	# Check positional parameters
+
+	set cmd [list [self] execute]
+	if {[llength $args] == 2} {
+	    lassign $args varname script
+	} elseif {[llength $args] == 3} {
+	    lassign $args varname dict script
+	    lappend cmd $dict
+	} else {
+	    set errorcode $generalError
+	    lappend errorcode wrongNumArgs
+	    return -code error -errorcode $errorcode \
+		"wrong # args: should be [lrange [info level 0] 0 1]\
+		 ?-option value?... ?--? varName ?dictionary? script"
+	}
+
+	# Get the result set
+
+	set resultSet [uplevel 1 $cmd]
+
+	# Delegate to the result set's [foreach] method to evaluate
+	# the script for each row of the result.
+
+	set cmd [list $resultSet foreach {*}$opts -- $varname $script]
+	set status [catch {
+	    uplevel 1 $cmd
+	} result options]
+
+	# Destroy the result set
+
+	catch {
+	    rename $resultSet {}
+	}
+
+	# Adjust return level in the case that the script [return]s
+
+	if {$status == 2} {
+	    set options [dict merge {-level 1} $options[set options {}]]
+	    dict incr options -level
+	}
+	return -options $options $result
+    }
+
+    # The 'close' method is syntactic sugar for invoking the destructor
+
+    method close {} {
+	my destroy
+    }
+
+    # Derived classes are expected to implement their own constructors,
+    # plus the following methods:
+
+    # paramtype paramName ?direction? type ?scale ?precision??
+    #     Declares the type of a parameter in the statement
+
+}
+
+#------------------------------------------------------------------------------
+#
+# Class: tdbc::resultset
+#
+#	Class that represents a result set in a generic database.
+#
+#------------------------------------------------------------------------------
+
+oo::class create tdbc::resultset {
+
+    constructor {} { }
+
+    # The 'allrows' method returns a list of all rows that a given
+    # result set returns.
+
+    method allrows args {
+
+	variable ::tdbc::generalError
+
+	# Parse args
+
+	set args [::tdbc::ParseConvenienceArgs $args[set args {}] opts]
+	if {[llength $args] != 0} {
+	    set errorcode $generalError
+	    lappend errorcode wrongNumArgs
+	    return -code error -errorcode $errorcode \
+		"wrong # args: should be [lrange [info level 0] 0 1]\
+		 ?-option value?... ?--? varName script"
+	}
+
+	# Do -columnsvariable if requested
+
+	if {[dict exists $opts -columnsvariable]} {
+	    upvar 1 [dict get $opts -columnsvariable] columns
+	}
+
+	# Assemble the results
+
+	if {[dict get $opts -as] eq {lists}} {
+	    set delegate nextlist
+	} else {
+	    set delegate nextdict
+	}
+	set results [list]
+	while {1} {
+	    set columns [my columns]
+	    while {[my $delegate row]} {
+		lappend results $row
+	    }
+	    if {![my nextresults]} break
+	}
+	return $results
+
+    }
+
+    # The 'foreach' method runs a script on each row from a result set.
+
+    method foreach args {
+
+	variable ::tdbc::generalError
+
+	# Grab keyword-value parameters
+
+	set args [::tdbc::ParseConvenienceArgs $args[set args {}] opts]
+
+	# Check positional parameters
+
+	if {[llength $args] != 2} {
+	    set errorcode $generalError
+	    lappend errorcode wrongNumArgs
+	    return -code error -errorcode $errorcode \
+		"wrong # args: should be [lrange [info level 0] 0 1]\
+		 ?-option value?... ?--? varName script"
+	}
+
+	# Do -columnsvariable if requested
+
+	if {[dict exists $opts -columnsvariable]} {
+	    upvar 1 [dict get $opts -columnsvariable] columns
+	}
+
+	# Iterate over the groups of results
+	while {1} {
+
+	    # Export column names to caller
+
+	    set columns [my columns]
+
+	    # Iterate over the rows of one group of results
+
+	    upvar 1 [lindex $args 0] row
+	    if {[dict get $opts -as] eq {lists}} {
+		set delegate nextlist
+	    } else {
+		set delegate nextdict
+	    }
+	    while {[my $delegate row]} {
+		set status [catch {
+		    uplevel 1 [lindex $args 1]
+		} result options]
+		switch -exact -- $status {
+		    0 - 4 {	# OK or CONTINUE
+		    }
+		    2 {		# RETURN
+			set options \
+			    [dict merge {-level 1} $options[set options {}]]
+			dict incr options -level
+			return -options $options $result
+		    }
+		    3 {		# BREAK
+			set broken 1
+			break
+		    }
+		    default {	# ERROR or unknown status
+			return -options $options $result
+		    }
+		}
+	    }
+
+	    # Advance to the next group of results if there is one
+
+	    if {[info exists broken] || ![my nextresults]} {
+		break
+	    }
+	}
+
+	return
+    }
+
+
+    # The 'nextrow' method retrieves a row in the form of either
+    # a list or a dictionary.
+
+    method nextrow {args} {
+
+	variable ::tdbc::generalError
+
+	set opts [dict create -as dicts]
+	set i 0
+
+	# Munch keyword options off the front of the command arguments
+
+	foreach {key value} $args {
+	    if {[string index $key 0] eq {-}} {
+		switch -regexp -- $key {
+		    -as? {
+			dict set opts -as $value
+		    }
+		    -- {
+			incr i
+			break
+		    }
+		    default {
+			set errorcode $generalError
+			lappend errorcode badOption $key
+			return -code error -errorcode $errorcode \
+			    "bad option \"$key\":\
+			     must be -as or -columnsvariable"
+		    }
+		}
+	    } else {
+		break
+	    }
+	    incr i 2
+	}
+
+	set args [lrange $args $i end]
+	if {[llength $args] != 1} {
+	    set errorcode $generalError
+	    lappend errorcode wrongNumArgs
+	    return -code error -errorcode $errorcode \
+		"wrong # args: should be [lrange [info level 0] 0 1]\
+		 ?-option value?... ?--? varName"
+	}
+	upvar 1 [lindex $args 0] row
+	if {[dict get $opts -as] eq {lists}} {
+	    set delegate nextlist
+	} else {
+	    set delegate nextdict
+	}
+	return [my $delegate row]
+    }
+
+    # Derived classes must override 'nextresults' if a single
+    # statement execution can yield multiple sets of results
+
+    method nextresults {} {
+	return 0
+    }
+
+    # Derived classes must override 'outputparams' if statements can
+    # have output parameters.
+
+    method outputparams {} {
+	return {}
+    }
+
+    # The 'close' method is syntactic sugar for destroying the result set.
+
+    method close {} {
+	my destroy
+    }
+
+    # Derived classes are expected to implement the following methods:
+
+    # constructor and destructor.
+    #        Constructor accepts a statement and an optional
+    #        a dictionary of substituted parameters  and
+    #        executes the statement against the database. If
+    #	     the dictionary is not supplied, then the default
+    #	     is to get params from variables in the caller's scope).
+    # columns
+    #     -- Returns a list of the names of the columns in the result.
+    # nextdict variableName
+    #     -- Stores the next row of the result set in the given variable
+    #        in caller's scope, in the form of a dictionary that maps
+    #	     column names to values.
+    # nextlist variableName
+    #     -- Stores the next row of the result set in the given variable
+    #        in caller's scope, in the form of a list of cells.
+    # rowcount
+    #     -- Returns a count of rows affected by the statement, or -1
+    #        if the count of rows has not been determined.
+
+}

src/vfs/punk8win.vfs/lib_tcl8/tdbc1.1.12/tdbcConfig.sh

@@ -0,0 +1,81 @@
+# tdbcConfig.sh --
+#
+# This shell script (for sh) is generated automatically by TDBC's configure
+# script. It will create shell variables for most of the configuration options
+# discovered by the configure script. This script is intended to be included
+# by the configure scripts for TDBC extensions so that they don't have to
+# figure this all out for themselves.
+#
+# The information in this file is specific to a single platform.
+#
+# RCS: @(#) $Id$
+
+# TDBC's version number
+tdbc_VERSION=1.1.12
+TDBC_VERSION=1.1.12
+
+# Name of the TDBC library - may be either a static or shared library
+tdbc_LIB_FILE=tdbc1112.dll
+TDBC_LIB_FILE=tdbc1112.dll
+
+# String to pass to the linker to pick up the TDBC library from its build dir
+tdbc_BUILD_LIB_SPEC="-LC:/bawt/BawtBuild/Windows/x64/Release/Build/Tcl/pkgs/tdbc1.1.12 -ltdbc1112"
+TDBC_BUILD_LIB_SPEC="-LC:/bawt/BawtBuild/Windows/x64/Release/Build/Tcl/pkgs/tdbc1.1.12 -ltdbc1112"
+
+# String to pass to the linker to pick up the TDBC library from its installed
+# dir.
+tdbc_LIB_SPEC="-LC:/bawt/BawtBuild/Windows/x64/Release/Install/Tcl/lib/tdbc1.1.12 -ltdbc1112"
+TDBC_LIB_SPEC="-LC:/bawt/BawtBuild/Windows/x64/Release/Install/Tcl/lib/tdbc1.1.12 -ltdbc1112"
+
+# Name of the TBDC stub library
+tdbc_STUB_LIB_FILE="libtdbcstub1112.a"
+TDBC_STUB_LIB_FILE="libtdbcstub1112.a"
+
+# String to pass to the linker to pick up the TDBC stub library from its
+# build directory
+tdbc_BUILD_STUB_LIB_SPEC="-LC:/bawt/BawtBuild/Windows/x64/Release/Build/Tcl/pkgs/tdbc1.1.12 -ltdbcstub1112"
+TDBC_BUILD_STUB_LIB_SPEC="-LC:/bawt/BawtBuild/Windows/x64/Release/Build/Tcl/pkgs/tdbc1.1.12 -ltdbcstub1112"
+
+# String to pass to the linker to pick up the TDBC stub library from its
+# installed directory
+tdbc_STUB_LIB_SPEC="-LC:/bawt/BawtBuild/Windows/x64/Release/Install/Tcl/lib/tdbc1.1.12 -ltdbcstub1112"
+TDBC_STUB_LIB_SPEC="-LC:/bawt/BawtBuild/Windows/x64/Release/Install/Tcl/lib/tdbc1.1.12 -ltdbcstub1112"
+
+# Path name of the TDBC stub library in its build directory
+tdbc_BUILD_STUB_LIB_PATH="C:/bawt/BawtBuild/Windows/x64/Release/Build/Tcl/pkgs/tdbc1.1.12/libtdbcstub1112.a"
+TDBC_BUILD_STUB_LIB_PATH="C:/bawt/BawtBuild/Windows/x64/Release/Build/Tcl/pkgs/tdbc1.1.12/libtdbcstub1112.a"
+
+# Path name of the TDBC stub library in its installed directory
+tdbc_STUB_LIB_PATH="C:/bawt/BawtBuild/Windows/x64/Release/Install/Tcl/lib/tdbc1.1.12/libtdbcstub1112.a"
+TDBC_STUB_LIB_PATH="C:/bawt/BawtBuild/Windows/x64/Release/Install/Tcl/lib/tdbc1.1.12/libtdbcstub1112.a"
+
+# Location of the top-level source directories from which TDBC was built.
+# This is the directory that contains doc/, generic/ and so on.  If TDBC
+# was compiled in a directory other than the source directory, this still
+# points to the location of the sources, not the location where TDBC was
+# compiled.
+tdbc_SRC_DIR="C:/bawt/BawtBuild/Windows/x64/Release/Build/Tcl/pkgs/tdbc1.1.12"
+TDBC_SRC_DIR="C:/bawt/BawtBuild/Windows/x64/Release/Build/Tcl/pkgs/tdbc1.1.12"
+
+# String to pass to the compiler so that an extension can find installed TDBC
+# headers
+tdbc_INCLUDE_SPEC="-I/C/bawt/BawtBuild/Windows/x64/Release/Install/Tcl/include"
+TDBC_INCLUDE_SPEC="-I/C/bawt/BawtBuild/Windows/x64/Release/Install/Tcl/include"
+
+# String to pass to the compiler so that an extension can find TDBC headers
+# in the source directory
+tdbc_BUILD_INCLUDE_SPEC="-IC:/bawt/BawtBuild/Windows/x64/Release/Build/Tcl/pkgs/tdbc1.1.12/generic"
+TDBC_BUILD_INCLUDE_SPEC="-IC:/bawt/BawtBuild/Windows/x64/Release/Build/Tcl/pkgs/tdbc1.1.12/generic"
+
+# Path name where .tcl files in the tdbc package appear at run time.
+tdbc_LIBRARY_PATH="/C/bawt/BawtBuild/Windows/x64/Release/Install/Tcl/lib/tdbc1.1.12"
+TDBC_LIBRARY_PATH="/C/bawt/BawtBuild/Windows/x64/Release/Install/Tcl/lib/tdbc1.1.12"
+
+# Path name where .tcl files in the tdbc package appear at build time.
+tdbc_BUILD_LIBRARY_PATH="C:/bawt/BawtBuild/Windows/x64/Release/Build/Tcl/pkgs/tdbc1.1.12/library"
+TDBC_BUILD_LIBRARY_PATH="C:/bawt/BawtBuild/Windows/x64/Release/Build/Tcl/pkgs/tdbc1.1.12/library"
+
+# Additional flags that must be passed to the C compiler to use tdbc
+tdbc_CFLAGS=
+TDBC_CFLAGS=
+

src/vfs/punk8win.vfs/lib_tcl8/tdbcmysql1.1.12/pkgIndex.tcl

@@ -0,0 +1,14 @@
+# Index file to load the TDBC MySQL package.
+
+if {![package vsatisfies [package provide Tcl] 8.6-]} {
+    return
+}
+if {[package vsatisfies [package provide Tcl] 9.0-]} {
+    package ifneeded tdbc::mysql 1.1.12 \
+	    "[list source -encoding utf-8 [file join $dir tdbcmysql.tcl]]\;\
+	    [list load [file join $dir tcl9tdbcmysql1112.dll] [string totitle tdbcmysql]]"
+} else {
+    package ifneeded tdbc::mysql 1.1.12 \
+	    "[list source -encoding utf-8 [file join $dir tdbcmysql.tcl]]\;\
+	    [list load [file join $dir tdbcmysql1112.dll] [string totitle tdbcmysql]]"
+}

src/vfs/punk8win.vfs/lib_tcl8/tdbcmysql1.1.12/tdbcmysql.tcl

@@ -100,23 +100,23 @@ package require tdbc
 	    } {
 		set stmt [my prepare "
 	     SELECT rc.CONSTRAINT_SCHEMA AS \"foreignConstraintSchema\",
-                    rc.CONSTRAINT_NAME AS \"foreignConstraintName\",
-                    rc.UPDATE_RULE AS \"updateAction\",
+		    rc.CONSTRAINT_NAME AS \"foreignConstraintName\",
+		    rc.UPDATE_RULE AS \"updateAction\",
 		    rc.DELETE_RULE AS \"deleteAction\",
 		    fkc.REFERENCED_TABLE_SCHEMA AS \"primarySchema\",
-                    fkc.REFERENCED_TABLE_NAME AS \"primaryTable\",
-                    fkc.REFERENCED_COLUMN_NAME AS \"primaryColumn\",
-                    fkc.TABLE_SCHEMA AS \"foreignSchema\",
-                    fkc.TABLE_NAME AS \"foreignTable\",
-                    fkc.COLUMN_NAME AS \"foreignColumn\",
-                    fkc.ORDINAL_POSITION AS \"ordinalPosition\"
-             FROM INFORMATION_SCHEMA.REFERENTIAL_CONSTRAINTS rc
-             INNER JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE fkc
-                     ON fkc.CONSTRAINT_NAME = rc.CONSTRAINT_NAME
-                    AND fkc.CONSTRAINT_SCHEMA = rc.CONSTRAINT_SCHEMA
-             WHERE 1=1
-                 $clause1
-                 $clause2
+		    fkc.REFERENCED_TABLE_NAME AS \"primaryTable\",
+		    fkc.REFERENCED_COLUMN_NAME AS \"primaryColumn\",
+		    fkc.TABLE_SCHEMA AS \"foreignSchema\",
+		    fkc.TABLE_NAME AS \"foreignTable\",
+		    fkc.COLUMN_NAME AS \"foreignColumn\",
+		    fkc.ORDINAL_POSITION AS \"ordinalPosition\"
+	     FROM INFORMATION_SCHEMA.REFERENTIAL_CONSTRAINTS rc
+	     INNER JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE fkc
+		     ON fkc.CONSTRAINT_NAME = rc.CONSTRAINT_NAME
+		    AND fkc.CONSTRAINT_SCHEMA = rc.CONSTRAINT_SCHEMA
+	     WHERE 1=1
+		 $clause1
+		 $clause2
 "]
 		dict set foreignKeysStatement $exists1 $exists2 $stmt
 	    }

src/vfs/punk8win.vfs/lib_tcl8/tdbcmysql1.1.5/pkgIndex.tcl

@@ -1,14 +0,0 @@
-# Index file to load the TDBC MySQL package.
-
-if {![package vsatisfies [package provide Tcl] 8.6-]} {
-    return
-}
-if {[package vsatisfies [package provide Tcl] 9.0-]} {
-    package ifneeded tdbc::mysql 1.1.5 \
-	    "[list source [file join $dir tdbcmysql.tcl]]\;\
-	    [list load [file join $dir tcl9tdbcmysql115.dll] [string totitle tdbcmysql]]"
-} else {
-    package ifneeded tdbc::mysql 1.1.5 \
-	    "[list source [file join $dir tdbcmysql.tcl]]\;\
-	    [list load [file join $dir tdbcmysql115.dll] [string totitle tdbcmysql]]"
-}

src/vfs/punk8win.vfs/lib_tcl8/tdbcodbc1.1.12/pkgIndex.tcl

@@ -0,0 +1,14 @@
+# Index file to load the TDBC ODBC package.
+
+if {![package vsatisfies [package provide Tcl] 8.6-]} {
+    return
+}
+if {[package vsatisfies [package provide Tcl] 9.0-]} {
+    package ifneeded tdbc::odbc 1.1.12 \
+	    "[list source -encoding utf-8 [file join $dir tdbcodbc.tcl]]\;\
+	    [list load [file join $dir tcl9tdbcodbc1112.dll] [string totitle tdbcodbc]]"
+} else {
+    package ifneeded tdbc::odbc 1.1.12 \
+	    "[list source -encoding utf-8 [file join $dir tdbcodbc.tcl]]\;\
+	    [list load [file join $dir tdbcodbc1112.dll] [string totitle tdbcodbc]]"
+}

src/vfs/punk8win.vfs/lib_tcl8/tdbcodbc1.1.12/tdbcodbc.tcl

@@ -270,7 +270,7 @@ package require tdbc
 
 	# at least if making all parameters 'inout' doesn't work.
 
-        }
+	}
 
     }
 

src/vfs/punk8win.vfs/lib_tcl8/tdbcodbc1.1.5/pkgIndex.tcl

@@ -1,14 +0,0 @@
-# Index file to load the TDBC ODBC package.
-
-if {![package vsatisfies [package provide Tcl] 8.6-]} {
-    return
-}
-if {[package vsatisfies [package provide Tcl] 9.0-]} {
-    package ifneeded tdbc::odbc 1.1.5 \
-	    "[list source [file join $dir tdbcodbc.tcl]]\;\
-	    [list load [file join $dir tcl9tdbcodbc115.dll] [string totitle tdbcodbc]]"
-} else {
-    package ifneeded tdbc::odbc 1.1.5 \
-	    "[list source [file join $dir tdbcodbc.tcl]]\;\
-	    [list load [file join $dir tdbcodbc115.dll] [string totitle tdbcodbc]]"
-}

src/vfs/punk8win.vfs/lib_tcl8/tdbcpostgres1.1.12/pkgIndex.tcl

@@ -0,0 +1,14 @@
+# Index file to load the TDBC Postgres package.
+
+if {![package vsatisfies [package provide Tcl] 8.6-]} {
+    return
+}
+if {[package vsatisfies [package provide Tcl] 9.0-]} {
+    package ifneeded tdbc::postgres 1.1.12 \
+	    "[list source -encoding utf-8 [file join $dir tdbcpostgres.tcl]]\;\
+	    [list load [file join $dir tcl9tdbcpostgres1112.dll] [string totitle tdbcpostgres]]"
+} else {
+    package ifneeded tdbc::postgres 1.1.12 \
+	    "[list source -encoding utf-8 [file join $dir tdbcpostgres.tcl]]\;\
+	    [list load [file join $dir tdbcpostgres1112.dll] [string totitle tdbcpostgres]]"
+}

src/vfs/punk8win.vfs/lib_tcl8/tdbcpostgres1.1.5/pkgIndex.tcl

@@ -1,14 +0,0 @@
-# Index file to load the TDBC Postgres package.
-
-if {![package vsatisfies [package provide Tcl] 8.6-]} {
-    return
-}
-if {[package vsatisfies [package provide Tcl] 9.0-]} {
-    package ifneeded tdbc::postgres 1.1.5 \
-	    "[list source [file join $dir tdbcpostgres.tcl]]\;\
-	    [list load [file join $dir tcl9tdbcpostgres115.dll] [string totitle tdbcpostgres]]"
-} else {
-    package ifneeded tdbc::postgres 1.1.5 \
-	    "[list source [file join $dir tdbcpostgres.tcl]]\;\
-	    [list load [file join $dir tdbcpostgres115.dll] [string totitle tdbcpostgres]]"
-}

src/vfs/punk8win.vfs/lib_tcl8/tdom0.9.3/pkgIndex.tcl

@@ -1,6 +0,0 @@
-#
-# Tcl package index file
-#
-package ifneeded tdom 0.9.3 \
-    "[list load [file join $dir tdom093.dll]];
-     [list source [file join $dir tdom.tcl]]"

src/vfs/punk8win.vfs/lib_tcl8/tdom0.9.6/pkgIndex.tcl

@@ -0,0 +1,12 @@
+#
+# Tcl package index file
+#
+if {[package vsatisfies [package provide Tcl] 9.0-]} {
+    package ifneeded tdom 0.9.6 \
+        "[list load [file join $dir tcl9tdom096.dll]];
+         [list source [file join $dir tdom.tcl]]"
+} else {
+    package ifneeded tdom 0.9.6 \
+        "[list load [file join $dir tdom096.dll]];
+         [list source [file join $dir tdom.tcl]]"
+}

src/vfs/punk8win.vfs/lib_tcl8/tdom0.9.6/tdom.tcl

@@ -54,6 +54,7 @@ namespace eval ::dom {
 namespace eval ::tdom { 
     variable extRefHandlerDebug 0
     variable useForeignDTD ""
+    variable utf8bom 0
 
     namespace export xmlOpenFile xmlReadFile xmlReadFileForSimple \
         extRefHandler baseURL
@@ -429,7 +430,7 @@ proc ::dom::domNode::substringData { node offset count } {
     } {
         return -code error "NOT_SUPPORTED_ERR: node is not a cdata node"
     }
-    set endOffset [expr $offset + $count - 1]
+    set endOffset {[expr $offset + $count - 1]}
     return [string range [$node nodeValue] $offset $endOffset]
 }
 
@@ -740,6 +741,7 @@ proc ::tdom::IANAEncoding2TclEncoding {IANAName} {
 #
 #----------------------------------------------------------------------------
 proc ::tdom::xmlOpenFileWorker {filename {encodingString {}} {forSimple 0} {forRead 0}} {
+    variable utf8bom
     
     # This partly (mis-)use the encoding of a channel handed to [dom
     # parse -channel ..] as a marker: if the channel encoding is utf-8
@@ -747,6 +749,11 @@ proc ::tdom::xmlOpenFileWorker {filename {encodingString {}} {forSimple 0} {forR
     # Tcl_ReadChars(). This is used for the encodings understood (and
     # checked) by the used expat implementation: utf-8 and utf-16 (in
     # either byte order).
+    #
+    # The -translation auto used used in the fconfigure commands which
+    # set the encoding isn't strictly necessary in case the parser is
+    # expat (because it handles that internally) but it is the right
+    # thing for the simple parser.
     
     set fd [open $filename]
 
@@ -757,9 +764,11 @@ proc ::tdom::xmlOpenFileWorker {filename {encodingString {}} {forSimple 0} {forR
     # The autodetection of the encoding follows
     # XML Recomendation, Appendix F
 
-    fconfigure $fd -encoding binary
+    fconfigure $fd -translation binary
     if {![binary scan [read $fd 4] "H8" firstBytes]} {
-        # very short (< 4 Bytes) file
+        # very short (< 4 Bytes) file, that means not a well-formed
+        # XML at all (the shortes possible would be <[a-zA-Z]/>).
+        # Don't report that here but let the parser do that.
         seek $fd 0 start
         set encString UTF-8
         return $fd
@@ -770,11 +779,17 @@ proc ::tdom::xmlOpenFileWorker {filename {encodingString {}} {forSimple 0} {forR
         "feff" {
             # feff: UTF-16, big-endian BOM
             if {$forSimple || $forRead} {
-                error "UTF-16be is not supported"
+                if {[package vsatisfies [package provide Tcl] 9-]} {
+                    seek $fd 2 start
+                    fconfigure $fd -encoding utf-16be -translation auto
+                } else {
+                    error "UTF-16be is not supported"
+                }
+            } else {
+                seek $fd 0 start
+                set encString UTF-16be
+                fconfigure $fd -encoding utf-8 -translation auto
             }
-            seek $fd 0 start
-            set encString UTF-16be
-            fconfigure $fd -encoding utf-8
             return $fd
         }
         "fffe" {
@@ -782,15 +797,33 @@ proc ::tdom::xmlOpenFileWorker {filename {encodingString {}} {forSimple 0} {forR
             set encString UTF-16le          
             if {$forSimple || $forRead} {
                 seek $fd 2 start
-                fconfigure $fd -encoding unicode
+                if {[package vsatisfies [package provide Tcl] 9-]} {
+                    fconfigure $fd -encoding utf-16le -translation auto
+                } else {
+                    fconfigure $fd -encoding unicode -translation auto
+                }
             } else {
                 seek $fd 0 start
-                fconfigure $fd -encoding utf-8
+                fconfigure $fd -encoding utf-8 -translation auto
             }
             return $fd
         }
     }
     
+    if {$utf8bom} {
+        # According to the Unicode standard
+        # (http://www.unicode.org/versions/Unicode5.0.0/ch02.pdf) the
+        # "[u]se of a BOM is neither required nor recommended for
+        # UTF-8". Nevertheless such files exits. If the programmer
+        # explcitely enables this by setting ::tdom::utf8bom to true
+        # this is handled here.
+        if {[string range $firstBytes 0 5] eq "efbbbf"} {
+            set encString UTF-8
+            seek $fd 3 start
+            fconfigure $fd -encoding utf-8 -translation auto
+            return $fd
+        }
+    }
     
     # If the entity has a XML Declaration, the first four characters
     # must be "<?xm".
@@ -838,27 +871,40 @@ proc ::tdom::xmlOpenFileWorker {filename {encodingString {}} {forSimple 0} {forR
         }
             "003c003f" {
             # UTF-16, big-endian, no BOM
-            if {$forSimple} {
-                error "UTF-16be is not supported by the simple parser"
+            if {$forSimple || $forRead} {
+                if {[package vsatisfies [package provide Tcl] 9-]} {
+                    set encoding utf-16be
+                } else {
+                    error "UTF-16be is not supported by the simple parser"
+                }
+            } else {
+                set encoding utf-8
             }
             seek $fd 0 start
-            set encoding utf-8
             set encString UTF-16be
         }
         "3c003f00" {
             # UTF-16, little-endian, no BOM
-            if {$forSimple} {
-                seek $fd 2 start
-                set encoding unicode
+            if {$forSimple || $forRead} {
+                if {[package vsatisfies [package provide Tcl] 9-]} {
+                    set encoding utf-16le
+                } else {
+                    set encoding unicode
+                }
             } else {
-                seek $fd 0 start
                 set encoding utf-8
             }
+            seek $fd 0 start
             set encString UTF-16le          
         }
         "4c6fa794" {
             # EBCDIC in some flavor
-            error "EBCDIC not supported"
+            if {[package vsatisfies [package provide Tcl] 9-]} {
+                seek $fd 0 start
+                set encoding ebcdic
+            } else {
+                error "EBCDIC not supported"
+            }
         }
         default {
             # UTF-8 without an encoding declaration
@@ -867,7 +913,7 @@ proc ::tdom::xmlOpenFileWorker {filename {encodingString {}} {forSimple 0} {forR
             set encString "UTF-8"
         }
     }
-    fconfigure $fd -encoding $encoding
+    fconfigure $fd -encoding $encoding -translation auto
     return $fd
 }
 
@@ -992,6 +1038,47 @@ proc ::tdom::baseURL {path} {
     }
 }
 
+namespace eval ::tdom::json {
+    namespace export asDict
+}
+
+# The argument node may be an element node as well as a document node.
+proc ::tdom::json::asDict {node} {
+    return [nodesAsDict [$node childNodes] [$node jsonType]]
+}
+
+proc ::tdom::json::nodesAsDict {nodes parentType} {
+    set result ""
+    foreach n $nodes {
+        set children [$n childNodes]
+        set jsonType [$n jsonType]
+        set childrendValue [nodesAsDict $children $jsonType]
+
+        switch $jsonType {
+            OBJECT {
+                if {[$n nodeName] ne "objectcontainer" || $parentType eq "OBJECT"} {
+                    lappend result [$n nodeName]
+                }
+                lappend result $childrendValue
+            }
+            NONE {
+                lappend result [$n nodeName] $childrendValue
+            }
+            ARRAY {
+                if {[$n nodeName] ne "arraycontainer" || $parentType eq "OBJECT"} {
+                    lappend result [$n nodeName]
+                }
+                lappend result $childrendValue
+            }
+            default {
+                set op [expr {[llength $nodes] > 1 ? "lappend" : "set"} ]
+                $op result [$n nodeValue]
+            }
+        }
+    }
+    return $result
+}
+
 namespace eval ::tDOM { 
     variable extRefHandlerDebug 0
     variable useForeignDTD ""
@@ -1008,7 +1095,7 @@ foreach ::tdom::cmd {
     baseURL
     IANAEncoding2TclEncoding
 } {
-    interp alias {} tDOM::$::tdom::cmd {} tdom::$::tdom::cmd
+    interp alias {} ::tDOM::$::tdom::cmd {} ::tdom::$::tdom::cmd
 }
 
 # EOF

src/vfs/punk8win.vfs/lib_tcl8/thread2.8.12/pkgIndex.tcl

@@ -0,0 +1,68 @@
+# -*- tcl -*-
+# Tcl package index file, version 1.1
+#
+
+if {![package vsatisfies [package provide Tcl] 8.4]} {
+    # Pre-8.4 Tcl interps we dont support at all.  Bye!
+    # 9.0+ Tcl interps are only supported on 32-bit platforms.
+    if {![package vsatisfies [package provide Tcl] 9.0]
+	    || ($::tcl_platform(pointerSize) != 4)} {
+	return
+    }
+}
+
+# All Tcl 8.4+ interps can [load] Thread 2.8.12
+#
+# For interps that are not thread-enabled, we still call [package ifneeded].
+# This is contrary to the usual convention, but is a good idea because we
+# cannot imagine any other version of Thread that might succeed in a
+# thread-disabled interp.  There's nothing to gain by yielding to other
+# competing callers of [package ifneeded Thread].  On the other hand,
+# deferring the error has the advantage that a script calling
+# [package require Thread] in a thread-disabled interp gets an error message
+# about a thread-disabled interp, instead of the message
+# "can't find package Thread".
+
+package ifneeded Thread 2.8.12 [list load [file join $dir thread2812.dll] [string totitle thread]]
+
+# package Ttrace uses some support machinery.
+
+# In Tcl 8.4 interps we use some older interfaces
+if {![package vsatisfies [package provide Tcl] 8.5]} {
+    package ifneeded Ttrace 2.8.12 "
+    [list proc thread_source {dir} {
+	if {[info exists ::env(TCL_THREAD_LIBRARY)] &&
+		[file readable $::env(TCL_THREAD_LIBRARY)/ttrace.tcl]} {
+	    source -encoding utf-8 $::env(TCL_THREAD_LIBRARY)/ttrace.tcl
+	} elseif {[file readable [file join $dir .. lib ttrace.tcl]]} {
+	    source -encoding utf-8 [file join $dir .. lib ttrace.tcl]
+	} elseif {[file readable [file join $dir ttrace.tcl]]} {
+	    source -encoding utf-8 [file join $dir ttrace.tcl]
+	}
+	if {[namespace which ::ttrace::update] ne ""} {
+	    ::ttrace::update
+	}
+    }]
+    [list thread_source $dir]
+    [list rename thread_source {}]"
+    return
+}
+
+# In Tcl 8.5+ interps; use [::apply]
+
+package ifneeded Ttrace 2.8.12 [list ::apply {{dir} {
+    if {[info exists ::env(TCL_THREAD_LIBRARY)] &&
+	[file readable $::env(TCL_THREAD_LIBRARY)/ttrace.tcl]} {
+	source -encoding utf-8 $::env(TCL_THREAD_LIBRARY)/ttrace.tcl
+    } elseif {[file readable [file join $dir .. lib ttrace.tcl]]} {
+	source -encoding utf-8 [file join $dir .. lib ttrace.tcl]
+    } elseif {[file readable [file join $dir ttrace.tcl]]} {
+	source -encoding utf-8 [file join $dir ttrace.tcl]
+    }
+    if {[namespace which ::ttrace::update] ne ""} {
+	::ttrace::update
+    }
+}} $dir]
+
+
+

src/vfs/punk8win.vfs/lib_tcl8/thread2.8.12/ttrace.tcl

@@ -0,0 +1,942 @@
+#
+# ttrace.tcl --
+#
+# Copyright (C) 2003 Zoran Vasiljevic, Archiware GmbH. All Rights Reserved.
+#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# ----------------------------------------------------------------------------
+#
+# User level commands:
+#
+#   ttrace::eval           top-level wrapper (ttrace-savvy eval)
+#   ttrace::enable         activates registered Tcl command traces
+#   ttrace::disable        terminates tracing of Tcl commands
+#   ttrace::isenabled      returns true if ttrace is enabled
+#   ttrace::cleanup        bring the interp to a pristine state
+#   ttrace::update         update interp to the latest trace epoch
+#   ttrace::config         setup some configuration options
+#   ttrace::getscript      returns a script for initializing interps
+#
+# Commands used for/from trace callbacks:
+#
+#   ttrace::atenable       register callback to be done at trace enable
+#   ttrace::atdisable      register callback to be done at trace disable
+#   ttrace::addtrace       register user-defined tracer callback
+#   ttrace::addscript      register user-defined script generator
+#   ttrace::addresolver    register user-defined command resolver
+#   ttrace::addcleanup     register user-defined cleanup procedures
+#   ttrace::addentry       adds one entry into the named trace store
+#   ttrace::getentry       returns the entry value from the named store
+#   ttrace::delentry       removes the entry from the named store
+#   ttrace::getentries     returns all entries from the named store
+#   ttrace::preload        register procedures to be preloaded always
+#
+#
+# Limitations:
+#
+#   o. [namespace forget] is still not implemented
+#   o. [namespace origin cmd] breaks if cmd is not already defined
+#
+#      I left this deliberately. I didn't want to override the [namespace]
+#      command in order to avoid potential slowdown.
+#
+
+namespace eval ttrace {
+
+    # Setup some compatibility wrappers
+    if {[info commands nsv_set] != ""} {
+	variable tvers 0
+	variable mutex ns_mutex
+	variable elock [$mutex create traceepochmutex]
+	# Import the underlying API; faster than recomputing
+	interp alias {} [namespace current]::_array   {} nsv_array
+	interp alias {} [namespace current]::_incr    {} nsv_incr
+	interp alias {} [namespace current]::_lappend {} nsv_lappend
+	interp alias {} [namespace current]::_names   {} nsv_names
+	interp alias {} [namespace current]::_set     {} nsv_set
+	interp alias {} [namespace current]::_unset   {} nsv_unset
+    } elseif {![catch {
+	variable tvers [package require Thread]
+    }]} {
+	variable mutex thread::mutex
+	variable elock [$mutex create]
+	# Import the underlying API; faster than recomputing
+	interp alias {} [namespace current]::_array   {} tsv::array
+	interp alias {} [namespace current]::_incr    {} tsv::incr
+	interp alias {} [namespace current]::_lappend {} tsv::lappend
+	interp alias {} [namespace current]::_names   {} tsv::names
+	interp alias {} [namespace current]::_set     {} tsv::set
+	interp alias {} [namespace current]::_unset   {} tsv::unset
+    } else {
+	error "requires NaviServer/AOLserver or Tcl threading extension"
+    }
+
+    # Keep in sync with the Thread package
+    package provide Ttrace 2.8.12
+
+    # Package variables
+    variable resolvers ""     ; # List of registered resolvers
+    variable tracers   ""     ; # List of registered cmd tracers
+    variable scripts   ""     ; # List of registered script makers
+    variable enables   ""     ; # List of trace-enable callbacks
+    variable disables  ""     ; # List of trace-disable callbacks
+    variable preloads  ""     ; # List of procedure names to preload
+    variable enabled   0      ; # True if trace is enabled
+    variable config           ; # Array with config options
+
+    variable epoch     -1     ; # The initialization epoch
+    variable cleancnt   0     ; # Counter of registered cleaners
+
+    # Package private namespaces
+    namespace eval resolve "" ; # Commands for resolving commands
+    namespace eval trace   "" ; # Commands registered for tracing
+    namespace eval enable  "" ; # Commands invoked at trace enable
+    namespace eval disable "" ; # Commands invoked at trace disable
+    namespace eval script  "" ; # Commands for generating scripts
+
+    # Exported commands
+    namespace export unknown
+
+    # Initialize ttrace shared state
+    if {[_array exists ttrace] == 0} {
+	_set ttrace lastepoch $epoch
+	_set ttrace epochlist ""
+    }
+
+    # Initially, allow creation of epochs
+    set config(-doepochs) 1
+
+    proc eval {cmd args} {
+	enable
+	set code [catch {uplevel 1 [concat $cmd $args]} result]
+	disable
+	if {$code == 0} {
+	    if {[llength [info commands ns_ictl]]} {
+		ns_ictl save [getscript]
+	    } else {
+		thread::broadcast {
+		    package require Ttrace
+		    ttrace::update
+		}
+	    }
+	}
+	return -code $code \
+	    -errorinfo $::errorInfo -errorcode $::errorCode $result
+    }
+
+    proc config {args} {
+	variable config
+	if {[llength $args] == 0} {
+	    array get config
+	} elseif {[llength $args] == 1} {
+	    set opt [lindex $args 0]
+	    set config($opt)
+	} else {
+	    set opt [lindex $args 0]
+	    set val [lindex $args 1]
+	    set config($opt) $val
+	}
+    }
+
+    proc enable {} {
+	variable config
+	variable tracers
+	variable enables
+	variable enabled
+	incr enabled 1
+	if {$enabled > 1} {
+	    return
+	}
+	if {$config(-doepochs) != 0} {
+	    variable epoch [_newepoch]
+	}
+	set nsp [namespace current]
+	foreach enabler $enables {
+	    enable::_$enabler
+	}
+	foreach trace $tracers {
+	    if {[info commands $trace] != ""} {
+		trace add execution $trace leave ${nsp}::trace::_$trace
+	    }
+	}
+    }
+
+    proc disable {} {
+	variable enabled
+	variable tracers
+	variable disables
+	incr enabled -1
+	if {$enabled > 0} {
+	    return
+	}
+	set nsp [namespace current]
+	foreach disabler $disables {
+	    disable::_$disabler
+	}
+	foreach trace $tracers {
+	    if {[info commands $trace] != ""} {
+		trace remove execution $trace leave ${nsp}::trace::_$trace
+	    }
+	}
+    }
+
+    proc isenabled {} {
+	variable enabled
+	expr {$enabled > 0}
+    }
+
+    proc update {{from -1}} {
+	if {$from < 0} {
+	    variable epoch [_set ttrace lastepoch]
+	} else {
+	    if {[lsearch [_set ttrace epochlist] $from] < 0} {
+		error "no such epoch: $from"
+	    }
+	    variable epoch $from
+	}
+	uplevel 1 [getscript]
+    }
+
+    proc getscript {} {
+	variable preloads
+	variable epoch
+	variable scripts
+	append script [_serializensp] \n
+	append script "::namespace eval [namespace current] {" \n
+	append script "::namespace export unknown" \n
+	append script "_useepoch $epoch" \n
+	append script "}" \n
+	foreach cmd $preloads {
+	    append script [_serializeproc $cmd] \n
+	}
+	foreach maker $scripts {
+	    append script [script::_$maker]
+	}
+	return $script
+    }
+
+    proc cleanup {args} {
+	foreach cmd [info commands resolve::cleaner_*] {
+	    uplevel 1 $cmd $args
+	}
+    }
+
+    proc preload {cmd} {
+	variable preloads
+	if {[lsearch $preloads $cmd] < 0} {
+	    lappend preloads $cmd
+	}
+    }
+
+    proc atenable {cmd arglist body} {
+	variable enables
+	if {[lsearch $enables $cmd] < 0} {
+	    lappend enables $cmd
+	    set cmd [namespace current]::enable::_$cmd
+	    proc $cmd $arglist $body
+	    return $cmd
+	}
+    }
+
+    proc atdisable {cmd arglist body} {
+	variable disables
+	if {[lsearch $disables $cmd] < 0} {
+	    lappend disables $cmd
+	    set cmd [namespace current]::disable::_$cmd
+	    proc $cmd $arglist $body
+	    return $cmd
+	}
+    }
+
+    proc addtrace {cmd arglist body} {
+	variable tracers
+	if {[lsearch $tracers $cmd] < 0} {
+	    lappend tracers $cmd
+	    set tracer [namespace current]::trace::_$cmd
+	    proc $tracer $arglist $body
+	    if {[isenabled]} {
+		trace add execution $cmd leave $tracer
+	    }
+	    return $tracer
+	}
+    }
+
+    proc addscript {cmd body} {
+	variable scripts
+	if {[lsearch $scripts $cmd] < 0} {
+	    lappend scripts $cmd
+	    set cmd [namespace current]::script::_$cmd
+	    proc $cmd args $body
+	    return $cmd
+	}
+    }
+
+    proc addresolver {cmd arglist body} {
+	variable resolvers
+	if {[lsearch $resolvers $cmd] < 0} {
+	    lappend resolvers $cmd
+	    set cmd [namespace current]::resolve::$cmd
+	    proc $cmd $arglist $body
+	    return $cmd
+	}
+    }
+
+    proc addcleanup {body} {
+	variable cleancnt
+	set cmd [namespace current]::resolve::cleaner_[incr cleancnt]
+	proc $cmd args $body
+	return $cmd
+    }
+
+    proc addentry {cmd var val} {
+	variable epoch
+	_set ${epoch}-$cmd $var $val
+    }
+
+    proc delentry {cmd var} {
+	variable epoch
+	set ei $::errorInfo
+	set ec $::errorCode
+	catch {_unset ${epoch}-$cmd $var}
+	set ::errorInfo $ei
+	set ::errorCode $ec
+    }
+
+    proc getentry {cmd var} {
+	variable epoch
+	set ei $::errorInfo
+	set ec $::errorCode
+	if {[catch {_set ${epoch}-$cmd $var} val]} {
+	    set ::errorInfo $ei
+	    set ::errorCode $ec
+	    set val ""
+	}
+	return $val
+    }
+
+    proc getentries {cmd {pattern *}} {
+	variable epoch
+	_array names ${epoch}-$cmd $pattern
+    }
+
+    proc unknown {args} {
+	set cmd [lindex $args 0]
+	if {[uplevel 1 ttrace::_resolve [list $cmd]]} {
+	    set c [catch {uplevel 1 $cmd [lrange $args 1 end]} r]
+	} else {
+	    set c [catch {uplevel 1 ::tcl::unknown $args} r]
+	}
+	return -code $c -errorcode $::errorCode -errorinfo $::errorInfo $r
+    }
+
+    proc _resolve {cmd} {
+	variable resolvers
+	foreach resolver $resolvers {
+	    if {[uplevel 1 [info comm resolve::$resolver] [list $cmd]]} {
+		return 1
+	    }
+	}
+	return 0
+    }
+
+    proc _getthread {} {
+	if {[info commands ns_thread] == ""} {
+	    thread::id
+	} else {
+	    ns_thread getid
+	}
+    }
+
+    proc _getthreads {} {
+	if {[info commands ns_thread] == ""} {
+	    return [thread::names]
+	} else {
+	    foreach entry [ns_info threads] {
+		lappend threads [lindex $entry 2]
+	    }
+	    return $threads
+	}
+    }
+
+    proc _newepoch {} {
+	variable elock
+	variable mutex
+	$mutex lock $elock
+	set old [_set ttrace lastepoch]
+	set new [_incr ttrace lastepoch]
+	_lappend ttrace $new [_getthread]
+	if {$old >= 0} {
+	    _copyepoch $old $new
+	    _delepochs
+	}
+	_lappend ttrace epochlist $new
+	$mutex unlock $elock
+	return $new
+    }
+
+    proc _copyepoch {old new} {
+	foreach var [_names $old-*] {
+	    set cmd [lindex [split $var -] 1]
+	    _array reset $new-$cmd [_array get $var]
+	}
+    }
+
+    proc _delepochs {} {
+	set tlist [_getthreads]
+	set elist ""
+	foreach epoch [_set ttrace epochlist] {
+	    if {[_dropepoch $epoch $tlist] == 0} {
+		lappend elist $epoch
+	    } else {
+		_unset ttrace $epoch
+	    }
+	}
+	_set ttrace epochlist $elist
+    }
+
+    proc _dropepoch {epoch threads} {
+	set self [_getthread]
+	foreach tid [_set ttrace $epoch] {
+	    if {$tid != $self && [lsearch $threads $tid] >= 0} {
+		lappend alive $tid
+	    }
+	}
+	if {[info exists alive]} {
+	    _set ttrace $epoch $alive
+	    return 0
+	} else {
+	    foreach var [_names $epoch-*] {
+		_unset $var
+	    }
+	    return 1
+	}
+    }
+
+    proc _useepoch {epoch} {
+	if {$epoch >= 0} {
+	    set tid [_getthread]
+	    if {[lsearch [_set ttrace $epoch] $tid] == -1} {
+		_lappend ttrace $epoch $tid
+	    }
+	}
+    }
+
+    proc _serializeproc {cmd} {
+	set dargs [info args $cmd]
+	set pbody [info body $cmd]
+	set pargs ""
+	foreach arg $dargs {
+	    if {![info default $cmd $arg def]} {
+		lappend pargs $arg
+	    } else {
+		lappend pargs [list $arg $def]
+	    }
+	}
+	set nsp [namespace qual $cmd]
+	if {$nsp == ""} {
+	    set nsp "::"
+	}
+	append res [list ::namespace eval $nsp] " {" \n
+	append res [list ::proc [namespace tail $cmd] $pargs $pbody] \n
+	append res "}" \n
+    }
+
+    proc _serializensp {{nsp ""} {result _}} {
+	upvar $result res
+	if {$nsp == ""} {
+	    set nsp [namespace current]
+	}
+	append res [list ::namespace eval $nsp] " {" \n
+	foreach var [info vars ${nsp}::*] {
+	    set vname [namespace tail $var]
+	    if {[array exists $var] == 0} {
+		append res [list ::variable $vname [set $var]] \n
+	    } else {
+		append res [list ::variable $vname] \n
+		append res [list ::array set $vname [array get $var]] \n
+	    }
+	}
+	foreach cmd [info procs ${nsp}::*] {
+	    append res [_serializeproc $cmd] \n
+	}
+	append res "}" \n
+	foreach nn [namespace children $nsp] {
+	    _serializensp $nn res
+	}
+	return $res
+    }
+}
+
+#
+# The code below is ment to be run once during the application start.  It
+# provides implementation of tracing callbacks for some Tcl commands.  Users
+# can supply their own tracer implementations on-the-fly.
+#
+# The code below will create traces for the following Tcl commands:
+#    "namespace", "variable", "load", "proc" and "rename"
+#
+# Also, the Tcl object extension XOTcl 1.1.0 is handled and all XOTcl related
+# things, like classes and objects are traced (many thanks to Gustaf Neumann
+# from XOTcl for his kind help and support).
+#
+
+eval {
+
+    #
+    # Register the "load" trace. This will create the following key/value pair
+    # in the "load" store:
+    #
+    #  --- key ----              --- value ---
+    #  <path_of_loaded_image>    <name_of_the_init_proc>
+    #
+    # We normally need only the name_of_the_init_proc for being able to load
+    # the package in other interpreters, but we store the path to the image
+    # file as well.
+    #
+
+    ttrace::addtrace load {cmdline code args} {
+	if {$code != 0} {
+	    return
+	}
+	set image [lindex $cmdline 1]
+	set initp [lindex $cmdline 2]
+	if {$initp == ""} {
+	    foreach pkg [info loaded] {
+		if {[lindex $pkg 0] == $image} {
+		    set initp [lindex $pkg 1]
+		}
+	    }
+	}
+	ttrace::addentry load $image $initp
+    }
+
+    ttrace::addscript load {
+	append res "\n"
+	foreach entry [ttrace::getentries load] {
+	    set initp [ttrace::getentry load $entry]
+	    append res "::load {} $initp" \n
+	}
+	return $res
+    }
+
+    #
+    # Register the "namespace" trace. This will create the following key/value
+    # entry in "namespace" store:
+    #
+    #  --- key ----                   --- value ---
+    #  ::fully::qualified::namespace  1
+    #
+    # It will also fill the "proc" store for procedures and commands imported
+    # in this namespace with following:
+    #
+    #  --- key ----                   --- value ---
+    #  ::fully::qualified::proc       [list <ns>  "" ""]
+    #
+    # The <ns> is the name of the namespace where the command or procedure is
+    # imported from.
+    #
+
+    ttrace::addtrace namespace {cmdline code args} {
+	if {$code != 0} {
+	    return
+	}
+	set nop [lindex $cmdline 1]
+	set cns [uplevel 1 namespace current]
+	if {$cns == "::"} {
+	    set cns ""
+	}
+	switch -glob $nop {
+	    eva* {
+		set nsp [lindex $cmdline 2]
+		if {![string match "::*" $nsp]} {
+		    set nsp ${cns}::$nsp
+		}
+		ttrace::addentry namespace $nsp 1
+	    }
+	    imp* {
+		# - parse import arguments (skip opt "-force")
+		set opts [lrange $cmdline 2 end]
+		if {[string match "-fo*" [lindex $opts 0]]} {
+		    set opts [lrange $cmdline 3 end]
+		}
+		# - register all imported procs and commands
+		foreach opt $opts {
+		    if {![string match "::*" [::namespace qual $opt]]} {
+			set opt ${cns}::$opt
+		    }
+		    # - first import procs
+		    foreach entry [ttrace::getentries proc $opt] {
+			set cmd ${cns}::[::namespace tail $entry]
+			set nsp [::namespace qual $entry]
+			set done($cmd) 1
+			set entry [list 0 $nsp "" ""]
+			ttrace::addentry proc $cmd $entry
+		    }
+
+		    # - then import commands
+		    foreach entry [info commands $opt] {
+			set cmd ${cns}::[::namespace tail $entry]
+			set nsp [::namespace qual $entry]
+			if {[info exists done($cmd)] == 0} {
+			    set entry [list 0 $nsp "" ""]
+			    ttrace::addentry proc $cmd $entry
+			}
+		    }
+		}
+	    }
+	}
+    }
+
+    ttrace::addscript namespace {
+	append res \n
+	foreach entry [ttrace::getentries namespace] {
+	    append res "::namespace eval $entry {}" \n
+	}
+	return $res
+    }
+
+    #
+    # Register the "variable" trace. This will create the following key/value
+    # entry in the "variable" store:
+    #
+    #  --- key ----                   --- value ---
+    #  ::fully::qualified::variable   1
+    #
+    # The variable value itself is ignored at the time of
+    # trace/collection. Instead, we take the real value at the time of script
+    # generation.
+    #
+
+    ttrace::addtrace variable {cmdline code args} {
+	if {$code != 0} {
+	    return
+	}
+	set opts [lrange $cmdline 1 end]
+	if {[llength $opts]} {
+	    set cns [uplevel 1 namespace current]
+	    if {$cns == "::"} {
+		set cns ""
+	    }
+	    foreach {var val} $opts {
+		if {![string match "::*" $var]} {
+		    set var ${cns}::$var
+		}
+		ttrace::addentry variable $var 1
+	    }
+	}
+    }
+
+    ttrace::addscript variable {
+	append res \n
+	foreach entry [ttrace::getentries variable] {
+	    set cns [namespace qual $entry]
+	    set var [namespace tail $entry]
+	    append res "::namespace eval $cns {" \n
+	    append res "::variable $var"
+	    if {[array exists $entry]} {
+		append res "\n::array set $var [list [array get $entry]]" \n
+	    } elseif {[info exists $entry]} {
+		append res " [list [set $entry]]" \n
+	    } else {
+		append res \n
+	    }
+	    append res "}" \n
+	}
+	return $res
+    }
+
+
+    #
+    # Register the "rename" trace. It will create the following key/value pair
+    # in "rename" store:
+    #
+    #  --- key ----              --- value ---
+    #  ::fully::qualified::old  ::fully::qualified::new
+    #
+    # The "new" value may be empty, for commands that have been deleted. In
+    # such cases we also remove any traced procedure definitions.
+    #
+
+    ttrace::addtrace rename {cmdline code args} {
+	if {$code != 0} {
+	    return
+	}
+	set cns [uplevel 1 namespace current]
+	if {$cns == "::"} {
+	    set cns ""
+	}
+	set old [lindex $cmdline 1]
+	if {![string match "::*" $old]} {
+	    set old ${cns}::$old
+	}
+	set new [lindex $cmdline 2]
+	if {$new != ""} {
+	    if {![string match "::*" $new]} {
+		set new ${cns}::$new
+	    }
+	    ttrace::addentry rename $old $new
+	} else {
+	    ttrace::delentry proc $old
+	}
+    }
+
+    ttrace::addscript rename {
+	append res \n
+	foreach old [ttrace::getentries rename] {
+	    set new [ttrace::getentry rename $old]
+	    append res "::rename $old {$new}" \n
+	}
+	return $res
+    }
+
+    #
+    # Register the "proc" trace. This will create the following key/value pair
+    # in the "proc" store:
+    #
+    #  --- key ----              --- value ---
+    #  ::fully::qualified::proc  [list <epoch> <ns> <arglist> <body>]
+    #
+    # The <epoch> chages anytime one (re)defines a proc.  The <ns> is the
+    # namespace where the command was imported from. If empty, the <arglist>
+    # and <body> will hold the actual procedure definition. See the
+    # "namespace" tracer implementation also.
+    #
+
+    ttrace::addtrace proc {cmdline code args} {
+	if {$code != 0} {
+	    return
+	}
+	set cns [uplevel 1 namespace current]
+	if {$cns == "::"} {
+	    set cns ""
+	}
+	set cmd [lindex $cmdline 1]
+	if {![string match "::*" $cmd]} {
+	    set cmd ${cns}::$cmd
+	}
+	set dargs [info args $cmd]
+	set pbody [info body $cmd]
+	set pargs ""
+	foreach arg $dargs {
+	    if {![info default $cmd $arg def]} {
+		lappend pargs $arg
+	    } else {
+		lappend pargs [list $arg $def]
+	    }
+	}
+	set pdef [ttrace::getentry proc $cmd]
+	if {$pdef == ""} {
+	    set epoch -1 ; # never traced before
+	} else {
+	    set epoch [lindex $pdef 0]
+	}
+	ttrace::addentry proc $cmd [list [incr epoch] "" $pargs $pbody]
+    }
+
+    ttrace::addscript proc {
+	return {
+	    if {[info command ::tcl::unknown] == ""} {
+		rename ::unknown ::tcl::unknown
+		namespace import -force ::ttrace::unknown
+	    }
+	    if {[info command ::tcl::info] == ""} {
+		rename ::info ::tcl::info
+	    }
+	    proc ::info args {
+		set cmd [lindex $args 0]
+		set hit [lsearch -glob {commands procs args default body} $cmd*]
+		if {$hit > 1} {
+		    if {[catch {uplevel 1 ::tcl::info $args}]} {
+			uplevel 1 ttrace::_resolve [list [lindex $args 1]]
+		    }
+		    return [uplevel 1 ::tcl::info $args]
+		}
+		if {$hit == -1} {
+		    return [uplevel 1 ::tcl::info $args]
+		}
+		set cns [uplevel 1 namespace current]
+		if {$cns == "::"} {
+		    set cns ""
+		}
+		set pat [lindex $args 1]
+		if {![string match "::*" $pat]} {
+		    set pat ${cns}::$pat
+		}
+		set fns [ttrace::getentries proc $pat]
+		if {[string match $cmd* commands]} {
+		    set fns [concat $fns [ttrace::getentries xotcl $pat]]
+		}
+		foreach entry $fns {
+		    if {$cns != [namespace qual $entry]} {
+			set lazy($entry) 1
+		    } else {
+			set lazy([namespace tail $entry]) 1
+		    }
+		}
+		foreach entry [uplevel 1 ::tcl::info $args] {
+		    set lazy($entry) 1
+		}
+		array names lazy
+	    }
+	}
+    }
+
+    #
+    # Register procedure resolver. This will try to resolve the command in the
+    # current namespace first, and if not found, in global namespace.  It also
+    # handles commands imported from other namespaces.
+    #
+
+    ttrace::addresolver resolveprocs {cmd {export 0}} {
+	set cns [uplevel 1 namespace current]
+	set name [namespace tail $cmd]
+	if {$cns == "::"} {
+	    set cns ""
+	}
+	if {![string match "::*" $cmd]} {
+	    set ncmd ${cns}::$cmd
+	    set gcmd ::$cmd
+	} else {
+	    set ncmd $cmd
+	    set gcmd $cmd
+	}
+	set pdef [ttrace::getentry proc $ncmd]
+	if {$pdef == ""} {
+	    set pdef [ttrace::getentry proc $gcmd]
+	    if {$pdef == ""} {
+		return 0
+	    }
+	    set cmd $gcmd
+	} else {
+	    set cmd $ncmd
+	}
+	set epoch [lindex $pdef 0]
+	set pnsp  [lindex $pdef 1]
+	if {$pnsp != ""} {
+	    set nsp [namespace qual $cmd]
+	    if {$nsp == ""} {
+		set nsp ::
+	    }
+	    set cmd ${pnsp}::$name
+	    if {[resolveprocs $cmd 1] == 0 && [info commands $cmd] == ""} {
+		return 0
+	    }
+	    namespace eval $nsp "namespace import -force $cmd"
+	} else {
+	    uplevel 0 [list ::proc $cmd [lindex $pdef 2] [lindex $pdef 3]]
+	    if {$export} {
+		set nsp [namespace qual $cmd]
+		if {$nsp == ""} {
+		    set nsp ::
+		}
+		namespace eval $nsp "namespace export $name"
+	    }
+	}
+	variable resolveproc
+	set resolveproc($cmd) $epoch
+	return 1
+    }
+
+    #
+    # For XOTcl, the entire item introspection/tracing is delegated to XOTcl
+    # itself. The xotcl store is filled with this:
+    #
+    #  --- key ----               --- value ---
+    #  ::fully::qualified::item   <body>
+    #
+    # The <body> is the script used to generate the entire item (class,
+    # object). Note that we do not fill in this during code tracing. It is
+    # done during the script generation. In this step, only the placeholder is
+    # set.
+    #
+    # NOTE: we assume all XOTcl commands are imported in global namespace
+    #
+
+    ttrace::atenable XOTclEnabler {args} {
+	if {[info commands ::xotcl::Class] == ""} {
+	    return
+	}
+	if {[info commands ::xotcl::_creator] == ""} {
+	    ::xotcl::Class create ::xotcl::_creator -instproc create {args} {
+		set result [next]
+		if {![string match ::xotcl::_* $result]} {
+		    ttrace::addentry xotcl $result ""
+		}
+		return $result
+	    }
+	}
+	::xotcl::Class instmixin ::xotcl::_creator
+    }
+
+    ttrace::atdisable XOTclDisabler {args} {
+	if {   [info commands ::xotcl::Class] == ""
+	    || [info commands ::xotcl::_creator] == ""} {
+	    return
+	}
+	::xotcl::Class instmixin ""
+	::xotcl::_creator destroy
+    }
+
+    set resolver [ttrace::addresolver resolveclasses {classname} {
+	set cns [uplevel 1 namespace current]
+	set script [ttrace::getentry xotcl $classname]
+	if {$script == ""} {
+	    set name [namespace tail $classname]
+	    if {$cns == "::"} {
+		set script [ttrace::getentry xotcl ::$name]
+	    } else {
+		set script [ttrace::getentry xotcl ${cns}::$name]
+		if {$script == ""} {
+		    set script [ttrace::getentry xotcl ::$name]
+		}
+	    }
+	    if {$script == ""} {
+		return 0
+	    }
+	}
+	uplevel 1 [list namespace eval $cns $script]
+	return 1
+    }]
+
+    ttrace::addscript xotcl [subst -nocommands {
+	if {![catch {Serializer new} ss]} {
+	    foreach entry [ttrace::getentries xotcl] {
+		if {[ttrace::getentry xotcl \$entry] == ""} {
+		    ttrace::addentry xotcl \$entry [\$ss serialize \$entry]
+		}
+	    }
+	    \$ss destroy
+	    return {::xotcl::Class proc __unknown name {$resolver \$name}}
+	}
+    }]
+
+    #
+    # Register callback to be called on cleanup. This will trash lazily loaded
+    # procs which have changed since.
+    #
+
+    ttrace::addcleanup {
+	variable resolveproc
+	foreach cmd [array names resolveproc] {
+	    set def [ttrace::getentry proc $cmd]
+	    if {$def != ""} {
+		set new [lindex $def 0]
+		set old $resolveproc($cmd)
+		if {[info command $cmd] != "" && $new != $old} {
+		    catch {rename $cmd ""}
+		}
+	    }
+	}
+    }
+}
+
+# EOF
+return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# tab-width: 8
+# indent-tabs-mode: nil
+# End:

src/vfs/punk8win.vfs/lib_tcl8/twapi-5.0b1/wts.tcl

@@ -1,64 +0,0 @@
-
-# Copyright (c) 2021 Ashok P. Nadkarni
-# All rights reserved.
-#
-# See the file LICENSE for license
-
-namespace eval twapi {
-    variable _wts_session_monitors
-    set _wts_session_monitors [dict create]
-}
-
-proc twapi::start_wts_session_monitor {script args} {
-    variable _wts_session_monitors
-
-    parseargs args {
-        all
-    } -maxleftover 0 -setvars]
-
-    set script [lrange $script 0 end]; # Verify syntactically a list
-
-    set id "wts#[TwapiId]"
-    if {[dict size $_wts_session_monitors] == 0} {
-        # No monitoring in progress. Start it
-        # 0x2B1 -> WM_WTSSESSION_CHANGE
-        Twapi_WTSRegisterSessionNotification $all
-        _register_script_wm_handler 0x2B1 [list [namespace current]::_wts_session_change_handler] 0
-    }
-
-    dict set  _wts_session_monitors $id $script
-    return $id
-}
-
-
-proc twapi::stop_wts_session_monitor {id} {
-    variable _wts_session_monitors
-
-    if {![dict exists $_wts_session_monitors $id]} {
-        return
-    }
-
-    dict unset _wts_session_monitors $id
-    if {[dict size $_wts_session_monitors] == 0} {
-        # 0x2B1 -> WM_WTSSESSION_CHANGE
-        _unregister_script_wm_handler 0x2B1 [list [namespace current]::_wts_session_handler]
-        Twapi_WTSUnRegisterSessionNotification
-    }
-}
-
-proc twapi::_wts_session_change_handler {msg change session_id msgpos ticks} {
-    variable _wts_session_monitors
-
-    if {[dict size $_wts_session_monitors] == 0} {
-        return; # Not an error, could have deleted while already queued
-    }
-
-    dict for {id script} $_wts_session_monitors {
-        set code [catch {uplevel #0 [linsert $script end $change $session_id]} msg]
-        if {$code == 1} {
-            # Error - put in background but we do not abort
-            after 0 [list error $msg $::errorInfo $::errorCode]
-        }
-    }
-    return
-}

src/vfs/punk8win.vfs/lib_tcl8/twapi5.1.1/README.md

@@ -1,39 +1,43 @@
 # Tcl Windows API (TWAPI) extension
 
-The Tcl Windows API (TWAPI) extension provides access to the Windows API from
-within the Tcl scripting language.
+The Tcl Windows API (TWAPI) extension provides access to the Windows API
+from within the Tcl scripting language.
 
   * Project source repository is at https://github.com/apnadkarni/twapi
-  * Documentation is at https://twapi.magicsplat.com
   * Binary distribution is at https://sourceforge.net/projects/twapi/files/Current%20Releases/Tcl%20Windows%20API/
+  * Documentation is at https://twapi.magicsplat.com
+  * Change history is at https://twapi.magicsplat.com/v5.1/versionhistory.html
 
 ## Supported platforms
 
-TWAPI 5.0 requires
+TWAPI 5.x requires
 
   * Windows 7 SP1 or later
   * Tcl 8.6.10+ or Tcl 9.x
 
 ### Binary distribution
 
-The single binary distribution supports Tcl 8.6 and Tcl 9 for both 32- and
-64-bit platforms.
+The single binary distribution supports Tcl 8.6 and Tcl 9 for both 32-
+and 64-bit platforms.
 
-It requires the VC++ runtime to already be installed
-on the system. Download from https://learn.microsoft.com/en-us/cpp/windows/latest-supported-vc-redist if necessary.
+It requires the VC++ runtime to already be installed on the system.
+Download from
+https://learn.microsoft.com/en-us/cpp/windows/latest-supported-vc-redist
+if necessary.
 
-Windows 7 and 8.x also require the Windows UCRT runtime to be installed if not
-present. Download from https://support.microsoft.com/en-gb/topic/update-for-universal-c-runtime-in-windows-c0514201-7fe6-95a3-b0a5-287930f3560c.
+Windows 7 and 8.x also require the Windows UCRT runtime to be installed
+if not present. Download from
+https://support.microsoft.com/en-gb/topic/update-for-universal-c-runtime-in-windows-c0514201-7fe6-95a3-b0a5-287930f3560c.
 
 In most cases, both the above should already be present on the system.
 
-Note that the *modular* and single file *bin* in 4.x distributions are no longer
-available and will not be supported in 5.0.
+Note that the *modular* and single file *bin* in 4.x distributions are
+no longer available.
 
 ## TWAPI Summary
 
-The Tcl Windows API (TWAPI) extension provides access to the Windows API from
-within the Tcl scripting language.
+The Tcl Windows API (TWAPI) extension provides access to the Windows API
+from within the Tcl scripting language.
 
 Functions in the following areas are implemented:
 

src/vfs/punk8win.vfs/lib_tcl8/twapi5.1.1/clipboard.tcl

@@ -25,13 +25,71 @@ proc twapi::empty_clipboard {} {
     EmptyClipboard
 }
 
+proc twapi::_init_global_heap_formats {} {
+    variable _clipboard_global_heap_formats
+    # The following types are known to return global handles to memory
+    # 1 - CF_TEXT
+    # 6 - CF_TIFF
+    # 7 - CF_OEMTEXT
+    # 8 - CF_DIB
+    # 13 - CF_UNICODE
+    # 15 - CF_HDROP
+    # 16 - CF_LOCALE
+    # 17 - CF_DIBV5
+    # Non-Standard formats "HTML Format", "PNG", "GIF"
+    array set _clipboard_global_heap_formats {
+        1 {} 6 {} 7 {} 8 {} 13 {} 15 {} 16 {} 17 {}
+    }
+    foreach fmt [list "HTML Format" PNG GIF] {
+        set fmt [format %u [register_clipboard_format $fmt]]
+        set _clipboard_global_heap_formats($fmt) ""
+    }
+    proc _init_global_heap_formats {} {}
+}
+
+proc twapi::clipboard_format_uses_global_heap {args} {
+    _init_global_heap_formats
+    variable _clipboard_global_heap_formats
+    set fmts [lmap fmt $args {
+        if {[string is integer $fmt]} {
+            if {$fmt < 0 || $fmt > 0x7fffffff} {
+                error "Clipboard format $fmt out of range."
+            }
+        } else {
+            set fmt [register_clipboard_format $fmt]
+        }
+        format %u $fmt
+    }]
+
+    # All formats verified, now add them
+    foreach fmt $fmts {
+        set _clipboard_global_heap_formats($fmt) ""
+    }
+}
+
+proc twapi::_check_if_global_memory_format {fmt} {
+    _init_global_heap_formats
+    variable _clipboard_global_heap_formats
+    set fmt [format %u $fmt]
+    if {[info exists _clipboard_global_heap_formats($fmt)]} {
+        return
+    }
+    error "Unsupported format $fmt."
+}
+
 proc twapi::_read_clipboard {fmt} {
     # Always catch errors and close clipboard before passing exception on
     # Also ensure memory unlocked
     trap {
         set h [GetClipboardData $fmt]
-        set p [GlobalLock $h]
-        set data [Twapi_ReadMemory 1 $p 0 [GlobalSize $h]]
+        if {$fmt == 14} {
+            # CF_ENHMETAFILE
+            set data [GetEnhMetaFileBits $h]
+        } else {
+            _check_if_global_memory_format $fmt
+            set p [GlobalLock $h]
+            set data [Twapi_ReadMemory 1 $p 0 [GlobalSize $h]]
+        }
     } onerror {} {
         catch {close_clipboard}
         rethrow
@@ -79,6 +137,8 @@ proc twapi::_write_clipboard {fmt data} {
     # Always catch errors and close
     # clipboard before passing exception on
     trap {
+        _check_if_global_memory_format $fmt
+
         # For byte arrays, string length does return correct size
         # (DO NOT USE string bytelength - see Tcl docs!)
         set len [string length $data]

src/vfs/punk8win.vfs/lib_tcl8/twapi5.1.1/pkgIndex.tcl

@@ -2,14 +2,14 @@ if {$::tcl_platform(platform) ne "windows"} {
     return
 }
 
-package ifneeded twapi_base 5.0b1 \
+package ifneeded twapi_base 5.1.1 \
     [list apply [list {dir} {
         package require platform
-        set packageVer [string map {. {}} 5.0b1]
+        set packageVer [string map {. {}} 5.1.1]
         if {[package vsatisfies [package require Tcl] 9]} {
-            set baseDllName "tcl9twapi50b1.dll"
+            set baseDllName "tcl9twapi511.dll"
         } else {
-            set baseDllName "twapi50b1t.dll"
+            set baseDllName "twapi511.dll"
         }
         set package "twapi"
         set package_ns ::$package
@@ -40,7 +40,7 @@ package ifneeded twapi_base 5.0b1 \
         set ${package_ns}::dllPath [file normalize $path]
         set ${package_ns}::packageDir $dir
         source [file join $dir twapi.tcl]
-        package provide twapi_base 5.0b1
+        package provide twapi_base 5.1.1
     }] $dir]
 
 set __twapimods {
@@ -79,21 +79,21 @@ set __twapimods {
     wmi
 }
 foreach __twapimod $__twapimods {
-    package ifneeded twapi_$__twapimod 5.0b1 \
+    package ifneeded twapi_$__twapimod 5.1.1 \
         [list apply [list {dir mod} {
-            package require twapi_base 5.0b1
+            package require twapi_base 5.1.1
             source [file join $dir $mod.tcl]
-            package provide twapi_$mod 5.0b1
+            package provide twapi_$mod 5.1.1
         }] $dir $__twapimod]
 }
 
-package ifneeded twapi 5.0b1 \
+package ifneeded twapi 5.1.1 \
     [list apply [list {dir mods} {
-        package require twapi_base 5.0b1
+        package require twapi_base 5.1.1
         foreach mod $mods {
-            package require twapi_$mod 5.0b1
+            package require twapi_$mod 5.1.1
         }
-        package provide twapi 5.0b1
+        package provide twapi 5.1.1
     }] $dir $__twapimods]
 
 unset __twapimod

src/vfs/punk8win.vfs/lib_tcl8/twapi5.1.1/service.tcl

@@ -1040,7 +1040,7 @@ proc twapi::_report_service_status {name} {
     # it back within that period of time, so schedule ourselves.
     if {$waithint} {
         set delay [expr {($waithint*3)/4}]
-        after $delay ::twapi::_call_scm_within_waithint $name $current_state $service_state($name,checkpoint)
+        after $delay [list ::twapi::_call_scm_within_waithint $name $current_state $service_state($name,checkpoint)]
     }
 
     return

src/vfs/punk8win.vfs/lib_tcl8/twapi5.1.1/ui.tcl

@@ -493,7 +493,7 @@ proc twapi::get_active_window_for_thread {tid} {
 
 # Get focus window for an application
 proc twapi::get_focus_window_for_thread {tid} {
-    return [_get_gui_thread_info $tid hwndFocus]
+    return [_return_window [_get_gui_thread_info $tid hwndFocus]]
 }
 
 # Get active window for current thread

src/vfs/punk8win.vfs/lib_tcl8/udp1.0.12/pkgIndex.tcl

@@ -0,0 +1,2 @@
+package ifneeded udp 1.0.12 \
+    [list load [file join $dir udp1012.dll]]