update bootsupport modules

src/bootsupport/include_modules.config

@@ -11,6 +11,7 @@ set bootsupport_modules [list\
     src/vendormodules textutil::tabify\
     src/vendormodules textutil::split\
     src/vendormodules textutil::wcswidth\
+    src/vendormodules uuid\
     modules punkcheck\
     modules punk::ansi\
     modules punk::args\

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

@@ -391,7 +391,7 @@ namespace eval punk::args {
             }
         }
         set opts [dict merge $defaults_dict_opts $checked_args]
-        #assert - checked_args keys are full-length option names if -anyopts was false or if the supplied option as a shortname matched one of our defined options 
+        #assertion - checked_args keys are full-length option names if -anyopts was false or if the supplied option as a shortname matched one of our defined options 
 
         set values [dict merge $defaults_dict_values $values_dict]
 

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

@@ -249,7 +249,7 @@ namespace eval punk::cap {
             puts stderr "register_capabilityname cannot register capability:$capname with handler:$capnamespace. There is already a registered handler:$hdlr" 
             return
         }
-        #assert: capnamespace may or may not be empty string, capname may or may not already exist in caps dict, caps $capname providers may have existing entries.
+        #assertion: capnamespace may or may not be empty string, capname may or may not already exist in caps dict, caps $capname providers may have existing entries.
         dict set caps $capname handler $capnamespace
         if {![dict exists $caps $capname providers]} {
             dict set caps $capname providers [list]

src/bootsupport/modules/punk/cap/handlers/templates-0.1.0.tm

@@ -698,8 +698,8 @@ namespace eval punk::cap::handlers::templates {
                     }
                 }
 
-                #assert path is first key of itemdict {callers are allowed to rely on it being first}
+                #assertion path is first key of itemdict {callers are allowed to rely on it being first}
-                #assert itemdict has keys path,basefolder,sourceinfo
+                #assertion itemdict has keys path,basefolder,sourceinfo
                 set result [dict create]
                 set keys [lreverse [dict keys $itemdict]]
                 foreach k $keys {

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

@@ -57,6 +57,7 @@
 
 package require Tcl 8.6-
 #dependency on tcllib not ideal for bootstrapping as punk::char is core to many features.. (textutil::wcswidth is therefore included in bootsupport/include_modules.config) review
+package require textutil
 package require textutil::wcswidth
 
 #*** !doctools
@@ -921,7 +922,7 @@ namespace eval punk::char {
                 set start [dict get [lindex $ranges 0] start]
                 set end [dict get [lindex $ranges 0] end]
                 if {![dict exists $charset_extents_startpoints $start] || $end ni [dict get $charset_extents_startpoints $start]} {
-                    #assert if end wasn't in startpoits list - then start won't be in endpoints list
+                    #assertion if end wasn't in startpoits list - then start won't be in endpoints list
                     dict lappend charset_extents_startpoints  $start $end 
                     dict lappend charset_extents_endpoints $end $start
                 }
@@ -934,7 +935,7 @@ namespace eval punk::char {
                     set start [dict get $range start]
                     set end [dict get $range end]
                     if {![dict exists $charset_extents_startpoints $start] || $end ni [dict get $charset_extents_startpoints $start]} {
-                        #assert if end wasn't in startpoits list - then start won't be in endpoints list
+                        #assertion if end wasn't in startpoits list - then start won't be in endpoints list
                         dict lappend charset_extents_startpoints  $start $end
                         dict lappend charset_extents_endpoints    $end   $start
                     }
@@ -1871,7 +1872,7 @@ namespace eval punk::char {
         if {[punk::ansi::ta::detect $text]} {
             puts stderr "string_width detected ANSI!"
         }
-        if {[string first \n $text] >= 0} {
+        if {[string last \n $text] >= 0} {
             error "string_width accepts only a single line"
         }
         tailcall ansifreestring_width $text
@@ -1900,7 +1901,7 @@ namespace eval punk::char {
         return [tcl::mathop::+ {*}$widths]
     }
 
-    #prerequisites - no ansi escapes -  no newlines 
+    #prerequisites - no ansi escapes -  no newlines  - utf8 encoding assumed
     #review - what about \r \t \b ?
     #NO processing of \b - already handled in ansi::printing_length which then calls this
     #this version breaks string into sequences of ascii vs unicode 
@@ -1935,20 +1936,38 @@ namespace eval punk::char {
         set re_diacritics {[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+} 
         set text [regsub -all $re_diacritics $text ""]
 
+        # -- --- --- --- --- --- ---
         #review
-        #if we strip out ZWJ \u0200d (zero width combiner) - then we don't give the chance for a grapheme combining test to merge properly e.g combining emojis
+        #if we strip out ZWJ \u200d (zero width combiner) - then we don't give the chance for a grapheme combining test to merge properly e.g combining emojis
-        #as at 2024 - textutil::wcswidth doesn't seem to be aware of these - and counts the joiner as one wide
+        #as at 2024 - textutil::wcswidth just uses the unicode east-asian width property data and doesn't seem to handle these specially - it counts this joiner and others as one wide (also BOM \uFFEF)
 
-        #ZWNJ \u0200c should also be zero length - but as a 'non' joiner - it should add zero to the length
+        #TODO - once we have proper grapheme cluster splitting - work out which of these characters should be left in and/or when exactly their length-effects apply
+        #
+        #for now - strip them out
 
-        #ZWSP \u0200b zero width space 
+        #ZWNJ \u200c should also be zero length - but as a 'non' joiner - it should add zero to the length
+        #ZWSP \u200b zero width space 
 
+        #\uFFEFBOM/ ZWNBSP and others that should be zero width
+        #todo - work out proper way to mark/group zero width. 
+
+        set text [string map [list \u200b "" \u200c "" \u200d "" \uFFEF ""] $text]
+        # -- --- --- --- --- --- ---
 
         #we should only map control sequences to nothing after processing ones with length effects, such as \b (\x07f) or DEL \x1f
         #todo - document that these shouldn't be present in input rather than explicitly checking here
+
+        #c0 controls
         set re_ascii_c0 {[\U0000-\U001F]}
         set text [regsub -all $re_ascii_c0 $text ""]
 
+        #c1 controls - first section of the Latin-1 Supplement block - all non-printable from a utf-8 perspective
+        #some or all of these may have a visual representation in other encodings e.g cp855 seems to have 1 width for them all
+        #we are presuming that the text supplied has been converted from any other encoding to utf8 - so we don't need to handle that here 
+        #they should also be unlikely to be present in an ansi-free string (as is a precondition for use of this function)
+        set text [regsub -all {[\u0080-\u009f]+} $text ""]
+
+
         #short-circuit basic cases
         #support tcl pre 2023-11 - see regexp bug below
         #if {![regexp {[\uFF-\U10FFFF]} $text]} {

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

@@ -30,6 +30,9 @@ if {"windows" eq $::tcl_platform(platform)} {
 
 # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
 namespace eval punk::console {
+    variable tabwidth 8  ;#default only - will attempt to detect and set to that configured in terminal
+    #Note that windows terminal cooked mode seems to use 8 for interactive use even if set differently
+    #e.g typing tab characters may still be echoed 8-spaced while writing to stdout my obey the terminal's tab stops.  
     variable has_twapi 0
     variable previous_stty_state_stdin ""
     variable previous_stty_state_stdout ""
@@ -572,7 +575,7 @@ namespace eval punk::console {
             if {$waitvar($callid) ne "timedout"} {
                 after cancel $cancel_timeout_id
             } else {
-                puts stderr "timeout in get_ansi_response_payload"
+                puts stderr "timeout in get_ansi_response_payload. Ansi request was:[ansistring VIEW $query]"
             }
 
             if {$was_raw == 0} {
@@ -881,6 +884,70 @@ namespace eval punk::console {
         set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels]
         return $payload
     }
+    proc get_tabstops {{inoutchannels {stdin stdout}}} {
+        #DECTABSR \x1b\[2\$w
+        #response example " ^[P2$u9/17/25/33/41/49/57/65/73/81^[\ " (where ^[ is \x1b)
+        #set capturingregex {(.*)(\x1b\[P2$u()\x1b\[\\)} 
+        #set capturingregex {(.*)(\x1bP2$u((?:[0-9]+)*(?:\/[0-9]+)*)\x1b\\)$}
+        set capturingregex {(.*)(\x1bP2\$u(.*)\x1b\\)$}
+        set request "\x1b\[2\$w"
+        set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels]
+        set tabstops [split $payload "/"]
+        return $tabstops
+    }
+
+    #a simple estimation of tab-width under assumption console is set with even spacing.
+    #It's known this isn't always the case - but things like textutil::untabify2 take only a single value
+    #on some systems test_char_width is a similar speed to get_tabstop_apparent_width - but on some test_char_width is much slower
+    #we will use test_char_width as a fallback
+    proc get_tabstop_apparent_width {} {
+        set tslist [get_tabstops]
+        if {![llength $tslist]} {
+            #either terminal failed to report - or none set.
+            set testw [test_char_width \t]
+            if {[string is integer -strict $testw]} {
+                return $testw 
+            }
+            #We don't support none - default to 8
+            return 8
+        }
+        #we generally expect to see a tabstop at column 1 - but it may not be set.
+        if {[lindex $tslist 0] eq "1"} {
+            if {[llength $tslist] == 1} {
+                set testw [test_char_width \t]
+                if {[string is integer -strict $testw]} {
+                    return $testw 
+                }
+                return 8
+            } else {
+                set next [lindex $tslist 1]
+                return [expr {$next - 1}]
+            }
+        } else {
+            #simplistic guess at width - review - do we need to consider leftmost tabstops as more likely to be non-representative and look further into the list?
+            if {[llength $tslist] == 1} {
+                return [lindex $tslist 0]
+            } else {
+                return [expr {[lindex $tslist 1] - [lindex $tslist 0]}]
+            }
+        }
+    }
+    #default to 8 just because it seems to be most common default in terminals
+    proc set_tabstop_width {{w 8}} {
+        set tsize [get_size]
+        set width [dict get $tsize columns]
+        set mod [expr {$width % $w}]
+        set max [expr {$width - $mod}]
+        set tstops ""
+        set c 1
+        while {$c <= $max} {
+            append tstops [string repeat " " $w][punk::ansi::set_tabstop]
+            incr c $w
+        }
+        set punk::console::tabwidth $w ;#we also attempt to read terminal's tabstops and set tabwidth to the apparent spacing of first non-1 value in tabstops list.
+        catch {textutil::tabify::untabify2 "" $w} ;#textutil tabify can end up uninitialised and raise errors like "can't read Spaces(<n>).." after a tabstop change  This call seems to keep tabify happy - review.
+        puts -nonewline "[punk::ansi::clear_all_tabstops]\n[punk::ansi::set_tabstop]$tstops"
+    }
 
 
     proc get_cursor_pos_list {} {
@@ -888,12 +955,14 @@ namespace eval punk::console {
     }
     proc get_size {} {
         if {[catch {
-            puts -nonewline [punk::ansi::cursor_off][punk::ansi::cursor_save][punk::ansi::move 2000 2000]
+            #some terminals (conemu on windows) scroll the viewport when we make a big move down like this - a  move to 1 1 immediately after cursor_save doesn't seem to fix that.
+            #This issue also occurs when switching back from the alternate screen buffer - so perhaps that needs to be addressed elsewhere.
+            puts -nonewline [punk::ansi::cursor_off][punk::ansi::cursor_save_dec][punk::ansi::move 2000 2000]
             lassign [get_cursor_pos_list] lines cols
             puts -nonewline [punk::ansi::cursor_restore][punk::console::cursor_on];flush stdout
             set result [list columns $cols rows $lines] 
         } errM]} {
-            puts -nonewline [punk::ansi::cursor_restore]
+            puts -nonewline [punk::ansi::cursor_restore_dec]
             puts -nonewline [punk::ansi::cursor_on]
             error "$errM"
         } else {
@@ -912,6 +981,22 @@ namespace eval punk::console {
         lassign [split $payload {;}] rows cols 
         return [list columns $cols rows $rows]
     }
+    proc get_mode_line_wrap {{inoutchannels {stdin stdout}}} {
+        set capturingregex {(.*)(\x1b\[\?7;([0-9]+)\$y)$} ;#must capture prefix,entire-response,response-payload
+        set request "\x1b\[?7\$p"
+        set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels]
+        return $payload
+    }
+
+    #Terminals generally default to LNM being reset (off) ie enter key sends a lone <cr> 
+    #Terminals tested on windows either don't respond to this query, or respond with 0 (meaning mode not understood)
+    #I presume from this that almost nobody is using LNM 1 (which sends both <cr> and <lf>)
+    proc get_mode_LNM {{inoutchannels {stdin stdout}}} {
+        set capturingregex {(.*)(\x1b\[\?20;([0-9]+)\$y)$} ;#must capture prefix,entire-response,response-payload
+        set request "\x1b\[?20\$p"
+        set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels]
+        return $payload
+    }
 
     #terminals lie. This should be a reasonable (albeit relatively slow) test of actual width - but some terminals seem to miscalculate.
     #todo - a visual interactive test/questionnaire to ask user if things are lining up or if the terminal is telling fibs about cursor position.
@@ -1131,10 +1216,10 @@ namespace eval punk::console {
             move  $orig_row $orig_col
         }
         proc scroll_up {n} {
-            puts -nonewline stdout [punk::ansi::scroll_up]
+            puts -nonewline stdout [punk::ansi::scroll_up $n]
         }
         proc scroll_down {n} {
-            puts -nonewline stdout [punk::ansi::scroll_down]
+            puts -nonewline stdout [punk::ansi::scroll_down $n]
         }
 
         #review - worth the extra microseconds to inline? might be if used in for example prompt on every keypress.
@@ -1149,6 +1234,18 @@ namespace eval punk::console {
             #[call [fun cursor_restore]]
             puts -nonewline \x1b\[u
         }
+        #DEC equivalents of cursor_save/cursor_restore - perhaps more widely supported?
+        proc cursor_save_dec {} {
+            #*** !doctools
+            #[call [fun cursor_save_dec]]
+            puts -nonewline \x1b7
+        }
+        proc cursor_restore_dec {} {
+            #*** !doctools
+            #[call [fun cursor_restore_dec]]
+            puts -nonewline \x1b8
+        }
+
         proc insert_spaces {count} {
             puts -nonewline stdout \x1b\[${count}@
         }
@@ -1175,6 +1272,8 @@ namespace eval punk::console {
     namespace import ansi::move_row
     namespace import ansi::cursor_save
     namespace import ansi::cursor_restore
+    namespace import ansi::cursor_save_dec
+    namespace import ansi::cursor_restore_dec
     namespace import ansi::scroll_down
     namespace import ansi::scroll_up
     namespace import ansi::insert_spaces
@@ -1193,7 +1292,7 @@ namespace eval punk::console {
         #set  blanks [string repeat " " [expr {$col + $tw}]]
         #puts -nonewline [punk::ansi::erase_eol]$blanks;move_emit_return this $col $text
         #puts -nonewline  [move_emit_return this $col [punk::ansi::insert_spaces 150]$text]
-        cursor_save 
+        cursor_save_dec 
         #move_emit_return this $col [punk::ansi::move_forward 50][punk::ansi::insert_spaces 150][punk::ansi::move_back 50][punk::ansi::move_forward $col]$text
         #puts -nonewline [punk::ansi::insert_spaces 150][punk::ansi::move_column $col]$text
         puts -nonewline [punk::ansi::erase_eol][punk::ansi::move_column $col]$text
@@ -1216,16 +1315,16 @@ namespace eval punk::console {
         puts -nonewline stdout $commands
         return ""
     }
-    #we can be faster and more efficient if we use the consoles cursor_save command - but each savecursor overrides any previous one.
+    #we can be faster and more efficient if we use the consoles cursor_save_dec command - but each savecursor overrides any previous one.
     #leave cursor_off/cursor_on to caller who can wrap more efficiently..
     proc cursorsave_move_emit_return {row col data args} {
         set commands ""
-        append commands [punk::ansi::cursor_save]
+        append commands [punk::ansi::cursor_save_dec]
         append commands [punk::ansi::move_emit $row $col $data]
         foreach {row col data} $args {
             append commands [punk::ansi::move_emit $row $col $data]
         }
-        append commands [punk::ansi::cursor_restore]
+        append commands [punk::ansi::cursor_restore_dec]
         puts -nonewline stdout $commands; flush stdout
     }
     proc move_emitblock_return {row col textblock} {
@@ -1242,12 +1341,12 @@ namespace eval punk::console {
     }
     proc cursorsave_move_emitblock_return {row col textblock} {
         set commands ""
-        append commands [punk::ansi::cursor_save]
+        append commands [punk::ansi::cursor_save_dec]
         foreach ln [split $textblock \n] {
             append commands [punk::ansi::move_emit $row $col $ln]
             incr row
         }
-        append commands [punk::ansi::cursor_restore]
+        append commands [punk::ansi::cursor_restore_dec]
         puts -nonewline stdout $commands;flush stdout
         return
     }
@@ -1481,7 +1580,7 @@ namespace eval punk::console {
                     set cix 0
                     foreach c [split $charline {}] {
                         if {$c} {
-                            append output [punk::ansi::move_emit [expr {$row + $line}] [expr {$col + $charno * 8 + $cix}] "[a reverse] [a noreverse]"]
+                            append output [punk::ansi::move_emit [expr {$row + $line}] [expr {$col + $charno * 8 + $cix}] "[a+ reverse] [a+ noreverse]"]
                             #curses attr on reverse
                             #curses move [expr $row + $line] [expr $col + $charno * 8 + $cix]
                             #curses puts " "
@@ -1493,6 +1592,11 @@ namespace eval punk::console {
             }
             return $output
         }
+        proc get_time {} {
+            overtype::left -width 70 "" [bigstr [clock format [clock seconds] -format %H:%M:%S] 1 1]
+        }
+
+
         proc display1 {} {
             #punk::console::clear
             punk::console::move_call_return 20 20 {punk::console::clear_above}

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

@@ -745,7 +745,7 @@ namespace eval punk::fileline::class {
                     lassign [my numeric_linerange $startidx $endidx] startidx endidx
                     set chunkstart  [dict get $o_linemap $startidx start]
                     set chunkend    [dict get $o_linemap $endidx end]
-                    set line_list [my chunkrange_to_lineinfolist $chunkstart $chunkend] ;# assert - no need to view truncations as we've picked start and end of complete lines
+                    set line_list [my chunkrange_to_lineinfolist $chunkstart $chunkend] ;# assertion - no need to view truncations as we've picked start and end of complete lines
                     #verify sanity
                     set l_start [lindex $line_list 0]
                     if {[set idx_start [dict get $l_start lineindex]] ne $startidx} {
@@ -983,9 +983,9 @@ namespace eval punk::fileline::class {
                         lappend infolist $last
                     }
                     ###########################
-                    #assert  all records have is_truncated key.
+                    #assertion  all records have is_truncated key.
-                    #assert if is_truncated == 1 truncatedside should contain a list of either left, right or both left and right
+                    #assertion if is_truncated == 1 truncatedside should contain a list of either left, right or both left and right
-                    #assert If not opt_show_truncated - then truncated records will not have truncated,truncatedleft,truncatedright keys. 
+                    #assertion If not opt_show_truncated - then truncated records will not have truncated,truncatedleft,truncatedright keys. 
                     return $infolist
                 }
 

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

@@ -599,7 +599,6 @@ namespace eval punk::lib {
         }
         return $prefix
     }
-
     #test example of the technique - not necessarily particularly useful as a function, except maybe for brevity/clarity. todo - test if inlined version gives any perf advantage compared to a temp var 
     proc swapnumvars {namea nameb} {
         upvar $namea a $nameb b
@@ -916,6 +915,11 @@ namespace eval punk::lib {
                                     set codestack [list $code]
                                 } else {
                                     if {[punk::ansi::codetype::is_sgr $code]} {
+                                        #todo - proper test of each code - so we only take latest background/foreground etc.
+                                        #requires handling codes with varying numbers of parameters.
+                                        #basic simplification - remove straight dupes. 
+                                        set dup_posns [lsearch -all -exact $codestack $code] ;#!must use -exact as codes have square brackets which are interpreted as glob chars.
+                                        set codestack [lremove $codestack {*}$dup_posns]
                                         lappend codestack $code
                                     } ;#else gx0 or other code - we don't want to stack it with SGR codes
                                 }
@@ -931,7 +935,9 @@ namespace eval punk::lib {
                                 }
                             }
 
-                            set newreplay [join $codestack ""]
+                            #set newreplay [join $codestack ""]
+                            set newreplay [punk::ansi::codetype::sgr_merge_list {*}$codestack]
+
                             if {$line_has_sgr && $newreplay ne $replaycodes} {
                                 #adjust if it doesn't already does a reset at start
                                 if {[punk::ansi::codetype::has_sgr_leadingreset $newreplay]} {
@@ -1264,7 +1270,7 @@ namespace eval punk::lib {
             }
         }
         set opts [dict merge $defaults_dict_opts $checked_args]
-        #assert - checked_args keys are full-length option names if -anyopts was false or if the supplied option as a shortname matched one of our defined options 
+        #assertion - checked_args keys are full-length option names if -anyopts was false or if the supplied option as a shortname matched one of our defined options 
 
         set values [dict merge $defaults_dict_values $values_dict]
 
@@ -1294,15 +1300,20 @@ namespace eval punk::lib {
                 set allow_ansi 0
             }
             if {!$allow_ansi} {
-                foreach e $vlist {
+                #detect should work fine directly on whole list
-                    if {[punk::ansi::ta::detect $e]} {
+                if {[punk::ansi::ta::detect $vlist]} {
-                        error "Option $o for $caller contains ansi - but -allow_ansi is false. Received: '$e'"
+                        error "Option $o for $caller contains ansi - but -allow_ansi is false. Received: [ansistring VIEW $vlist]"
-                    }
                 }
+                #foreach e $vlist {
+                #    if {[punk::ansi::ta::detect $e]} {
+                #        error "Option $o for $caller contains ansi - but -allow_ansi is false. Received: '$e'"
+                #    }
+                #}
             }
 
             set vlist_check [list]
             foreach e $vlist {
+                #could probably stripansi entire list safely in one go? - review
                 if {$validate_without_ansi} {
                     lappend vlist_check [punk::ansi::stripansi $e]
                 } else {
@@ -1529,6 +1540,9 @@ namespace eval punk::lib {
 
         return "$average +/- $sigma microseconds per iteration"
     }
+
+    #test function to use with show_jump_tables
+    #todo - check if switch compilation to jump tables differs by Tcl version
     proc switch_char_test {c} {
         set dec [scan $c %c]
         foreach t [list 1 2 3] {
@@ -1545,6 +1559,7 @@ namespace eval punk::lib {
             }
         }
 
+        #tcl 8.6/8.7 (at least)
         #curlies must be unescaped and unbraced to work as literals in switch and enable it to compile to jumpTable
         switch -- $c {
                 a {

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

@@ -466,7 +466,7 @@ namespace eval punk::mix::commandset::loadedlib {
             puts stdout "---"
             set question "Proceed to create ${pkgtail}-${ver}.tm module? Y|N" 
             set answer [punk::lib::askuser $question] ;#takes account of previous stdin state and terminal raw vs line state
-            if {$answer ne "y"} {
+            if {[string tolower $answer] ne "y"} {
                 puts stderr "mix libcopy.asmodule aborting due to user response '$answer' (required Y|y to proceed)  use -askme 0 to avoid prompts."
                 return
             }
@@ -486,7 +486,7 @@ namespace eval punk::mix::commandset::loadedlib {
             if {$opt_askme} {
                 set question "Copy anyway? Y|N" 
                 set answer [punk::lib::askuser $question]
-                if {$answer ne "y"} {
+                if {[string tolower $answer] ne "y"} {
                     puts stderr "mix libcopy.asmodule aborting due to user response '$answer' (required Y|y to proceed)  use -askme 0 to avoid prompts."
                     return
                 }

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

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

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

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

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

@@ -215,7 +215,7 @@ namespace eval punk::ns {
     }
     proc nschildren {fqns} {
         if {![string match ::* $fqns]} {
-            error "nschildren only accespts a fully qualified namespace"
+            error "nschildren only accepts a fully qualified namespace"
         }
         set parent [nsprefix $fqns]
         set tail [nstail $fqns]
@@ -225,6 +225,9 @@ namespace eval punk::ns {
         return [lsort $nslist]
     }
 
+    #Note nsjoin,nsjoinall,nsprefix,nstail are string functions that don't care about namespaces in existence.
+    #Some functions in punk::ns are 
+
     proc nsjoin {prefix name} {
         if {[string match ::* $name]} {
             if {"$prefix" ne ""} {
@@ -265,6 +268,17 @@ namespace eval punk::ns {
         }
         return [join $nonempty_segments ::]
     }
+
+
+    #REVIEW - the combination of nsprefix & nstail are designed to *almost* always be able to reassemble the input, and to be independent of what namespaces actually exist
+    #The main difference being collapsing (or ignoring) repeated double-colons
+    #we need to distinguish unprefixed from prefixed ie ::x vs x
+    #There is an apparent inconsistency with nstail ::a:::x being able to return :x
+    #whereas nsprefix :::a  will return just a
+    #This is because :x (or even just : ) can in theory be the name of a command and we may need to see it (although it is not a good idea)
+    #and a namespace can exist with leading colon - but is even worse - as default Tcl commands will misreport e.g namespace current within namespace eval
+    #The view is taken that a namespace with leading/trailing colons is so error-prone that even introspection is unreliable so we will rule that out.
+    # 
     proc nsprefix {{nspath ""}} {
         #normalize the common case of ::::
         set nspath [string map [list :::: ::] $nspath]
@@ -281,8 +295,8 @@ namespace eval punk::ns {
         }
     }
 
-    #namespace tail which handles :::cmd  ::x:::y  ::x:::/y  etc
+    #namespace tail which handles :::cmd  ::x:::y  ::x:::/y  etc in a specific manner for string processing
-    #todo - raise error for unexpected sequences such as ::::  or more than 2 colons together.
+    #review - consider making -strict raise an error for unexpected sequences such as ::::  or any situation with more than 2 colons together.
     proc nstail {nspath args} {
         #normalize the common case of ::::
         set nspath [string map [list :::: ::] $nspath]
@@ -301,7 +315,7 @@ namespace eval punk::ns {
             }
         }
 
-        #e.g  ::x::y:::z  should return ":z"
+        #e.g  ::x::y:::z  should return ":z" despite it being a bad idea for a command name.
         return [lindex $parts end]
     }
 
@@ -792,7 +806,7 @@ namespace eval punk::ns {
                         }
                         if {$cmd in $aliases && $cmd in $seencmds} {
                             #masked commandless-alias
-                            #assert member of masked - but we use seencmds instead to detect.
+                            #assertion member of masked - but we use seencmds instead to detect.
                             set c [a+ yellow bold]
                             set prefix "${a}als  "
                             set prefix [overtype::right $prefix "-R"]
@@ -880,12 +894,14 @@ namespace eval punk::ns {
         foreach nsdict $with_results {
             dict set opts -nsdict $nsdict
             set block [get_nslist {*}$opts]
-            if {[string first \n $block] < 0} {
+            #if {[string first \n $block] < 0} {
-                #single line
+            #    #single line
-                set width [textblock::width [list $block]]
+            #    set width [textblock::width [list $block]]
-            } else {
+            #} else {
-                set width [textblock::width $block]
+            #    set width [textblock::width $block]
-            }
+            #}
+            set width [textblock::width $block]
+
             #if multiple results or if there is only 1 result - but we are path-globbing - then we need to show location 
             if {$count_with_results > 1 || [regexp {[*?]} [nsprefix $ns_absolute]]} {
                 append output \n [dict get $nsdict location]
@@ -1356,7 +1372,14 @@ namespace eval punk::ns {
     proc corp {path} {
         #thanks to Richard Suchenwirth for the original - wiki.tcl-lang.org/page/corp 
         #Note: modified here to support aliases and relative/absolute name (with respect to namespace .ie ::name vs name)
-        set indent "    " ;#review
+        if {[info exists punk::console::tabwidth]} {
+            set tw $::punk::console::tabwidth
+        } else {
+            set tw 8 
+        }
+        set indent [string repeat " " $tw] ;#match 
+        #set indent [string repeat "    " $tw] ;#A more sensible default for code - review 
+
         if {[info exists ::auto_index($path)]} {
             set body "\n${indent}#corp# auto_index $::auto_index($path)"
         } else {
@@ -1415,7 +1438,7 @@ namespace eval punk::ns {
         if {![catch {package require textutil::tabify} errpkg]} {
             set bodytext [info body $origin]
             #punk::lib::indent preserves trailing empty lines - unlike textutil version 
-            set bodytext [punk::lib::undent [textutil::untabify2 $bodytext]]
+            set bodytext [punk::lib::undent [textutil::untabify2 $bodytext $tw]]
             append body [punk::lib::indent $bodytext $indent]
         } else {
             append body [info body $origin]
@@ -1522,20 +1545,23 @@ namespace eval punk::ns {
 
 
         #todo support leading solo flags such as -capture to control whether we do a static capture of local vars in the ns
-        if {[string tolower $pkg_or_existing_ns] in [list :: global]} {
+        switch -- [string tolower $pkg_or_existing_ns] {
-            set ns ::
+            "::" - global {
-            set ver "";# tcl version?
+                set ns ::
-        } else {
+                set ver "";# tcl version?
-            if {[string match ::* $pkg_or_existing_ns]} {
+            }
-                if {![namespace exists $pkg_or_existing_ns]} {
+            default {
-                    set ver [package require [string range $pkg_or_existing_ns 2 end]]
+                if {[string match ::* $pkg_or_existing_ns]} {
+                    if {![namespace exists $pkg_or_existing_ns]} {
+                        set ver [package require [string range $pkg_or_existing_ns 2 end]]
+                    } else {
+                        set ver ""
+                    }
+                    set ns $pkg_or_existing_ns
                 } else {
-                    set ver ""
+                    set ver [package require $pkg_or_existing_ns]
+                    set ns ::$pkg_or_existing_ns
                 }
-                set ns $pkg_or_existing_ns
-            } else {
-                set ver [package require $pkg_or_existing_ns]
-                set ns ::$pkg_or_existing_ns
             }
         }
         if {[namespace exists $ns]} {

src/bootsupport/modules/punkcheck-0.1.0.tm

@@ -1493,53 +1493,57 @@ namespace eval punkcheck {
                         lappend files_copied $current_source_dir/$m
                         incr filecount_new
                     } else {
-                        if {$overwrite_what eq "installedsourcechanged-targets"} {
+                        switch -- $overwrite_what {
-                            if {[llength $changed]} {
+                            installedsourcechanged-targets {
-                                #An unrecorded installation is considered a source change (from unknown/unrecorded source to recorded)
+                                if {[llength $changed]} {
-                                file copy -force $current_source_dir/$m $current_target_dir
+                                    #An unrecorded installation is considered a source change (from unknown/unrecorded source to recorded)
-                                set new_tgt_cksum_info [punk::mix::base::lib::cksum_path $current_target_dir/$m]
-                                lappend files_copied $current_source_dir/$m
-                            } else {
-                                set is_skip 1
-                                lappend files_skipped $current_source_dir/$m
-                            }
-                        } elseif {$overwrite_what eq "synced-targets"} {
-                            if {[llength $changed]} {
-                                #only overwrite if the target checksum equals the last installed checksum (ie target is in sync with source and so hasn't been customized)
-                                set existing_tgt_cksum_info [punk::mix::base::lib::cksum_path $current_target_dir/$m]
-                                set is_target_unmodified_since_install 0
-                                set target_cksum_compare "unknown"
-                                set latest_install_record [punkcheck::recordlist::file_record_latest_installrecord $filerec] ;#may be no such record - in which case we get an empty list
-                                if {[dict exists $latest_install_record -targets_cksums]} {
-                                set last_install_cksum [dict get $latest_install_record -targets_cksums] ;#in this case we know there is only one as 'install' always uses targetset size of 1. (FILEINFO record per file in source folder)
-                                    if {[dict get $existing_tgt_cksum_info cksum] eq $last_install_cksum} {
-                                        set is_target_unmodified_since_install 1
-                                        set target_cksum_compare "match"
-                                    } else {
-                                        set target_cksum_compare "nomatch"
-                                    }
-                                } else {
-                                    set target_cksum_compare "norecord"
-                                }
-                                if {$is_target_unmodified_since_install} {
                                     file copy -force $current_source_dir/$m $current_target_dir
                                     set new_tgt_cksum_info [punk::mix::base::lib::cksum_path $current_target_dir/$m]
                                     lappend files_copied $current_source_dir/$m
                                 } else {
-                                    #either cksum is different or we were unable to verify the record. Either way we can't know if the target is in sync so we must skip it
                                     set is_skip 1
-                                    puts stderr "Skipping file copy $m target $current_target_dir/$m - require synced_target to overwrite - current target cksum compared to previous install: $target_cksum_compare" 
                                     lappend files_skipped $current_source_dir/$m
                                 }
-                            } else {
+                            }
+                            synced-targets {
+                                if {[llength $changed]} {
+                                    #only overwrite if the target checksum equals the last installed checksum (ie target is in sync with source and so hasn't been customized)
+                                    set existing_tgt_cksum_info [punk::mix::base::lib::cksum_path $current_target_dir/$m]
+                                    set is_target_unmodified_since_install 0
+                                    set target_cksum_compare "unknown"
+                                    set latest_install_record [punkcheck::recordlist::file_record_latest_installrecord $filerec] ;#may be no such record - in which case we get an empty list
+                                    if {[dict exists $latest_install_record -targets_cksums]} {
+                                    set last_install_cksum [dict get $latest_install_record -targets_cksums] ;#in this case we know there is only one as 'install' always uses targetset size of 1. (FILEINFO record per file in source folder)
+                                        if {[dict get $existing_tgt_cksum_info cksum] eq $last_install_cksum} {
+                                            set is_target_unmodified_since_install 1
+                                            set target_cksum_compare "match"
+                                        } else {
+                                            set target_cksum_compare "nomatch"
+                                        }
+                                    } else {
+                                        set target_cksum_compare "norecord"
+                                    }
+                                    if {$is_target_unmodified_since_install} {
+                                        file copy -force $current_source_dir/$m $current_target_dir
+                                        set new_tgt_cksum_info [punk::mix::base::lib::cksum_path $current_target_dir/$m]
+                                        lappend files_copied $current_source_dir/$m
+                                    } else {
+                                        #either cksum is different or we were unable to verify the record. Either way we can't know if the target is in sync so we must skip it
+                                        set is_skip 1
+                                        puts stderr "Skipping file copy $m target $current_target_dir/$m - require synced_target to overwrite - current target cksum compared to previous install: $target_cksum_compare" 
+                                        lappend files_skipped $current_source_dir/$m
+                                    }
+                                } else {
+                                    set is_skip 1
+                                    lappend files_skipped $current_source_dir/$m
+                                }
+                            }
+                            default {
                                 set is_skip 1
+                                puts stderr "Skipping file copy $m target $current_target_dir/$m already exists (use -overwrite all-targets  to overwrite)"
+                                #TODO! implement newer-targets older-targets? (note ctimes/mtimes are unreliable - may not be worth implementing)
                                 lappend files_skipped $current_source_dir/$m
                             }
-                        } else {
-                            set is_skip 1
-                            puts stderr "Skipping file copy $m target $current_target_dir/$m already exists (use -overwrite all-targets  to overwrite)"
-                            #TODO! implement newer-targets older-targets? (note ctimes/mtimes are unreliable - may not be worth implementing)
-                            lappend files_skipped $current_source_dir/$m
                         }
                     }
                 }
@@ -1584,11 +1588,15 @@ namespace eval punkcheck {
                 set subdirs [glob -nocomplain -dir $current_source_dir -type d -tail *]
                 set hiddensubdirs [glob -nocomplain -dir $current_source_dir -type {hidden d} -tail *]
                 foreach h $hiddensubdirs {
-                    if {$h in [list "." ".."]} {
+                    switch -- $h {
-                        continue
+                        "." - ".." {
-                    }
+                            continue
-                    if {$h ni $subdirs} {
+                        }
-                        lappend subdirs $h
+                        default {
+                            if {$h ni $subdirs} {
+                                lappend subdirs $h
+                            }
+                        }
                     }
                 }
             }
@@ -1736,8 +1744,24 @@ namespace eval punkcheck {
             }
             proc file_install_record_source_changes {install_record} {
                 #reject INSTALLFAILED items ?
-                if {[dict get $install_record tag] ni [list "QUERY-INPROGRESS" "INSTALL-RECORD" "INSTALL-SKIPPED" "INSTALL-INPROGRESS" "MODIFY-INPROGRESS" "MODIFY-RECORD" "MODIFY-SKIPPED" "VIRTUAL-INPROGRESS" "VIRTUAL-RECORD" "VIRTUAL-SKIPPED" "DELETE-RECORD" "DELETE-INPROGRESS" "DELETE-SKIPPED"]} {
+                switch -- [dict get $install_record tag] {
-                    error "file_install_record_source_changes bad install record: tag '[dict get $install_record tag]' not INSTALL-RECORD|SKIPPED|INSTALL-INPROGRESS|MODIFY-RECORD|MODIFY-INPROGRESS|VIRTUAL-RECORD|VIRTUAL-INPROGRESS|DELETE-RECORD|DELETE-INPROGRESS"
+                    "QUERY-INPROGRESS" -
+                    "INSTALL-RECORD" -
+                    "INSTALL-SKIPPED" -
+                    "INSTALL-INPROGRESS" -
+                    "MODIFY-INPROGRESS" -
+                    "MODIFY-RECORD" -
+                    "MODIFY-SKIPPED" -
+                    "VIRTUAL-INPROGRESS" -
+                    "VIRTUAL-RECORD" -
+                    "VIRTUAL-SKIPPED" -
+                    "DELETE-RECORD" -
+                    "DELETE-INPROGRESS" -
+                    "DELETE-SKIPPED" {
+                    }
+                    default {
+                        error "file_install_record_source_changes bad install record: tag '[dict get $install_record tag]' not INSTALL-RECORD|SKIPPED|INSTALL-INPROGRESS|MODIFY-RECORD|MODIFY-INPROGRESS|VIRTUAL-RECORD|VIRTUAL-INPROGRESS|DELETE-RECORD|DELETE-INPROGRESS"
+                    }
                 }
                 set source_list [dict_getwithdefault $install_record body [list]]
                 set changed [list]

src/bootsupport/modules/uuid-1.0.7.tm

@@ -0,0 +1,245 @@
+# uuid.tcl - Copyright (C) 2004 Pat Thoyts <patthoyts@users.sourceforge.net>
+#
+# UUIDs are 128 bit values that attempt to be unique in time and space.
+#
+# Reference:
+#   http://www.opengroup.org/dce/info/draft-leach-uuids-guids-01.txt
+#
+# uuid: scheme:
+# http://www.globecom.net/ietf/draft/draft-kindel-uuid-uri-00.html
+#
+# Usage: uuid::uuid generate
+#        uuid::uuid equal $idA $idB
+
+package require Tcl 8.5
+
+namespace eval uuid {
+    variable accel
+    array set accel {critcl 0}
+
+    namespace export uuid
+
+    variable uid
+    if {![info exists uid]} {
+        set uid 1
+    }
+
+    proc K {a b} {set a}
+}
+
+###
+# Optimization
+# Caches machine info after the first pass
+###
+
+proc ::uuid::generate_tcl_machinfo {} {
+  variable machinfo
+  if {[info exists machinfo]} {
+    return $machinfo
+  }
+  lappend machinfo [clock seconds]; # timestamp
+  lappend machinfo [clock clicks];  # system incrementing counter
+  lappend machinfo [info hostname]; # spatial unique id (poor)
+  lappend machinfo [pid];           # additional entropy
+  lappend machinfo [array get ::tcl_platform]
+
+  ###
+  # If we have /dev/urandom just stream 128 bits from that
+  ###
+  if {[file exists /dev/urandom]} {
+    set fin [open /dev/urandom r]
+    binary scan [read $fin 128] H* machinfo
+    close $fin
+  } elseif {[catch {package require nettool}]} {
+    # More spatial information -- better than hostname.
+    # bug 1150714: opening a server socket may raise a warning messagebox
+    #   with WinXP firewall, using ipconfig will return all IP addresses
+    #   including ipv6 ones if available. ipconfig is OK on win98+
+    if {[string equal $::tcl_platform(platform) "windows"]} {
+      catch {exec ipconfig} config
+      lappend machinfo $config
+    } else {
+      catch {
+          set s [socket -server void -myaddr [info hostname] 0]
+          K [fconfigure $s -sockname] [close $s]
+      } r
+      lappend machinfo $r
+    }
+
+    if {[package provide Tk] != {}} {
+      lappend machinfo [winfo pointerxy .]
+      lappend machinfo [winfo id .]
+    }
+  } else {
+    ###
+    # If the nettool package works on this platform
+    # use the stream of hardware ids from it
+    ###
+    lappend machinfo {*}[::nettool::hwid_list]
+  }
+  return $machinfo
+}
+
+# Generates a binary UUID as per the draft spec. We generate a pseudo-random
+# type uuid (type 4). See section 3.4
+#
+proc ::uuid::generate_tcl {} {
+    package require md5 2
+    variable uid
+
+    set tok [md5::MD5Init]
+    md5::MD5Update $tok [incr uid];      # package incrementing counter
+    foreach string [generate_tcl_machinfo] {
+      md5::MD5Update $tok $string
+    }
+    set r [md5::MD5Final $tok]
+    binary scan $r c* r
+
+    # 3.4: set uuid versioning fields
+    lset r 8 [expr {([lindex $r 8] & 0x3F) | 0x80}]
+    lset r 6 [expr {([lindex $r 6] & 0x0F) | 0x40}]
+
+    return [binary format c* $r]
+}
+
+if {[string equal $tcl_platform(platform) "windows"]
+        && [package provide critcl] != {}} {
+    namespace eval uuid {
+        critcl::ccode {
+            #define WIN32_LEAN_AND_MEAN
+            #define STRICT
+            #include <windows.h>
+            #include <ole2.h>
+            typedef long (__stdcall *LPFNUUIDCREATE)(UUID *);
+            typedef const unsigned char cu_char;
+        }
+        critcl::cproc generate_c {Tcl_Interp* interp} ok {
+            HRESULT hr = S_OK;
+            int r = TCL_OK;
+            UUID uuid = {0};
+            HMODULE hLib;
+            LPFNUUIDCREATE lpfnUuidCreate = NULL;
+            hLib = LoadLibraryA(("rpcrt4.dll"));
+            if (hLib)
+                lpfnUuidCreate = (LPFNUUIDCREATE)
+                    GetProcAddress(hLib, "UuidCreate");
+            if (lpfnUuidCreate) {
+                Tcl_Obj *obj;
+                lpfnUuidCreate(&uuid);
+                obj = Tcl_NewByteArrayObj((cu_char *)&uuid, sizeof(uuid));
+                Tcl_SetObjResult(interp, obj);
+            } else {
+                Tcl_SetResult(interp, "error: failed to create a guid",
+                              TCL_STATIC);
+                r = TCL_ERROR;
+            }
+            return r;
+        }
+    }
+}
+
+# Convert a binary uuid into its string representation.
+#
+proc ::uuid::tostring {uuid} {
+    binary scan $uuid H* s
+    foreach {a b} {0 7 8 11 12 15 16 19 20 end} {
+        append r [string range $s $a $b] -
+    }
+    return [string tolower [string trimright $r -]]
+}
+
+# Convert a string representation of a uuid into its binary format.
+#
+proc ::uuid::fromstring {uuid} {
+    return [binary format H* [string map {- {}} $uuid]]
+}
+
+# Compare two uuids for equality.
+#
+proc ::uuid::equal {left right} {
+    set l [fromstring $left]
+    set r [fromstring $right]
+    return [string equal $l $r]
+}
+
+# Call our generate uuid implementation
+proc ::uuid::generate {} {
+    variable accel
+    if {$accel(critcl)} {
+        return [generate_c]
+    } else {
+        return [generate_tcl]
+    }
+}
+
+# uuid generate -> string rep of a new uuid
+# uuid equal uuid1 uuid2
+#
+proc uuid::uuid {cmd args} {
+    switch -exact -- $cmd {
+        generate {
+            if {[llength $args] != 0} {
+                return -code error "wrong # args:\
+                    should be \"uuid generate\""
+            }
+            return [tostring [generate]]
+        }
+        equal {
+            if {[llength $args] != 2} {
+                return -code error "wrong \# args:\
+                    should be \"uuid equal uuid1 uuid2\""
+            }
+            return [eval [linsert $args 0 equal]]
+        }
+        default {
+            return -code error "bad option \"$cmd\":\
+                must be generate or equal"
+        }
+    }
+}
+
+# -------------------------------------------------------------------------
+
+# LoadAccelerator --
+#
+#	This package can make use of a number of compiled extensions to
+#	accelerate the digest computation. This procedure manages the
+#	use of these extensions within the package. During normal usage
+#	this should not be called, but the test package manipulates the
+#	list of enabled accelerators.
+#
+proc ::uuid::LoadAccelerator {name} {
+    variable accel
+    set r 0
+    switch -exact -- $name {
+        critcl {
+            if {![catch {package require tcllibc}]} {
+                set r [expr {[info commands ::uuid::generate_c] != {}}]
+            }
+        }
+        default {
+            return -code error "invalid accelerator package:\
+                must be one of [join [array names accel] {, }]"
+        }
+    }
+    set accel($name) $r
+}
+
+# -------------------------------------------------------------------------
+
+# Try and load a compiled extension to help.
+namespace eval ::uuid {
+    variable e {}
+    foreach e {critcl} {
+        if {[LoadAccelerator $e]} break
+    }
+    unset e
+}
+
+package provide uuid 1.0.7
+
+# -------------------------------------------------------------------------
+# Local variables:
+#   mode: tcl
+#   indent-tabs-mode: nil
+# End: