flagfilter object cleanups, punk::args default val fixes & error table improvements, textblock::table fixes

src/modules/flagfilter-0.3.tm

@@ -1051,19 +1051,20 @@ namespace eval flagfilter {
         set sequence 0
         set argerrors [list] ;#despite being a list - we will break out at first entry and return for now.
         set parsestatus "ok"
-        set LAUNCHED [oolib::collection create col_processors_launched_$runid]
+
-        set MATCHED [oolib::collection create col_processors_matched_$runid]
+        #set LAUNCHED [oolib::collection create col_processors_launched_$runid]
-        oo::objdefine col_processors_matched_$runid {
+        #set MATCHED [oolib::collection create col_processors_matched_$runid]
-            method test {} {
+        #oo::objdefine col_processors_matched_$runid {
-                return 1
+        #    method test {} {
-            }
+        #        return 1
-        }
+        #    }
+        #}
 
         #set objp [$PROCESSORS object_from_record $p]  ;#temp convenience
 
         foreach objp [$PROCESSORS items] {
             set objparent [$objp parent]
-            $LAUNCHED add $objp [$objp name]
+            #$LAUNCHED add $objp [$objp name]
             set p [$objp get_def] ;#individual record  e.g {mycmd {match run singleopts {-x}}}  or  {tail_processor {}}
              
             lassign $p parentname pinfo
@@ -1599,6 +1600,12 @@ namespace eval flagfilter {
                 lappend o_longopts {*}[dict get $o_pinfo longopts]
             }
         }
+        destructor {
+            catch {$o_vmap destroy}
+            if {!$o_is_sub} {
+                $o_col_children destroy
+            }
+        }
 
         method name {} {
             return $o_name
@@ -2552,6 +2559,21 @@ namespace eval flagfilter {
                 }
             }
         }
+
+
+        # ---------------------------------
+        foreach obj [$PARENTS items] {
+            catch {$obj destroy}
+        }
+        $PARENTS destroy
+        #puts "PROCESSORS: $PROCESSORS"
+        foreach obj [$PROCESSORS items] {
+            catch {$obj destroy}
+        }
+        $PROCESSORS destroy
+        catch {$RETURNED_VMAP destroy}
+        # ---------------------------------
+
         do_debug 1 $debugc "[string repeat = 40]"
         do_debug 1 $debugc "DEBUG-END $caller"
         if {[string length $raise_dispatch_error_instead_of_return]} {

src/modules/natsort-0.1.1.6.tm

@@ -860,6 +860,11 @@ namespace eval natsort {
         #puts stdout "natsort::sort args: $args"
         variable debug
         if {![llength $stringlist]} return
+        if {[llength $stringlist] == 1} {
+            if {"-inputformat" ni $args && "-outputformat" ni $args} {
+                return $stringlist
+            }
+        }
         
         #allow pass through of the check_flags flag -debugargs so it can be set by the caller
         set debugargs 0
@@ -874,7 +879,8 @@ namespace eval natsort {
 
         #-return flagged|defaults doesn't work Review.
         #flagfilter global processor/allocator not working 2023-08
-        set args [check_flags \
+
+        set flagspecs [dict create\
           -caller natsort::sort \
           -return supplied|defaults \
           -debugargs $debugargs \
@@ -895,28 +901,44 @@ namespace eval natsort {
           -required {all} \
           -extras {none} \
           -commandprocessors {}\
-          -values $args]
+        ]
 
-       #csv unimplemented
+        set opts [check_flags {*}$flagspecs -values $args] 
+
+        #we can only shortcircuit input list of single element at this point if there aren't non-default -inputformat or -outputformat transformations
+        if {[llength $stringlist] == 1} {
+            set is_basic 1
+            foreach fname [list -inputformat -outputformat] {
+                if {[dict get $flagspecs -defaults $fname] ne [dict get $opts $fname]} {
+                    set is_basic 0
+                    break
+                }
+            }
+            if {$is_basic} {
+                return $stringlist
+            }
+        }
+
+
+        set winlike                     [dict get $opts -winlike]
+        set topchars                    [dict get $opts -topchars]
+        set cols                        [dict get $opts -cols]
+        set debug                       [dict get $opts -debug]
+        set stacktrace                  [dict get $opts -stacktrace]
+        set showsplits                  [dict get $opts -showsplits]
+        set splits                      [dict get $opts -splits]
+        set sortmethod                  [dict get $opts -sortmethod]
+        set opt_collate                 [dict get $opts -collate]
+        set opt_inputformat             [dict get $opts -inputformat]
+        set opt_inputformatapply        [dict get $opts -inputformatapply]
+        set opt_inputformatoptions      [dict get $opts -inputformatoptions]
+        set opt_outputformat            [dict get $opts -outputformat]
+        set opt_outputformatoptions     [dict get $opts -outputformatoptions]
 
-        set winlike         [dict get $args -winlike]
-        set topchars        [dict get $args -topchars]
-        set cols            [dict get $args -cols]
-        set debug           [dict get $args -debug]
-        set stacktrace      [dict get $args -stacktrace]
-        set showsplits      [dict get $args -showsplits]
-        set splits          [dict get $args -splits]
-        set sortmethod      [dict get $args -sortmethod]
-        set opt_collate         [dict get $args -collate]
-        set opt_inputformat     [dict get $args -inputformat]
-        set opt_inputformatapply     [dict get $args -inputformatapply]
-        set opt_inputformatoptions     [dict get $args -inputformatoptions]
-        set opt_outputformat    [dict get $args -outputformat]
-        set opt_outputformatoptions    [dict get $args -outputformatoptions]
-        dict unset args -showsplits
-        dict unset args -splits 
         if {$debug} {
-            puts stdout "natsort::sort processed_args: $args"
+            #dict unset opts -showsplits
+            #dict unset opts -splits 
+            puts stdout "natsort::sort processed_args: $opts"
             if {$debug == 1} {
                 puts stdout "natsort::sort - try also -debug 2, -debug 3"
             }

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

@@ -488,6 +488,7 @@ tcl::namespace::eval punk::args {
                                     }
                                     tcl::dict::set valspec_defaults $k $v
                                 }
+                                -optional -
                                 -allow_ansi -
                                 -validate_without_ansi -
                                 -strip_ansi -
@@ -637,6 +638,7 @@ tcl::namespace::eval punk::args {
         ]
         tcl::dict::set argspec_cache $cache_key $result
         tcl::dict::set argspecs $spec_id $optionspecs
+        #puts "xxx:$result"
         return $result
     }
 
@@ -658,28 +660,59 @@ tcl::namespace::eval punk::args {
     proc Get_caller {} {
         set cmdinfo [tcl::dict::get [tcl::info::frame -3] cmd]
         #puts "-->$cmdinfo"
+        #puts "-->[tcl::info::frame -3]"
         set caller [regexp -inline {\S+} $cmdinfo]
         if {$caller eq "namespace"} {
-            set caller "punk::args::get_dict called from namespace"
+            set cmdinfo "punk::args::get_dict called from namespace"
         }
-        return $caller
+        return $cmdinfo
     }
 
     proc arg_error {msg spec_dict {badarg ""}} {
         set errmsg $msg
         if {![catch {package require textblock}]} {
+            if {[catch  {
                 append errmsg \n
-            set title "Usage"
+                set procname [punk::lib::dict_getdef $spec_dict proc_info -name ""]
-            if {[dict exists $spec_dict proc_info -name]} {
+                set prochelp [punk::lib::dict_getdef $spec_dict proc_info -help ""]
-                set title "Usage: [dict get $spec_dict proc_info -name]"
+
+                set t [textblock::class::table new [a+ web-yellow]Usage[a]]
+
+                set blank_header_col [list ""]
+                if {$procname ne ""} {
+                    lappend blank_header_col ""
+                    set procname_display [a+ web-white]$procname[a]
+                } else {
+                    set procname_display ""
+                }
+                if {$prochelp ne ""} {
+                    lappend blank_header_col ""
+                    set prochelp_display [a+ web-white]$prochelp[a]
+                } else {
+                    set prochelp_display ""
+                }
+                $t add_column -headers $blank_header_col 
+                $t add_column -headers $blank_header_col 
+                $t add_column -headers $blank_header_col 
+                $t add_column -headers $blank_header_col 
+                $t add_column -headers $blank_header_col 
+                if {"$procname$prochelp" eq ""} {
+                    $t configure_header 0 -values {Arg Type Default Multiple Help}
+                } elseif {$procname eq ""} {
+                    $t configure_header 0 -colspans {1 4 0 0 0} -values [list Description: $prochelp_display]
+                    $t configure_header 1 -values {Arg Type Default Multiple Help}
+                } elseif {$prochelp eq ""} {
+                    $t configure_header 0 -colspans {1 4 0 0 0} -values [list PROC/METHOD: $procname_display]
+                    $t configure_header 1 -values {Arg Type Default Multiple Help}
+                } else {
+                    $t configure_header 0 -colspans {1 4 0 0 0} -values [list PROC/METHOD: $procname_display]
+                    $t configure_header 1 -colspans {1 4 0 0 0} -values [list Description: $prochelp_display]
+                    $t configure_header 2 -values {Arg Type Default Multiple Help}
                 }
-            set t [textblock::class::table new [a+ web-yellow]$title[a]]
-            $t add_column -headers {Arg}
-            $t add_column -headers {Type}
-            $t add_column -headers {Default}
 
                 set c_default [a+ web-white Web-limegreen]
                 set c_badarg [a+ web-crimson]
+                set greencheck [a+ web-limegreen]\u2713[a]
 
                 foreach arg [dict get $spec_dict opt_names] {
                     set arginfo [dict get $spec_dict arg_info $arg]
@@ -689,7 +722,17 @@ tcl::namespace::eval punk::args {
                     } else {
                         set default ""
                     }
-                $t add_row [list $arg [dict get $arginfo -type] $default]
+                    set help [punk::lib::dict_getdef $arginfo -help ""]
+                    if {[dict exists $arginfo -choices]} {
+                        if {$help ne ""} {append help \n}
+                        append help "Choices: [dict get $arginfo -choices]"
+                    }
+                    if {[punk::lib::dict_getdef $arginfo -multiple 0]} {
+                        set multiple $greencheck 
+                    } else {
+                        set multiple ""
+                    }
+                    $t add_row [list $arg [dict get $arginfo -type] $default $multiple $help]
                     if {$arg eq $badarg} {
                         $t configure_row [expr {[$t row_count]-1}] -ansibase $c_badarg
                     }
@@ -701,7 +744,17 @@ tcl::namespace::eval punk::args {
                     } else {
                         set default ""
                     }
-                $t add_row [list $arg [dict get $arginfo -type] $default]
+                    set help [punk::lib::dict_getdef $arginfo -help ""]
+                    if {[dict exists $arginfo -choices]} {
+                        if {$help ne ""} {append help \n}
+                        append help "Choices: [dict get $arginfo -choices]"
+                    }
+                    if {[punk::lib::dict_getdef $arginfo -multiple 0]} {
+                        set multiple $greencheck 
+                    } else {
+                        set multiple ""
+                    }
+                    $t add_row [list $arg [dict get $arginfo -type] $default $multiple $help]
                     if {$arg eq $badarg} {
                         $t configure_row [expr {[$t row_count]-1}] -ansibase $c_badarg
                     }
@@ -709,7 +762,17 @@ tcl::namespace::eval punk::args {
 
 
                 $t configure -show_hseps 0 -show_header 1 -ansibase_body [a+ web-white] -ansibase_header [a+ brightyellow] -ansiborder_header [a+ brightyellow] -ansiborder_body [a+ brightyellow]
+                $t configure -maxwidth 80
                 append errmsg [$t print]
+                $t destroy
+            } errM]} {
+                catch {$t destroy}
+                append errmsg \n
+                append errmsg "(additional error in punk::args::arg_error when attempting to display usage)" \n
+                append errmsg "$errM" \n
+                append errmsg "$::errorInfo"
+
+            }
         } else {
             #todo - something boring 
         }
@@ -799,7 +862,10 @@ tcl::namespace::eval punk::args {
         set argspecs [Get_argspecs $optionspecs]
         tcl::dict::with argspecs {} ;#turn keys into vars
         #puts "-arg_info->$arg_info"
-        set flagsreceived [list]
+        set flagsreceived [list] ;#for checking if required flags satisfied
+        #secondary purpose:
+        #for -multple true, we need to ensure we can differentiate between a default value and a first of many that happens to match the default.
+        #-default value must not be appended to if argname not yet in flagsreceived 
 
         set opts $opt_defaults
         if {[set eopts [lsearch -exact $rawargs "--"]] >= 0} {
@@ -812,13 +878,76 @@ tcl::namespace::eval punk::args {
                     #we can't treat as first positional arg - as it comes before the eopt indicator --
                     arg_error "punk::args::get_dict bad options for [Get_caller]. Expected flag (leading -) at position $i got:$rawargs" $argspecs
                 }
-                #TODO!
+
+                if {![catch {tcl::prefix match -message "options for %caller%. Unexpected option" $opt_names $a } fullopt]} {
+                    if {[tcl::dict::get $arg_info $fullopt -type] ne "none"} { 
+                        #non-solo
+                        set flagval [lindex $arglist $i+1]
+                        if {[dict get $arg_info $fullopt -multiple]} {
+                            #don't lappend to default - we need to replace if there is a default
+                            #review - what if user sets first value that happens to match a default?
+                            if {$fullopt ni $flagsreceived && [tcl::dict::exists $opt_defaults $fullopt] && ([tcl::dict::get $opt_defaults $fullopt] eq [tcl::dict::get $opts $fullopt])} {
+                                #first occurrence of this flag, whilst stored value matches default
+                                tcl::dict::set opts $fullopt $flagval
+                            } else {
+                                tcl::dict::lappend opts $fullopt $flagval 
+                            }
+                        } else {
+                            tcl::dict::set opts $fullopt $flagval 
+                        }
+                        #incr i to skip flagval
+                        if {[incr i] > $maxidx} {
+                            arg_error "punk::args::get_dict bad options for [Get_caller]. No value supplied for last option $fullopt at index [expr {$i-1}] which is not marked with -type none" $argspecs $fullopt
+                        }
+                    } else {
+                        #type none (solo-flag)
+                        if {[tcl::dict::get $arg_info $fullopt -multiple]} {
+                            if {[tcl::dict::get $opts $fullopt] == 0} {
+                                #review - what if default at time opt was specified is not zero? we will end up with more items in the list than the number of times the flag was specified
+                                tcl::dict::set opts $fullopt 1
+                            } else {
+                                tcl::dict::lappend opts $fullopt 1
+                            }
+                        } else {
+                            tcl::dict::set opts $fullopt 1
+                        }
+                    }
+                    lappend flagsreceived $fullopt ;#dups ok
+                } else {
+                    if {$opt_any} {
+                        set newval [lindex $arglist $i+1]
+                        #opt was unspecified but is allowed due to *opt -any 1 -  'adhoc/passthrough' option  
+                        tcl::dict::set arg_info $a $optspec_defaults ;#use default settings for unspecified opt
+                        tcl::dict::set arg_checks $a $opt_checks_defaults
                         if {[tcl::dict::get $arg_info $a -type] ne "none"} {
+                            if {[tcl::dict::get $arg_info $a -multiple]} {
+                                tcl::dict::lappend opts $a $newval
+                            } else {
+                                tcl::dict::set opts $a $newval 
+                            }
+                            lappend flagsreceived $a ;#adhoc flag as supplied
                             if {[incr i] > $maxidx} {
-                        arg_error "punk::args::get_dict bad options for [Get_caller]. No value supplied for last option $a which is not marked with -solo 1" $argspecs $a
+                                arg_error "punk::args::get_dict bad options for [Get_caller]. No value supplied for last adhoc option $a at index [expr {$i-1}] which is not marked with -type none" $argspecs $a
                             }
+                        } else {
+                            #review -we can't provide a way to allow unspecified -type none flags through reliably/unambiguously unless all remaining unspecified options are -type none 
+                            if {[tcl::dict::get $arg_info $a -multiple]} {
+                                if {![tcl::dict::exists $opts $a]} {
+                                    tcl::dict::set opts $a 1
+                                } else {
+                                    tcl::dict::lappend opts $a 1
+                                }
+                            } else {
+                                tcl::dict::set opts $a 1
+                            }
+                        }
+                    } else {
+                        #delay Get_caller so only called in the unhappy path
+                        set errmsg [tcl::string::map [list %caller% [Get_caller]] $fullopt] 
+                        arg_error $errmsg $argspecs $fullopt
                     }
-                lappend flagsreceived $a ;#dups ok
+                }
+
             }
         } else {
             if {[lsearch $rawargs -*] >= 0} {
@@ -841,7 +970,14 @@ tcl::namespace::eval punk::args {
                             #non-solo
                             set flagval [lindex $rawargs $i+1]
                             if {[dict get $arg_info $fullopt -multiple]} {
+                                #don't lappend to default - we need to replace if there is a default
+                                #review - what if user sets first value that happens to match a default?
+                                if {$fullopt ni $flagsreceived && [tcl::dict::exists $opt_defaults $fullopt] && ([tcl::dict::get $opt_defaults $fullopt] eq [tcl::dict::get $opts $fullopt])} {
+                                    #first occurrence of this flag, whilst stored value matches default
+                                    tcl::dict::set opts $fullopt $flagval
+                                } else {
                                     tcl::dict::lappend opts $fullopt $flagval 
+                                }
                             } else {
                                 tcl::dict::set opts $fullopt $flagval 
                             }
@@ -918,7 +1054,12 @@ tcl::namespace::eval punk::args {
             }
             if {$valname ne ""} {
                 if {[tcl::dict::get $arg_info $valname -multiple]} {
+                    if {[tcl::dict::exists $val_defaults $valname] && ([tcl::dict::get $val_defaults $valname] eq [tcl::dict::get $values_dict $valname])} {
+                        #current stored val equals defined default - don't include default in the list we build up
+                        tcl::dict::set values_dict $valname $val
+                    } else {
                         tcl::dict::lappend values_dict $valname $val
+                    }
                     set in_multiple $valname 
                 } else {
                     tcl::dict::set values_dict $valname $val 
@@ -1045,6 +1186,7 @@ tcl::namespace::eval punk::args {
             #puts "argname:$argname v:$v  is_default:$is_default"
             #we want defaults to pass through - even if they don't pass the checks that would be required for a specified value
             #If the caller manually specified a value that happens to match the default - we don't detect that as any different from an unspecified value - Review.
+            #arguments that are at their default are not subject to type and other checks
             if {$is_default == 0} {
                 switch -- $type {
                     any {}

src/modules/punk/cap/handlers/templates-999999.0a1.0.tm

@@ -658,6 +658,7 @@ namespace eval punk::cap::handlers::templates {
                 } $args]
                 set opts [dict get $argd opts]
                 set globsearches [dict get $argd values globsearches]; #note that in this case our globsearch won't reduce the machine's effort in scannning the filesystem - as we need to search on the renamed results
+                #puts stderr "=-=============>globsearches:$globsearches"
                 # -- --- --- --- --- --- --- --- ---
                 set opt_startdir [dict get $opts -startdir]
                 set opt_templatefolder_subdir   [dict get $opts -templatefolder_subdir]

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

@@ -1821,7 +1821,7 @@ namespace eval punk::lib {
 #todo - way to generate 'internal' docs separately?
 #*** !doctools
 #[section Internal]
-namespace eval punk::lib::system {
+tcl::namespace::eval punk::lib::system {
     #*** !doctools 
     #[subsection {Namespace punk::lib::system}]
     #[para] Internal functions that are not part of the API 

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

@@ -82,6 +82,13 @@ namespace eval punk::mix::commandset::layout {
         }
 
         proc _default {args} {
+            punk::args::get_dict [subst {
+                *proc -name ::punk::mix::commandset::layout::collection::_default 
+                -startdir   -type string
+                -not        -type string -multiple 1
+                globsearches -default * -multiple 1
+            }] $args
+
             set tdict_low_to_high [as_dict {*}$args]
             #convert to screen order - with higher priority at the top
             set tdict [dict create]

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

@@ -26,33 +26,102 @@ package require punk::lib
 namespace eval punk::mix::commandset::loadedlib {
     namespace export *
     #search automatically wrapped in * * - can contain inner * ? globs
-    proc search {searchstring} {
+    proc search {args} {
+        set argspecs {
+            *proc -name "punk::mix::commandset::loadedlib search" -help "search all Tcl libraries available to your local interpreter"
+            -return  -type string -default table -choices {table tableobject list lines}
+            -present -type integer -default 2 -choices {0 1 2} -choicelabels {absent present both} -help "(unimplemented) Display only those that are 0:absent 1:present 2:both"
+            -highlight -type boolean -default 1 -help "Highlight which version is present with ansi underline and colour"
+            -refresh -default 0 -type boolean -help "Re-scan the tm and library folders"
+            searchstrings -default * -multiple 1 -help "Names to search for, may contain glob chars (* ?) e.g *lib*
+            If no glob chars are explicitly specified, the searchstring will be wrapped with star globs.
+            eg name -> *name* 
+            "
+        }
+        set argd [punk::args::get_dict $argspecs $args]
+        set searchstrings [dict get $argd values searchstrings]
+        set opts [dict get $argd opts]
+        set opt_return      [dict get $opts -return]
+        set opt_highlight   [dict get $opts -highlight]
+
         catch {package require frobznodule666} ;#ensure pkg system has loaded/searched for everything
         if {[catch {package require natsort}]} {
             set has_natsort 0
         } else {
             set has_natsort 1
         }
-        if {[regexp {[?*]} $searchstring]} {
+        set packages [package names]
+        set matches [list]
+        foreach search $searchstrings {
+            if {[regexp {[?*]} $search]} {
                 #caller has specified specific glob pattern - use it
                 #todo - respect supplied case only if uppers present? require another flag?
-            set matches [lsearch -all -inline -nocase [package names] $searchstring]
+                lappend matches {*}[lsearch -all -inline -nocase $packages $search]
+            } elseif {[string match =* $search]} {
+                lappend matches {*}[lsearch -all -inline -exact $packages [string range $search 1 end]]
             } else {
                 #make it easy to search for anything
-            set matches [lsearch -all -inline -nocase [package names] "*$searchstring*"]
+                lappend matches {*}[lsearch -all -inline -nocase $packages "*$search*"]
             }
-
+        }
+        set matches [lsort -unique $matches][unset matches]
         set matchinfo [list]
+        set highlight_ansi [a+ web-limegreen underline]
+        set RST [a]
         foreach m $matches {
             set versions [package versions $m]
+            if {![llength $versions]} {
+                #e.g builtins such as zlib - shows no versions - but will show version when package present/provide used
+                set versions [package provide $m]
+                #if {![catch {package present $m} v]} {
+                #    set versions $v
+                #}
+            }
             if {$has_natsort} {
                 set versions [natsort::sort $versions]
             } else {
                 set versions [lsort $versions]
             }
+            if {$opt_highlight} {
+                set v [package provide $m]
+                if {$v ne ""} {
+                    set posn [lsearch $versions $v]
+                    if {$posn >= 0} {
+                        #FIXME! (probably in textblock::pad ?)
+                        #TODO - determine why underline is extended to padding even with double reset. (space or other char required to prevent)
+                        set highlighted "$highlight_ansi$v$RST $RST"
+                        set versions [lreplace $versions $posn $posn $highlighted]
+                    } else {
+                        #shouldn't be possible?
+                        puts stderr "failed to find version '$v' in versions:$versions for package $m"
+                    }
+                }
+            }
             lappend matchinfo [list $m $versions]
         }
-        return [join [lsort $matchinfo] \n]
+        switch -- $opt_return {
+            list {
+                return $matchinfo 
+            }
+            lines {
+                return [join $matchinfo \n]
+            }
+            table - tableobject {
+                set t [textblock::class::table new]
+                $t add_column -headers "Package"
+                $t add_column -headers "Version"
+                $t configure -show_hseps 0
+                foreach m $matchinfo {
+                    $t add_row [list [lindex $m 0] [join [lindex $m 1] " "]]
+                }
+                if {$opt_return eq "tableobject"} {
+                    return $t
+                }
+                set result [$t print]
+                $t destroy
+                return $result
+            }
+        }
     }
     proc loaded.search {searchstring} {
         set search_result [search $searchstring]

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

@@ -122,6 +122,14 @@ namespace eval punk::mix::commandset::module {
     }
     #return all module templates with repeated ones suffixed with .2 .3 etc
     proc templates_dict {args} {
+        set argspec {
+            *proc -name templates_dict -help "Templates from module and project paths"
+            -startdir -default "" -help "Project folder used in addition to module paths"
+            -not -default "" -multiple 1
+            *values
+            globsearches -default * -multiple 1
+        }
+        set argd [punk::args::get_dict $argspec $args]
         package require punk::cap
         if {[punk::cap::capability_has_handler punk.templates]} {
             set template_folder_dict [punk::cap::call_handler punk.templates get_itemdict_moduletemplates {*}$args]

src/modules/punk/overlay-0.1.tm

@@ -2,37 +2,37 @@
 
 package require punk::mix::util
 
-namespace eval ::punk::overlay {
+tcl::namespace::eval ::punk::overlay {
     #based *loosely* on: wiki.tcl-lang.org/page/ensemble+extend
     # extend an ensemble-like routine with the routines in some namespace
     #
     # e.g custom_from_base ::punk::mix::cli ::punk::mix::base
     #
     proc custom_from_base {routine base} {
-        if {![string match ::* $routine]} {
+        if {![tcl::string::match ::* $routine]} {
-            set resolved [uplevel 1 [list ::namespace which $routine]]
+            set resolved [uplevel 1 [list ::tcl::namespace::which $routine]]
             if {$resolved eq {}} {
                 error [list {no such routine} $routine]
             }
             set routine $resolved
         }
-        set routinens [namespace qualifiers $routine]
+        set routinens [tcl::namespace::qualifiers $routine]
         if {$routinens eq {::}} {
             set routinens {}
         }
-        set routinetail [namespace tail $routine]
+        set routinetail [tcl::namespace::tail $routine]
 
-        if {![string match ::* $base]} {
+        if {![tcl::string::match ::* $base]} {
             set base [uplevel 1 [
-                list [namespace which namespace] current]]::$base
+                list [tcl::namespace::which namespace] current]]::$base
         }
 
-        if {![namespace exists $base]} {
+        if {![tcl::namespace::exists $base]} {
             error [list {no such namespace} $base]
         }
 
-        set base [namespace eval $base [
+        set base [tcl::namespace::eval $base [
-            list [namespace which namespace] current]]
+            list [tcl::namespace::which namespace] current]]
 
 
         #while 1 {
@@ -40,8 +40,8 @@ namespace eval ::punk::overlay {
         #    if {[namespace which $renamed] eq {}} break
         #}
 
-        namespace eval $routine [
+        tcl::namespace::eval $routine [
-            ::list namespace ensemble configure  $routine -unknown [
+            ::list tcl::namespace::ensemble configure  $routine -unknown [
                 ::list ::apply {{base ensemble subcommand args} {
                     ::list ${base}::_redirected $ensemble $subcommand 
                 }} $base
@@ -57,25 +57,25 @@ namespace eval ::punk::overlay {
         #    ::namespace import <base>::lib::*
         #}]
 
-        namespace eval ${routine}::lib [string map [list <base> $base <routine> $routine] {
+        tcl::namespace::eval ${routine}::lib [tcl::string::map [list <base> $base <routine> $routine] {
-            if {[::namespace exists <base>::lib]} {
+            if {[tcl::namespace::exists <base>::lib]} {
-                ::set current_paths [namespace path]
+                ::set current_paths [tcl::namespace::path]
                 if {"<routine>" ni $current_paths} {
                     ::lappend current_paths <routine>
                 }
-                ::namespace path $current_paths
+                tcl::namespace::path $current_paths
             }
         }]
 
-        namespace eval $routine {
+        tcl::namespace::eval $routine {
             ::set exportlist [::list]
-            ::foreach cmd [::info commands [::namespace current]::*] {
+            ::foreach cmd [tcl::info::commands [tcl::namespace::current]::*] {
-                ::set c [::namespace tail $cmd]
+                ::set c [tcl::namespace::tail $cmd]
-                if {![::string match _* $c]} {
+                if {![tcl::string::match _* $c]} {
                     ::lappend exportlist $c
                 }
             }
-            ::namespace export {*}$exportlist
+            tcl::namespace::export {*}$exportlist
         }
 
         return $routine
@@ -96,20 +96,20 @@ namespace eval ::punk::overlay {
         }
         #namespace may or may not be a package
         # allow with or without leading ::
-        if {[string range $cmdnamespace 0 1] eq "::"} {
+        if {[tcl::string::range $cmdnamespace 0 1] eq "::"} {
-            set cmdpackage [string range $cmdnamespace 2 end]
+            set cmdpackage [tcl::string::range $cmdnamespace 2 end]
         } else {
             set cmdpackage $cmdnamespace
             set cmdnamespace ::$cmdnamespace
         }
 
-        if {![namespace exists $cmdnamespace]} {
+        if {![tcl::namespace::exists $cmdnamespace]} {
             #only do package require if the namespace not already present
             catch {package require $cmdpackage} pkg_load_info 
             #recheck
-            if {![namespace exists $cmdnamespace]} {
+            if {![tcl::namespace::exists $cmdnamespace]} {
                 set prov [package provide $cmdpackage]
-                if {[string length $prov]} {
+                if {[tcl::string::length $prov]} {
                     set provinfo "(package $cmdpackage is present with version $prov)"
                 } else {
                     set provinfo "(package $cmdpackage not present)"
@@ -121,21 +121,21 @@ namespace eval ::punk::overlay {
         punk::mix::util::namespace_import_pattern_to_namespace_noclobber ::punk::mix::util::* ${cmdnamespace}::util
 
         #let child namespace 'lib' resolve parent namespace and thus util::xxx
-        namespace eval ${cmdnamespace}::lib [string map [list <cmdns> $cmdnamespace] {
+        tcl::namespace::eval ${cmdnamespace}::lib [tcl::string::map [list <cmdns> $cmdnamespace] {
-            ::set nspaths [::namespace path]
+            ::set nspaths [tcl::namespace::path]
             if {"<cmdns>" ni $nspaths} {
                 ::lappend nspaths <cmdns>
             }
-            ::namespace path $nspaths
+            tcl::namespace::path $nspaths
         }]
 
         set imported_commands [list]
-        set nscaller [uplevel 1 [list namespace current]]
+        set nscaller [uplevel 1 [list tcl::namespace::current]]
         if {[catch {
             #review - noclobber?
-            namespace eval ${nscaller}::temp_import [list ::namespace import ${cmdnamespace}::*]
+            tcl::namespace::eval ${nscaller}::temp_import [list tcl::namespace::import ${cmdnamespace}::*]
-            foreach cmd [info commands ${nscaller}::temp_import::*] {
+            foreach cmd [tcl::info::commands ${nscaller}::temp_import::*] {
-                set cmdtail [namespace tail $cmd]
+                set cmdtail [tcl::namespace::tail $cmd]
                 if {$cmdtail eq "_default"} {
                     set import_as ${nscaller}::${prefix}
                 } else {
@@ -153,7 +153,7 @@ namespace eval ::punk::overlay {
 }
 
 
-package provide punk::overlay [namespace eval punk::overlay {
+package provide punk::overlay [tcl::namespace::eval punk::overlay {
     variable version
     set version 0.1 
 }]

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

@@ -2926,8 +2926,27 @@ tcl::namespace::eval textblock {
                             set col [lindex $memcols 0]
                             set space_to_alloc [expr {$hwidth - [tcl::dict::get $colwidths $col]}]
                             if {$space_to_alloc > 0} { 
-                                tcl::dict::set colwidths $col $hwidth
+                                set maxwidth [tcl::dict::get $o_columndefs $col -maxwidth]
-                                tcl::dict::set colspace_added $col $space_to_alloc
+                                if {$maxwidth ne ""} {
+                                    if {$maxwidth > [tcl::dict::get $colwidths $col]} {
+                                        set can_alloc [expr {$maxwidth - [tcl::dict::get $colwidths $col]}]
+                                    } else {
+                                        set can_alloc 0
+                                    }
+                                    set will_alloc [expr {min($space_to_alloc,$can_alloc)}]
+                                } else {
+                                    set will_alloc $space_to_alloc 
+                                }
+                                if {$will_alloc} {
+                                    #tcl::dict::set colwidths $col $hwidth
+                                    tcl::dict::incr colwidths $col $will_alloc
+                                    tcl::dict::set colspace_added $col $will_alloc
+                                }
+                                #log!
+                                #if {$will_alloc < $space_to_alloc} {
+                                #    #todo - debug only
+                                #    puts stderr "max width $maxwidth hit for col $col - cannot allocate extra [expr {$space_to_alloc - $will_alloc}]"
+                                #}
                             }
                         } elseif {$num_cols_spanned > 1} {
                             set spannedwidth 0
@@ -2941,7 +2960,7 @@ tcl::namespace::eval textblock {
                             } 
                             #review - we want to reduce overallocation to earlier or later columns - hence the use of colspace_added
                             switch -- $allocmethod {
-                                0 {
+                                least {
                                     #add to least-expanded each time
                                     #safer than method 1 - pretty balanced  
                                     if {$space_to_alloc > 0} {
@@ -2960,7 +2979,39 @@ tcl::namespace::eval textblock {
                                         }
                                     }
                                 }
-                                1 {
+                                least_unmaxed {
+                                    #TODO - fix header truncation/overflow issues when they are restricted by column maxwidth 
+                                    #(we should be able to collapse column width to zero and have header colspans gracefully respond)
+                                    #add to least-expanded each time
+                                    #safer than method 1 - pretty balanced  
+                                    if {$space_to_alloc > 0} {
+                                        for {set i 0} {$i < $space_to_alloc} {incr i} {
+                                            set ordered_colspace_added [lsort -stride 2 -index 1 -integer $colspace_added]
+                                            set ordered_all_colids [tcl::dict::keys $ordered_colspace_added]
+                                            set colid ""
+                                            foreach testcolid $ordered_all_colids {
+                                                set maxwidth [tcl::dict::get $o_columndefs $testcolid -maxwidth]
+                                                set can_alloc [expr {$maxwidth eq "" || $maxwidth > [tcl::dict::get $colwidths $testcolid]}]
+                                                if {$testcolid in $colids} {
+                                                    if {$can_alloc} {
+                                                        set colid $testcolid
+                                                        break
+                                                    } else {
+                                                        #remove from future consideration in for loop
+                                                        #log!
+                                                        #puts stderr "max width $maxwidth hit for col $testcolid"
+                                                        tcl::dict::unset colspace_added $testcolid
+                                                    }
+                                                }
+                                            }
+                                            if {$colid ne ""} {
+                                                tcl::dict::incr colwidths $colid
+                                                tcl::dict::incr colspace_added $colid
+                                            }
+                                        }
+                                    }
+                                }
+                                all {
                                     #adds space to all columns - not just those spanned - risk of underallocating and truncating some headers!
                                     #probably not a good idea for tables with complex headers and spans
                                     while {$space_to_alloc > 0} {
@@ -3137,12 +3188,13 @@ tcl::namespace::eval textblock {
                         }
                         span {
                             #widest of smallest spans first method 
-                            set calcresult [my columncalc_spans 0]
+                            #set calcresult [my columncalc_spans least]
+                            set calcresult [my columncalc_spans least_unmaxed]
                             set o_calculated_column_widths [tcl::dict::get $calcresult colwidths]
                         }
                         span2 {
                             #allocates more evenly - but truncates headers sometimes
-                            set calcresult [my columncalc_spans 1]
+                            set calcresult [my columncalc_spans all]
                             set o_calculated_column_widths [tcl::dict::get $calcresult colwidths]
                         }
                         default {