diff --git a/src/modules/flagfilter-0.3.tm b/src/modules/flagfilter-0.3.tm
index 007a66bd..1d37e215 100644
--- a/src/modules/flagfilter-0.3.tm
+++ b/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]
- oo::objdefine col_processors_matched_$runid {
- method test {} {
- return 1
- }
- }
+
+ #set LAUNCHED [oolib::collection create col_processors_launched_$runid]
+ #set MATCHED [oolib::collection create col_processors_matched_$runid]
+ #oo::objdefine col_processors_matched_$runid {
+ # 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]} {
diff --git a/src/modules/natsort-0.1.1.6.tm b/src/modules/natsort-0.1.1.6.tm
index 9509f558..ec52c475 100644
--- a/src/modules/natsort-0.1.1.6.tm
+++ b/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 \
@@ -894,29 +900,45 @@ namespace eval natsort {
-debug 0 -db "" -stacktrace 0 -splits "\uFFFF" -showsplits 0] \
-required {all} \
-extras {none} \
- -commandprocessors {} \
- -values $args]
+ -commandprocessors {}\
+ ]
+
+ 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]
- #csv unimplemented
-
- 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"
}
diff --git a/src/modules/punk/args-999999.0a1.0.tm b/src/modules/punk/args-999999.0a1.0.tm
index 35c46939..810eb2fd 100644
--- a/src/modules/punk/args-999999.0a1.0.tm
+++ b/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,64 +660,125 @@ 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}]} {
- append errmsg \n
- set title "Usage"
- if {[dict exists $spec_dict proc_info -name]} {
- set title "Usage: [dict get $spec_dict proc_info -name]"
- }
- 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]
-
- foreach arg [dict get $spec_dict opt_names] {
- set arginfo [dict get $spec_dict arg_info $arg]
- if {[dict exists $arginfo -default]} {
- #set default $c_default[dict get $arginfo -default]
- set default [dict get $arginfo -default]
+ if {[catch {
+ append errmsg \n
+ set procname [punk::lib::dict_getdef $spec_dict proc_info -name ""]
+ set prochelp [punk::lib::dict_getdef $spec_dict proc_info -help ""]
+
+ 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 default ""
+ set procname_display ""
}
- $t add_row [list $arg [dict get $arginfo -type] $default]
- if {$arg eq $badarg} {
- $t configure_row [expr {[$t row_count]-1}] -ansibase $c_badarg
+ if {$prochelp ne ""} {
+ lappend blank_header_col ""
+ set prochelp_display [a+ web-white]$prochelp[a]
+ } else {
+ set prochelp_display ""
}
- }
- foreach arg [dict get $spec_dict val_names] {
- set arginfo [dict get $spec_dict arg_info $arg]
- if {[dict exists $arginfo -default]} {
- set default [dict get $arginfo -default]
+ $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 {
- set default ""
+ $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}
}
- $t add_row [list $arg [dict get $arginfo -type] $default]
- if {$arg eq $badarg} {
- $t configure_row [expr {[$t row_count]-1}] -ansibase $c_badarg
+
+ 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]
+ if {[dict exists $arginfo -default]} {
+ #set default $c_default[dict get $arginfo -default]
+ set default [dict get $arginfo -default]
+ } else {
+ set 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
+ }
+ }
+ foreach arg [dict get $spec_dict val_names] {
+ set arginfo [dict get $spec_dict arg_info $arg]
+ if {[dict exists $arginfo -default]} {
+ set default [dict get $arginfo -default]
+ } else {
+ set 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
+ }
}
- }
- $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]
- append errmsg [$t print]
+ $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
}
error $errmsg
}
-
+
#generally we expect values to contain leading dashes only if -- specified. Otherwise no reliable way determine difference between bad flags and values
#If no eopts (--) specified we stop looking for opts at the first nondash encountered in a position we'd expect a dash - so without eopt, values could contain dashes - but not in first position after flags.
#only supports -flag val pairs, not solo options
@@ -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 {[tcl::dict::get $arg_info $a -type] ne "none"} {
- 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
+
+ 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 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]} {
- tcl::dict::lappend opts $fullopt $flagval
+ #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]} {
- tcl::dict::lappend values_dict $valname $val
+ 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 {}
diff --git a/src/modules/punk/cap/handlers/templates-999999.0a1.0.tm b/src/modules/punk/cap/handlers/templates-999999.0a1.0.tm
index 39eb5c2a..4cc3f00c 100644
--- a/src/modules/punk/cap/handlers/templates-999999.0a1.0.tm
+++ b/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]
diff --git a/src/modules/punk/lib-999999.0a1.0.tm b/src/modules/punk/lib-999999.0a1.0.tm
index 6b64ccf4..2959d273 100644
--- a/src/modules/punk/lib-999999.0a1.0.tm
+++ b/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
diff --git a/src/modules/punk/mix/commandset/layout-999999.0a1.0.tm b/src/modules/punk/mix/commandset/layout-999999.0a1.0.tm
index 2acbf555..ba2663b0 100644
--- a/src/modules/punk/mix/commandset/layout-999999.0a1.0.tm
+++ b/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]
diff --git a/src/modules/punk/mix/commandset/loadedlib-999999.0a1.0.tm b/src/modules/punk/mix/commandset/loadedlib-999999.0a1.0.tm
index 3788dc16..7bdce9ac 100644
--- a/src/modules/punk/mix/commandset/loadedlib-999999.0a1.0.tm
+++ b/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]} {
- #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]
- } else {
- #make it easy to search for anything
- set matches [lsearch -all -inline -nocase [package names] "*$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?
+ 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
+ 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]
diff --git a/src/modules/punk/mix/commandset/module-999999.0a1.0.tm b/src/modules/punk/mix/commandset/module-999999.0a1.0.tm
index 9a5cbcc9..7f3c7aac 100644
--- a/src/modules/punk/mix/commandset/module-999999.0a1.0.tm
+++ b/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]
diff --git a/src/modules/punk/overlay-0.1.tm b/src/modules/punk/overlay-0.1.tm
index b11e8c51..5534dad3 100644
--- a/src/modules/punk/overlay-0.1.tm
+++ b/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]} {
- set resolved [uplevel 1 [list ::namespace which $routine]]
+ if {![tcl::string::match ::* $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 [
- list [namespace which namespace] current]]
+ set base [tcl::namespace::eval $base [
+ 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 [
- ::list namespace ensemble configure $routine -unknown [
+ tcl::namespace::eval $routine [
+ ::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 ::lib::*
#}]
- namespace eval ${routine}::lib [string map [list $base $routine] {
- if {[::namespace exists ::lib]} {
- ::set current_paths [namespace path]
+ tcl::namespace::eval ${routine}::lib [tcl::string::map [list $base $routine] {
+ if {[tcl::namespace::exists ::lib]} {
+ ::set current_paths [tcl::namespace::path]
if {"" ni $current_paths} {
::lappend current_paths
}
- ::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]::*] {
- ::set c [::namespace tail $cmd]
- if {![::string match _* $c]} {
+ ::foreach cmd [tcl::info::commands [tcl::namespace::current]::*] {
+ ::set c [tcl::namespace::tail $cmd]
+ 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 "::"} {
- set cmdpackage [string range $cmdnamespace 2 end]
+ if {[tcl::string::range $cmdnamespace 0 1] eq "::"} {
+ 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 $cmdnamespace] {
- ::set nspaths [::namespace path]
+ tcl::namespace::eval ${cmdnamespace}::lib [tcl::string::map [list $cmdnamespace] {
+ ::set nspaths [tcl::namespace::path]
if {"" ni $nspaths} {
::lappend nspaths
}
- ::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}::*]
- foreach cmd [info commands ${nscaller}::temp_import::*] {
- set cmdtail [namespace tail $cmd]
+ tcl::namespace::eval ${nscaller}::temp_import [list tcl::namespace::import ${cmdnamespace}::*]
+ foreach cmd [tcl::info::commands ${nscaller}::temp_import::*] {
+ 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
}]
diff --git a/src/modules/textblock-999999.0a1.0.tm b/src/modules/textblock-999999.0a1.0.tm
index 3ffa2ba1..ea8795dc 100644
--- a/src/modules/textblock-999999.0a1.0.tm
+++ b/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
- tcl::dict::set colspace_added $col $space_to_alloc
+ set maxwidth [tcl::dict::get $o_columndefs $col -maxwidth]
+ 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 {