From 251f07aa6359554a7d03b07360a7465f62fb78b8 Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Sun, 30 Nov 2025 01:25:35 +1100 Subject: [PATCH] punk::lib indexset change api, minor doc fix, punk::imap4 fix --- .../args/moduledoc/tclcore-999999.0a1.0.tm | 2 +- src/modules/punk/imap4-999999.0a1.0.tm | 12 +- src/modules/punk/imap4-buildversion.txt | 2 +- src/modules/punk/lib-999999.0a1.0.tm | 389 ++++++++++++++---- 4 files changed, 330 insertions(+), 75 deletions(-) diff --git a/src/modules/punk/args/moduledoc/tclcore-999999.0a1.0.tm b/src/modules/punk/args/moduledoc/tclcore-999999.0a1.0.tm index aaddd39a..c282e62b 100644 --- a/src/modules/punk/args/moduledoc/tclcore-999999.0a1.0.tm +++ b/src/modules/punk/args/moduledoc/tclcore-999999.0a1.0.tm @@ -8316,7 +8316,7 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { 4. If the end of the input string is reached before any conversions have been performed and no variables are given, an empty string is returned. } - @values -min 1 -max 2 + @values -min 2 -max 3 string -type string format -type string varName -type string -optional 1 -multiple 1 diff --git a/src/modules/punk/imap4-999999.0a1.0.tm b/src/modules/punk/imap4-999999.0a1.0.tm index 7bc6bb3e..8ef1ccd1 100644 --- a/src/modules/punk/imap4-999999.0a1.0.tm +++ b/src/modules/punk/imap4-999999.0a1.0.tm @@ -3311,7 +3311,11 @@ tcl::namespace::eval punk::imap4 { punk::imap4::proto::debugmode_info $chan set prev_stdin_conf [chan configure stdin] - chan configure stdin -blocking 1 -inputmode normal + chan configure stdin -blocking 1 + # -inputmode not available in tcl 8.6 + catch { + chan configure -inputmode normal + } set last_request_tag * try { @@ -3360,7 +3364,11 @@ tcl::namespace::eval punk::imap4 { } finally { set debugmode 0 dict set coninfo $chan debugmode $prev_chan_debug ;#restore channel debug flag - chan configure stdin -blocking [dict get $prev_stdin_conf -blocking] -inputmode [dict get $prev_stdin_conf -inputmode] + chan configure stdin -blocking [dict get $prev_stdin_conf -blocking] + if {[dict exists $prev_stdin_conf -inputmode]} { + #-inputmode not present in tcl 8.6 + chan configure stdin -inputmode [dict get $prev_stdin_conf -inputmode] + } } } diff --git a/src/modules/punk/imap4-buildversion.txt b/src/modules/punk/imap4-buildversion.txt index 329cdfff..f854e23e 100644 --- a/src/modules/punk/imap4-buildversion.txt +++ b/src/modules/punk/imap4-buildversion.txt @@ -1,3 +1,3 @@ -0.9 +0.9.1 #First line must be a semantic version number #all other lines are ignored. diff --git a/src/modules/punk/lib-999999.0a1.0.tm b/src/modules/punk/lib-999999.0a1.0.tm index 96358f98..dca9ae3b 100644 --- a/src/modules/punk/lib-999999.0a1.0.tm +++ b/src/modules/punk/lib-999999.0a1.0.tm @@ -174,6 +174,18 @@ tcl::namespace::eval punk::lib::check { set description "lsearch -stride with -subindices -inline -all and single index - incorrect results." return [dict create bug $bug bugref 5a1aaa201d description $description level major] } + proc has_tclbug_lseq_sign {} { + #https://core.tcl-lang.org/tcl/tktview/999b6966b2 + if {[catch {lseq 1 10}]} { + set bug 0 + } else { + set r1 [lseq 1 10 -9] + set r2 [lseq 1 10 -10] + set bug [expr {$r1 ne $r2}] + } + set description "lseq step sign not matching sequence direction - inconsistent results." + return [dict create bug $bug bugref 999b6966b2 description $description level minor] + } proc has_tclbug_list_quoting_emptyjoin {} { #https://core.tcl-lang.org/tcl/tktview/e38dce74e2 @@ -827,23 +839,67 @@ namespace eval punk::lib { #tcl 8.7+ lseq significantly faster, especially for larger ranges #The internal rep can be an 'arithseries' with no string representation #support minimal set from to - proc range {from to} { - lseq $from $to + proc range {from to {by 1}} { + #note inconsistency with lseq 1 10 by -9 vs lseq 1 10 by -10 + #https://core.tcl-lang.org/tcl/tktview/999b6966b2 + lseq $from $to by $by } } else { #lseq accepts basic expressions e.g 4-2 for both arguments #e.g we can do lseq 0 [llength $list]-1 #if range is to be consistent with the lseq version above - it should support that, even though we don't support most lseq functionality in either wrapper. - proc range {from to} { + #our range function doesn't support double like lseq does. (deliberate) review + proc range {from to {by ""}} { + if {$by eq "0"} { + #as per lseq, step (by) zero always gives no result + return [list] + } set to [offset_expr $to] set from [offset_expr $from] + if {$by ne ""} { + set by [offset_expr $by] + } + #assert $by is now empty string or an integer if {$to > $from} { - set count [expr {($to -$from) + 1}] - if {$from == 0} { - return [lsearch -all [lrepeat $count 0] *] - } else { - incr from -1 - return [lmap v [lrepeat $count 0] {incr from}] + switch -- $by { + "" - 1 { + set count [expr {($to -$from) + 1}] + if {$from == 0} { + return [lsearch -all [lrepeat $count 0] *] + } else { + incr from -1 + return [lmap v [lrepeat $count 0] {incr from}] + } + } + default { + set count [expr {($to - $from + $by) / $by}] + if {$count <= 0} { + #return [list] + #https://core.tcl-lang.org/tcl/tktview/999b6966b2 + return [list $from] ;#review + } + set result [list] + for {set i $from} {$i <= $to} {incr i $by} { + lappend result $i + } + return $result + + #if we don't have lseq, we probably don't have lsearch -stride, which would make things simpler. + #set count [expr {($to -$from) + 1}] + #if {$from == 0} { + # set fullrange [lsearch -all [lrepeat $count 0] *] + #} else { + # incr from -1 + # set fullrange [lmap v [lrepeat $count 0] {incr from}] + #} + #set result [list] + #for {set i 0} {$i < $count} {incr i} { + # if {$i % $by == 0} { + # lappend result [lindex $fullrange $i] + # } + #} + #return $result + } } #slower methods. #2) @@ -858,13 +914,28 @@ namespace eval punk::lib { #} #return $L } elseif {$from > $to} { - set count [expr {$from - $to} + 1] - #1) - if {$to == 0} { - return [lreverse [lsearch -all [lrepeat $count 0] *]] - } else { - incr from - return [lmap v [lrepeat $count 0] {incr from -1}] + switch -- $by { + "" - -1 { + set count [expr {$from - $to} + 1] + if {$to == 0} { + return [lreverse [lsearch -all [lrepeat $count 0] *]] + } else { + incr from + return [lmap v [lrepeat $count 0] {incr from -1}] + } + } + default { + set count [expr {($to - $from + $by) / $by}] + if {$count <= 0} { + #return [list] + return [list $from] ;#review + } + set result [list] + for {set i $from} {$i >= $to} {incr i $by} { + lappend result $i + } + return $result + } } #2) @@ -2468,7 +2539,7 @@ namespace eval punk::lib { #supports *safe* ultra basic offset expressions as used by lindex etc, but without the 'end' features #safe in that we don't evaluate the expression as a string. proc offset_expr {expression} { - set expression [tcl::string::map {_ {}} $expression] + set expression [tcl::string::map {_ {}} $expression] ;#review - this is for 8.6 to understand underscored ints if {[tcl::string::is integer -strict $expression]} { return [expr {$expression}] } @@ -2531,22 +2602,35 @@ namespace eval punk::lib { if {$rposn >= 0} { set sepsize 2 set step 1 - } else { + #review - whitespace between ints? + lappend validateindices {*}[string range $r 0 $rposn-1] {*}[string range $r $rposn+2 end] + } elseif {[string first . $r] >= 0} { + set stripped [string map {. ""} $r] + if {[tcl::string::length $stripped] != [tcl::string::length $r]-2} { + #if one dot exists - must be exactly 2 dots in total - possibly separated by positive/negative int (not zero) + return 0 + } + #assert - we have exactly 2 dots separated by something. #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]} { - } - } + #1.0.10 should be valid but behave similarly to lseq 1 0 by 0 ie returns nothing - if {$rposn >= 0} { - lappend validateindices {*}[string range $r 0 $rposn-1] {*}[string range $r $rposn+2 end] + #1.end.10 or similar shouldn't be valid - but we need to allow other basic index expressions. + if {[string match *end* $step] || [catch {lindex {} $step}]} { + return 0 + } + #if {![string is integer -strict $step] || $step == 0} { + # return 0 + #} + lappend validateindices {*}[string range $r 0 $fdot-1] {*}[string range $r $ldot+1 end] } else { #'range' is just an index set validateindices [list $r] } + foreach v $validateindices { if {$v eq "" || $v eq "end"} {continue} if {[string is integer -strict $v]} {continue} @@ -2558,6 +2642,7 @@ namespace eval punk::lib { return 1 } #review - compare to IMAP4 methods of specifying ranges? + #TODO add tests to test::punk::lib indexset_resolve is a little tricky punk::args::define { @id -id ::punk::lib::indexset_resolve @cmd -name punk::lib::indexset_resolve\ @@ -2568,13 +2653,44 @@ namespace eval punk::lib { e.g in a basic case: for a list of 10 items, 'indexset_resolve 10 end' will return the index 9 An indexset consists of a comma delimited list of indexes or index-ranges. - Ranges must be specified with .. as the separator, with an empty value at either side of the - separator representing beginning and end of the index range respectively. + Ranges must be specified with a range-indicator such as .. as the separator, with an empty value at + either side of the separator representing beginning and end of the index range respectively. + The range-separator can be of the form .x. where x is an integer or basic expression + (single +/- operation) that indicates the step value to use. This is equivalent to the 'by' value + in the tcl9 lseq command. + + When the start index is lower than the end, the step value defaults to 1. + ie indexset_resolve 0..7 is equivalent to indexset_resolve 0.1.7 + When the start index is higher than the end, the step value defaults to -1. + ie indexset_resolve 7..0 is equivalent to indexset_resolve 0.-1.7 + + If start and end are ommitted, increasing order is assumed if the step isn't specified. + eg + .. represents the range from the base to the end + .-1. would represent end to base with step -1 + + If start is omitted and only the end is supplied: + The default step is 1 indicating ascension and the missing end is equivalent to 'end' + indexset_resolve 5 2.. + -> 2 3 4 + The default end is the base if the step is negative + indexset_resolve 5 2.-1. + -> 2 1 0 + If end is omitted and onlthe start is supplied: + The default step is 1 indicating ascension and the missing start is equivalent to the base. + indexset_resolve 5 ..2 + -> 0 1 2 + The default start is 'end' if the step is negative + indexset_resolve 5 .-1.2 + -> 4 3 2 + + + Like the tcl9 lseq command - a step (by) value of zero produces no results. The indexes are 0-based by default, but the base can be specified. indexset_resolve 7 .. -> 0 1 2 3 4 5 6 - indexset_resolve 7 .. -3 + indexset_resolve -base -3 7 .. -> -3 -2 -1 0 1 2 3 Whitespace is ignored. @@ -2599,10 +2715,9 @@ namespace eval punk::lib { output the first 3 indices, and the last index. end-1..0 output the indexes in reverse order from 2nd last item to first item." - @values -min 2 -max 3 - numitems -type integer - indexset -type indexset -help "comma delimited specification for indices to return" - base -type integer -default 0 -help\ + @leaders -min 0 -max 0 + @opts + -base -type integer -prefix 1 -default 0 -help\ "This is the starting index. It can be positive, negative or zero. This affects the start and end calculations, limiting what indices will be returned. @@ -2613,73 +2728,175 @@ namespace eval punk::lib { For base 1, index 0 is considered to be below the range. ie - indexset_resolve 10 0..3 1 + indexset_resolve -base 1 10 0..3 -> 1 2 3 - indexset_resolve 10 0..3 0 + indexset_resolve -base 0 10 0..3 -> 0 1 2 3 - It does not *convert* integers within the range. + It does not *convert* indexes within the range. - indexset_resolve 10 5 1 + indexset_resolve -base 1 10 5 -> 5 - indexset_resolve 10 5 0 + indexset_resolve -base 0 10 5 -> 5 - ie if you ask for a 1 based indexset the integers that are within the - range will come out the same, so the result needs to be treated as a - 1-based set of indices when performing further operations. + ie if you ask for a 1-based resolution of an indexset the integers that are within + the range will come out the same, so the result needs to be treated as a 1-based + set of indices when performing further operations. " + @values -min 2 -max 3 + numitems -type integer + indexset -type indexset -help "comma delimited specification for indices to return" } - proc indexset_resolve {numitems indexset {base 0}} { + + #limit punk::args parsing to unhappy paths where possible + proc indexset_resolve {args} { + # -------------------------------------------------- + # Manual parsing of happy path args instead of using punk::args::parse $args withid ::punk::lib::indexset_resolve + # This is because indexset_resolve is *somewhat* low level, has only a few args, and we don't want any overhead. + # for the unhappy path - the punk::args::parse is fine to generate the usage/error information. + # -------------------------------------------------- + if {[llength $args] < 2} { + punk::args::resolve $args withid ::punk::lib::indexset_resolve + } + set indexset [lindex $args end] + set numitems [lindex $args end-1] if {![string is integer -strict $numitems] || ![is_indexset $indexset]} { #use parser on unhappy path only set errmsg [punk::args::usage -scheme error ::punk::lib::indexset_resolve] uplevel 1 [list return -code error -errorcode {TCL WRONGARGS PUNK} $errmsg] } + #assert we have 2 or more args + set base 0 ;#default + if {[llength $args] > 2} { + #if more than just numitems and indexset - we expect only -base ie 4 args in total + if {[llength $args] != 4} { + set errmsg [punk::args::usage -scheme error ::punk::lib::indexset_resolve] + uplevel 1 [list return -code error -errorcode {TCL WRONGARGS PUNK} $errmsg] + } + set optname [lindex $args 0] + set optval [lindex $args 1] + set fulloptname [tcl::prefix::match -error "" -base $optname] + if {$fulloptname ne "-base" || ![string is integer -strict $optval]} { + set errmsg [punk::args::usage -scheme error ::punk::lib::indexset_resolve] + uplevel 1 [list return -code error -errorcode {TCL WRONGARGS PUNK} $errmsg] + } + set base $optval + } + # -------------------------------------------------- + + set indexset [string map [list " " "" \t "" \r\n "" \n ""] $indexset] ;#collapse basic whitespace set index_list [list] ;#list of actual indexes within the range set iparts [split $indexset ,] set based_max [expr {$numitems -1 + $base}] + #we already did is_indexset check above, so we can make assumptions about well-formedness of each part foreach ipart $iparts { set ipart [string trim $ipart] - set rposn [string first .. $ipart] + #we need to cater for n..m as well as n.s.m where s is 'step' + set rposn [string first . $ipart] if {$rposn>=0} { - #range - lassign [punk::lib::string_splitbefore_indices $ipart $rposn $rposn+2] rawa _ rawb - set rawa [string trim $rawa] - set rawb [string trim $rawb] - if {$rawa eq ""} {set rawa $base} - set a [punk::lib::lindex_resolve $numitems $rawa $base] - if {$a == -Inf} { - #(was -3) - #undershot - leave negative - } elseif {$a == Inf} { - #overshot - set a [expr {$based_max + 1}] ;#put it outside the range on the upper side + #if we found one dot - there must be exactly 2 dots in the ipart, separated by nothing, or a basic integer-expression + set rposn2 [string last . $ipart] + if {$rposn2 == $rposn+1} { + #.. + set step "default" ;#could be 1 or -1 + } else { + set step [tcl::string::range $ipart $rposn+1 $rposn2-1] } - #review - a may be -Inf + lassign [punk::lib::string_splitbefore_indices $ipart $rposn $rposn2+1] rawa _ rawb - if {$rawb eq ""} { - if {$a > $based_max} { - set rawb $a ;#make sure .. doesn't return last item - should return nothing + set rawa [string trim $rawa] + set rawb [string trim $rawb] + if {$rawa eq "" && $rawb eq ""} { + if {$step eq "default"} { + set step 1 ;#default ascending when no start and no end + } + if {$step < 0} { + set rawa end + set rawb $base } else { + set rawa $base set rawb end } - } - set b [punk::lib::lindex_resolve $numitems $rawb $base] - if {$b == -Inf} { - #undershot - leave negative - } elseif {$b == Inf} { - #set b [expr {$numitems}] ;#overshot - put it outside the range on the upper side - set b [expr {$based_max + 1}] ;#overshot - put it outside the range on the upper side + #if neither start nor end specified - we won't get out of range results from lindex_resolve + set a [punk::lib::lindex_resolve $numitems $rawa $base] + set b [punk::lib::lindex_resolve $numitems $rawb $base] + } else { + if {$rawa eq ""} { + if {$step eq "default"} { + #when start not specified, but end is - default direction always ascending + #(even if end is base or below range) + set step 1 + } + if {$step < 0} { + set rawa end + } else { + set rawa $base + } + } + set a [punk::lib::lindex_resolve $numitems $rawa $base] + if {$a == -Inf} { + #undershot - leave negative + } elseif {$a == Inf} { + #overshot + set a [expr {$based_max + 1}] ;#put it outside the range on the upper side + } + #review - a may be -Inf + + if {$rawb eq ""} { + if {$step eq "default"} { + set step 1 + } + if {$step < 0} { + if {$a < $base} { + #make sure both + #mathfunc::isinf is tcl9+ + if {[catch { + if {[::tcl::mathfunc::isinf $a]} { + set a [expr {$base -1}] + } + }]} { + if {[string match -nocase *inf* $a]} { + set a [expr {$base -1}] + } + } + set rawb $a + } else { + set rawb $base + } + } else { + if {$a > $based_max} { + set rawb $a ;#make sure .. doesn't return last item - should return nothing + } else { + set rawb end + } + } + } + set b [punk::lib::lindex_resolve $numitems $rawb $base] + if {$b == -Inf} { + #undershot - leave negative + } elseif {$b == Inf} { + #set b [expr {$numitems}] ;#overshot - put it outside the range on the upper side + set b [expr {$based_max + 1}] ;#overshot - put it outside the range on the upper side + } } #JJJ #e.g make sure .. doesn't return last item - should return nothing as both are above the range. if {$a >= $base && $a <= $based_max && $b >=$base && $b <= $based_max} { - lappend index_list {*}[punk::lib::range $a $b] ;#required for tcl8.6, on tcl9 this will call lseq internally. + #assert a & b are integers within the range + if {$step eq "default"} { + #unspecified step - base direction on order of a & b + if {$a <= $b} { + set step 1 + } else { + set step -1 + } + } + lappend index_list {*}[punk::lib::range $a $b $step] ;#required for tcl8.6, on tcl9 this will call lseq internally. } else { if {$a >= $base && $a <= $based_max} { #only a is in the range @@ -2688,27 +2905,57 @@ namespace eval punk::lib { } else { set b $based_max } - lappend index_list {*}[punk::lib::range $a $b] ;#required for tcl8.6, on tcl9 this will call lseq internally. + if {$step eq "default"} { + if {$a <= $b} { + set step 1 + } else { + set step -1 + } + } + lappend index_list {*}[punk::lib::range $a $b $step] ;#required for tcl8.6, on tcl9 this will call lseq internally. } elseif {$b >=$base && $b <= $based_max} { #only b is in the range - if {$a < $base} { - set a $base + if {$step eq "default"} { + if {$a <= $b} { + set step 1 + } else { + set step -1 + } + } + if {$step < 0} { + if {$a < $base} { + #negative step from below - doesn't matter if b is in range - recast both to an int below $base + #(a may be -Inf) + set a [expr {$base -1}] + set b $a + set step 0 ;#we should return nothing + } } else { - set a $based_max + if {$a < $base} { + set a $base + } else { + set a $based_max + } } - lappend index_list {*}[punk::lib::range $a $b] ;#required for tcl8.6, on tcl9 this will call lseq internally. + lappend index_list {*}[punk::lib::range $a $b $step] ;#required for tcl8.6, on tcl9 this will call lseq internally. } else { #both outside the range if {$a < $base && $b > $base} { #spans the range in forward order set a $base set b $based_max - lappend index_list {*}[punk::lib::range $a $b] ;#required for tcl8.6, on tcl9 this will call lseq internally. + if {$step eq "default"} { + set step 1 + } + lappend index_list {*}[punk::lib::range $a $b $step] ;#required for tcl8.6, on tcl9 this will call lseq internally. } elseif {$a > $base && $b < $base} { #spans the range in reverse order set a $based_max set b $base - lappend index_list {*}[punk::lib::range $a $b] ;#required for tcl8.6, on tcl9 this will call lseq internally. + if {$step eq "default"} { + set step -1 + } + lappend index_list {*}[punk::lib::range $a $b $step] ;#required for tcl8.6, on tcl9 this will call lseq internally. } #both outside of range on same side }