set record_base_indent "" ;#indent of first line in the record e.g a parameter or @directive record which will often have subsequent lines further indented.
#If last is less than first, then any specified elements will be inserted into the list before the element specified by first with no elements being deleted.
#If last is less than first, then any specified elements will be inserted into the list before the element specified by first with no elements being deleted.
set post [lrange $l $fidx end]
set post [lrange $l $fidx end]
} else {
} else {
set post [lrange $l $last+1 end]
#set post [lrange $l $last+1 end]
set post [lrange $l $lidx+1 end]
}
}
}
}
}
}
@ -1526,7 +1528,7 @@ namespace eval punk::lib {
set pnext [string range $pnext 1 end]
set pnext [string range $pnext 1 end]
}
}
# single type in segment e.g /@@something/
# single type in segment e.g /@@something/
switch -exact $pnext {
switch -exact -- $pnext {
"" {
"" {
set substructure string
set substructure string
}
}
@ -2159,7 +2161,7 @@ namespace eval punk::lib {
if {[tcl::string::is integer -strict $expression]} {
if {[tcl::string::is integer -strict $expression]} {
return [expr {$expression}]
return [expr {$expression}]
}
}
if {[regexp {(.*)([+-])(.*)} $expression _match a op b] && [tcl::string::is integer -strict $a] && [tcl::string::is integer -strict $b]} {
if {[regexp {([^+-]*)([+-])(.*)} $expression _match a op b] && [tcl::string::is integer -strict $a] && [tcl::string::is integer -strict $b]} {
if {$op eq "-"} {
if {$op eq "-"} {
return [expr {$a - $b}]
return [expr {$a - $b}]
} else {
} else {
@ -2180,7 +2182,18 @@ namespace eval punk::lib {
An indexset consists of a comma delimited list of indexes or index-ranges.
An indexset consists of a comma delimited list of indexes or index-ranges.
The indexes are 0-based.
The indexes are 0-based.
Ranges must be specified with .. as the separator.
The normal 'range' specifier is ..
The range specifier can appear at the beginning, middle or end, or even alone to indicate the entire
range of valid values.
e.g the following are all valid ranges
1..
(index 1 to max)
..10
(index 0 to 10)
2..11
(index 2o to 11)
..
(all indices)
Common whitespace elements space,tab,newlines are ignored.
Common whitespace elements space,tab,newlines are ignored.
Each index (or endpoint of an index-range) can be of the forms accepted by Tcl list or string commands,
Each index (or endpoint of an index-range) can be of the forms accepted by Tcl list or string commands,
e.g end-2 or 2+2.
e.g end-2 or 2+2.
@ -2199,6 +2212,19 @@ namespace eval punk::lib {
foreach r $ranges {
foreach r $ranges {
set validateindices [list]
set validateindices [list]
set rposn [string first .. $r]
set rposn [string first .. $r]
if {$rposn >= 0} {
set sepsize 2
set step 1
} else {
#check for .n. 'stepped' range
set fdot [string first . $r]
set ldot [string last . $r]
set step [string range $r $fdot+1 $ldot-1]
#todo - allow basic mathops for step: 2+1 2+-1 etc same as tcl lindex, lseq
if {![string is integer -strict $step]} {
}
}
if {$rposn >= 0} {
if {$rposn >= 0} {
lappend validateindices {*}[string range $r 0 $rposn-1] {*}[string range $r $rposn+2 end]
lappend validateindices {*}[string range $r 0 $rposn-1] {*}[string range $r $rposn+2 end]
} else {
} else {
@ -2389,16 +2415,22 @@ namespace eval punk::lib {
#[para]For empty lists, end and end+x indices are considered to be out of bounds on the upper side - thus returning -2
#[para]For empty lists, end and end+x indices are considered to be out of bounds on the upper side - thus returning -2
#Note that for an index such as $x+1 - we never see the '$x' as it is substituted in the calling command. We will get something like 10+1 - which can be resolved safely with expr
#Note that for an index such as $x+1 - we never see the '$x' as it is substituted in the calling command. We will get something like 10+1 - which can be resolved safely with expr
#if {![llength $list]} {
# #review
# return ???
#REVIEW - we need compat for 1_000 etc to handle things like toml even in 8.6?
#}
#A basic string map means we aren't properly validating
if {![string is integer -strict $len]} {
#<0 ?
error "lindex_resolve len must be an integer"
}
set index [tcl::string::map {_ {}} $index] ;#basic forward compatibility with integers such as 1_000 for 8.6
#todo - be stricter about malformations such as 1000_
#todo - be stricter about malformations such as 1000_
if {![string is integer -strict 1_0]} {
#basic forward compatibility with integers such as 1_000 for 8.6.x
set index [tcl::string::map {_ {}} $index]
set len [tcl::string::map {_ {}} $len]
}
if {![string is integer -strict $len] || $len < 0} {
error "lindex_resolve len must be a positive integer"
}
if {[string is integer -strict $index]} {
if {[string is integer -strict $index]} {
#can match +i -i
#can match +i -i
if {$index < 0} {
if {$index < 0} {
@ -2414,40 +2446,42 @@ namespace eval punk::lib {
if {$index ne "end"} {
if {$index ne "end"} {
set op [string index $index 3]
set op [string index $index 3]
set offset [string range $index 4 end]
set offset [string range $index 4 end]
#note - offset could have leading + or -
# 'string is integer -strict +1' ==> true
#e.g end+-1 is valid (end++-1 is not)
if {$op ni {+ -} || ![string is integer -strict $offset]} {error "bad index '$index': must be integer?\[+-\]integer? or end?\[+-\]integer?"}
if {$op ni {+ -} || ![string is integer -strict $offset]} {error "bad index '$index': must be integer?\[+-\]integer? or end?\[+-\]integer?"}
if {$op eq "+" && $offset != 0} {
if {$offset == 0} {
return -2
#(offset +0, -0 or 0 or 000 0_0 etc)
}
#op either + or - is irrelevant
} else {
#index is 'end'
set index [expr {$len-1}]
set index [expr {$len-1}]
if {$index < 0} {
if {$index < 0} {
#special case - 'end' with empty list - treat end like a positive number out of bounds
return -2 ;#special case - equivalent to 'end', with empty list - treat like a positive number out of bounds
return -2
} else {
} else {
return $index
return $index
}
}
}
}
if {$offset == 0} {
set index [expr {$len-1}]
set index [if {$op eq "+"} {expr {($len-1) + $offset}} else {expr {($len-1) - $offset}}]
if {$index < 0} {
if {$index < 0} {
return -2 ;#special case as above
return -3
} elseif {$index > $len-1} {
return -2
} else {
} else {
return $index
return $index
}
}
} else {
} else {
#by now, if op = + then offset = 0 so we only need to handle the minus case
#index is 'end'
set index [expr {($len-1) - $offset}]
if {$len == 0} {
#special case - 'end' with empty list - treat end like a positive number out of bounds
return -2
}
}
if {$index < 0} {
return [expr {$len - 1}]
return -3
} else {
return $index
}
}
} else {
} else {
#plain +-<int> already handled above.
#plain +-<int> already handled above.
#we are trying to avoid evaluating unbraced expr of potentially insecure origin
#we are trying to avoid evaluating unbraced expr of potentially insecure origin
if {[regexp {(.*)([+-])(.*)} $index _match a op b]} {
#regexp must split a++b to a + +b (not a+ + b) ie first +/- is the op
if {[regexp {([^+-]*)([+-])(.*)} $index _match a op b]} {
if {[string is integer -strict $a] && [string is integer -strict $b]} {
if {[string is integer -strict $a] && [string is integer -strict $b]} {
set leadernames [dict get $spec FORMS $fid LEADER_NAMES]
set leadernames [dict get $spec FORMS $fid LEADER_NAMES]
set optnames [dict get $spec FORMS $fid OPT_NAMES]
set optnames [dict get $spec FORMS $fid OPT_NAMES]
set valnames [dict get $spec FORMS $fid VAL_NAMES]
set valnames [dict get $spec FORMS $fid VAL_NAMES]
#review - see 'string is word' vs 'string is wordchar' behaviour due to documented common opts/vals in the parent ensemble-like command '::tcl::string::is'
#we should be preferring the most specific documentation
#Alternatively - we could adjust the 'string is' documentation to have @values -unnamed true
#and put the common info in the help for <unnamed> - but that would give us an inferior synopsis for 'string is'
if {![llength $optnames] && ![llength $valnames]} {
if {![llength $optnames] && ![llength $valnames]} {
test parse_withdef_auto_change_argspace_from_options_to_values {test first non dashed argdef after option is treated as a value when @values not explicit}\
-setup $common -body {
#test val1 following -opt is automatically placed in 'values' when @values directive is missing
set argd [punk::args::parse {-opt 1 b} withdef -opt val1]
set docid [dict get $argd id]
set vals [dict get $argd values]
set result $vals
}\
-cleanup {
punk::args::undefine $docid 1
}\
-result [list\
val1 b
]
test parse_withdef_option_ordering_defaults {Test ordering of options when some have defaults}\
test parse_withdef_option_ordering_defaults {Test ordering of options when some have defaults}\
-setup $common -body {
-setup $common -body {
#for consistency with leaders and values dicts - try to maintain definition order for options too
#for consistency with leaders and values dicts - try to maintain definition order for options too
# we re-use the argument definition from punk::args::standard_about and override some items
set overrides [dict create]
dict set overrides @id -id "::test::punk::lib::about"
dict set overrides @cmd -name "test::punk::lib::about"
dict set overrides @cmd -help [string trim [punk::args::lib::tstr {
About test::punk::lib
}] \n]
dict set overrides topic -choices [list {*}[test::punk::lib::argdoc::about_topics] *]
dict set overrides topic -choicerestricted 1
dict set overrides topic -default [test::punk::lib::argdoc::default_topics] ;#if -default is present 'topic' will always appear in parsed 'values' dict
set newdef [punk::args::resolved_def -antiglobs -package_about_namespace -override $overrides ::punk::args::package::standard_about *]
lappend PUNKARGS [list $newdef]
proc about {args} {
package require punk::args
#standard_about accepts additional choices for topic - but we need to normalize any abbreviations to full topic name before passing on
set argd [punk::args::parse $args withid ::test::punk::lib::about]
