set nsthis [uplevel 1 {::namespace current}] ;#must use :: - we can find ourselves in a namespace with a different 'namespace' command
tailcall punk::lib::alias $aliasorglob {*}$args
if {[llength $args]} {
if {$aliasorglob in [interp aliases ""]} {
set existing [interp alias "" $aliasorglob]
puts stderr "Overwriting existing alias $aliasorglob -> $existing with $aliasorglob -> $args (in current session only)"
}
if {([llength $args] ==1) && [string trim [lindex $args 0]] eq ""} {
#use empty string/whitespace as intention to delete alias
return [interp alias "" $aliasorglob ""]
}
return [interp alias "" $aliasorglob "" {*}$args]
} else {
if {![string length $aliasorglob]} {
set aliaslist [punk::aliases]
puts -nonewline stderr $aliaslist
return
}
#we need to first check for exact match of alias that happens to have glob chars i.e the supplied aliasorglob looks like a glob but is actually directly an alias
set target [interp alias "" $aliasorglob]
if {[llength $target]} {
return $target
}
}
if {([string first "*" $aliasorglob] >= 0) || ([string first "?" $aliasorglob] >= 0)} {
set aliaslist [punk::aliases $aliasorglob]
puts -nonewline stderr $aliaslist
return
}
return [list]
}
}
#pipeline-toys - put in lib/scriptlib?
#pipeline-toys - put in lib/scriptlib?
##geometric mean
##geometric mean
@ -7669,8 +7603,6 @@ namespace eval punk {
interp alias {} help {} punk::help
interp alias {} help {} punk::help
interp alias {} aliases {} punk::aliases
interp alias {} alias {} punk::alias
interp alias {} treemore {} punk::xmore tree
interp alias {} treemore {} punk::xmore tree
interp alias {} tmhere {} .= pwd |path> {::tcl::tm::add {*}$data; set path} |> inspect -label added_to_module_path <0/#|
interp alias {} tmhere {} .= pwd |path> {::tcl::tm::add {*}$data; set path} |> inspect -label added_to_module_path <0/#|
# #setting -type none indicates a flag that doesn't take a value (solo flag)
# #setting -type none indicates a flag that doesn't take a value (solo flag)
# -nocomplain -type none
# -nocomplain -type none
# *values -min 1 -max -1
# *values -min 1 -max -1
# } $args]] opts values
# } $args]] leaders opts values
#
#
# puts "translation is [dict get $opts -translation]"
# puts "translation is [dict get $opts -translation]"
# foreach f [dict values $values] {
# foreach f [dict values $values] {
@ -68,7 +68,7 @@
#}]
#}]
#[para]The lines beginning with * are optional in most cases and can be used to set defaults and some extra controls
#[para]The lines beginning with * are optional in most cases and can be used to set defaults and some extra controls
#[para] - the above example would work just fine with only the -<optionname> lines, but would allow zero filenames to be supplied as no -min value is set for *values
#[para] - the above example would work just fine with only the -<optionname> lines, but would allow zero filenames to be supplied as no -min value is set for *values
#[para]valid * lines being with *proc *opts *values
#[para]valid * lines being with *proc *leaders *opts *values
#[para]lines beginning with a dash define options - a name can optionally be given to each trailing positional argument.
#[para]lines beginning with a dash define options - a name can optionally be given to each trailing positional argument.
#[para]If no names are defined for positional arguments, they will end up in the values key of the dict with numerical keys starting at zero.
#[para]If no names are defined for positional arguments, they will end up in the values key of the dict with numerical keys starting at zero.
#[para]e.g the result from the punk::args call above may be something like:
#[para]e.g the result from the punk::args call above may be something like:
#default -allow_ansi to 1 and -validate_ansistripped to 0 and -strip_ansi 0 - it takes time to strip ansi
#default -allow_ansi to 1 and -validate_ansistripped to 0 and -strip_ansi 0 - it takes time to strip ansi
#todo - detect if anything in the spec uses -allow_ansi 0, -validate_ansistripped 1 or -strip_ansi 1 and set a flag indicating if punk::ansi::ta::detect should be run on the argslist
#todo - detect if anything in the spec uses -allow_ansi 0, -validate_ansistripped 1 or -strip_ansi 1 and set a flag indicating if punk::ansi::ta::detect should be run on the argslist
set leader_required [list]
set opt_required [list]
set opt_required [list]
set val_required [list]
set val_required [list]
set arg_info [tcl::dict::create]
set arg_info [tcl::dict::create]
set arg_checks [tcl::dict::create]
set arg_checks [tcl::dict::create]
set opt_defaults [tcl::dict::create]
set opt_defaults [tcl::dict::create]
set opt_names [list] ;#defined opts
set opt_names [list] ;#defined opts
set leader_defaults [tcl::dict::create]
set val_defaults [tcl::dict::create]
set val_defaults [tcl::dict::create]
set opt_solos [list]
set opt_solos [list]
#first process dashed and non-dashed argspecs without regard to whether non-dashed are at the beginning or end
#first process dashed and non-dashed argspecs without regard to whether non-dashed are at the beginning or end
#todo - document that ambiguities in API are likely if both *leaders and *values used
#todo - do some checks for obvious bad definitions involving a mix of *leaders and *values (e.g with optional options)
set leader_checks_defaults [tcl::dict::remove $leaderspec_defaults -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minlen
set opt_checks_defaults [tcl::dict::remove $optspec_defaults -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minlen
set opt_checks_defaults [tcl::dict::remove $optspec_defaults -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minlen
set val_checks_defaults [tcl::dict::remove $valspec_defaults -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minlen
set val_checks_defaults [tcl::dict::remove $valspec_defaults -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minlen
set positionalidx 0 ;#index for unnamed positionals (both leaders and values)
if {[set eopts [lsearch -exact $rawargs "--"]] >= 0} {
set ldridx 0
lappend flagsreceived --
set leadernames_received [list]
set values [lrange $rawargs $eopts+1 end]
set leaders_dict $leader_defaults
set arglist [lrange $rawargs 0 $eopts-1]
set num_leaders [llength $leaders]
set maxidx [expr {[llength $arglist]-1}]
foreach leadername $leader_names ldr $leaders {
for {set i 0} {$i <= $maxidx} {incr i} {
if {$ldridx+1 > $num_leaders} {
set a [lindex $arglist $i]
if {![tcl::string::match -* $a]} {
#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
}
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 [list $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
}
}
}
} else {
if {[lsearch $rawargs -*] >= 0} {
#no -- end of opts indicator
#to support option values with leading dash e.g -offset -1 , we can't just use the last flagindex to determine start of positional args.
#we break on first non-flag looking argument that isn't in an option's value position and use that index as the division.
#The caller should use -- if the first positional arg is likely or has the potential to start with a dash.
set maxidx [expr {[llength $rawargs]-1}]
for {set i 0} {$i <= $maxidx} {incr i} {
set a [lindex $rawargs $i]
#we can automatically rule out arguments containing whitespace from the set of simple flags beginning with a dash
#This helps for example when first value is a dict or list in which the first item happens to begin with a dash
#explicit -- still safer in many cases, but this is a reasonable and fast enough test
if {![tcl::string::match -* $a] || [regexp {\s+} $a]} {
#assume beginning of positional args
incr i -1
break
break
}
}
if {$leadername ne ""} {
if {![catch {tcl::prefix match -message "options for %caller%. Unexpected option" $opt_names $a } fullopt]} {
tcl::dict::set leaders_dict $leadername $ldr
if {[tcl::dict::get $arg_info $fullopt -type] ne "none"} {
lappend leadernames_received $leadername
#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
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 $rawargs $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]
# error "Required value missing for [Get_caller]. missing values $missing marked with -optional false - so must be present"
# error "Required value missing for [Get_caller]. missing values $missing marked with -optional false - so must be present"
#}
#}
#for now (2024-06) punk::lib::ldiff is a better compromise across normal/safe interps e.g 0.7/0.8us
#for now (2024-06) punk::lib::ldiff is a better compromise across normal/safe interps e.g 0.7/0.8us
if {[llength [set missing [punklib_ldiff $leader_required $leadernames_received]]]} {
arg_error "Required leader missing for [Get_caller]. missing values: '$missing' marked with -optional false - so must be present" $argspecs
}
if {[llength [set missing [punklib_ldiff $opt_required $flagsreceived]]]} {
if {[llength [set missing [punklib_ldiff $opt_required $flagsreceived]]]} {
arg_error "Required option missing for [Get_caller]. missing flags: '$missing' are marked with -optional false - so must be present in full-length form" $argspecs
arg_error "Required option missing for [Get_caller]. missing flags: '$missing' are marked with -optional false - so must be present in full-length form" $argspecs
set opts_and_values [tcl::dict::merge $opts $values_dict]
set opts_and_values [tcl::dict::merge $leaders_dict $opts $values_dict]
#set combined_defaults [tcl::dict::merge $val_defaults $opt_defaults] ;#can be no key collisions - we don't allow a value key beginning with dash - opt names must begin with dash
#set combined_defaults [tcl::dict::merge $val_defaults $opt_defaults] ;#can be no key collisions - we don't allow a value key beginning with dash - opt names must begin with dash
set receivednames [list {*}$leadernames_received {*}$flagsreceived {*}$valnames_received]
set received_posns [concat {*}[lmap a $receivednames b [zero_to_n [expr {[llength $receivednames]-1}]] {list $a $b}]] ;#flat zip named with overall posn including opts
return [tcl::dict::create leaders $leaders_dict opts $opts values $values_dict received $received_posns]
set nsthis [uplevel 1 {::namespace current}] ;#must use :: - we can find ourselves in a namespace with a different 'namespace' command
if {[llength $args]} {
if {$aliasorglob in [interp aliases ""]} {
set existing [interp alias "" $aliasorglob]
puts stderr "Overwriting existing alias $aliasorglob -> $existing with $aliasorglob -> $args (in current session only)"
}
if {([llength $args] ==1) && [string trim [lindex $args 0]] eq ""} {
#use empty string/whitespace as intention to delete alias
return [interp alias "" $aliasorglob ""]
}
return [interp alias "" $aliasorglob "" {*}$args]
} else {
if {![string length $aliasorglob]} {
set aliaslist [punk::lib::aliases]
puts -nonewline stderr $aliaslist
return
}
#we need to first check for exact match of alias that happens to have glob chars i.e the supplied aliasorglob looks like a glob but is actually directly an alias
set target [interp alias "" $aliasorglob]
if {[llength $target]} {
return $target
}
if {([string first "*" $aliasorglob] >= 0) || ([string first "?" $aliasorglob] >= 0)} {
