jn
/
punkshell
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

bootsupport,vfs,project_layout catch up with module changess

master
Julian Noble 2 months ago
parent
251f07aa63
commit
d6d70a19ce
22 changed files with 18751 additions and 332 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 2
      src/bootsupport/modules/punk/args/moduledoc/tclcore-0.1.0.tm
  2. 389
      src/bootsupport/modules/punk/lib-0.1.5.tm
  3. 2
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args/moduledoc/tclcore-0.1.0.tm
  4. 389
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/lib-0.1.5.tm
  5. 8
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/libunknown-0.1.tm
  6. 9
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repl-0.1.2.tm
  7. 2
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args/moduledoc/tclcore-0.1.0.tm
  8. 389
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/lib-0.1.5.tm
  9. 8
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/libunknown-0.1.tm
  10. 9
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repl-0.1.2.tm
  11. 1
      src/vfs/_vfscommon.vfs/modules/punk/args-0.2.1.tm
  12. 2
      src/vfs/_vfscommon.vfs/modules/punk/args/moduledoc/tclcore-0.1.0.tm
  13. 28
      src/vfs/_vfscommon.vfs/modules/punk/console-0.1.1.tm
  14. 4444
      src/vfs/_vfscommon.vfs/modules/punk/imap4-0.9.1.tm
  15. 389
      src/vfs/_vfscommon.vfs/modules/punk/lib-0.1.5.tm
  16. 8
      src/vfs/_vfscommon.vfs/modules/punk/libunknown-0.1.tm
  17. 3271
      src/vfs/_vfscommon.vfs/modules/punk/netbox-0.1.1.tm
  18. 147
      src/vfs/_vfscommon.vfs/modules/punk/netbox/man-0.1.0.tm
  19. 11
      src/vfs/_vfscommon.vfs/modules/punk/repl-0.1.2.tm
  20. 28
      src/vfs/_vfscommon.vfs/modules/shellfilter-0.2.1.tm
  21. 58
      src/vfs/_vfscommon.vfs/modules/shellthread-1.6.2.tm
  22. 9489
      src/vfs/_vfscommon.vfs/modules/tomlish-1.1.8.tm

2
src/bootsupport/modules/punk/args/moduledoc/tclcore-0.1.0.tm
Unescape View File

@ -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

389
src/bootsupport/modules/punk/lib-0.1.5.tm
Unescape View File

@ -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 <int> 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 <overshot>.. 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 <undershot>
#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 <overshot>.. 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 <overshot>.. 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
}

2
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args/moduledoc/tclcore-0.1.0.tm
Unescape View File

@ -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

389
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/lib-0.1.5.tm
Unescape View File

@ -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 <int> 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 <overshot>.. 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 <undershot>
#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 <overshot>.. 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 <overshot>.. 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
}

8
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/libunknown-0.1.tm
Unescape View File

@ -62,7 +62,7 @@ package require Tcl 8.6-
tcl::namespace::eval punk::libunknown {
tcl::namespace::eval ::punk::libunknown {
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# Base namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
@ -1576,7 +1576,7 @@ tcl::namespace::eval punk::libunknown {
}
# == === === === === === === === === === === === === === ===
namespace eval punk::libunknown {
namespace eval ::punk::libunknown {
#for 8.6 compat
if {"::ledit" ni [info commands ::ledit]} {
#maint: taken from punk::lib
@ -1702,7 +1702,7 @@ namespace eval punk::libunknown {
}
}
tcl::namespace::eval punk::libunknown::lib {
tcl::namespace::eval ::punk::libunknown::lib {
#A version of textutil::string::longestCommonPrefixList
#(also as ::punk::lib::longestCommonPrefixList)
@ -1788,7 +1788,7 @@ namespace eval ::punk::args::register {
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Ready
package provide punk::libunknown [tcl::namespace::eval punk::libunknown {
package provide punk::libunknown [tcl::namespace::eval ::punk::libunknown {
variable pkg punk::libunknown
variable version
set version 0.1

9
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repl-0.1.2.tm
Unescape View File

@ -52,7 +52,10 @@ if {[package provide punk::libunknown] eq ""} {
if {$libunknown ne ""} {
uplevel 1 [list source $libunknown]
if {[catch {punk::libunknown::init -caller triggered_by_repl_package_require} errM]} {
puts "error initialising punk::libunknown\n$errM"
puts stderr "error initialising punk::libunknown during punk::repl package load of script [info script]"
puts stderr "sourcing from: $libunknown"
puts stderr "tcl::tm::list: [tcl::tm::list]"
puts stderr $errM
}
}
}}
@ -3593,7 +3596,9 @@ namespace eval repl {
if {$libunknown ne ""} {
uplevel 1 [list ::source $libunknown]
if {[catch {punk::libunknown::init -caller "repl::init init_script code interp for punk"} errM]} {
puts "error initialising punk::libunknown\n$errM"
puts stderr "error initialising punk::libunknown\n from: '$libunknown'"
puts stderr "tcl::tm::list: [tcl::tm::list]"
puts stderr "error: $errM"
}
}
}}

2
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args/moduledoc/tclcore-0.1.0.tm
Unescape View File

@ -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

389
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/lib-0.1.5.tm
Unescape View File

@ -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 <int> 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 <overshot>.. 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 <undershot>
#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 <overshot>.. 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 <overshot>.. 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
}

8
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/libunknown-0.1.tm
Unescape View File

@ -62,7 +62,7 @@ package require Tcl 8.6-
tcl::namespace::eval punk::libunknown {
tcl::namespace::eval ::punk::libunknown {
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# Base namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
@ -1576,7 +1576,7 @@ tcl::namespace::eval punk::libunknown {
}
# == === === === === === === === === === === === === === ===
namespace eval punk::libunknown {
namespace eval ::punk::libunknown {
#for 8.6 compat
if {"::ledit" ni [info commands ::ledit]} {
#maint: taken from punk::lib
@ -1702,7 +1702,7 @@ namespace eval punk::libunknown {
}
}
tcl::namespace::eval punk::libunknown::lib {
tcl::namespace::eval ::punk::libunknown::lib {
#A version of textutil::string::longestCommonPrefixList
#(also as ::punk::lib::longestCommonPrefixList)
@ -1788,7 +1788,7 @@ namespace eval ::punk::args::register {
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Ready
package provide punk::libunknown [tcl::namespace::eval punk::libunknown {
package provide punk::libunknown [tcl::namespace::eval ::punk::libunknown {
variable pkg punk::libunknown
variable version
set version 0.1

9
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repl-0.1.2.tm
Unescape View File

@ -52,7 +52,10 @@ if {[package provide punk::libunknown] eq ""} {
if {$libunknown ne ""} {
uplevel 1 [list source $libunknown]
if {[catch {punk::libunknown::init -caller triggered_by_repl_package_require} errM]} {
puts "error initialising punk::libunknown\n$errM"
puts stderr "error initialising punk::libunknown during punk::repl package load of script [info script]"
puts stderr "sourcing from: $libunknown"
puts stderr "tcl::tm::list: [tcl::tm::list]"
puts stderr $errM
}
}
}}
@ -3593,7 +3596,9 @@ namespace eval repl {
if {$libunknown ne ""} {
uplevel 1 [list ::source $libunknown]
if {[catch {punk::libunknown::init -caller "repl::init init_script code interp for punk"} errM]} {
puts "error initialising punk::libunknown\n$errM"
puts stderr "error initialising punk::libunknown\n from: '$libunknown'"
puts stderr "tcl::tm::list: [tcl::tm::list]"
puts stderr "error: $errM"
}
}
}}

1
src/vfs/_vfscommon.vfs/modules/punk/args-0.2.1.tm
Unescape View File

@ -4897,7 +4897,6 @@ tcl::namespace::eval punk::args {
lappend PUNKARGS [list {
@dynamic
@id -id ::punk::args::usage
@cmd -name punk::args::usage -help\
"Return usage information for a command identified by an id.

2
src/vfs/_vfscommon.vfs/modules/punk/args/moduledoc/tclcore-0.1.0.tm
Unescape View File

@ -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

28
src/vfs/_vfscommon.vfs/modules/punk/console-0.1.1.tm
Unescape View File

@ -515,8 +515,18 @@ namespace eval punk::console {
}
}
exec {*}$sttycmd raw -echo <@$channel
tsv::set console is_raw 1
#REVIEW
switch $channel {
stdin {
exec {*}$sttycmd -icanon -echo -isig
}
default {
exec {*}$sttycmd raw -echo <@$channel
}
}
catch {
tsv::set console is_raw 1
}
return [dict create previous [set previous_stty_state_$channel]]
}
proc disableRaw {{channel stdin}} {
@ -529,8 +539,18 @@ namespace eval punk::console {
tsv::set console is_raw 0
return restored
}
exec {*}$sttycmd -raw echo <@$channel
tsv::set console is_raw 0
#REVIEW
switch $channel {
stdin {
exec {*}$sttycmd icanon echo isig
}
default {
exec {*}$sttycmd -raw echo <@$channel
}
}
catch {
tsv::set console is_raw 0
}
return done
}
}

4444
src/vfs/_vfscommon.vfs/modules/punk/imap4-0.9.1.tm
View File

File diff suppressed because it is too large Load Diff

389
src/vfs/_vfscommon.vfs/modules/punk/lib-0.1.5.tm
Unescape View File

@ -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 <int> 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 <overshot>.. 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 <undershot>
#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 <overshot>.. 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 <overshot>.. 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
}

8
src/vfs/_vfscommon.vfs/modules/punk/libunknown-0.1.tm
Unescape View File

@ -62,7 +62,7 @@ package require Tcl 8.6-
tcl::namespace::eval punk::libunknown {
tcl::namespace::eval ::punk::libunknown {
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# Base namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
@ -1576,7 +1576,7 @@ tcl::namespace::eval punk::libunknown {
}
# == === === === === === === === === === === === === === ===
namespace eval punk::libunknown {
namespace eval ::punk::libunknown {
#for 8.6 compat
if {"::ledit" ni [info commands ::ledit]} {
#maint: taken from punk::lib
@ -1702,7 +1702,7 @@ namespace eval punk::libunknown {
}
}
tcl::namespace::eval punk::libunknown::lib {
tcl::namespace::eval ::punk::libunknown::lib {
#A version of textutil::string::longestCommonPrefixList
#(also as ::punk::lib::longestCommonPrefixList)
@ -1788,7 +1788,7 @@ namespace eval ::punk::args::register {
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Ready
package provide punk::libunknown [tcl::namespace::eval punk::libunknown {
package provide punk::libunknown [tcl::namespace::eval ::punk::libunknown {
variable pkg punk::libunknown
variable version
set version 0.1

3271
src/vfs/_vfscommon.vfs/modules/punk/netbox-0.1.1.tm
View File

File diff suppressed because it is too large Load Diff

147
src/vfs/_vfscommon.vfs/modules/punk/netbox/man-0.1.0.tm
Unescape View File

@ -133,6 +133,151 @@ tcl::namespace::eval punk::netbox::man {
}
}
tcl::namespace::eval punk::netbox::man::dcim {
namespace export {[a-z]*}
namespace ensemble create -parameters {apicontextid}
tcl::namespace::eval devices {
namespace export {[a-z]*}
namespace ensemble create -parameters {apicontextid}
variable PUNKARGS
namespace eval argdoc {
variable PUNKARGS
#mark as @dynamic and ensure double-substitution present for dynamic parts
set DYN_CONTEXTNAMES {${[punk::netbox::api_context_names]}}
lappend PUNKARGS [::list\
{@dynamic}\
[punk::args::resolved_def\
-antiglobs {@leaders @values -RETURN}\
-override {
@id {-id ::punk::netbox::man::dcim::devices::list }
apicontextid {-choices {${$DYN_CONTEXTNAMES}} }
}\
::punk::netbox::dcim::devices_list\
]\
{-RETURN -default table -choices {table tableobject list}}\
{-MAXRESULTS -type integer -default -1}\
{@values -min 0 -max 0}\
]
}
#caution: must use ::list to avoid loop
proc list {args} {
set argd [punk::args::parse $args withid "::punk::netbox::man::dcim::devices::list"]
set urlnext ""
set requests_allowed 1000 ;#review
set resultlist [::list]
set token [dict get $argd leaders apicontextid]
set opts [dict get $argd opts]
set vals [dict get $argd values]
set multis [dict get $argd multis]
set maxresults [dict get $opts -MAXRESULTS]
set initial_pagelimit [dict get $opts -limit]
set opts [dict remove $opts -MAXRESULTS]
set outer_return [dict get $opts -RETURN]
set opts [dict remove $opts -RETURN] ;#opts from punk::args::parse is a dict (no dup keys) - can use 'dict remove' safely
#we can't just pass through 'multi' opts even if only one was supplied - list level is wrong
set nextopts [::list]
dict for {opt val} $opts {
if {$opt ni $multis} {
lappend nextopts $opt $val
} else {
foreach v $val {
lappend nextopts $opt $v
}
}
}
#Now opts is a list with possible repeated options! (for flags that have -multiple true)
if {$maxresults == -1} {
set maxresults $initial_pagelimit
}
if {$maxresults < $initial_pagelimit} {
punk::netbox::man::system::dupkeylist_setfirst nextopts -limit $maxresults
}
set to_go [expr {$maxresults - [llength $resultlist]}]
while {$urlnext ne "null"} {
if {$urlnext ne ""} {
set urlnext_params [punk::netbox::man::system::uri_get_querystring_as_keyval_list $urlnext]
if {[punk::netbox::man::system::dupkeylist_getfirst $nextopts -limit] > $to_go} {
punk::netbox::man::system::dupkeylist_setfirst urlnext_params limit $to_go
}
#sync to -limit,-offset from the url's limit, offset values
punk::netbox::man::system::optionlistvar_sync_from_urlparams nextopts $urlnext_params
}
puts "-->next:$urlnext nextopts:$nextopts vals:$vals"
set resultd [punk::netbox::dcim::devices_list $token {*}$nextopts -RETURN dict {*}$vals]
set urlnext [dict get $resultd next]
set batch [dict get $resultd results]
lappend resultlist {*}$batch
set to_go [expr {$maxresults - [llength $resultlist]}]
if {$to_go <= 0} {break}
incr requests_allowed -1
if {$requests_allowed < 1} {break}
}
if {$outer_return in {table tableobject}} {
package require textblock
set t [textblock::list_as_table -return tableobject -colheaders {id device cluster primary_ip tenant site platform status comments}]
foreach dev $resultlist {
if {[dict exists $dev cluster id]} {
set cluster "[dict get $dev cluster id]: [dict get $dev cluster name]"
} else {
set cluster [dict get $dev cluster]
}
if {[dict exists $dev primary_ip id]} {
set primary_ip "[dict get $dev primary_ip id]: [dict get $dev primary_ip address]"
} else {
set primary_ip [dict get $dev primary_ip]
}
if {[dict exists $dev tenant id]} {
set tenant "[dict get $dev tenant id]: [dict get $dev tenant slug]"
} else {
set tenant [dict get $dev tenant] ;#probably null
}
if {[dict exists $dev site id]} {
set site "[dict get $dev site id]: [dict get $dev site name]"
} else {
set site [dict get $dev site] ;#probably null
}
if {[dict exists $dev platform id]} {
set platform "[dict get $dev platform id]: [dict get $dev platform name]"
} else {
set platform [dict get $dev platform] ;#probably null
}
set r [::list\
[dict get $dev id]\
[dict get $dev name]\
$cluster\
$primary_ip\
$tenant\
$site\
$platform\
[dict get $dev status value]\
[dict get $dev comments]\
]
$t add_row $r
}
}
switch -- $outer_return {
table {
set result [$t print]
$t destroy
return $result
}
tableobject {
return $t
}
}
return $resultlist
#return [showdict $resultd]
}
}
}
tcl::namespace::eval punk::netbox::man::prefixes {
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
@ -1549,6 +1694,8 @@ namespace eval ::punk::args::register {
::punk::netbox::man::virtualization::virtual-machines\
::punk::netbox::man::extras\
::punk::netbox::man::extras::tags\
::punk::netbox::man::dcim\
::punk::netbox::man::dcim::devices\
}
# -----------------------------------------------------------------------------

11
src/vfs/_vfscommon.vfs/modules/punk/repl-0.1.2.tm
Unescape View File

@ -52,7 +52,10 @@ if {[package provide punk::libunknown] eq ""} {
if {$libunknown ne ""} {
uplevel 1 [list source $libunknown]
if {[catch {punk::libunknown::init -caller triggered_by_repl_package_require} errM]} {
puts "error initialising punk::libunknown\n$errM"
puts stderr "error initialising punk::libunknown during punk::repl package load of script [info script]"
puts stderr "sourcing from: $libunknown"
puts stderr "tcl::tm::list: [tcl::tm::list]"
puts stderr $errM
}
}
}}
@ -2854,7 +2857,7 @@ namespace eval repl {
if {$libunknown ne ""} {
uplevel 1 [list source $libunknown]
if {[catch {punk::libunknown::init -caller "repl::init init_script parent interp"} errM]} {
puts "repl::init problem - error initialising punk::libunknown\n$errM"
puts "repl::init problem - error initialising punk::libunknown\n from '$libunknown'\n err $errM"
}
#package require punk::lib
#puts [punk::libunknown::package_query snit]
@ -3593,7 +3596,9 @@ namespace eval repl {
if {$libunknown ne ""} {
uplevel 1 [list ::source $libunknown]
if {[catch {punk::libunknown::init -caller "repl::init init_script code interp for punk"} errM]} {
puts "error initialising punk::libunknown\n$errM"
puts stderr "error initialising punk::libunknown\n from: '$libunknown'"
puts stderr "tcl::tm::list: [tcl::tm::list]"
puts stderr "error: $errM"
}
}
}}

28
src/vfs/_vfscommon.vfs/modules/shellfilter-0.2.1.tm
Unescape View File

@ -18,16 +18,19 @@ tcl::namespace::eval shellfilter::log {
proc disable {} {
variable is_enabled
set is_enabled 0
proc ::shellfilter::log::open {tag settingsdict} {}
proc ::shellfilter::log::write {tag msg} {}
proc ::shellfilter::log::write_sync {tag msg} {}
proc ::shellfilter::log::close {tag} {}
proc ::shellfilter::log::open {tag settingsdict} {}
proc ::shellfilter::log::write {tag msg} {}
proc ::shellfilter::log::write_sync {tag msg} {}
proc ::shellfilter::log::close {tag} {}
}
proc enable {} {
variable is_enabled
set is_enabled 1
#'tag' is an identifier for the log source.
#(well.. really it's a common *target* of file and/or syslog host:port which can be written to from any thread that uses the tag)
#the terminology here is kinda ratshit.
# each tag will use it's own thread to write to the configured log target
proc ::shellfilter::log::open {tag {settingsdict {}}} {
upvar ::shellfilter::sources sourcelist
@ -43,7 +46,7 @@ tcl::namespace::eval shellfilter::log {
lappend sourcelist $tag
}
#note new_worker
#review new_worker/assign_worker?
set worker_tid [shellthread::manager::new_worker $tag $settingsdict]
#puts stderr "shellfilter::log::open this_threadid: [thread::id] tag: $tag worker_tid: $worker_tid"
return $worker_tid
@ -138,6 +141,7 @@ namespace eval shellfilter::pipe {
chan configure $worker_chan -buffering [dict get $settingsdict -buffering]
chan configure $program_chan -buffering [dict get $settingsdict -buffering]
#review
chan configure $program_chan -blocking 0
chan configure $worker_chan -blocking 0
set worker_tid [shellthread::manager::new_worker $tag_pipename $settingsdict]
@ -1758,7 +1762,7 @@ namespace eval shellfilter::stack {
dict set transform_record -obj $obj
dict set transform_record -note "insert_transform-with-aside"
lappend stack $transform_record
#add back poplist *except* the one we transferred into -aside (if we were able)
# add back poplist *except* the one we transferred into -aside (if we were able)
foreach p [lrange $poplist $put_aside end] {
set t [dict get $p -transform]
set tsettings [dict get $p -settings]
@ -2639,7 +2643,12 @@ namespace eval shellfilter {
::shellfilter::log::write $debugname " waitvar '$waitvar'"
}
lassign [chan pipe] rderr wrerr
chan configure $wrerr -blocking 0
#---------------
#JMN 2025
# e.g cannot run ansible cmdline tools if non-blocking
#chan configure $wrerr -blocking 0
#------------------
set custom_stderr ""
set lastitem [lindex $commandlist end]
@ -2824,7 +2833,8 @@ namespace eval shellfilter {
#chan configure $inchan -buffering none -blocking 1 ;#test
chan configure $inchan -buffering $inbuffering -blocking 0 ;#we are setting up a readable handler for this - so non-blocking ok
#chan configure $inchan -buffering $inbuffering -blocking 0 ;#we are setting up a readable handler for this - so non-blocking ok
chan configure $inchan -buffering $inbuffering
chan configure $errchan -buffering $errbuffering
@ -3176,6 +3186,8 @@ namespace eval shellfilter {
#set newbytes [encoding convertto utf-16 $stringrep]
#puts -nonewline $outchan $newbytes
puts -nonewline $outchan $outchunk
#jmn test 2025
flush $outchan
}
}

58
src/vfs/_vfscommon.vfs/modules/shellthread-1.6.2.tm
Unescape View File

@ -21,6 +21,8 @@ namespace eval shellthread {
namespace eval shellthread::worker {
variable settings
variable settings_defaults
set settings_defaults [list -raw 0 -file "" -syslog "" -direction out] ;#also used for reset when worker returned to free thread list
variable sysloghost_port
variable sock
variable logfile ""
@ -48,6 +50,7 @@ namespace eval shellthread::worker {
variable sysloghost_port
variable logfile
variable settings
variable settings_defaults
interp bgerror {} shellthread::worker::bgerror
#package require overtype ;#overtype uses tcllib textutil, punk::char etc - currently too heavyweight in terms of loading time for use in threads.
variable client_ids
@ -55,8 +58,7 @@ namespace eval shellthread::worker {
lappend client_ids $tidclient
set ts_start_micros $start_m
set defaults [list -raw 0 -file "" -syslog "" -direction out]
set settings [dict merge $defaults $settingsdict]
set settings [dict merge $settings_defaults $settingsdict]
set syslog [dict get $settings -syslog]
if {[string length $syslog]} {
@ -111,7 +113,9 @@ namespace eval shellthread::worker {
error "shellthread::worker::start_pipe_read - inpipe not configured. Use shellthread::manager::set_pipe_read_from_client to thread::transfer the pipe end"
}
set inpipe $readchan
chan configure $readchan -blocking 0
#JMN 2025
#chan configure $readchan -blocking 0
set waitvar ::shellthread::worker::wait($inpipe,[clock micros])
#tcl::chan::fifo2 based pipe seems slower to establish events upon than Memchan
@ -483,13 +487,28 @@ namespace eval shellthread::manager {
}
if {[dict exists $workers $sourcetag]} {
set winfo [dict get $workers $sourcetag]
if {[dict get $winfo tid] ne "noop" && [thread::exists [dict get $winfo tid]]} {
#add our client-info to existing worker thread
dict lappend winfo list_client_tids $tidclient
dict set workers $sourcetag $winfo ;#writeback
return [dict get $winfo tid]
}
set winfo [dict get $workers $sourcetag]
if {[dict get $winfo tid] ne "noop" && [thread::exists [dict get $winfo tid]]} {
# add our client-info to existing worker thread
set existing_settings [get_tag_config $sourcetag]
if {$settingsdict eq $existing_settings} {
#same settings - share the worker
dict lappend winfo list_client_tids $tidclient
dict set workers $sourcetag $winfo ;#writeback
return [dict get $winfo tid]
} elseif {$existing_settings eq {-raw 0 -file {} -syslog {} -direction out}} {
#review - magic dict seems brittle - shouldn't hard code here.???
dict lappend winfo list_client_tids $tidclient
dict set workers $sourcetag $winfo ;#writeback
return [dict get $winfo tid]
} else {
set emsg "shellthread::manager::new_worker error: tag $sourcetag already has a worker with a different configuration\n"
append emsg "existing: $existing_settings\n"
append emsg "attempted: $settingsdict\n"
append emsg "workers info: $winfo"
error $emsg
}
}
}
#noop fake worker for empty syslog and empty file
@ -508,7 +527,9 @@ namespace eval shellthread::manager {
if {[llength $free_threads]} {
#todo - re-use from tail - as most likely to have been doing similar work?? review
set free_threads [lassign $free_threads tidworker]
#set free_threads [lassign $free_threads tidworker]
set tidworker [lpop free_threads 0]
#todo - keep track of real ts_start of free threads... kill when too old
set winfo [dict create tid $tidworker list_client_tids [list $tidclient] ts_start $ts_start ts_end_list [list] workertype [dict get $settingsdict -workertype]]
#puts stderr "shellfilter::new_worker Re-using free worker thread: $tidworker with tag $sourcetag"
@ -641,7 +662,7 @@ namespace eval shellthread::manager {
proc unsubscribe {sourcetaglist} {
variable workers
#workers structure example:
#[list sourcetag1 [list tid <tidworker> list_client_tids <clients>] ts_start <ts_start> ts_end_list {}]
#[list sourcetag1 [list tid <tidworker> list_client_tids <clients> ts_start <ts_start> ts_end_list {} workertype message|pipe]]
variable free_threads
set mytid [thread::id] ;#caller of shellthread::manager::xxx is the client thread
@ -684,6 +705,9 @@ namespace eval shellthread::manager {
foreach workertid $subscriberless_workers {
if {$workertid ni $shuttingdown_workers} {
if {$workertid ni $free_threads && $workertid ne "noop"} {
#JMN
thread::send $workertid {set ::shellthread::worker::settings $::shellthread::worker::settings_defaults}
#todo - log freeing up of thread
lappend free_threads $workertid
}
}
@ -704,6 +728,16 @@ namespace eval shellthread::manager {
return $taginfo_list
}
proc get_tag_config {tag} {
#review
variable workers
if {![dict exists $workers $tag]} {
error "shellthread::manager::get_tag_config error no existing tag $tag"
}
set workertid [dict get $workers $tag tid]
set conf [thread::send $workertid {set ::shellthread::worker::settings}]
}
#finalisation
proc shutdown_free_threads {{timeout 2500}} {
variable free_threads

9489
src/vfs/_vfscommon.vfs/modules/tomlish-1.1.8.tm
View File

File diff suppressed because it is too large Load Diff
Write Preview
Loading…
Cancel
Save