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

misc ansi fixes, refactoring

master
Julian Noble 2 days ago
parent
d6d70a19ce
commit
d814e7e283
31 changed files with 8449 additions and 1620 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. 148
      src/bootsupport/modules/dictn-0.1.2.tm
  2. 493
      src/bootsupport/modules/punk/lib-0.1.5.tm
  3. 3
      src/bootsupport/modules/punk/repl-0.1.2.tm
  4. 18
      src/bootsupport/modules/punkcheck-0.1.0.tm
  5. 32
      src/bootsupport/modules/textblock-0.1.3.tm
  6. 1428
      src/modules/overtype-999999.0a1.0.tm
  7. 2
      src/modules/overtype-buildversion.txt
  8. 3
      src/modules/punk/ansi-999999.0a1.0.tm
  9. 493
      src/modules/punk/lib-999999.0a1.0.tm
  10. 6
      src/modules/punk/path-999999.0a1.0.tm
  11. 3
      src/modules/punk/repl-999999.0a1.0.tm
  12. 12
      src/modules/punk/safe-999999.0a1.0.tm
  13. 18
      src/modules/punkcheck-0.1.0.tm
  14. 35
      src/modules/textblock-999999.0a1.0.tm
  15. 148
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/dictn-0.1.2.tm
  16. 493
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/lib-0.1.5.tm
  17. 3
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repl-0.1.2.tm
  18. 18
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punkcheck-0.1.0.tm
  19. 32
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/textblock-0.1.3.tm
  20. 148
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/dictn-0.1.2.tm
  21. 493
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/lib-0.1.5.tm
  22. 3
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repl-0.1.2.tm
  23. 18
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punkcheck-0.1.0.tm
  24. 32
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/textblock-0.1.3.tm
  25. 148
      src/vfs/_vfscommon.vfs/modules/dictn-0.1.2.tm
  26. 94
      src/vfs/_vfscommon.vfs/modules/overtype-1.7.3.tm
  27. 5199
      src/vfs/_vfscommon.vfs/modules/overtype-1.7.4.tm
  28. 493
      src/vfs/_vfscommon.vfs/modules/punk/lib-0.1.5.tm
  29. 3
      src/vfs/_vfscommon.vfs/modules/punk/repl-0.1.2.tm
  30. 18
      src/vfs/_vfscommon.vfs/modules/punkcheck-0.1.0.tm
  31. 32
      src/vfs/_vfscommon.vfs/modules/textblock-0.1.3.tm

148
src/bootsupport/modules/dictn-0.1.2.tm
Unescape View File

@ -25,17 +25,46 @@
namespace eval dictn {
namespace export {[a-z]*}
namespace ensemble create
namespace eval argdoc {
variable PUNKARGS
#non-colour SGR codes
set I "\x1b\[3m" ;# [a+ italic]
set NI "\x1b\[23m" ;# [a+ noitalic]
set B "\x1b\[1m" ;# [a+ bold]
set N "\x1b\[22m" ;# [a+ normal]
set T "\x1b\[1\;4m" ;# [a+ bold underline]
set NT "\x1b\[22\;24m\x1b\[4:0m" ;# [a+ normal nounderline]
}
}
## ::dictn::append
#This can of course 'ruin' a nested dict if applied to the wrong element
# - i.e using the string op 'append' on an element that is itself a nested dict is analogous to the standard Tcl:
# %set list {a b {c d}}
# %append list x
# a b {c d}x
# IOW - don't do that unless you really know that's what you want.
#
tcl::namespace::eval ::dictn::argdoc {
lappend PUNKARGS [list {
@id -id ::dictn::append
@cmd -name dictn::append\
-summary\
"Append a single string to the value at dict path."\
-help\
"Append a single string to the value at a given dictionary path.
This can of course 'ruin' a nested dict if applied to the wrong element
- i.e using the string op 'append' on an element that is itself a nested dict is analogous to the standard Tcl:
%set list {a b {c d}}
%append list x
a b {c d}x
IOW - don't do that unless you really know that's what you want.
Note than unlike dict append - only a single value is accepted for appending.
"
@values -min 2 -max 3
dictvar -type string
path -type list
value -type any -default "" -optional 1
}]
}
proc ::dictn::append {dictvar path {value {}}} {
if {[llength $path] == 1} {
uplevel 1 [list dict append $dictvar $path $value]
@ -43,7 +72,7 @@ proc ::dictn::append {dictvar path {value {}}} {
upvar 1 $dictvar dvar
::set str [dict get $dvar {*}$path]
append str $val
append str $value
dict set dvar {*}$path $str
}
}
@ -73,6 +102,25 @@ proc ::dictn::for {keyvalvars dictval path body} {
proc ::dictn::get {dictval {path {}}} {
return [dict get $dictval {*}$path]
}
tcl::namespace::eval ::dictn::argdoc {
lappend PUNKARGS [list {
@id -id ::dictn::getn
@cmd -name dictn::getn\
-summary\
"Get one or more paths in a dict simultaneously."\
-help\
""
@values -min 1 -max -1
dictvar -type string
path -type list -multiple 1
}]
}
proc ::dictn::getn {dictval args} {
if {![llength $args]} {
return [::tcl::dict::get $dictval]
}
lmap path $args {::tcl::dict::get $dictval {*}$path}
}
if {[info commands ::tcl::dict::getdef] ne ""} {
@ -85,10 +133,18 @@ if {[info commands ::tcl::dict::getdef] ne ""} {
return [dict getdef $dictval {*}$path $default]
}
proc ::dictn::incr {dictvar path {increment {}} } {
if {$increment eq ""} {
::set increment 1
proc ::dictn::incr {dictvar path {increment 1} } {
upvar 1 $dictvar dvar
if {[llength $path] == 1} {
return [::tcl::dict::incr dvar $path $increment]
}
if {[::tcl::info::exists dvar]} {
::set increment [expr {[::tcl::dict::getdef $dvar {*}$path 0] + $increment}]
}
return [::tcl::dict::set dvar {*}$path $increment]
}
#test - compare disassembly
proc ::dictn::incr2 {dictvar path {increment 1} } {
if {[llength $path] == 1} {
uplevel 1 [list dict incr $dictvar $path $increment]
} else {
@ -233,6 +289,33 @@ proc ::dictn::set {dictvar path newval} {
return [dict set dvar {*}$path $newval]
}
tcl::namespace::eval ::dictn::argdoc {
lappend PUNKARGS [list {
@id -id ::dictn::setn
@cmd -name dictn::setn\
-summary\
"Set one or more paths in a dict to value(s)"\
-help\
""
@values -min 3 -max -1
dictvar -type string
path_newval -type {path newval} -multiple 1
}]
}
proc ::dictn::setn {dictvar args} {
if {[llength $args] == 0} {
error "dictn::setn requires at least one <path> <newval> pair"
}
if {[llength $args] % 2 != 0} {
error "dictn::setn requires trailing <path> <newval> pairs"
}
upvar 1 $dictvar dvar
foreach {p v} $args {
::tcl::dict::set dvar {*}$p $v
}
return $dvar
}
proc ::dictn::size {dictval {path {}}} {
return [dict size [dict get $dictval {*}$path]]
}
@ -312,6 +395,46 @@ proc ::dictn::values {dictval {path {}} {glob {}}} {
}
}
tcl::namespace::eval ::dictn::argdoc {
lappend PUNKARGS [list {
@id -id ::dictn::with
@cmd -name dictn::with\
-summary\
"Execute script for each key at dict path."\
-help\
"Execute the Tcl script in body with the value for each key within the
given key-path mapped to either variables or keys in a specified array.
If the name of an array variable is not supplied for arrayvar,
dictn with behaves like dict with, except that it accepts a list
for the possibly nested key-path instead of separate arguments.
The subkeys of the dict at the given key-path will create variables
in the calling scope.
If an arrayvar is passed, an array of that name in the calling
scope will be populated with keys and values from the subkeys and
values of the dict at the given key-path."
@form -form standard
@values -min 3 -max 3
dictvar -type string
path -type list
body -type string
@form -form array
@values -min 4 -max 4
dictvar -type string
path -type list
arrayvar -type string -help\
"Name of array variable in which key values are
stored for the given dict path.
This prevents key values being used as variable
names in the calling scope, instead capturing them
as keys in the single specified array at the calling
scope."
body -type string
}]
}
# Standard form:
#'dictn with dictVariable path body'
#
@ -351,7 +474,10 @@ proc ::dictn::with {dictvar path args} {
::tcl::namespace::eval ::punk::args::register {
#use fully qualified so 8.6 doesn't find existing var in global namespace
lappend ::punk::args::register::NAMESPACES ::dictn
}

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

@ -751,6 +751,27 @@ namespace eval punk::lib {
# -- ---
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lswap
@cmd -name punk::lib::lswap\
-summary\
"Swap list values in-place"\
-help\
"Similar to struct::list swap, except it fully supports basic
list index expressions such as 7-2 end-1 etc.
struct::list swap doesn't support 'end' offsets, and only
sometimes appears to support basic expressions, depending on the
expression compared to the list length."
@values -min 1 -max 1
lvar -type string -help\
"name of list variable"
a -type indexexpression
z -type indexexpression
}]
}
proc lswap {lvar a z} {
upvar $lvar l
set len [llength $l]
@ -955,181 +976,233 @@ namespace eval punk::lib {
}
}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lzip
@cmd -name punk::lib::lzip\
-summary\
"zip any number of lists together."\
-help\
"Conceptually equivalent to converting a list of rows
to a list of columns.
The number of returned lists (columns) will be equal to
the length of the longest supplied list (row).
If lengths of supplied lists don't match, empty strings
will be inserted in the resulting lists.
e.g lzip {a b c d e} {1 2 3 4} {x y z}
-> {a 1 x} {b 2 y} {c 3 z} {d 4 {}} {3 {} {}}
"
@values -min 1 -max 1
lvar -type string -help\
"name of list variable"
a -type indexexpression
z -type indexexpression
}]
}
proc lzip {args} {
switch -- [llength $args] {
0 {return {}}
1 {return [lindex $args 0]}
2 {return [lzip2lists {*}$args]}
3 {return [lzip3lists {*}$args]}
4 {return [lzip4lists {*}$args]}
5 {return [lzip5lists {*}$args]}
6 {return [lzip6lists {*}$args]}
7 {return [lzip7lists {*}$args]}
8 {return [lzip8lists {*}$args]}
9 {return [lzip9lists {*}$args]}
10 {return [lzip10lists {*}$args]}
0 {return {}}
1 {return [lindex $args 0]}
2 {return [::punk::lib::system::lzip2lists {*}$args]}
3 {return [::punk::lib::system::lzip3lists {*}$args]}
4 {return [::punk::lib::system::lzip4lists {*}$args]}
5 {return [::punk::lib::system::lzip5lists {*}$args]}
6 {return [::punk::lib::system::lzip6lists {*}$args]}
7 {return [::punk::lib::system::lzip7lists {*}$args]}
8 {return [::punk::lib::system::lzip8lists {*}$args]}
9 {return [::punk::lib::system::lzip9lists {*}$args]}
10 {return [::punk::lib::system::lzip10lists {*}$args]}
11 - 12 - 13 - 14 - 15 - 16 - 17 - 18 - 19 - 20 - 21 - 22 - 23 - 24 - 25 - 26 - 27 - 28 - 29 - 30 - 31 - 32 {
set n [llength $args]
if {[info commands ::punk::lib::lzip${n}lists] eq ""} {
puts "calling ::punk::lib::Build_lzipn $n"
::punk::lib::Build_lzipn $n
if {[info commands ::punk::lib::system::lzip${n}lists] eq ""} {
#puts "calling ::punk::lib::system::Build_lzipn $n"
::punk::lib::system::Build_lzipn $n
}
return [lzip${n}lists {*}$args]
return [::punk::lib::system::lzip${n}lists {*}$args]
}
default {
if {[llength $args] < 4000} {
set n [llength $args]
if {[info commands ::punk::lib::lzip${n}lists] eq ""} {
puts "calling ::punk::lib::Build_lzipn $n"
::punk::lib::Build_lzipn $n
if {[info commands ::punk::lib::system::lzip${n}lists] eq ""} {
#puts "calling ::punk::lib::system::Build_lzipn $n"
::punk::lib::system::Build_lzipn $n
}
return [lzip${n}lists {*}$args]
return [::punk::lib::system::lzip${n}lists {*}$args]
} else {
return [lzipn {*}$args]
return [::punk::lib::lzipn {*}$args]
}
}
}
}
proc Build_lzipn {n} {
set arglist [list]
#use punk::lib::range which defers to lseq if available
set vars [lmap i [punk::lib::range 0 $n] {string cat v$i}] ;#v0 v1 v2.. (v0 ignored)
set body "\nlmap "
for {set i 1} {$i <= $n} {incr i} {
lappend arglist l$i
append body "[lindex $vars $i] \$l$i "
}
append body "\{list "
for {set i 1} {$i <= $n} {incr i} {
append body "\$[lindex $vars $i] "
namespace eval system {
proc Build_lzipn {n} {
set arglist [list]
#use punk::lib::range which defers to lseq if available
set vars [lmap i [punk::lib::range 0 $n] {string cat v$i}] ;#v0 v1 v2.. (v0 ignored)
set body "\nlmap "
for {set i 1} {$i <= $n} {incr i} {
lappend arglist l$i
append body "[lindex $vars $i] \$l$i "
}
append body "\{list "
for {set i 1} {$i <= $n} {incr i} {
append body "\$[lindex $vars $i] "
}
append body "\}" \n
#puts "proc punk::lib::system::lzip${n}lists {$arglist} \{"
#puts "$body"
#puts "\}"
proc ::punk::lib::system::lzip${n}lists $arglist $body
}
append body "\}" \n
puts "proc punk::lib::lzip${n}lists {$arglist} \{"
puts "$body"
puts "\}"
proc ::punk::lib::lzip${n}lists $arglist $body
}
#fastest is to know the number of lists to be zipped
proc lzip2lists {l1 l2} {
lmap a $l1 b $l2 {list $a $b}
}
proc lzip3lists {l1 l2 l3} {
lmap a $l1 b $l2 c $l3 {list $a $b $c}
}
proc lzip4lists {l1 l2 l3 l4} {
lmap a $l1 b $l2 c $l3 d $l4 {list $a $b $c $d}
}
proc lzip5lists {l1 l2 l3 l4 l5} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 {list $a $b $c $d $e}
}
proc lzip6lists {l1 l2 l3 l4 l5 l6} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 {list $a $b $c $d $e $f}
}
proc lzip7lists {l1 l2 l3 l4 l5 l6 l7} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 {list $a $b $c $d $e $f $g}
}
proc lzip8lists {l1 l2 l3 l4 l5 l6 l7 l8} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 h $l8 {list $a $b $c $d $e $f $g $h}
}
proc lzip9lists {l1 l2 l3 l4 l5 l6 l7 l8 l9} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 h $l8 i $l9 {list $a $b $c $d $e $f $g $h $i}
}
proc lzip10lists {l1 l2 l3 l4 l5 l6 l7 l8 l9 l10} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 h $l8 i $l9 j $l10 {list $a $b $c $d $e $f $g $h $i $j}
}
#fastest is to know the number of lists to be zipped
proc lzip2lists {l1 l2} {
lmap a $l1 b $l2 {list $a $b}
}
proc lzip3lists {l1 l2 l3} {
lmap a $l1 b $l2 c $l3 {list $a $b $c}
}
proc lzip4lists {l1 l2 l3 l4} {
lmap a $l1 b $l2 c $l3 d $l4 {list $a $b $c $d}
}
proc lzip5lists {l1 l2 l3 l4 l5} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 {list $a $b $c $d $e}
}
proc lzip6lists {l1 l2 l3 l4 l5 l6} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 {list $a $b $c $d $e $f}
}
proc lzip7lists {l1 l2 l3 l4 l5 l6 l7} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 {list $a $b $c $d $e $f $g}
}
proc lzip8lists {l1 l2 l3 l4 l5 l6 l7 l8} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 h $l8 {list $a $b $c $d $e $f $g $h}
}
proc lzip9lists {l1 l2 l3 l4 l5 l6 l7 l8 l9} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 h $l8 i $l9 {list $a $b $c $d $e $f $g $h $i}
}
proc lzip10lists {l1 l2 l3 l4 l5 l6 l7 l8 l9 l10} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 h $l8 i $l9 j $l10 {list $a $b $c $d $e $f $g $h $i $j}
}
#neat algorithm - but while lmap seems better than foreach - it seems the script is evaluated a little slowly
# review -
proc lzipn_alt args {
#stackoverflow - courtesy glenn jackman (modified)
foreach l $args {
lappend vars [incr n]
lappend lmap_args $n $l
#neat algorithm - but while lmap seems better than foreach - it seems the script is evaluated a little slowly
# review -
proc lzipn_alt args {
#stackoverflow - courtesy glenn jackman (modified)
foreach l $args {
lappend vars [incr n]
lappend lmap_args $n $l
}
lmap {*}$lmap_args {lmap v $vars {set $v}}
}
lmap {*}$lmap_args {lmap v $vars {set $v}}
}
#2024 - outperforms lmap version - presumably because list sizes reduced as it goes(?)
proc lzipn_tcl8 {args} {
#wiki - courtesy JAL
set list_l $args
set zip_l []
while {1} {
set cur [lmap a_l $list_l { lindex $a_l 0 }]
set list_l [lmap a_l $list_l { lrange $a_l 1 end }]
#2024 - outperforms lmap version - presumably because list sizes reduced as it goes(?)
proc lzipn_tcl8 {args} {
#For tcl pre 9 (without lsearch -stride)
#wiki - courtesy JAL
set list_l $args
set zip_l []
while {1} {
set cur [lmap a_l $list_l { lindex $a_l 0 }]
set list_l [lmap a_l $list_l { lrange $a_l 1 end }]
if {[join $cur {}] eq {}} {
break
if {[join $cur {}] eq {}} {
break
}
lappend zip_l $cur
}
return $zip_l
}
proc lzipn_tcl9a {args} {
#For Tcl 9+ (with lsearch -stride)
#compared to wiki version
#comparable for lists len <3 or number of args < 3
#approx 2x faster for large lists or more lists
#needs -stride single index bug fix to use empty string instead of NULL
if {![llength $args]} {return {}}
set lens [lmap l $args {llength $l}]
set numcolumns [::tcl::mathfunc::max {*}$lens]
set flatlist [lrepeat [expr {$numcolumns * [llength $args]}] {}]
set outlist [lrepeat $numcolumns {}]
set s 0
foreach len $lens list $args {
#ledit flatlist $s $e {*}$l {*}[lrepeat [expr {($numcolumns -([llength $l] % $numcolumns)) % $numcolumns}] NULL]
ledit flatlist $s [expr {$s + $len - 1}] {*}$list
incr s $numcolumns
}
#needs single index lstride bugfix
for {set c 0} {$c < $numcolumns} {incr c} {
ledit outlist $c $c [lsearch -stride $numcolumns -index $c -inline -all -subindices $flatlist *]
}
return $outlist
}
proc lzipn_tcl9b {args} {
if {![llength $args]} {return {}}
set lens [lmap l $args {llength $l}]
set numcolumns [::tcl::mathfunc::max {*}$lens]
set flatlist [list]
foreach len $lens list $args {
lappend flatlist {*}$list {*}[lrepeat [expr {($numcolumns - ($len % $numcolumns)) % $numcolumns}] ""]
}
lmap c [lseq 0 $numcolumns-1] {lsearch -stride $numcolumns -index $c -inline -all -subindices $flatlist *}
}
proc lzipn_tcl9c {args} {
#SLOW
if {![llength $args]} {return {}}
set lens [lmap l $args {llength $l}]
set numcolumns [::tcl::mathfunc::max {*}$lens]
set flatlist [list]
foreach len $lens list $args {
lappend flatlist {*}$list {*}[lrepeat [expr {($numcolumns - ($len % $numcolumns)) % $numcolumns}] ""]
}
set zip_l {}
set cols_remaining $numcolumns
for {set c 0} {$c < $numcolumns} {incr c} {
if {$cols_remaining == 1} {
return [list {*}$zip_l $flatlist]
}
lappend zip_l [lsearch -stride $cols_remaining -index 0 -inline -all -subindices $flatlist *]
set flen [llength $flatlist]
set flatlist [lremove $flatlist {*}[lseq 0 to $flen-1 by $cols_remaining]]
incr cols_remaining -1
}
lappend zip_l $cur
return $zip_l
}
return $zip_l
}
proc lzipn_tcl9a {args} {
#compared to wiki version
#comparable for lists len <3 or number of args < 3
#approx 2x faster for large lists or more lists
#needs -stride single index bug fix to use empty string instead of NULL
if {![llength $args]} {return {}}
set lens [lmap l $args {llength $l}]
set numcolumns [::tcl::mathfunc::max {*}$lens]
set flatlist [lrepeat [expr {$numcolumns * [llength $args]}] {}]
set outlist [lrepeat $numcolumns {}]
set s 0
foreach len $lens list $args {
#ledit flatlist $s $e {*}$l {*}[lrepeat [expr {($numcolumns -([llength $l] % $numcolumns)) % $numcolumns}] NULL]
ledit flatlist $s [expr {$s + $len - 1}] {*}$list
incr s $numcolumns
}
#needs single index lstride bugfix
for {set c 0} {$c < $numcolumns} {incr c} {
ledit outlist $c $c [lsearch -stride $numcolumns -index $c -inline -all -subindices $flatlist *]
}
return $outlist
}
proc lzipn_tcl9b {args} {
if {![llength $args]} {return {}}
set lens [lmap l $args {llength $l}]
set numcolumns [::tcl::mathfunc::max {*}$lens]
set flatlist [list]
foreach len $lens list $args {
lappend flatlist {*}$list {*}[lrepeat [expr {($numcolumns - ($len % $numcolumns)) % $numcolumns}] ""]
}
lmap c [lseq 0 $numcolumns-1] {lsearch -stride $numcolumns -index $c -inline -all -subindices $flatlist *}
}
proc lzipn_tcl9c {args} {
#SLOW
if {![llength $args]} {return {}}
set lens [lmap l $args {llength $l}]
set numcolumns [::tcl::mathfunc::max {*}$lens]
set flatlist [list]
foreach len $lens list $args {
lappend flatlist {*}$list {*}[lrepeat [expr {($numcolumns - ($len % $numcolumns)) % $numcolumns}] ""]
}
set zip_l {}
set cols_remaining $numcolumns
for {set c 0} {$c < $numcolumns} {incr c} {
if {$cols_remaining == 1} {
return [list {*}$zip_l $flatlist]
}
lappend zip_l [lsearch -stride $cols_remaining -index 0 -inline -all -subindices $flatlist *]
set flen [llength $flatlist]
set flatlist [lremove $flatlist {*}[lseq 0 to $flen-1 by $cols_remaining]]
incr cols_remaining -1
}
return $zip_l
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lzipn
@cmd -name punk::lib::lzipn\
-summary\
"zip any number of lists together (unoptimised)."\
-help\
"Conceptually equivalent to converting a list of rows
to a list of columns.
See lzip which provides the same functionality but with
optimisations depending on the number of supplied lists.
"
@values -min 1 -max 1
lvar -type string -help\
"name of list variable"
a -type indexexpression
z -type indexexpression
}]
}
#keep both lzipn_tclX functions available for side-by-side testing in Tcl versions where it's possible
if {![package vsatisfies [package present Tcl] 9.0-] || [dict get [punk::lib::check::has_tclbug_lsearch_strideallinline] bug]} {
#-stride either not available - or has bug preventing use of main algorithm below
proc lzipn {args} [info body ::punk::lib::lzipn_tcl8]
proc lzipn {args} [info body ::punk::lib::system::lzipn_tcl8]
} else {
proc lzipn {args} [info body ::punk::lib::lzipn_tcl9a]
proc lzipn {args} [info body ::punk::lib::system::lzipn_tcl9a]
}
namespace import ::punk::args::lib::tstr
namespace eval argdoc {
@ -2291,13 +2364,31 @@ namespace eval punk::lib {
proc is_list_all_ni_list2 {a b} $body
}
#somewhat like struct::set difference - but order preserving, and doesn't treat as a 'set' so preserves dupes in fromlist
#struct::set difference may happen to preserve ordering when items are integers, but order can't be relied on,
# especially as struct::set has 2 differing implementations (tcl vs critcl) which return results with different ordering to each other and different deduping behaviour in some cases (e.g empty 2nd arg)
proc ldiff {fromlist removeitems} {
if {[llength $removeitems] == 0} {return $fromlist}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::ldiff
@cmd -name punk::lib::ldiff\
-summary\
"Difference consisting of items with removeitems removed."\
-help\
"Somewhat like struct::set difference, but order preserving, and doesn't
treat as a 'set' so preserves any duplicates in items.
struct::set difference may happen to preserve ordering when items are
integers, but order can't be relied on, especially as struct::set has
2 differening implementations (tcl vs critcl) which return results with
different ordering to each other and different deduping behaviour in
some cases (e.g when 2nd arg is empty)"
@values -min 2 -max 2
items -type list
removeitems -type list
}]
}
proc ldiff {items removeitems} {
if {[llength $removeitems] == 0} {return $items}
set result {}
foreach item $fromlist {
foreach item $items {
if {$item ni $removeitems} {
lappend result $item
}
@ -2361,6 +2452,28 @@ namespace eval punk::lib {
return [array names tmp]
}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lunique_unordered
@cmd -name punk::lib::lunique_unordered\
-summary\
"unique values in list"\
-help\
"Return unique values in provided list.
This removes duplicates but *may* rearrange the
order of the returned elements compared to the
original list.
When struct::set is available this will be used
for the implementation, as it can be *slightly*
faster if acceleration is present. When struct::set
is not available it will fallback to lunique and
provide the same functionality with order preserved."
@values -min 1 -max 1
list -type list
}]
}
#default/fallback implementation
proc lunique_unordered {list} {
lunique $list
@ -2371,13 +2484,33 @@ namespace eval punk::lib {
struct::set union $list {}
}
} else {
puts stderr "WARNING: struct::set union <list> <emptylist> no longer dedupes!"
#struct::set union operates on a 'set' - so this probably won't change, and hopefully is
#consistent across unacelerated versions and those implemented in accelerators,
#but if it ever does change - be a little noisy about it.
puts stderr "punk::lib WARNING: struct::set union <list> <emptylist> no longer dedupes!"
#we could also test a sequence of: struct::set add
}
}
#order-preserving
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lunique
@cmd -name punk::lib::lunique\
-summary\
"Order-preserving unique values in list"\
-help\
"Return unique values in provided list.
This removes duplicates whilst preserving the
original order of the provided list.
When struct::set is available with acceleration,
lunique_unordered may be slightly faster."
@values -min 1 -max 1
list -type list
}]
}
proc lunique {list} {
set new {}
foreach item $list {
@ -2569,18 +2702,21 @@ namespace eval punk::lib {
To validate if an indexset is strictly within range, both the length of the data and the base would
need to be considered.
The normal 'range' specifier is ..
The normal 'range' specifier is .. but can be of the form .x. where x is the step value.
The range specifier can appear at the beginning, middle or end, or even alone to indicate the entire
range of valid values.
e.g the following are all valid ranges
1..
(index 1 to 'max')
..10
(index 'base' to 10)
2..11
(index 2 to 11)
..
(all indices)
1..
(index 1 to 'max')
..10
(index 'base' to 10)
2..11
(index 2 to 11)
..
(all indices)
.3.
(1st index and every 3rd index thereafter)
Common whitespace elements space,tab,newlines are ignored.
Each index (or endpoint of an index-range) can be of the forms accepted by Tcl list or string commands,
e.g end-2 or 2+2.
@ -2670,20 +2806,19 @@ namespace eval punk::lib {
.-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
If end is omitted and only the start 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
Like the tcl9 lseq command - a step (by) value of zero produces no results.
@ -2703,7 +2838,7 @@ namespace eval punk::lib {
indexset examples:
These assume the default 0-based indices (base == 0)
These assume the default 0-based indices (-base 0)
1,3..
output the index 1 (2nd item) followed by all from index 3 to the end.
@ -3604,7 +3739,7 @@ namespace eval punk::lib {
@id -id ::punk::lib::gcd
@cmd -name punk::lib::gcd\
-summary\
"Gretest common divisor of m and n."\
"Greatest common divisor of m and n."\
-help\
"Return the greatest common divisor of m and n.
Straight from Lars Hellström's math::numtheory library in Tcllib
@ -3643,12 +3778,22 @@ namespace eval punk::lib {
return $m
}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lcm
@cmd -name punk::lib::lcm\
-summary\
"Lowest common multiple of m and n."\
-help\
"Return the lowest common multiple of m and n.
Straight from Lars Hellström's math::numtheory library in Tcllib"
@values -min 2 -max 2
m -type integer
n -type integer
}]
}
proc lcm {n m} {
#*** !doctools
#[call [fun gcd] [arg n] [arg m]]
#[para]Return the lowest common multiple of m and n
#[para]Straight from Lars Hellström's math::numtheory library in Tcllib
#[para]
set gcd [gcd $n $m]
return [expr {$n*$m/$gcd}]
}

3
src/bootsupport/modules/punk/repl-0.1.2.tm
Unescape View File

@ -1036,7 +1036,8 @@ namespace eval punk::repl::class {
# set o_rendered_lines [linsert $o_rendered_lines $cursor_row_idx ""]
# incr nextrow -1
#}
set o_rendered_lines [linsert $o_rendered_lines $cursor_row_idx ""]
#set o_rendered_lines [linsert $o_rendered_lines $cursor_row_idx ""]
ledit o_rendered_lines $cursor_row_idx $cursor_row_idx-1 ""
set o_cursor_col 1
}

18
src/bootsupport/modules/punkcheck-0.1.0.tm
Unescape View File

@ -323,7 +323,8 @@ namespace eval punkcheck {
if {$isnew} {
lappend record_list $o_fileset_record
} else {
set record_list [linsert $record_list[unset record_list] $oldposition $o_fileset_record]
#set record_list [linsert $record_list[unset record_list] $oldposition $o_fileset_record]
ledit record_list $oldposition $oldposition-1 $o_fileset_record
}
if {$o_operation ne "QUERY"} {
punkcheck::save_records_to_file $record_list $punkcheck_file
@ -536,7 +537,8 @@ namespace eval punkcheck {
set existing_header_posn [dict get $resultinfo position]
if {$existing_header_posn == -1} {
set this_installer_record [punkcheck::recordlist::new_installer_record $o_name]
set o_record_list [linsert $o_record_list 0 $this_installer_record]
#set o_record_list [linsert $o_record_list 0 $this_installer_record]
ledit o_record_list -1 -1 $this_installer_record
} else {
set this_installer_record [dict get $resultinfo record]
}
@ -616,7 +618,8 @@ namespace eval punkcheck {
set persistedinfo [punkcheck::recordlist::get_installer_record $o_name $file_records]
set existing_header_posn [dict get $persistedinfo position]
if {$existing_header_posn == -1} {
set file_records [linsert $file_records 0 $this_installer_record]
#set file_records [linsert $file_records 0 $this_installer_record]
ledit file_records -1 -1 $this_installer_record
} else {
lset file_records $existing_header_posn $this_installer_record
}
@ -710,7 +713,8 @@ namespace eval punkcheck {
if {$existing_header_posn == -1} {
#not found - prepend
set record_list [linsert $record_list 0 $this_installer_record]
#set record_list [linsert $record_list 0 $this_installer_record]
ledit record_list -1 -1 $this_installer_record
} else {
#replace
lset record_list $existing_header_posn $this_installer_record
@ -791,7 +795,8 @@ namespace eval punkcheck {
if {$isnew} {
lappend record_list $file_record
} else {
set record_list [linsert $record_list[unset record_list] $oldposition $file_record]
#set record_list [linsert $record_list[unset record_list] $oldposition $file_record]
ledit record_list $oldposition $oldposition-1 $file_record
}
save_records_to_file $record_list $punkcheck_file
@ -1191,7 +1196,8 @@ namespace eval punkcheck {
# dst is: base/sub = sub
while {$baselen > 0} {
set dst [linsert $dst 0 ..]
#set dst [linsert $dst 0 ..]
ledit dst -1 -1 ..
incr baselen -1
}
set dst [file join {*}$dst]

32
src/bootsupport/modules/textblock-0.1.3.tm
Unescape View File

@ -4480,7 +4480,8 @@ tcl::namespace::eval textblock {
set code_idx 3
foreach {pt code} [lrange $parts 2 end] {
if {[punk::ansi::codetype::is_sgr_reset $code]} {
set parts [linsert $parts $code_idx+1 $base]
#set parts [linsert $parts $code_idx+1 $base]
ledit parts $code_idx+1 $code_idx $base
}
incr code_idx 2
}
@ -4504,12 +4505,14 @@ tcl::namespace::eval textblock {
#first pt & code
if {$pt ne ""} {
#leading plaintext
set parts [linsert $parts 0 $base]
#set parts [linsert $parts 0 $base]
ledit parts -1 -1 $base
incr offset
}
}
if {[punk::ansi::codetype::is_sgr_reset $code]} {
set parts [linsert $parts [expr {$code_idx+1+$offset}] $base]
#ledit parts [expr {$code_idx+1+$offset}] $code_idx+$offset $base
incr offset
}
incr code_idx 2
@ -5371,6 +5374,9 @@ tcl::namespace::eval textblock {
r-1 {
if {[lindex $line_chunks end] eq ""} {
set line_chunks [linsert $line_chunks end-2 $pad]
#breaks layout e.g subtables in: i i
#why?
#ledit line_chunks end-2 end-3 $pad
} else {
lappend line_chunks $pad
}
@ -5379,13 +5385,16 @@ tcl::namespace::eval textblock {
lappend line_chunks $pad
}
l-0 {
set line_chunks [linsert $line_chunks 0 $pad]
#set line_chunks [linsert $line_chunks 0 $pad]
ledit line_chunks -1 -1 $pad
}
l-1 {
if {[lindex $line_chunks 0] eq ""} {
set line_chunks [linsert $line_chunks 2 $pad]
#set line_chunks [linsert $line_chunks 2 $pad]
ledit line_chunks 2 1 $pad
} else {
set line_chunks [linsert $line_chunks 0 $pad]
#set line_chunks [linsert $line_chunks 0 $pad]
ledit line_chunks -1 -1 $pad
}
}
l-2 {
@ -5393,10 +5402,12 @@ tcl::namespace::eval textblock {
if {[lindex $line_chunks 0] eq ""} {
set line_chunks [linsert $line_chunks 2 $pad]
} else {
set line_chunks [linsert $line_chunks 0 $pad]
#set line_chunks [linsert $line_chunks 0 $pad]
ledit line_chunks -1 -1 $pad
}
} else {
set line_chunks [linsert $line_chunks 0 $pad]
#set line_chunks [linsert $line_chunks 0 $pad]
ledit line_chunks -1 -1 $pad
}
}
}
@ -5466,14 +5477,17 @@ tcl::namespace::eval textblock {
#} else {
# set line_chunks [linsert $line_chunks 0 $pad]
#}
set line_chunks [linsert $line_chunks 0 $pad]
#set line_chunks [linsert $line_chunks 0 $pad]
ledit line_chunks -1 -1 $pad
}
l-1 {
#set line_chunks [linsert $line_chunks 0 $pad]
set line_chunks [_insert_before_text_or_last_ansi $pad $line_chunks]
}
l-2 {
set line_chunks [linsert $line_chunks 0 $pad]
#set line_chunks [linsert $line_chunks 0 $pad]
ledit line_chunks -1 -1 $pad
}
}
}

1428
src/modules/overtype-999999.0a1.0.tm
View File

File diff suppressed because it is too large Load Diff

2
src/modules/overtype-buildversion.txt
Unescape View File

@ -1,3 +1,3 @@
1.7.3
1.7.4
#First line must be a semantic version number
#all other lines are ignored.

3
src/modules/punk/ansi-999999.0a1.0.tm
Unescape View File

@ -4072,7 +4072,8 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
# \033 - octal. equivalently \x1b in hex which is more common in documentation
# empty list [a] should do reset - same for [a nonexistant]
# explicit reset at beginning of parameter list for a= (as opposed to a+)
set t [linsert $t[unset t] 0 0]
#set t [linsert $t[unset t] 0 0]
ledit t -1 -1 0
if {![llength $e]} {
set result "\x1b\[[join $t {;}]m"
} else {

493
src/modules/punk/lib-999999.0a1.0.tm
Unescape View File

@ -751,6 +751,27 @@ namespace eval punk::lib {
# -- ---
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lswap
@cmd -name punk::lib::lswap\
-summary\
"Swap list values in-place"\
-help\
"Similar to struct::list swap, except it fully supports basic
list index expressions such as 7-2 end-1 etc.
struct::list swap doesn't support 'end' offsets, and only
sometimes appears to support basic expressions, depending on the
expression compared to the list length."
@values -min 1 -max 1
lvar -type string -help\
"name of list variable"
a -type indexexpression
z -type indexexpression
}]
}
proc lswap {lvar a z} {
upvar $lvar l
set len [llength $l]
@ -955,181 +976,233 @@ namespace eval punk::lib {
}
}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lzip
@cmd -name punk::lib::lzip\
-summary\
"zip any number of lists together."\
-help\
"Conceptually equivalent to converting a list of rows
to a list of columns.
The number of returned lists (columns) will be equal to
the length of the longest supplied list (row).
If lengths of supplied lists don't match, empty strings
will be inserted in the resulting lists.
e.g lzip {a b c d e} {1 2 3 4} {x y z}
-> {a 1 x} {b 2 y} {c 3 z} {d 4 {}} {3 {} {}}
"
@values -min 1 -max 1
lvar -type string -help\
"name of list variable"
a -type indexexpression
z -type indexexpression
}]
}
proc lzip {args} {
switch -- [llength $args] {
0 {return {}}
1 {return [lindex $args 0]}
2 {return [lzip2lists {*}$args]}
3 {return [lzip3lists {*}$args]}
4 {return [lzip4lists {*}$args]}
5 {return [lzip5lists {*}$args]}
6 {return [lzip6lists {*}$args]}
7 {return [lzip7lists {*}$args]}
8 {return [lzip8lists {*}$args]}
9 {return [lzip9lists {*}$args]}
10 {return [lzip10lists {*}$args]}
0 {return {}}
1 {return [lindex $args 0]}
2 {return [::punk::lib::system::lzip2lists {*}$args]}
3 {return [::punk::lib::system::lzip3lists {*}$args]}
4 {return [::punk::lib::system::lzip4lists {*}$args]}
5 {return [::punk::lib::system::lzip5lists {*}$args]}
6 {return [::punk::lib::system::lzip6lists {*}$args]}
7 {return [::punk::lib::system::lzip7lists {*}$args]}
8 {return [::punk::lib::system::lzip8lists {*}$args]}
9 {return [::punk::lib::system::lzip9lists {*}$args]}
10 {return [::punk::lib::system::lzip10lists {*}$args]}
11 - 12 - 13 - 14 - 15 - 16 - 17 - 18 - 19 - 20 - 21 - 22 - 23 - 24 - 25 - 26 - 27 - 28 - 29 - 30 - 31 - 32 {
set n [llength $args]
if {[info commands ::punk::lib::lzip${n}lists] eq ""} {
puts "calling ::punk::lib::Build_lzipn $n"
::punk::lib::Build_lzipn $n
if {[info commands ::punk::lib::system::lzip${n}lists] eq ""} {
#puts "calling ::punk::lib::system::Build_lzipn $n"
::punk::lib::system::Build_lzipn $n
}
return [lzip${n}lists {*}$args]
return [::punk::lib::system::lzip${n}lists {*}$args]
}
default {
if {[llength $args] < 4000} {
set n [llength $args]
if {[info commands ::punk::lib::lzip${n}lists] eq ""} {
puts "calling ::punk::lib::Build_lzipn $n"
::punk::lib::Build_lzipn $n
if {[info commands ::punk::lib::system::lzip${n}lists] eq ""} {
#puts "calling ::punk::lib::system::Build_lzipn $n"
::punk::lib::system::Build_lzipn $n
}
return [lzip${n}lists {*}$args]
return [::punk::lib::system::lzip${n}lists {*}$args]
} else {
return [lzipn {*}$args]
return [::punk::lib::lzipn {*}$args]
}
}
}
}
proc Build_lzipn {n} {
set arglist [list]
#use punk::lib::range which defers to lseq if available
set vars [lmap i [punk::lib::range 0 $n] {string cat v$i}] ;#v0 v1 v2.. (v0 ignored)
set body "\nlmap "
for {set i 1} {$i <= $n} {incr i} {
lappend arglist l$i
append body "[lindex $vars $i] \$l$i "
}
append body "\{list "
for {set i 1} {$i <= $n} {incr i} {
append body "\$[lindex $vars $i] "
namespace eval system {
proc Build_lzipn {n} {
set arglist [list]
#use punk::lib::range which defers to lseq if available
set vars [lmap i [punk::lib::range 0 $n] {string cat v$i}] ;#v0 v1 v2.. (v0 ignored)
set body "\nlmap "
for {set i 1} {$i <= $n} {incr i} {
lappend arglist l$i
append body "[lindex $vars $i] \$l$i "
}
append body "\{list "
for {set i 1} {$i <= $n} {incr i} {
append body "\$[lindex $vars $i] "
}
append body "\}" \n
#puts "proc punk::lib::system::lzip${n}lists {$arglist} \{"
#puts "$body"
#puts "\}"
proc ::punk::lib::system::lzip${n}lists $arglist $body
}
append body "\}" \n
puts "proc punk::lib::lzip${n}lists {$arglist} \{"
puts "$body"
puts "\}"
proc ::punk::lib::lzip${n}lists $arglist $body
}
#fastest is to know the number of lists to be zipped
proc lzip2lists {l1 l2} {
lmap a $l1 b $l2 {list $a $b}
}
proc lzip3lists {l1 l2 l3} {
lmap a $l1 b $l2 c $l3 {list $a $b $c}
}
proc lzip4lists {l1 l2 l3 l4} {
lmap a $l1 b $l2 c $l3 d $l4 {list $a $b $c $d}
}
proc lzip5lists {l1 l2 l3 l4 l5} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 {list $a $b $c $d $e}
}
proc lzip6lists {l1 l2 l3 l4 l5 l6} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 {list $a $b $c $d $e $f}
}
proc lzip7lists {l1 l2 l3 l4 l5 l6 l7} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 {list $a $b $c $d $e $f $g}
}
proc lzip8lists {l1 l2 l3 l4 l5 l6 l7 l8} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 h $l8 {list $a $b $c $d $e $f $g $h}
}
proc lzip9lists {l1 l2 l3 l4 l5 l6 l7 l8 l9} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 h $l8 i $l9 {list $a $b $c $d $e $f $g $h $i}
}
proc lzip10lists {l1 l2 l3 l4 l5 l6 l7 l8 l9 l10} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 h $l8 i $l9 j $l10 {list $a $b $c $d $e $f $g $h $i $j}
}
#fastest is to know the number of lists to be zipped
proc lzip2lists {l1 l2} {
lmap a $l1 b $l2 {list $a $b}
}
proc lzip3lists {l1 l2 l3} {
lmap a $l1 b $l2 c $l3 {list $a $b $c}
}
proc lzip4lists {l1 l2 l3 l4} {
lmap a $l1 b $l2 c $l3 d $l4 {list $a $b $c $d}
}
proc lzip5lists {l1 l2 l3 l4 l5} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 {list $a $b $c $d $e}
}
proc lzip6lists {l1 l2 l3 l4 l5 l6} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 {list $a $b $c $d $e $f}
}
proc lzip7lists {l1 l2 l3 l4 l5 l6 l7} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 {list $a $b $c $d $e $f $g}
}
proc lzip8lists {l1 l2 l3 l4 l5 l6 l7 l8} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 h $l8 {list $a $b $c $d $e $f $g $h}
}
proc lzip9lists {l1 l2 l3 l4 l5 l6 l7 l8 l9} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 h $l8 i $l9 {list $a $b $c $d $e $f $g $h $i}
}
proc lzip10lists {l1 l2 l3 l4 l5 l6 l7 l8 l9 l10} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 h $l8 i $l9 j $l10 {list $a $b $c $d $e $f $g $h $i $j}
}
#neat algorithm - but while lmap seems better than foreach - it seems the script is evaluated a little slowly
# review -
proc lzipn_alt args {
#stackoverflow - courtesy glenn jackman (modified)
foreach l $args {
lappend vars [incr n]
lappend lmap_args $n $l
#neat algorithm - but while lmap seems better than foreach - it seems the script is evaluated a little slowly
# review -
proc lzipn_alt args {
#stackoverflow - courtesy glenn jackman (modified)
foreach l $args {
lappend vars [incr n]
lappend lmap_args $n $l
}
lmap {*}$lmap_args {lmap v $vars {set $v}}
}
lmap {*}$lmap_args {lmap v $vars {set $v}}
}
#2024 - outperforms lmap version - presumably because list sizes reduced as it goes(?)
proc lzipn_tcl8 {args} {
#wiki - courtesy JAL
set list_l $args
set zip_l []
while {1} {
set cur [lmap a_l $list_l { lindex $a_l 0 }]
set list_l [lmap a_l $list_l { lrange $a_l 1 end }]
#2024 - outperforms lmap version - presumably because list sizes reduced as it goes(?)
proc lzipn_tcl8 {args} {
#For tcl pre 9 (without lsearch -stride)
#wiki - courtesy JAL
set list_l $args
set zip_l []
while {1} {
set cur [lmap a_l $list_l { lindex $a_l 0 }]
set list_l [lmap a_l $list_l { lrange $a_l 1 end }]
if {[join $cur {}] eq {}} {
break
if {[join $cur {}] eq {}} {
break
}
lappend zip_l $cur
}
return $zip_l
}
proc lzipn_tcl9a {args} {
#For Tcl 9+ (with lsearch -stride)
#compared to wiki version
#comparable for lists len <3 or number of args < 3
#approx 2x faster for large lists or more lists
#needs -stride single index bug fix to use empty string instead of NULL
if {![llength $args]} {return {}}
set lens [lmap l $args {llength $l}]
set numcolumns [::tcl::mathfunc::max {*}$lens]
set flatlist [lrepeat [expr {$numcolumns * [llength $args]}] {}]
set outlist [lrepeat $numcolumns {}]
set s 0
foreach len $lens list $args {
#ledit flatlist $s $e {*}$l {*}[lrepeat [expr {($numcolumns -([llength $l] % $numcolumns)) % $numcolumns}] NULL]
ledit flatlist $s [expr {$s + $len - 1}] {*}$list
incr s $numcolumns
}
#needs single index lstride bugfix
for {set c 0} {$c < $numcolumns} {incr c} {
ledit outlist $c $c [lsearch -stride $numcolumns -index $c -inline -all -subindices $flatlist *]
}
return $outlist
}
proc lzipn_tcl9b {args} {
if {![llength $args]} {return {}}
set lens [lmap l $args {llength $l}]
set numcolumns [::tcl::mathfunc::max {*}$lens]
set flatlist [list]
foreach len $lens list $args {
lappend flatlist {*}$list {*}[lrepeat [expr {($numcolumns - ($len % $numcolumns)) % $numcolumns}] ""]
}
lmap c [lseq 0 $numcolumns-1] {lsearch -stride $numcolumns -index $c -inline -all -subindices $flatlist *}
}
proc lzipn_tcl9c {args} {
#SLOW
if {![llength $args]} {return {}}
set lens [lmap l $args {llength $l}]
set numcolumns [::tcl::mathfunc::max {*}$lens]
set flatlist [list]
foreach len $lens list $args {
lappend flatlist {*}$list {*}[lrepeat [expr {($numcolumns - ($len % $numcolumns)) % $numcolumns}] ""]
}
set zip_l {}
set cols_remaining $numcolumns
for {set c 0} {$c < $numcolumns} {incr c} {
if {$cols_remaining == 1} {
return [list {*}$zip_l $flatlist]
}
lappend zip_l [lsearch -stride $cols_remaining -index 0 -inline -all -subindices $flatlist *]
set flen [llength $flatlist]
set flatlist [lremove $flatlist {*}[lseq 0 to $flen-1 by $cols_remaining]]
incr cols_remaining -1
}
lappend zip_l $cur
return $zip_l
}
return $zip_l
}
proc lzipn_tcl9a {args} {
#compared to wiki version
#comparable for lists len <3 or number of args < 3
#approx 2x faster for large lists or more lists
#needs -stride single index bug fix to use empty string instead of NULL
if {![llength $args]} {return {}}
set lens [lmap l $args {llength $l}]
set numcolumns [::tcl::mathfunc::max {*}$lens]
set flatlist [lrepeat [expr {$numcolumns * [llength $args]}] {}]
set outlist [lrepeat $numcolumns {}]
set s 0
foreach len $lens list $args {
#ledit flatlist $s $e {*}$l {*}[lrepeat [expr {($numcolumns -([llength $l] % $numcolumns)) % $numcolumns}] NULL]
ledit flatlist $s [expr {$s + $len - 1}] {*}$list
incr s $numcolumns
}
#needs single index lstride bugfix
for {set c 0} {$c < $numcolumns} {incr c} {
ledit outlist $c $c [lsearch -stride $numcolumns -index $c -inline -all -subindices $flatlist *]
}
return $outlist
}
proc lzipn_tcl9b {args} {
if {![llength $args]} {return {}}
set lens [lmap l $args {llength $l}]
set numcolumns [::tcl::mathfunc::max {*}$lens]
set flatlist [list]
foreach len $lens list $args {
lappend flatlist {*}$list {*}[lrepeat [expr {($numcolumns - ($len % $numcolumns)) % $numcolumns}] ""]
}
lmap c [lseq 0 $numcolumns-1] {lsearch -stride $numcolumns -index $c -inline -all -subindices $flatlist *}
}
proc lzipn_tcl9c {args} {
#SLOW
if {![llength $args]} {return {}}
set lens [lmap l $args {llength $l}]
set numcolumns [::tcl::mathfunc::max {*}$lens]
set flatlist [list]
foreach len $lens list $args {
lappend flatlist {*}$list {*}[lrepeat [expr {($numcolumns - ($len % $numcolumns)) % $numcolumns}] ""]
}
set zip_l {}
set cols_remaining $numcolumns
for {set c 0} {$c < $numcolumns} {incr c} {
if {$cols_remaining == 1} {
return [list {*}$zip_l $flatlist]
}
lappend zip_l [lsearch -stride $cols_remaining -index 0 -inline -all -subindices $flatlist *]
set flen [llength $flatlist]
set flatlist [lremove $flatlist {*}[lseq 0 to $flen-1 by $cols_remaining]]
incr cols_remaining -1
}
return $zip_l
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lzipn
@cmd -name punk::lib::lzipn\
-summary\
"zip any number of lists together (unoptimised)."\
-help\
"Conceptually equivalent to converting a list of rows
to a list of columns.
See lzip which provides the same functionality but with
optimisations depending on the number of supplied lists.
"
@values -min 1 -max 1
lvar -type string -help\
"name of list variable"
a -type indexexpression
z -type indexexpression
}]
}
#keep both lzipn_tclX functions available for side-by-side testing in Tcl versions where it's possible
if {![package vsatisfies [package present Tcl] 9.0-] || [dict get [punk::lib::check::has_tclbug_lsearch_strideallinline] bug]} {
#-stride either not available - or has bug preventing use of main algorithm below
proc lzipn {args} [info body ::punk::lib::lzipn_tcl8]
proc lzipn {args} [info body ::punk::lib::system::lzipn_tcl8]
} else {
proc lzipn {args} [info body ::punk::lib::lzipn_tcl9a]
proc lzipn {args} [info body ::punk::lib::system::lzipn_tcl9a]
}
namespace import ::punk::args::lib::tstr
namespace eval argdoc {
@ -2291,13 +2364,31 @@ namespace eval punk::lib {
proc is_list_all_ni_list2 {a b} $body
}
#somewhat like struct::set difference - but order preserving, and doesn't treat as a 'set' so preserves dupes in fromlist
#struct::set difference may happen to preserve ordering when items are integers, but order can't be relied on,
# especially as struct::set has 2 differing implementations (tcl vs critcl) which return results with different ordering to each other and different deduping behaviour in some cases (e.g empty 2nd arg)
proc ldiff {fromlist removeitems} {
if {[llength $removeitems] == 0} {return $fromlist}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::ldiff
@cmd -name punk::lib::ldiff\
-summary\
"Difference consisting of items with removeitems removed."\
-help\
"Somewhat like struct::set difference, but order preserving, and doesn't
treat as a 'set' so preserves any duplicates in items.
struct::set difference may happen to preserve ordering when items are
integers, but order can't be relied on, especially as struct::set has
2 differening implementations (tcl vs critcl) which return results with
different ordering to each other and different deduping behaviour in
some cases (e.g when 2nd arg is empty)"
@values -min 2 -max 2
items -type list
removeitems -type list
}]
}
proc ldiff {items removeitems} {
if {[llength $removeitems] == 0} {return $items}
set result {}
foreach item $fromlist {
foreach item $items {
if {$item ni $removeitems} {
lappend result $item
}
@ -2361,6 +2452,28 @@ namespace eval punk::lib {
return [array names tmp]
}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lunique_unordered
@cmd -name punk::lib::lunique_unordered\
-summary\
"unique values in list"\
-help\
"Return unique values in provided list.
This removes duplicates but *may* rearrange the
order of the returned elements compared to the
original list.
When struct::set is available this will be used
for the implementation, as it can be *slightly*
faster if acceleration is present. When struct::set
is not available it will fallback to lunique and
provide the same functionality with order preserved."
@values -min 1 -max 1
list -type list
}]
}
#default/fallback implementation
proc lunique_unordered {list} {
lunique $list
@ -2371,13 +2484,33 @@ namespace eval punk::lib {
struct::set union $list {}
}
} else {
puts stderr "WARNING: struct::set union <list> <emptylist> no longer dedupes!"
#struct::set union operates on a 'set' - so this probably won't change, and hopefully is
#consistent across unacelerated versions and those implemented in accelerators,
#but if it ever does change - be a little noisy about it.
puts stderr "punk::lib WARNING: struct::set union <list> <emptylist> no longer dedupes!"
#we could also test a sequence of: struct::set add
}
}
#order-preserving
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lunique
@cmd -name punk::lib::lunique\
-summary\
"Order-preserving unique values in list"\
-help\
"Return unique values in provided list.
This removes duplicates whilst preserving the
original order of the provided list.
When struct::set is available with acceleration,
lunique_unordered may be slightly faster."
@values -min 1 -max 1
list -type list
}]
}
proc lunique {list} {
set new {}
foreach item $list {
@ -2569,18 +2702,21 @@ namespace eval punk::lib {
To validate if an indexset is strictly within range, both the length of the data and the base would
need to be considered.
The normal 'range' specifier is ..
The normal 'range' specifier is .. but can be of the form .x. where x is the step value.
The range specifier can appear at the beginning, middle or end, or even alone to indicate the entire
range of valid values.
e.g the following are all valid ranges
1..
(index 1 to 'max')
..10
(index 'base' to 10)
2..11
(index 2 to 11)
..
(all indices)
1..
(index 1 to 'max')
..10
(index 'base' to 10)
2..11
(index 2 to 11)
..
(all indices)
.3.
(1st index and every 3rd index thereafter)
Common whitespace elements space,tab,newlines are ignored.
Each index (or endpoint of an index-range) can be of the forms accepted by Tcl list or string commands,
e.g end-2 or 2+2.
@ -2670,20 +2806,19 @@ namespace eval punk::lib {
.-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
If end is omitted and only the start 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
Like the tcl9 lseq command - a step (by) value of zero produces no results.
@ -2703,7 +2838,7 @@ namespace eval punk::lib {
indexset examples:
These assume the default 0-based indices (base == 0)
These assume the default 0-based indices (-base 0)
1,3..
output the index 1 (2nd item) followed by all from index 3 to the end.
@ -3604,7 +3739,7 @@ namespace eval punk::lib {
@id -id ::punk::lib::gcd
@cmd -name punk::lib::gcd\
-summary\
"Gretest common divisor of m and n."\
"Greatest common divisor of m and n."\
-help\
"Return the greatest common divisor of m and n.
Straight from Lars Hellström's math::numtheory library in Tcllib
@ -3643,12 +3778,22 @@ namespace eval punk::lib {
return $m
}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lcm
@cmd -name punk::lib::lcm\
-summary\
"Lowest common multiple of m and n."\
-help\
"Return the lowest common multiple of m and n.
Straight from Lars Hellström's math::numtheory library in Tcllib"
@values -min 2 -max 2
m -type integer
n -type integer
}]
}
proc lcm {n m} {
#*** !doctools
#[call [fun gcd] [arg n] [arg m]]
#[para]Return the lowest common multiple of m and n
#[para]Straight from Lars Hellström's math::numtheory library in Tcllib
#[para]
set gcd [gcd $n $m]
return [expr {$n*$m/$gcd}]
}

6
src/modules/punk/path-999999.0a1.0.tm
Unescape View File

@ -294,7 +294,8 @@ namespace eval punk::path {
}
} elseif {[lindex $parts 0] ne ""} {
#relpath a/b/c
set parts [linsert $parts 0 .]
#set parts [linsert $parts 0 .]
ledit parts -1 -1 .
set rootindex 0
#allow backtracking arbitrarily for leading .. entries - simplify where possible
#also need to stop possible conversion to absolute path
@ -1091,7 +1092,8 @@ namespace eval punk::path {
# loc is: ref/sub = sub
while {$reference_len > 0} {
set location [linsert $location 0 ..]
#set location [linsert $location 0 ..]
ledit location -1 -1 ..
incr reference_len -1
}
set location [file join {*}$location]

3
src/modules/punk/repl-999999.0a1.0.tm
Unescape View File

@ -1036,7 +1036,8 @@ namespace eval punk::repl::class {
# set o_rendered_lines [linsert $o_rendered_lines $cursor_row_idx ""]
# incr nextrow -1
#}
set o_rendered_lines [linsert $o_rendered_lines $cursor_row_idx ""]
#set o_rendered_lines [linsert $o_rendered_lines $cursor_row_idx ""]
ledit o_rendered_lines $cursor_row_idx $cursor_row_idx-1 ""
set o_cursor_col 1
}

12
src/modules/punk/safe-999999.0a1.0.tm
Unescape View File

@ -922,14 +922,18 @@ tcl::namespace::eval punk::safe::system {
set where [lsearch -exact $access_path [info library]]
if {$where < 0} {
# not found, add it.
set access_path [linsert $access_path 0 [info library]]
#set access_path [linsert $access_path 0 [info library]]
ledit access_path -1 -1 [info library]
Log $child "tcl_library was not in auto_path,\
added it to child's access_path" NOTICE
} elseif {$where != 0} {
# not first, move it first
set access_path [linsert \
[lreplace $access_path $where $where] \
0 [info library]]
#set access_path [linsert \
# [lreplace $access_path $where $where] \
# 0 [info library]]
ledit access_path $where $where
ledit access_path -1 -1 [info library]
Log $child "tcl_libray was not in first in auto_path,\
moved it to front of child's access_path" NOTICE
}

18
src/modules/punkcheck-0.1.0.tm
Unescape View File

@ -323,7 +323,8 @@ namespace eval punkcheck {
if {$isnew} {
lappend record_list $o_fileset_record
} else {
set record_list [linsert $record_list[unset record_list] $oldposition $o_fileset_record]
#set record_list [linsert $record_list[unset record_list] $oldposition $o_fileset_record]
ledit record_list $oldposition $oldposition-1 $o_fileset_record
}
if {$o_operation ne "QUERY"} {
punkcheck::save_records_to_file $record_list $punkcheck_file
@ -536,7 +537,8 @@ namespace eval punkcheck {
set existing_header_posn [dict get $resultinfo position]
if {$existing_header_posn == -1} {
set this_installer_record [punkcheck::recordlist::new_installer_record $o_name]
set o_record_list [linsert $o_record_list 0 $this_installer_record]
#set o_record_list [linsert $o_record_list 0 $this_installer_record]
ledit o_record_list -1 -1 $this_installer_record
} else {
set this_installer_record [dict get $resultinfo record]
}
@ -616,7 +618,8 @@ namespace eval punkcheck {
set persistedinfo [punkcheck::recordlist::get_installer_record $o_name $file_records]
set existing_header_posn [dict get $persistedinfo position]
if {$existing_header_posn == -1} {
set file_records [linsert $file_records 0 $this_installer_record]
#set file_records [linsert $file_records 0 $this_installer_record]
ledit file_records -1 -1 $this_installer_record
} else {
lset file_records $existing_header_posn $this_installer_record
}
@ -710,7 +713,8 @@ namespace eval punkcheck {
if {$existing_header_posn == -1} {
#not found - prepend
set record_list [linsert $record_list 0 $this_installer_record]
#set record_list [linsert $record_list 0 $this_installer_record]
ledit record_list -1 -1 $this_installer_record
} else {
#replace
lset record_list $existing_header_posn $this_installer_record
@ -791,7 +795,8 @@ namespace eval punkcheck {
if {$isnew} {
lappend record_list $file_record
} else {
set record_list [linsert $record_list[unset record_list] $oldposition $file_record]
#set record_list [linsert $record_list[unset record_list] $oldposition $file_record]
ledit record_list $oldposition $oldposition-1 $file_record
}
save_records_to_file $record_list $punkcheck_file
@ -1191,7 +1196,8 @@ namespace eval punkcheck {
# dst is: base/sub = sub
while {$baselen > 0} {
set dst [linsert $dst 0 ..]
#set dst [linsert $dst 0 ..]
ledit dst -1 -1 ..
incr baselen -1
}
set dst [file join {*}$dst]

35
src/modules/textblock-999999.0a1.0.tm
Unescape View File

@ -4480,7 +4480,8 @@ tcl::namespace::eval textblock {
set code_idx 3
foreach {pt code} [lrange $parts 2 end] {
if {[punk::ansi::codetype::is_sgr_reset $code]} {
set parts [linsert $parts $code_idx+1 $base]
#set parts [linsert $parts $code_idx+1 $base]
ledit parts $code_idx+1 $code_idx $base
}
incr code_idx 2
}
@ -4504,12 +4505,14 @@ tcl::namespace::eval textblock {
#first pt & code
if {$pt ne ""} {
#leading plaintext
set parts [linsert $parts 0 $base]
#set parts [linsert $parts 0 $base]
ledit parts -1 -1 $base
incr offset
}
}
if {[punk::ansi::codetype::is_sgr_reset $code]} {
set parts [linsert $parts [expr {$code_idx+1+$offset}] $base]
#ledit parts [expr {$code_idx+1+$offset}] $code_idx+$offset $base
incr offset
}
incr code_idx 2
@ -5371,6 +5374,9 @@ tcl::namespace::eval textblock {
r-1 {
if {[lindex $line_chunks end] eq ""} {
set line_chunks [linsert $line_chunks end-2 $pad]
#breaks layout e.g subtables in: i i
#why?
#ledit line_chunks end-2 end-3 $pad
} else {
lappend line_chunks $pad
}
@ -5379,24 +5385,30 @@ tcl::namespace::eval textblock {
lappend line_chunks $pad
}
l-0 {
set line_chunks [linsert $line_chunks 0 $pad]
#set line_chunks [linsert $line_chunks 0 $pad]
ledit line_chunks -1 -1 $pad
}
l-1 {
if {[lindex $line_chunks 0] eq ""} {
set line_chunks [linsert $line_chunks 2 $pad]
#set line_chunks [linsert $line_chunks 2 $pad]
ledit line_chunks 2 1 $pad
} else {
set line_chunks [linsert $line_chunks 0 $pad]
#set line_chunks [linsert $line_chunks 0 $pad]
ledit line_chunks -1 -1 $pad
}
}
l-2 {
if {$lnum == 0} {
if {[lindex $line_chunks 0] eq ""} {
set line_chunks [linsert $line_chunks 2 $pad]
#set line_chunks [linsert $line_chunks 2 $pad]
ledit line_chunks 2 1 $pad
} else {
set line_chunks [linsert $line_chunks 0 $pad]
#set line_chunks [linsert $line_chunks 0 $pad]
ledit line_chunks -1 -1 $pad
}
} else {
set line_chunks [linsert $line_chunks 0 $pad]
#set line_chunks [linsert $line_chunks 0 $pad]
ledit line_chunks -1 -1 $pad
}
}
}
@ -5466,14 +5478,17 @@ tcl::namespace::eval textblock {
#} else {
# set line_chunks [linsert $line_chunks 0 $pad]
#}
set line_chunks [linsert $line_chunks 0 $pad]
#set line_chunks [linsert $line_chunks 0 $pad]
ledit line_chunks -1 -1 $pad
}
l-1 {
#set line_chunks [linsert $line_chunks 0 $pad]
set line_chunks [_insert_before_text_or_last_ansi $pad $line_chunks]
}
l-2 {
set line_chunks [linsert $line_chunks 0 $pad]
#set line_chunks [linsert $line_chunks 0 $pad]
ledit line_chunks -1 -1 $pad
}
}
}

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

@ -25,17 +25,46 @@
namespace eval dictn {
namespace export {[a-z]*}
namespace ensemble create
namespace eval argdoc {
variable PUNKARGS
#non-colour SGR codes
set I "\x1b\[3m" ;# [a+ italic]
set NI "\x1b\[23m" ;# [a+ noitalic]
set B "\x1b\[1m" ;# [a+ bold]
set N "\x1b\[22m" ;# [a+ normal]
set T "\x1b\[1\;4m" ;# [a+ bold underline]
set NT "\x1b\[22\;24m\x1b\[4:0m" ;# [a+ normal nounderline]
}
}
## ::dictn::append
#This can of course 'ruin' a nested dict if applied to the wrong element
# - i.e using the string op 'append' on an element that is itself a nested dict is analogous to the standard Tcl:
# %set list {a b {c d}}
# %append list x
# a b {c d}x
# IOW - don't do that unless you really know that's what you want.
#
tcl::namespace::eval ::dictn::argdoc {
lappend PUNKARGS [list {
@id -id ::dictn::append
@cmd -name dictn::append\
-summary\
"Append a single string to the value at dict path."\
-help\
"Append a single string to the value at a given dictionary path.
This can of course 'ruin' a nested dict if applied to the wrong element
- i.e using the string op 'append' on an element that is itself a nested dict is analogous to the standard Tcl:
%set list {a b {c d}}
%append list x
a b {c d}x
IOW - don't do that unless you really know that's what you want.
Note than unlike dict append - only a single value is accepted for appending.
"
@values -min 2 -max 3
dictvar -type string
path -type list
value -type any -default "" -optional 1
}]
}
proc ::dictn::append {dictvar path {value {}}} {
if {[llength $path] == 1} {
uplevel 1 [list dict append $dictvar $path $value]
@ -43,7 +72,7 @@ proc ::dictn::append {dictvar path {value {}}} {
upvar 1 $dictvar dvar
::set str [dict get $dvar {*}$path]
append str $val
append str $value
dict set dvar {*}$path $str
}
}
@ -73,6 +102,25 @@ proc ::dictn::for {keyvalvars dictval path body} {
proc ::dictn::get {dictval {path {}}} {
return [dict get $dictval {*}$path]
}
tcl::namespace::eval ::dictn::argdoc {
lappend PUNKARGS [list {
@id -id ::dictn::getn
@cmd -name dictn::getn\
-summary\
"Get one or more paths in a dict simultaneously."\
-help\
""
@values -min 1 -max -1
dictvar -type string
path -type list -multiple 1
}]
}
proc ::dictn::getn {dictval args} {
if {![llength $args]} {
return [::tcl::dict::get $dictval]
}
lmap path $args {::tcl::dict::get $dictval {*}$path}
}
if {[info commands ::tcl::dict::getdef] ne ""} {
@ -85,10 +133,18 @@ if {[info commands ::tcl::dict::getdef] ne ""} {
return [dict getdef $dictval {*}$path $default]
}
proc ::dictn::incr {dictvar path {increment {}} } {
if {$increment eq ""} {
::set increment 1
proc ::dictn::incr {dictvar path {increment 1} } {
upvar 1 $dictvar dvar
if {[llength $path] == 1} {
return [::tcl::dict::incr dvar $path $increment]
}
if {[::tcl::info::exists dvar]} {
::set increment [expr {[::tcl::dict::getdef $dvar {*}$path 0] + $increment}]
}
return [::tcl::dict::set dvar {*}$path $increment]
}
#test - compare disassembly
proc ::dictn::incr2 {dictvar path {increment 1} } {
if {[llength $path] == 1} {
uplevel 1 [list dict incr $dictvar $path $increment]
} else {
@ -233,6 +289,33 @@ proc ::dictn::set {dictvar path newval} {
return [dict set dvar {*}$path $newval]
}
tcl::namespace::eval ::dictn::argdoc {
lappend PUNKARGS [list {
@id -id ::dictn::setn
@cmd -name dictn::setn\
-summary\
"Set one or more paths in a dict to value(s)"\
-help\
""
@values -min 3 -max -1
dictvar -type string
path_newval -type {path newval} -multiple 1
}]
}
proc ::dictn::setn {dictvar args} {
if {[llength $args] == 0} {
error "dictn::setn requires at least one <path> <newval> pair"
}
if {[llength $args] % 2 != 0} {
error "dictn::setn requires trailing <path> <newval> pairs"
}
upvar 1 $dictvar dvar
foreach {p v} $args {
::tcl::dict::set dvar {*}$p $v
}
return $dvar
}
proc ::dictn::size {dictval {path {}}} {
return [dict size [dict get $dictval {*}$path]]
}
@ -312,6 +395,46 @@ proc ::dictn::values {dictval {path {}} {glob {}}} {
}
}
tcl::namespace::eval ::dictn::argdoc {
lappend PUNKARGS [list {
@id -id ::dictn::with
@cmd -name dictn::with\
-summary\
"Execute script for each key at dict path."\
-help\
"Execute the Tcl script in body with the value for each key within the
given key-path mapped to either variables or keys in a specified array.
If the name of an array variable is not supplied for arrayvar,
dictn with behaves like dict with, except that it accepts a list
for the possibly nested key-path instead of separate arguments.
The subkeys of the dict at the given key-path will create variables
in the calling scope.
If an arrayvar is passed, an array of that name in the calling
scope will be populated with keys and values from the subkeys and
values of the dict at the given key-path."
@form -form standard
@values -min 3 -max 3
dictvar -type string
path -type list
body -type string
@form -form array
@values -min 4 -max 4
dictvar -type string
path -type list
arrayvar -type string -help\
"Name of array variable in which key values are
stored for the given dict path.
This prevents key values being used as variable
names in the calling scope, instead capturing them
as keys in the single specified array at the calling
scope."
body -type string
}]
}
# Standard form:
#'dictn with dictVariable path body'
#
@ -351,7 +474,10 @@ proc ::dictn::with {dictvar path args} {
::tcl::namespace::eval ::punk::args::register {
#use fully qualified so 8.6 doesn't find existing var in global namespace
lappend ::punk::args::register::NAMESPACES ::dictn
}

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

@ -751,6 +751,27 @@ namespace eval punk::lib {
# -- ---
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lswap
@cmd -name punk::lib::lswap\
-summary\
"Swap list values in-place"\
-help\
"Similar to struct::list swap, except it fully supports basic
list index expressions such as 7-2 end-1 etc.
struct::list swap doesn't support 'end' offsets, and only
sometimes appears to support basic expressions, depending on the
expression compared to the list length."
@values -min 1 -max 1
lvar -type string -help\
"name of list variable"
a -type indexexpression
z -type indexexpression
}]
}
proc lswap {lvar a z} {
upvar $lvar l
set len [llength $l]
@ -955,181 +976,233 @@ namespace eval punk::lib {
}
}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lzip
@cmd -name punk::lib::lzip\
-summary\
"zip any number of lists together."\
-help\
"Conceptually equivalent to converting a list of rows
to a list of columns.
The number of returned lists (columns) will be equal to
the length of the longest supplied list (row).
If lengths of supplied lists don't match, empty strings
will be inserted in the resulting lists.
e.g lzip {a b c d e} {1 2 3 4} {x y z}
-> {a 1 x} {b 2 y} {c 3 z} {d 4 {}} {3 {} {}}
"
@values -min 1 -max 1
lvar -type string -help\
"name of list variable"
a -type indexexpression
z -type indexexpression
}]
}
proc lzip {args} {
switch -- [llength $args] {
0 {return {}}
1 {return [lindex $args 0]}
2 {return [lzip2lists {*}$args]}
3 {return [lzip3lists {*}$args]}
4 {return [lzip4lists {*}$args]}
5 {return [lzip5lists {*}$args]}
6 {return [lzip6lists {*}$args]}
7 {return [lzip7lists {*}$args]}
8 {return [lzip8lists {*}$args]}
9 {return [lzip9lists {*}$args]}
10 {return [lzip10lists {*}$args]}
0 {return {}}
1 {return [lindex $args 0]}
2 {return [::punk::lib::system::lzip2lists {*}$args]}
3 {return [::punk::lib::system::lzip3lists {*}$args]}
4 {return [::punk::lib::system::lzip4lists {*}$args]}
5 {return [::punk::lib::system::lzip5lists {*}$args]}
6 {return [::punk::lib::system::lzip6lists {*}$args]}
7 {return [::punk::lib::system::lzip7lists {*}$args]}
8 {return [::punk::lib::system::lzip8lists {*}$args]}
9 {return [::punk::lib::system::lzip9lists {*}$args]}
10 {return [::punk::lib::system::lzip10lists {*}$args]}
11 - 12 - 13 - 14 - 15 - 16 - 17 - 18 - 19 - 20 - 21 - 22 - 23 - 24 - 25 - 26 - 27 - 28 - 29 - 30 - 31 - 32 {
set n [llength $args]
if {[info commands ::punk::lib::lzip${n}lists] eq ""} {
puts "calling ::punk::lib::Build_lzipn $n"
::punk::lib::Build_lzipn $n
if {[info commands ::punk::lib::system::lzip${n}lists] eq ""} {
#puts "calling ::punk::lib::system::Build_lzipn $n"
::punk::lib::system::Build_lzipn $n
}
return [lzip${n}lists {*}$args]
return [::punk::lib::system::lzip${n}lists {*}$args]
}
default {
if {[llength $args] < 4000} {
set n [llength $args]
if {[info commands ::punk::lib::lzip${n}lists] eq ""} {
puts "calling ::punk::lib::Build_lzipn $n"
::punk::lib::Build_lzipn $n
if {[info commands ::punk::lib::system::lzip${n}lists] eq ""} {
#puts "calling ::punk::lib::system::Build_lzipn $n"
::punk::lib::system::Build_lzipn $n
}
return [lzip${n}lists {*}$args]
return [::punk::lib::system::lzip${n}lists {*}$args]
} else {
return [lzipn {*}$args]
return [::punk::lib::lzipn {*}$args]
}
}
}
}
proc Build_lzipn {n} {
set arglist [list]
#use punk::lib::range which defers to lseq if available
set vars [lmap i [punk::lib::range 0 $n] {string cat v$i}] ;#v0 v1 v2.. (v0 ignored)
set body "\nlmap "
for {set i 1} {$i <= $n} {incr i} {
lappend arglist l$i
append body "[lindex $vars $i] \$l$i "
}
append body "\{list "
for {set i 1} {$i <= $n} {incr i} {
append body "\$[lindex $vars $i] "
namespace eval system {
proc Build_lzipn {n} {
set arglist [list]
#use punk::lib::range which defers to lseq if available
set vars [lmap i [punk::lib::range 0 $n] {string cat v$i}] ;#v0 v1 v2.. (v0 ignored)
set body "\nlmap "
for {set i 1} {$i <= $n} {incr i} {
lappend arglist l$i
append body "[lindex $vars $i] \$l$i "
}
append body "\{list "
for {set i 1} {$i <= $n} {incr i} {
append body "\$[lindex $vars $i] "
}
append body "\}" \n
#puts "proc punk::lib::system::lzip${n}lists {$arglist} \{"
#puts "$body"
#puts "\}"
proc ::punk::lib::system::lzip${n}lists $arglist $body
}
append body "\}" \n
puts "proc punk::lib::lzip${n}lists {$arglist} \{"
puts "$body"
puts "\}"
proc ::punk::lib::lzip${n}lists $arglist $body
}
#fastest is to know the number of lists to be zipped
proc lzip2lists {l1 l2} {
lmap a $l1 b $l2 {list $a $b}
}
proc lzip3lists {l1 l2 l3} {
lmap a $l1 b $l2 c $l3 {list $a $b $c}
}
proc lzip4lists {l1 l2 l3 l4} {
lmap a $l1 b $l2 c $l3 d $l4 {list $a $b $c $d}
}
proc lzip5lists {l1 l2 l3 l4 l5} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 {list $a $b $c $d $e}
}
proc lzip6lists {l1 l2 l3 l4 l5 l6} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 {list $a $b $c $d $e $f}
}
proc lzip7lists {l1 l2 l3 l4 l5 l6 l7} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 {list $a $b $c $d $e $f $g}
}
proc lzip8lists {l1 l2 l3 l4 l5 l6 l7 l8} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 h $l8 {list $a $b $c $d $e $f $g $h}
}
proc lzip9lists {l1 l2 l3 l4 l5 l6 l7 l8 l9} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 h $l8 i $l9 {list $a $b $c $d $e $f $g $h $i}
}
proc lzip10lists {l1 l2 l3 l4 l5 l6 l7 l8 l9 l10} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 h $l8 i $l9 j $l10 {list $a $b $c $d $e $f $g $h $i $j}
}
#fastest is to know the number of lists to be zipped
proc lzip2lists {l1 l2} {
lmap a $l1 b $l2 {list $a $b}
}
proc lzip3lists {l1 l2 l3} {
lmap a $l1 b $l2 c $l3 {list $a $b $c}
}
proc lzip4lists {l1 l2 l3 l4} {
lmap a $l1 b $l2 c $l3 d $l4 {list $a $b $c $d}
}
proc lzip5lists {l1 l2 l3 l4 l5} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 {list $a $b $c $d $e}
}
proc lzip6lists {l1 l2 l3 l4 l5 l6} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 {list $a $b $c $d $e $f}
}
proc lzip7lists {l1 l2 l3 l4 l5 l6 l7} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 {list $a $b $c $d $e $f $g}
}
proc lzip8lists {l1 l2 l3 l4 l5 l6 l7 l8} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 h $l8 {list $a $b $c $d $e $f $g $h}
}
proc lzip9lists {l1 l2 l3 l4 l5 l6 l7 l8 l9} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 h $l8 i $l9 {list $a $b $c $d $e $f $g $h $i}
}
proc lzip10lists {l1 l2 l3 l4 l5 l6 l7 l8 l9 l10} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 h $l8 i $l9 j $l10 {list $a $b $c $d $e $f $g $h $i $j}
}
#neat algorithm - but while lmap seems better than foreach - it seems the script is evaluated a little slowly
# review -
proc lzipn_alt args {
#stackoverflow - courtesy glenn jackman (modified)
foreach l $args {
lappend vars [incr n]
lappend lmap_args $n $l
#neat algorithm - but while lmap seems better than foreach - it seems the script is evaluated a little slowly
# review -
proc lzipn_alt args {
#stackoverflow - courtesy glenn jackman (modified)
foreach l $args {
lappend vars [incr n]
lappend lmap_args $n $l
}
lmap {*}$lmap_args {lmap v $vars {set $v}}
}
lmap {*}$lmap_args {lmap v $vars {set $v}}
}
#2024 - outperforms lmap version - presumably because list sizes reduced as it goes(?)
proc lzipn_tcl8 {args} {
#wiki - courtesy JAL
set list_l $args
set zip_l []
while {1} {
set cur [lmap a_l $list_l { lindex $a_l 0 }]
set list_l [lmap a_l $list_l { lrange $a_l 1 end }]
#2024 - outperforms lmap version - presumably because list sizes reduced as it goes(?)
proc lzipn_tcl8 {args} {
#For tcl pre 9 (without lsearch -stride)
#wiki - courtesy JAL
set list_l $args
set zip_l []
while {1} {
set cur [lmap a_l $list_l { lindex $a_l 0 }]
set list_l [lmap a_l $list_l { lrange $a_l 1 end }]
if {[join $cur {}] eq {}} {
break
if {[join $cur {}] eq {}} {
break
}
lappend zip_l $cur
}
return $zip_l
}
proc lzipn_tcl9a {args} {
#For Tcl 9+ (with lsearch -stride)
#compared to wiki version
#comparable for lists len <3 or number of args < 3
#approx 2x faster for large lists or more lists
#needs -stride single index bug fix to use empty string instead of NULL
if {![llength $args]} {return {}}
set lens [lmap l $args {llength $l}]
set numcolumns [::tcl::mathfunc::max {*}$lens]
set flatlist [lrepeat [expr {$numcolumns * [llength $args]}] {}]
set outlist [lrepeat $numcolumns {}]
set s 0
foreach len $lens list $args {
#ledit flatlist $s $e {*}$l {*}[lrepeat [expr {($numcolumns -([llength $l] % $numcolumns)) % $numcolumns}] NULL]
ledit flatlist $s [expr {$s + $len - 1}] {*}$list
incr s $numcolumns
}
#needs single index lstride bugfix
for {set c 0} {$c < $numcolumns} {incr c} {
ledit outlist $c $c [lsearch -stride $numcolumns -index $c -inline -all -subindices $flatlist *]
}
return $outlist
}
proc lzipn_tcl9b {args} {
if {![llength $args]} {return {}}
set lens [lmap l $args {llength $l}]
set numcolumns [::tcl::mathfunc::max {*}$lens]
set flatlist [list]
foreach len $lens list $args {
lappend flatlist {*}$list {*}[lrepeat [expr {($numcolumns - ($len % $numcolumns)) % $numcolumns}] ""]
}
lmap c [lseq 0 $numcolumns-1] {lsearch -stride $numcolumns -index $c -inline -all -subindices $flatlist *}
}
proc lzipn_tcl9c {args} {
#SLOW
if {![llength $args]} {return {}}
set lens [lmap l $args {llength $l}]
set numcolumns [::tcl::mathfunc::max {*}$lens]
set flatlist [list]
foreach len $lens list $args {
lappend flatlist {*}$list {*}[lrepeat [expr {($numcolumns - ($len % $numcolumns)) % $numcolumns}] ""]
}
set zip_l {}
set cols_remaining $numcolumns
for {set c 0} {$c < $numcolumns} {incr c} {
if {$cols_remaining == 1} {
return [list {*}$zip_l $flatlist]
}
lappend zip_l [lsearch -stride $cols_remaining -index 0 -inline -all -subindices $flatlist *]
set flen [llength $flatlist]
set flatlist [lremove $flatlist {*}[lseq 0 to $flen-1 by $cols_remaining]]
incr cols_remaining -1
}
lappend zip_l $cur
return $zip_l
}
return $zip_l
}
proc lzipn_tcl9a {args} {
#compared to wiki version
#comparable for lists len <3 or number of args < 3
#approx 2x faster for large lists or more lists
#needs -stride single index bug fix to use empty string instead of NULL
if {![llength $args]} {return {}}
set lens [lmap l $args {llength $l}]
set numcolumns [::tcl::mathfunc::max {*}$lens]
set flatlist [lrepeat [expr {$numcolumns * [llength $args]}] {}]
set outlist [lrepeat $numcolumns {}]
set s 0
foreach len $lens list $args {
#ledit flatlist $s $e {*}$l {*}[lrepeat [expr {($numcolumns -([llength $l] % $numcolumns)) % $numcolumns}] NULL]
ledit flatlist $s [expr {$s + $len - 1}] {*}$list
incr s $numcolumns
}
#needs single index lstride bugfix
for {set c 0} {$c < $numcolumns} {incr c} {
ledit outlist $c $c [lsearch -stride $numcolumns -index $c -inline -all -subindices $flatlist *]
}
return $outlist
}
proc lzipn_tcl9b {args} {
if {![llength $args]} {return {}}
set lens [lmap l $args {llength $l}]
set numcolumns [::tcl::mathfunc::max {*}$lens]
set flatlist [list]
foreach len $lens list $args {
lappend flatlist {*}$list {*}[lrepeat [expr {($numcolumns - ($len % $numcolumns)) % $numcolumns}] ""]
}
lmap c [lseq 0 $numcolumns-1] {lsearch -stride $numcolumns -index $c -inline -all -subindices $flatlist *}
}
proc lzipn_tcl9c {args} {
#SLOW
if {![llength $args]} {return {}}
set lens [lmap l $args {llength $l}]
set numcolumns [::tcl::mathfunc::max {*}$lens]
set flatlist [list]
foreach len $lens list $args {
lappend flatlist {*}$list {*}[lrepeat [expr {($numcolumns - ($len % $numcolumns)) % $numcolumns}] ""]
}
set zip_l {}
set cols_remaining $numcolumns
for {set c 0} {$c < $numcolumns} {incr c} {
if {$cols_remaining == 1} {
return [list {*}$zip_l $flatlist]
}
lappend zip_l [lsearch -stride $cols_remaining -index 0 -inline -all -subindices $flatlist *]
set flen [llength $flatlist]
set flatlist [lremove $flatlist {*}[lseq 0 to $flen-1 by $cols_remaining]]
incr cols_remaining -1
}
return $zip_l
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lzipn
@cmd -name punk::lib::lzipn\
-summary\
"zip any number of lists together (unoptimised)."\
-help\
"Conceptually equivalent to converting a list of rows
to a list of columns.
See lzip which provides the same functionality but with
optimisations depending on the number of supplied lists.
"
@values -min 1 -max 1
lvar -type string -help\
"name of list variable"
a -type indexexpression
z -type indexexpression
}]
}
#keep both lzipn_tclX functions available for side-by-side testing in Tcl versions where it's possible
if {![package vsatisfies [package present Tcl] 9.0-] || [dict get [punk::lib::check::has_tclbug_lsearch_strideallinline] bug]} {
#-stride either not available - or has bug preventing use of main algorithm below
proc lzipn {args} [info body ::punk::lib::lzipn_tcl8]
proc lzipn {args} [info body ::punk::lib::system::lzipn_tcl8]
} else {
proc lzipn {args} [info body ::punk::lib::lzipn_tcl9a]
proc lzipn {args} [info body ::punk::lib::system::lzipn_tcl9a]
}
namespace import ::punk::args::lib::tstr
namespace eval argdoc {
@ -2291,13 +2364,31 @@ namespace eval punk::lib {
proc is_list_all_ni_list2 {a b} $body
}
#somewhat like struct::set difference - but order preserving, and doesn't treat as a 'set' so preserves dupes in fromlist
#struct::set difference may happen to preserve ordering when items are integers, but order can't be relied on,
# especially as struct::set has 2 differing implementations (tcl vs critcl) which return results with different ordering to each other and different deduping behaviour in some cases (e.g empty 2nd arg)
proc ldiff {fromlist removeitems} {
if {[llength $removeitems] == 0} {return $fromlist}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::ldiff
@cmd -name punk::lib::ldiff\
-summary\
"Difference consisting of items with removeitems removed."\
-help\
"Somewhat like struct::set difference, but order preserving, and doesn't
treat as a 'set' so preserves any duplicates in items.
struct::set difference may happen to preserve ordering when items are
integers, but order can't be relied on, especially as struct::set has
2 differening implementations (tcl vs critcl) which return results with
different ordering to each other and different deduping behaviour in
some cases (e.g when 2nd arg is empty)"
@values -min 2 -max 2
items -type list
removeitems -type list
}]
}
proc ldiff {items removeitems} {
if {[llength $removeitems] == 0} {return $items}
set result {}
foreach item $fromlist {
foreach item $items {
if {$item ni $removeitems} {
lappend result $item
}
@ -2361,6 +2452,28 @@ namespace eval punk::lib {
return [array names tmp]
}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lunique_unordered
@cmd -name punk::lib::lunique_unordered\
-summary\
"unique values in list"\
-help\
"Return unique values in provided list.
This removes duplicates but *may* rearrange the
order of the returned elements compared to the
original list.
When struct::set is available this will be used
for the implementation, as it can be *slightly*
faster if acceleration is present. When struct::set
is not available it will fallback to lunique and
provide the same functionality with order preserved."
@values -min 1 -max 1
list -type list
}]
}
#default/fallback implementation
proc lunique_unordered {list} {
lunique $list
@ -2371,13 +2484,33 @@ namespace eval punk::lib {
struct::set union $list {}
}
} else {
puts stderr "WARNING: struct::set union <list> <emptylist> no longer dedupes!"
#struct::set union operates on a 'set' - so this probably won't change, and hopefully is
#consistent across unacelerated versions and those implemented in accelerators,
#but if it ever does change - be a little noisy about it.
puts stderr "punk::lib WARNING: struct::set union <list> <emptylist> no longer dedupes!"
#we could also test a sequence of: struct::set add
}
}
#order-preserving
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lunique
@cmd -name punk::lib::lunique\
-summary\
"Order-preserving unique values in list"\
-help\
"Return unique values in provided list.
This removes duplicates whilst preserving the
original order of the provided list.
When struct::set is available with acceleration,
lunique_unordered may be slightly faster."
@values -min 1 -max 1
list -type list
}]
}
proc lunique {list} {
set new {}
foreach item $list {
@ -2569,18 +2702,21 @@ namespace eval punk::lib {
To validate if an indexset is strictly within range, both the length of the data and the base would
need to be considered.
The normal 'range' specifier is ..
The normal 'range' specifier is .. but can be of the form .x. where x is the step value.
The range specifier can appear at the beginning, middle or end, or even alone to indicate the entire
range of valid values.
e.g the following are all valid ranges
1..
(index 1 to 'max')
..10
(index 'base' to 10)
2..11
(index 2 to 11)
..
(all indices)
1..
(index 1 to 'max')
..10
(index 'base' to 10)
2..11
(index 2 to 11)
..
(all indices)
.3.
(1st index and every 3rd index thereafter)
Common whitespace elements space,tab,newlines are ignored.
Each index (or endpoint of an index-range) can be of the forms accepted by Tcl list or string commands,
e.g end-2 or 2+2.
@ -2670,20 +2806,19 @@ namespace eval punk::lib {
.-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
If end is omitted and only the start 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
Like the tcl9 lseq command - a step (by) value of zero produces no results.
@ -2703,7 +2838,7 @@ namespace eval punk::lib {
indexset examples:
These assume the default 0-based indices (base == 0)
These assume the default 0-based indices (-base 0)
1,3..
output the index 1 (2nd item) followed by all from index 3 to the end.
@ -3604,7 +3739,7 @@ namespace eval punk::lib {
@id -id ::punk::lib::gcd
@cmd -name punk::lib::gcd\
-summary\
"Gretest common divisor of m and n."\
"Greatest common divisor of m and n."\
-help\
"Return the greatest common divisor of m and n.
Straight from Lars Hellström's math::numtheory library in Tcllib
@ -3643,12 +3778,22 @@ namespace eval punk::lib {
return $m
}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lcm
@cmd -name punk::lib::lcm\
-summary\
"Lowest common multiple of m and n."\
-help\
"Return the lowest common multiple of m and n.
Straight from Lars Hellström's math::numtheory library in Tcllib"
@values -min 2 -max 2
m -type integer
n -type integer
}]
}
proc lcm {n m} {
#*** !doctools
#[call [fun gcd] [arg n] [arg m]]
#[para]Return the lowest common multiple of m and n
#[para]Straight from Lars Hellström's math::numtheory library in Tcllib
#[para]
set gcd [gcd $n $m]
return [expr {$n*$m/$gcd}]
}

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

@ -1036,7 +1036,8 @@ namespace eval punk::repl::class {
# set o_rendered_lines [linsert $o_rendered_lines $cursor_row_idx ""]
# incr nextrow -1
#}
set o_rendered_lines [linsert $o_rendered_lines $cursor_row_idx ""]
#set o_rendered_lines [linsert $o_rendered_lines $cursor_row_idx ""]
ledit o_rendered_lines $cursor_row_idx $cursor_row_idx-1 ""
set o_cursor_col 1
}

18
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punkcheck-0.1.0.tm
Unescape View File

@ -323,7 +323,8 @@ namespace eval punkcheck {
if {$isnew} {
lappend record_list $o_fileset_record
} else {
set record_list [linsert $record_list[unset record_list] $oldposition $o_fileset_record]
#set record_list [linsert $record_list[unset record_list] $oldposition $o_fileset_record]
ledit record_list $oldposition $oldposition-1 $o_fileset_record
}
if {$o_operation ne "QUERY"} {
punkcheck::save_records_to_file $record_list $punkcheck_file
@ -536,7 +537,8 @@ namespace eval punkcheck {
set existing_header_posn [dict get $resultinfo position]
if {$existing_header_posn == -1} {
set this_installer_record [punkcheck::recordlist::new_installer_record $o_name]
set o_record_list [linsert $o_record_list 0 $this_installer_record]
#set o_record_list [linsert $o_record_list 0 $this_installer_record]
ledit o_record_list -1 -1 $this_installer_record
} else {
set this_installer_record [dict get $resultinfo record]
}
@ -616,7 +618,8 @@ namespace eval punkcheck {
set persistedinfo [punkcheck::recordlist::get_installer_record $o_name $file_records]
set existing_header_posn [dict get $persistedinfo position]
if {$existing_header_posn == -1} {
set file_records [linsert $file_records 0 $this_installer_record]
#set file_records [linsert $file_records 0 $this_installer_record]
ledit file_records -1 -1 $this_installer_record
} else {
lset file_records $existing_header_posn $this_installer_record
}
@ -710,7 +713,8 @@ namespace eval punkcheck {
if {$existing_header_posn == -1} {
#not found - prepend
set record_list [linsert $record_list 0 $this_installer_record]
#set record_list [linsert $record_list 0 $this_installer_record]
ledit record_list -1 -1 $this_installer_record
} else {
#replace
lset record_list $existing_header_posn $this_installer_record
@ -791,7 +795,8 @@ namespace eval punkcheck {
if {$isnew} {
lappend record_list $file_record
} else {
set record_list [linsert $record_list[unset record_list] $oldposition $file_record]
#set record_list [linsert $record_list[unset record_list] $oldposition $file_record]
ledit record_list $oldposition $oldposition-1 $file_record
}
save_records_to_file $record_list $punkcheck_file
@ -1191,7 +1196,8 @@ namespace eval punkcheck {
# dst is: base/sub = sub
while {$baselen > 0} {
set dst [linsert $dst 0 ..]
#set dst [linsert $dst 0 ..]
ledit dst -1 -1 ..
incr baselen -1
}
set dst [file join {*}$dst]

32
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/textblock-0.1.3.tm
Unescape View File

@ -4480,7 +4480,8 @@ tcl::namespace::eval textblock {
set code_idx 3
foreach {pt code} [lrange $parts 2 end] {
if {[punk::ansi::codetype::is_sgr_reset $code]} {
set parts [linsert $parts $code_idx+1 $base]
#set parts [linsert $parts $code_idx+1 $base]
ledit parts $code_idx+1 $code_idx $base
}
incr code_idx 2
}
@ -4504,12 +4505,14 @@ tcl::namespace::eval textblock {
#first pt & code
if {$pt ne ""} {
#leading plaintext
set parts [linsert $parts 0 $base]
#set parts [linsert $parts 0 $base]
ledit parts -1 -1 $base
incr offset
}
}
if {[punk::ansi::codetype::is_sgr_reset $code]} {
set parts [linsert $parts [expr {$code_idx+1+$offset}] $base]
#ledit parts [expr {$code_idx+1+$offset}] $code_idx+$offset $base
incr offset
}
incr code_idx 2
@ -5371,6 +5374,9 @@ tcl::namespace::eval textblock {
r-1 {
if {[lindex $line_chunks end] eq ""} {
set line_chunks [linsert $line_chunks end-2 $pad]
#breaks layout e.g subtables in: i i
#why?
#ledit line_chunks end-2 end-3 $pad
} else {
lappend line_chunks $pad
}
@ -5379,13 +5385,16 @@ tcl::namespace::eval textblock {
lappend line_chunks $pad
}
l-0 {
set line_chunks [linsert $line_chunks 0 $pad]
#set line_chunks [linsert $line_chunks 0 $pad]
ledit line_chunks -1 -1 $pad
}
l-1 {
if {[lindex $line_chunks 0] eq ""} {
set line_chunks [linsert $line_chunks 2 $pad]
#set line_chunks [linsert $line_chunks 2 $pad]
ledit line_chunks 2 1 $pad
} else {
set line_chunks [linsert $line_chunks 0 $pad]
#set line_chunks [linsert $line_chunks 0 $pad]
ledit line_chunks -1 -1 $pad
}
}
l-2 {
@ -5393,10 +5402,12 @@ tcl::namespace::eval textblock {
if {[lindex $line_chunks 0] eq ""} {
set line_chunks [linsert $line_chunks 2 $pad]
} else {
set line_chunks [linsert $line_chunks 0 $pad]
#set line_chunks [linsert $line_chunks 0 $pad]
ledit line_chunks -1 -1 $pad
}
} else {
set line_chunks [linsert $line_chunks 0 $pad]
#set line_chunks [linsert $line_chunks 0 $pad]
ledit line_chunks -1 -1 $pad
}
}
}
@ -5466,14 +5477,17 @@ tcl::namespace::eval textblock {
#} else {
# set line_chunks [linsert $line_chunks 0 $pad]
#}
set line_chunks [linsert $line_chunks 0 $pad]
#set line_chunks [linsert $line_chunks 0 $pad]
ledit line_chunks -1 -1 $pad
}
l-1 {
#set line_chunks [linsert $line_chunks 0 $pad]
set line_chunks [_insert_before_text_or_last_ansi $pad $line_chunks]
}
l-2 {
set line_chunks [linsert $line_chunks 0 $pad]
#set line_chunks [linsert $line_chunks 0 $pad]
ledit line_chunks -1 -1 $pad
}
}
}

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

@ -25,17 +25,46 @@
namespace eval dictn {
namespace export {[a-z]*}
namespace ensemble create
namespace eval argdoc {
variable PUNKARGS
#non-colour SGR codes
set I "\x1b\[3m" ;# [a+ italic]
set NI "\x1b\[23m" ;# [a+ noitalic]
set B "\x1b\[1m" ;# [a+ bold]
set N "\x1b\[22m" ;# [a+ normal]
set T "\x1b\[1\;4m" ;# [a+ bold underline]
set NT "\x1b\[22\;24m\x1b\[4:0m" ;# [a+ normal nounderline]
}
}
## ::dictn::append
#This can of course 'ruin' a nested dict if applied to the wrong element
# - i.e using the string op 'append' on an element that is itself a nested dict is analogous to the standard Tcl:
# %set list {a b {c d}}
# %append list x
# a b {c d}x
# IOW - don't do that unless you really know that's what you want.
#
tcl::namespace::eval ::dictn::argdoc {
lappend PUNKARGS [list {
@id -id ::dictn::append
@cmd -name dictn::append\
-summary\
"Append a single string to the value at dict path."\
-help\
"Append a single string to the value at a given dictionary path.
This can of course 'ruin' a nested dict if applied to the wrong element
- i.e using the string op 'append' on an element that is itself a nested dict is analogous to the standard Tcl:
%set list {a b {c d}}
%append list x
a b {c d}x
IOW - don't do that unless you really know that's what you want.
Note than unlike dict append - only a single value is accepted for appending.
"
@values -min 2 -max 3
dictvar -type string
path -type list
value -type any -default "" -optional 1
}]
}
proc ::dictn::append {dictvar path {value {}}} {
if {[llength $path] == 1} {
uplevel 1 [list dict append $dictvar $path $value]
@ -43,7 +72,7 @@ proc ::dictn::append {dictvar path {value {}}} {
upvar 1 $dictvar dvar
::set str [dict get $dvar {*}$path]
append str $val
append str $value
dict set dvar {*}$path $str
}
}
@ -73,6 +102,25 @@ proc ::dictn::for {keyvalvars dictval path body} {
proc ::dictn::get {dictval {path {}}} {
return [dict get $dictval {*}$path]
}
tcl::namespace::eval ::dictn::argdoc {
lappend PUNKARGS [list {
@id -id ::dictn::getn
@cmd -name dictn::getn\
-summary\
"Get one or more paths in a dict simultaneously."\
-help\
""
@values -min 1 -max -1
dictvar -type string
path -type list -multiple 1
}]
}
proc ::dictn::getn {dictval args} {
if {![llength $args]} {
return [::tcl::dict::get $dictval]
}
lmap path $args {::tcl::dict::get $dictval {*}$path}
}
if {[info commands ::tcl::dict::getdef] ne ""} {
@ -85,10 +133,18 @@ if {[info commands ::tcl::dict::getdef] ne ""} {
return [dict getdef $dictval {*}$path $default]
}
proc ::dictn::incr {dictvar path {increment {}} } {
if {$increment eq ""} {
::set increment 1
proc ::dictn::incr {dictvar path {increment 1} } {
upvar 1 $dictvar dvar
if {[llength $path] == 1} {
return [::tcl::dict::incr dvar $path $increment]
}
if {[::tcl::info::exists dvar]} {
::set increment [expr {[::tcl::dict::getdef $dvar {*}$path 0] + $increment}]
}
return [::tcl::dict::set dvar {*}$path $increment]
}
#test - compare disassembly
proc ::dictn::incr2 {dictvar path {increment 1} } {
if {[llength $path] == 1} {
uplevel 1 [list dict incr $dictvar $path $increment]
} else {
@ -233,6 +289,33 @@ proc ::dictn::set {dictvar path newval} {
return [dict set dvar {*}$path $newval]
}
tcl::namespace::eval ::dictn::argdoc {
lappend PUNKARGS [list {
@id -id ::dictn::setn
@cmd -name dictn::setn\
-summary\
"Set one or more paths in a dict to value(s)"\
-help\
""
@values -min 3 -max -1
dictvar -type string
path_newval -type {path newval} -multiple 1
}]
}
proc ::dictn::setn {dictvar args} {
if {[llength $args] == 0} {
error "dictn::setn requires at least one <path> <newval> pair"
}
if {[llength $args] % 2 != 0} {
error "dictn::setn requires trailing <path> <newval> pairs"
}
upvar 1 $dictvar dvar
foreach {p v} $args {
::tcl::dict::set dvar {*}$p $v
}
return $dvar
}
proc ::dictn::size {dictval {path {}}} {
return [dict size [dict get $dictval {*}$path]]
}
@ -312,6 +395,46 @@ proc ::dictn::values {dictval {path {}} {glob {}}} {
}
}
tcl::namespace::eval ::dictn::argdoc {
lappend PUNKARGS [list {
@id -id ::dictn::with
@cmd -name dictn::with\
-summary\
"Execute script for each key at dict path."\
-help\
"Execute the Tcl script in body with the value for each key within the
given key-path mapped to either variables or keys in a specified array.
If the name of an array variable is not supplied for arrayvar,
dictn with behaves like dict with, except that it accepts a list
for the possibly nested key-path instead of separate arguments.
The subkeys of the dict at the given key-path will create variables
in the calling scope.
If an arrayvar is passed, an array of that name in the calling
scope will be populated with keys and values from the subkeys and
values of the dict at the given key-path."
@form -form standard
@values -min 3 -max 3
dictvar -type string
path -type list
body -type string
@form -form array
@values -min 4 -max 4
dictvar -type string
path -type list
arrayvar -type string -help\
"Name of array variable in which key values are
stored for the given dict path.
This prevents key values being used as variable
names in the calling scope, instead capturing them
as keys in the single specified array at the calling
scope."
body -type string
}]
}
# Standard form:
#'dictn with dictVariable path body'
#
@ -351,7 +474,10 @@ proc ::dictn::with {dictvar path args} {
::tcl::namespace::eval ::punk::args::register {
#use fully qualified so 8.6 doesn't find existing var in global namespace
lappend ::punk::args::register::NAMESPACES ::dictn
}

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

@ -751,6 +751,27 @@ namespace eval punk::lib {
# -- ---
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lswap
@cmd -name punk::lib::lswap\
-summary\
"Swap list values in-place"\
-help\
"Similar to struct::list swap, except it fully supports basic
list index expressions such as 7-2 end-1 etc.
struct::list swap doesn't support 'end' offsets, and only
sometimes appears to support basic expressions, depending on the
expression compared to the list length."
@values -min 1 -max 1
lvar -type string -help\
"name of list variable"
a -type indexexpression
z -type indexexpression
}]
}
proc lswap {lvar a z} {
upvar $lvar l
set len [llength $l]
@ -955,181 +976,233 @@ namespace eval punk::lib {
}
}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lzip
@cmd -name punk::lib::lzip\
-summary\
"zip any number of lists together."\
-help\
"Conceptually equivalent to converting a list of rows
to a list of columns.
The number of returned lists (columns) will be equal to
the length of the longest supplied list (row).
If lengths of supplied lists don't match, empty strings
will be inserted in the resulting lists.
e.g lzip {a b c d e} {1 2 3 4} {x y z}
-> {a 1 x} {b 2 y} {c 3 z} {d 4 {}} {3 {} {}}
"
@values -min 1 -max 1
lvar -type string -help\
"name of list variable"
a -type indexexpression
z -type indexexpression
}]
}
proc lzip {args} {
switch -- [llength $args] {
0 {return {}}
1 {return [lindex $args 0]}
2 {return [lzip2lists {*}$args]}
3 {return [lzip3lists {*}$args]}
4 {return [lzip4lists {*}$args]}
5 {return [lzip5lists {*}$args]}
6 {return [lzip6lists {*}$args]}
7 {return [lzip7lists {*}$args]}
8 {return [lzip8lists {*}$args]}
9 {return [lzip9lists {*}$args]}
10 {return [lzip10lists {*}$args]}
0 {return {}}
1 {return [lindex $args 0]}
2 {return [::punk::lib::system::lzip2lists {*}$args]}
3 {return [::punk::lib::system::lzip3lists {*}$args]}
4 {return [::punk::lib::system::lzip4lists {*}$args]}
5 {return [::punk::lib::system::lzip5lists {*}$args]}
6 {return [::punk::lib::system::lzip6lists {*}$args]}
7 {return [::punk::lib::system::lzip7lists {*}$args]}
8 {return [::punk::lib::system::lzip8lists {*}$args]}
9 {return [::punk::lib::system::lzip9lists {*}$args]}
10 {return [::punk::lib::system::lzip10lists {*}$args]}
11 - 12 - 13 - 14 - 15 - 16 - 17 - 18 - 19 - 20 - 21 - 22 - 23 - 24 - 25 - 26 - 27 - 28 - 29 - 30 - 31 - 32 {
set n [llength $args]
if {[info commands ::punk::lib::lzip${n}lists] eq ""} {
puts "calling ::punk::lib::Build_lzipn $n"
::punk::lib::Build_lzipn $n
if {[info commands ::punk::lib::system::lzip${n}lists] eq ""} {
#puts "calling ::punk::lib::system::Build_lzipn $n"
::punk::lib::system::Build_lzipn $n
}
return [lzip${n}lists {*}$args]
return [::punk::lib::system::lzip${n}lists {*}$args]
}
default {
if {[llength $args] < 4000} {
set n [llength $args]
if {[info commands ::punk::lib::lzip${n}lists] eq ""} {
puts "calling ::punk::lib::Build_lzipn $n"
::punk::lib::Build_lzipn $n
if {[info commands ::punk::lib::system::lzip${n}lists] eq ""} {
#puts "calling ::punk::lib::system::Build_lzipn $n"
::punk::lib::system::Build_lzipn $n
}
return [lzip${n}lists {*}$args]
return [::punk::lib::system::lzip${n}lists {*}$args]
} else {
return [lzipn {*}$args]
return [::punk::lib::lzipn {*}$args]
}
}
}
}
proc Build_lzipn {n} {
set arglist [list]
#use punk::lib::range which defers to lseq if available
set vars [lmap i [punk::lib::range 0 $n] {string cat v$i}] ;#v0 v1 v2.. (v0 ignored)
set body "\nlmap "
for {set i 1} {$i <= $n} {incr i} {
lappend arglist l$i
append body "[lindex $vars $i] \$l$i "
}
append body "\{list "
for {set i 1} {$i <= $n} {incr i} {
append body "\$[lindex $vars $i] "
namespace eval system {
proc Build_lzipn {n} {
set arglist [list]
#use punk::lib::range which defers to lseq if available
set vars [lmap i [punk::lib::range 0 $n] {string cat v$i}] ;#v0 v1 v2.. (v0 ignored)
set body "\nlmap "
for {set i 1} {$i <= $n} {incr i} {
lappend arglist l$i
append body "[lindex $vars $i] \$l$i "
}
append body "\{list "
for {set i 1} {$i <= $n} {incr i} {
append body "\$[lindex $vars $i] "
}
append body "\}" \n
#puts "proc punk::lib::system::lzip${n}lists {$arglist} \{"
#puts "$body"
#puts "\}"
proc ::punk::lib::system::lzip${n}lists $arglist $body
}
append body "\}" \n
puts "proc punk::lib::lzip${n}lists {$arglist} \{"
puts "$body"
puts "\}"
proc ::punk::lib::lzip${n}lists $arglist $body
}
#fastest is to know the number of lists to be zipped
proc lzip2lists {l1 l2} {
lmap a $l1 b $l2 {list $a $b}
}
proc lzip3lists {l1 l2 l3} {
lmap a $l1 b $l2 c $l3 {list $a $b $c}
}
proc lzip4lists {l1 l2 l3 l4} {
lmap a $l1 b $l2 c $l3 d $l4 {list $a $b $c $d}
}
proc lzip5lists {l1 l2 l3 l4 l5} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 {list $a $b $c $d $e}
}
proc lzip6lists {l1 l2 l3 l4 l5 l6} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 {list $a $b $c $d $e $f}
}
proc lzip7lists {l1 l2 l3 l4 l5 l6 l7} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 {list $a $b $c $d $e $f $g}
}
proc lzip8lists {l1 l2 l3 l4 l5 l6 l7 l8} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 h $l8 {list $a $b $c $d $e $f $g $h}
}
proc lzip9lists {l1 l2 l3 l4 l5 l6 l7 l8 l9} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 h $l8 i $l9 {list $a $b $c $d $e $f $g $h $i}
}
proc lzip10lists {l1 l2 l3 l4 l5 l6 l7 l8 l9 l10} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 h $l8 i $l9 j $l10 {list $a $b $c $d $e $f $g $h $i $j}
}
#fastest is to know the number of lists to be zipped
proc lzip2lists {l1 l2} {
lmap a $l1 b $l2 {list $a $b}
}
proc lzip3lists {l1 l2 l3} {
lmap a $l1 b $l2 c $l3 {list $a $b $c}
}
proc lzip4lists {l1 l2 l3 l4} {
lmap a $l1 b $l2 c $l3 d $l4 {list $a $b $c $d}
}
proc lzip5lists {l1 l2 l3 l4 l5} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 {list $a $b $c $d $e}
}
proc lzip6lists {l1 l2 l3 l4 l5 l6} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 {list $a $b $c $d $e $f}
}
proc lzip7lists {l1 l2 l3 l4 l5 l6 l7} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 {list $a $b $c $d $e $f $g}
}
proc lzip8lists {l1 l2 l3 l4 l5 l6 l7 l8} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 h $l8 {list $a $b $c $d $e $f $g $h}
}
proc lzip9lists {l1 l2 l3 l4 l5 l6 l7 l8 l9} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 h $l8 i $l9 {list $a $b $c $d $e $f $g $h $i}
}
proc lzip10lists {l1 l2 l3 l4 l5 l6 l7 l8 l9 l10} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 h $l8 i $l9 j $l10 {list $a $b $c $d $e $f $g $h $i $j}
}
#neat algorithm - but while lmap seems better than foreach - it seems the script is evaluated a little slowly
# review -
proc lzipn_alt args {
#stackoverflow - courtesy glenn jackman (modified)
foreach l $args {
lappend vars [incr n]
lappend lmap_args $n $l
#neat algorithm - but while lmap seems better than foreach - it seems the script is evaluated a little slowly
# review -
proc lzipn_alt args {
#stackoverflow - courtesy glenn jackman (modified)
foreach l $args {
lappend vars [incr n]
lappend lmap_args $n $l
}
lmap {*}$lmap_args {lmap v $vars {set $v}}
}
lmap {*}$lmap_args {lmap v $vars {set $v}}
}
#2024 - outperforms lmap version - presumably because list sizes reduced as it goes(?)
proc lzipn_tcl8 {args} {
#wiki - courtesy JAL
set list_l $args
set zip_l []
while {1} {
set cur [lmap a_l $list_l { lindex $a_l 0 }]
set list_l [lmap a_l $list_l { lrange $a_l 1 end }]
#2024 - outperforms lmap version - presumably because list sizes reduced as it goes(?)
proc lzipn_tcl8 {args} {
#For tcl pre 9 (without lsearch -stride)
#wiki - courtesy JAL
set list_l $args
set zip_l []
while {1} {
set cur [lmap a_l $list_l { lindex $a_l 0 }]
set list_l [lmap a_l $list_l { lrange $a_l 1 end }]
if {[join $cur {}] eq {}} {
break
if {[join $cur {}] eq {}} {
break
}
lappend zip_l $cur
}
return $zip_l
}
proc lzipn_tcl9a {args} {
#For Tcl 9+ (with lsearch -stride)
#compared to wiki version
#comparable for lists len <3 or number of args < 3
#approx 2x faster for large lists or more lists
#needs -stride single index bug fix to use empty string instead of NULL
if {![llength $args]} {return {}}
set lens [lmap l $args {llength $l}]
set numcolumns [::tcl::mathfunc::max {*}$lens]
set flatlist [lrepeat [expr {$numcolumns * [llength $args]}] {}]
set outlist [lrepeat $numcolumns {}]
set s 0
foreach len $lens list $args {
#ledit flatlist $s $e {*}$l {*}[lrepeat [expr {($numcolumns -([llength $l] % $numcolumns)) % $numcolumns}] NULL]
ledit flatlist $s [expr {$s + $len - 1}] {*}$list
incr s $numcolumns
}
#needs single index lstride bugfix
for {set c 0} {$c < $numcolumns} {incr c} {
ledit outlist $c $c [lsearch -stride $numcolumns -index $c -inline -all -subindices $flatlist *]
}
return $outlist
}
proc lzipn_tcl9b {args} {
if {![llength $args]} {return {}}
set lens [lmap l $args {llength $l}]
set numcolumns [::tcl::mathfunc::max {*}$lens]
set flatlist [list]
foreach len $lens list $args {
lappend flatlist {*}$list {*}[lrepeat [expr {($numcolumns - ($len % $numcolumns)) % $numcolumns}] ""]
}
lmap c [lseq 0 $numcolumns-1] {lsearch -stride $numcolumns -index $c -inline -all -subindices $flatlist *}
}
proc lzipn_tcl9c {args} {
#SLOW
if {![llength $args]} {return {}}
set lens [lmap l $args {llength $l}]
set numcolumns [::tcl::mathfunc::max {*}$lens]
set flatlist [list]
foreach len $lens list $args {
lappend flatlist {*}$list {*}[lrepeat [expr {($numcolumns - ($len % $numcolumns)) % $numcolumns}] ""]
}
set zip_l {}
set cols_remaining $numcolumns
for {set c 0} {$c < $numcolumns} {incr c} {
if {$cols_remaining == 1} {
return [list {*}$zip_l $flatlist]
}
lappend zip_l [lsearch -stride $cols_remaining -index 0 -inline -all -subindices $flatlist *]
set flen [llength $flatlist]
set flatlist [lremove $flatlist {*}[lseq 0 to $flen-1 by $cols_remaining]]
incr cols_remaining -1
}
lappend zip_l $cur
return $zip_l
}
return $zip_l
}
proc lzipn_tcl9a {args} {
#compared to wiki version
#comparable for lists len <3 or number of args < 3
#approx 2x faster for large lists or more lists
#needs -stride single index bug fix to use empty string instead of NULL
if {![llength $args]} {return {}}
set lens [lmap l $args {llength $l}]
set numcolumns [::tcl::mathfunc::max {*}$lens]
set flatlist [lrepeat [expr {$numcolumns * [llength $args]}] {}]
set outlist [lrepeat $numcolumns {}]
set s 0
foreach len $lens list $args {
#ledit flatlist $s $e {*}$l {*}[lrepeat [expr {($numcolumns -([llength $l] % $numcolumns)) % $numcolumns}] NULL]
ledit flatlist $s [expr {$s + $len - 1}] {*}$list
incr s $numcolumns
}
#needs single index lstride bugfix
for {set c 0} {$c < $numcolumns} {incr c} {
ledit outlist $c $c [lsearch -stride $numcolumns -index $c -inline -all -subindices $flatlist *]
}
return $outlist
}
proc lzipn_tcl9b {args} {
if {![llength $args]} {return {}}
set lens [lmap l $args {llength $l}]
set numcolumns [::tcl::mathfunc::max {*}$lens]
set flatlist [list]
foreach len $lens list $args {
lappend flatlist {*}$list {*}[lrepeat [expr {($numcolumns - ($len % $numcolumns)) % $numcolumns}] ""]
}
lmap c [lseq 0 $numcolumns-1] {lsearch -stride $numcolumns -index $c -inline -all -subindices $flatlist *}
}
proc lzipn_tcl9c {args} {
#SLOW
if {![llength $args]} {return {}}
set lens [lmap l $args {llength $l}]
set numcolumns [::tcl::mathfunc::max {*}$lens]
set flatlist [list]
foreach len $lens list $args {
lappend flatlist {*}$list {*}[lrepeat [expr {($numcolumns - ($len % $numcolumns)) % $numcolumns}] ""]
}
set zip_l {}
set cols_remaining $numcolumns
for {set c 0} {$c < $numcolumns} {incr c} {
if {$cols_remaining == 1} {
return [list {*}$zip_l $flatlist]
}
lappend zip_l [lsearch -stride $cols_remaining -index 0 -inline -all -subindices $flatlist *]
set flen [llength $flatlist]
set flatlist [lremove $flatlist {*}[lseq 0 to $flen-1 by $cols_remaining]]
incr cols_remaining -1
}
return $zip_l
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lzipn
@cmd -name punk::lib::lzipn\
-summary\
"zip any number of lists together (unoptimised)."\
-help\
"Conceptually equivalent to converting a list of rows
to a list of columns.
See lzip which provides the same functionality but with
optimisations depending on the number of supplied lists.
"
@values -min 1 -max 1
lvar -type string -help\
"name of list variable"
a -type indexexpression
z -type indexexpression
}]
}
#keep both lzipn_tclX functions available for side-by-side testing in Tcl versions where it's possible
if {![package vsatisfies [package present Tcl] 9.0-] || [dict get [punk::lib::check::has_tclbug_lsearch_strideallinline] bug]} {
#-stride either not available - or has bug preventing use of main algorithm below
proc lzipn {args} [info body ::punk::lib::lzipn_tcl8]
proc lzipn {args} [info body ::punk::lib::system::lzipn_tcl8]
} else {
proc lzipn {args} [info body ::punk::lib::lzipn_tcl9a]
proc lzipn {args} [info body ::punk::lib::system::lzipn_tcl9a]
}
namespace import ::punk::args::lib::tstr
namespace eval argdoc {
@ -2291,13 +2364,31 @@ namespace eval punk::lib {
proc is_list_all_ni_list2 {a b} $body
}
#somewhat like struct::set difference - but order preserving, and doesn't treat as a 'set' so preserves dupes in fromlist
#struct::set difference may happen to preserve ordering when items are integers, but order can't be relied on,
# especially as struct::set has 2 differing implementations (tcl vs critcl) which return results with different ordering to each other and different deduping behaviour in some cases (e.g empty 2nd arg)
proc ldiff {fromlist removeitems} {
if {[llength $removeitems] == 0} {return $fromlist}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::ldiff
@cmd -name punk::lib::ldiff\
-summary\
"Difference consisting of items with removeitems removed."\
-help\
"Somewhat like struct::set difference, but order preserving, and doesn't
treat as a 'set' so preserves any duplicates in items.
struct::set difference may happen to preserve ordering when items are
integers, but order can't be relied on, especially as struct::set has
2 differening implementations (tcl vs critcl) which return results with
different ordering to each other and different deduping behaviour in
some cases (e.g when 2nd arg is empty)"
@values -min 2 -max 2
items -type list
removeitems -type list
}]
}
proc ldiff {items removeitems} {
if {[llength $removeitems] == 0} {return $items}
set result {}
foreach item $fromlist {
foreach item $items {
if {$item ni $removeitems} {
lappend result $item
}
@ -2361,6 +2452,28 @@ namespace eval punk::lib {
return [array names tmp]
}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lunique_unordered
@cmd -name punk::lib::lunique_unordered\
-summary\
"unique values in list"\
-help\
"Return unique values in provided list.
This removes duplicates but *may* rearrange the
order of the returned elements compared to the
original list.
When struct::set is available this will be used
for the implementation, as it can be *slightly*
faster if acceleration is present. When struct::set
is not available it will fallback to lunique and
provide the same functionality with order preserved."
@values -min 1 -max 1
list -type list
}]
}
#default/fallback implementation
proc lunique_unordered {list} {
lunique $list
@ -2371,13 +2484,33 @@ namespace eval punk::lib {
struct::set union $list {}
}
} else {
puts stderr "WARNING: struct::set union <list> <emptylist> no longer dedupes!"
#struct::set union operates on a 'set' - so this probably won't change, and hopefully is
#consistent across unacelerated versions and those implemented in accelerators,
#but if it ever does change - be a little noisy about it.
puts stderr "punk::lib WARNING: struct::set union <list> <emptylist> no longer dedupes!"
#we could also test a sequence of: struct::set add
}
}
#order-preserving
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lunique
@cmd -name punk::lib::lunique\
-summary\
"Order-preserving unique values in list"\
-help\
"Return unique values in provided list.
This removes duplicates whilst preserving the
original order of the provided list.
When struct::set is available with acceleration,
lunique_unordered may be slightly faster."
@values -min 1 -max 1
list -type list
}]
}
proc lunique {list} {
set new {}
foreach item $list {
@ -2569,18 +2702,21 @@ namespace eval punk::lib {
To validate if an indexset is strictly within range, both the length of the data and the base would
need to be considered.
The normal 'range' specifier is ..
The normal 'range' specifier is .. but can be of the form .x. where x is the step value.
The range specifier can appear at the beginning, middle or end, or even alone to indicate the entire
range of valid values.
e.g the following are all valid ranges
1..
(index 1 to 'max')
..10
(index 'base' to 10)
2..11
(index 2 to 11)
..
(all indices)
1..
(index 1 to 'max')
..10
(index 'base' to 10)
2..11
(index 2 to 11)
..
(all indices)
.3.
(1st index and every 3rd index thereafter)
Common whitespace elements space,tab,newlines are ignored.
Each index (or endpoint of an index-range) can be of the forms accepted by Tcl list or string commands,
e.g end-2 or 2+2.
@ -2670,20 +2806,19 @@ namespace eval punk::lib {
.-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
If end is omitted and only the start 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
Like the tcl9 lseq command - a step (by) value of zero produces no results.
@ -2703,7 +2838,7 @@ namespace eval punk::lib {
indexset examples:
These assume the default 0-based indices (base == 0)
These assume the default 0-based indices (-base 0)
1,3..
output the index 1 (2nd item) followed by all from index 3 to the end.
@ -3604,7 +3739,7 @@ namespace eval punk::lib {
@id -id ::punk::lib::gcd
@cmd -name punk::lib::gcd\
-summary\
"Gretest common divisor of m and n."\
"Greatest common divisor of m and n."\
-help\
"Return the greatest common divisor of m and n.
Straight from Lars Hellström's math::numtheory library in Tcllib
@ -3643,12 +3778,22 @@ namespace eval punk::lib {
return $m
}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lcm
@cmd -name punk::lib::lcm\
-summary\
"Lowest common multiple of m and n."\
-help\
"Return the lowest common multiple of m and n.
Straight from Lars Hellström's math::numtheory library in Tcllib"
@values -min 2 -max 2
m -type integer
n -type integer
}]
}
proc lcm {n m} {
#*** !doctools
#[call [fun gcd] [arg n] [arg m]]
#[para]Return the lowest common multiple of m and n
#[para]Straight from Lars Hellström's math::numtheory library in Tcllib
#[para]
set gcd [gcd $n $m]
return [expr {$n*$m/$gcd}]
}

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

@ -1036,7 +1036,8 @@ namespace eval punk::repl::class {
# set o_rendered_lines [linsert $o_rendered_lines $cursor_row_idx ""]
# incr nextrow -1
#}
set o_rendered_lines [linsert $o_rendered_lines $cursor_row_idx ""]
#set o_rendered_lines [linsert $o_rendered_lines $cursor_row_idx ""]
ledit o_rendered_lines $cursor_row_idx $cursor_row_idx-1 ""
set o_cursor_col 1
}

18
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punkcheck-0.1.0.tm
Unescape View File

@ -323,7 +323,8 @@ namespace eval punkcheck {
if {$isnew} {
lappend record_list $o_fileset_record
} else {
set record_list [linsert $record_list[unset record_list] $oldposition $o_fileset_record]
#set record_list [linsert $record_list[unset record_list] $oldposition $o_fileset_record]
ledit record_list $oldposition $oldposition-1 $o_fileset_record
}
if {$o_operation ne "QUERY"} {
punkcheck::save_records_to_file $record_list $punkcheck_file
@ -536,7 +537,8 @@ namespace eval punkcheck {
set existing_header_posn [dict get $resultinfo position]
if {$existing_header_posn == -1} {
set this_installer_record [punkcheck::recordlist::new_installer_record $o_name]
set o_record_list [linsert $o_record_list 0 $this_installer_record]
#set o_record_list [linsert $o_record_list 0 $this_installer_record]
ledit o_record_list -1 -1 $this_installer_record
} else {
set this_installer_record [dict get $resultinfo record]
}
@ -616,7 +618,8 @@ namespace eval punkcheck {
set persistedinfo [punkcheck::recordlist::get_installer_record $o_name $file_records]
set existing_header_posn [dict get $persistedinfo position]
if {$existing_header_posn == -1} {
set file_records [linsert $file_records 0 $this_installer_record]
#set file_records [linsert $file_records 0 $this_installer_record]
ledit file_records -1 -1 $this_installer_record
} else {
lset file_records $existing_header_posn $this_installer_record
}
@ -710,7 +713,8 @@ namespace eval punkcheck {
if {$existing_header_posn == -1} {
#not found - prepend
set record_list [linsert $record_list 0 $this_installer_record]
#set record_list [linsert $record_list 0 $this_installer_record]
ledit record_list -1 -1 $this_installer_record
} else {
#replace
lset record_list $existing_header_posn $this_installer_record
@ -791,7 +795,8 @@ namespace eval punkcheck {
if {$isnew} {
lappend record_list $file_record
} else {
set record_list [linsert $record_list[unset record_list] $oldposition $file_record]
#set record_list [linsert $record_list[unset record_list] $oldposition $file_record]
ledit record_list $oldposition $oldposition-1 $file_record
}
save_records_to_file $record_list $punkcheck_file
@ -1191,7 +1196,8 @@ namespace eval punkcheck {
# dst is: base/sub = sub
while {$baselen > 0} {
set dst [linsert $dst 0 ..]
#set dst [linsert $dst 0 ..]
ledit dst -1 -1 ..
incr baselen -1
}
set dst [file join {*}$dst]

32
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/textblock-0.1.3.tm
Unescape View File

@ -4480,7 +4480,8 @@ tcl::namespace::eval textblock {
set code_idx 3
foreach {pt code} [lrange $parts 2 end] {
if {[punk::ansi::codetype::is_sgr_reset $code]} {
set parts [linsert $parts $code_idx+1 $base]
#set parts [linsert $parts $code_idx+1 $base]
ledit parts $code_idx+1 $code_idx $base
}
incr code_idx 2
}
@ -4504,12 +4505,14 @@ tcl::namespace::eval textblock {
#first pt & code
if {$pt ne ""} {
#leading plaintext
set parts [linsert $parts 0 $base]
#set parts [linsert $parts 0 $base]
ledit parts -1 -1 $base
incr offset
}
}
if {[punk::ansi::codetype::is_sgr_reset $code]} {
set parts [linsert $parts [expr {$code_idx+1+$offset}] $base]
#ledit parts [expr {$code_idx+1+$offset}] $code_idx+$offset $base
incr offset
}
incr code_idx 2
@ -5371,6 +5374,9 @@ tcl::namespace::eval textblock {
r-1 {
if {[lindex $line_chunks end] eq ""} {
set line_chunks [linsert $line_chunks end-2 $pad]
#breaks layout e.g subtables in: i i
#why?
#ledit line_chunks end-2 end-3 $pad
} else {
lappend line_chunks $pad
}
@ -5379,13 +5385,16 @@ tcl::namespace::eval textblock {
lappend line_chunks $pad
}
l-0 {
set line_chunks [linsert $line_chunks 0 $pad]
#set line_chunks [linsert $line_chunks 0 $pad]
ledit line_chunks -1 -1 $pad
}
l-1 {
if {[lindex $line_chunks 0] eq ""} {
set line_chunks [linsert $line_chunks 2 $pad]
#set line_chunks [linsert $line_chunks 2 $pad]
ledit line_chunks 2 1 $pad
} else {
set line_chunks [linsert $line_chunks 0 $pad]
#set line_chunks [linsert $line_chunks 0 $pad]
ledit line_chunks -1 -1 $pad
}
}
l-2 {
@ -5393,10 +5402,12 @@ tcl::namespace::eval textblock {
if {[lindex $line_chunks 0] eq ""} {
set line_chunks [linsert $line_chunks 2 $pad]
} else {
set line_chunks [linsert $line_chunks 0 $pad]
#set line_chunks [linsert $line_chunks 0 $pad]
ledit line_chunks -1 -1 $pad
}
} else {
set line_chunks [linsert $line_chunks 0 $pad]
#set line_chunks [linsert $line_chunks 0 $pad]
ledit line_chunks -1 -1 $pad
}
}
}
@ -5466,14 +5477,17 @@ tcl::namespace::eval textblock {
#} else {
# set line_chunks [linsert $line_chunks 0 $pad]
#}
set line_chunks [linsert $line_chunks 0 $pad]
#set line_chunks [linsert $line_chunks 0 $pad]
ledit line_chunks -1 -1 $pad
}
l-1 {
#set line_chunks [linsert $line_chunks 0 $pad]
set line_chunks [_insert_before_text_or_last_ansi $pad $line_chunks]
}
l-2 {
set line_chunks [linsert $line_chunks 0 $pad]
#set line_chunks [linsert $line_chunks 0 $pad]
ledit line_chunks -1 -1 $pad
}
}
}

148
src/vfs/_vfscommon.vfs/modules/dictn-0.1.2.tm
Unescape View File

@ -25,17 +25,46 @@
namespace eval dictn {
namespace export {[a-z]*}
namespace ensemble create
namespace eval argdoc {
variable PUNKARGS
#non-colour SGR codes
set I "\x1b\[3m" ;# [a+ italic]
set NI "\x1b\[23m" ;# [a+ noitalic]
set B "\x1b\[1m" ;# [a+ bold]
set N "\x1b\[22m" ;# [a+ normal]
set T "\x1b\[1\;4m" ;# [a+ bold underline]
set NT "\x1b\[22\;24m\x1b\[4:0m" ;# [a+ normal nounderline]
}
}
## ::dictn::append
#This can of course 'ruin' a nested dict if applied to the wrong element
# - i.e using the string op 'append' on an element that is itself a nested dict is analogous to the standard Tcl:
# %set list {a b {c d}}
# %append list x
# a b {c d}x
# IOW - don't do that unless you really know that's what you want.
#
tcl::namespace::eval ::dictn::argdoc {
lappend PUNKARGS [list {
@id -id ::dictn::append
@cmd -name dictn::append\
-summary\
"Append a single string to the value at dict path."\
-help\
"Append a single string to the value at a given dictionary path.
This can of course 'ruin' a nested dict if applied to the wrong element
- i.e using the string op 'append' on an element that is itself a nested dict is analogous to the standard Tcl:
%set list {a b {c d}}
%append list x
a b {c d}x
IOW - don't do that unless you really know that's what you want.
Note than unlike dict append - only a single value is accepted for appending.
"
@values -min 2 -max 3
dictvar -type string
path -type list
value -type any -default "" -optional 1
}]
}
proc ::dictn::append {dictvar path {value {}}} {
if {[llength $path] == 1} {
uplevel 1 [list dict append $dictvar $path $value]
@ -43,7 +72,7 @@ proc ::dictn::append {dictvar path {value {}}} {
upvar 1 $dictvar dvar
::set str [dict get $dvar {*}$path]
append str $val
append str $value
dict set dvar {*}$path $str
}
}
@ -73,6 +102,25 @@ proc ::dictn::for {keyvalvars dictval path body} {
proc ::dictn::get {dictval {path {}}} {
return [dict get $dictval {*}$path]
}
tcl::namespace::eval ::dictn::argdoc {
lappend PUNKARGS [list {
@id -id ::dictn::getn
@cmd -name dictn::getn\
-summary\
"Get one or more paths in a dict simultaneously."\
-help\
""
@values -min 1 -max -1
dictvar -type string
path -type list -multiple 1
}]
}
proc ::dictn::getn {dictval args} {
if {![llength $args]} {
return [::tcl::dict::get $dictval]
}
lmap path $args {::tcl::dict::get $dictval {*}$path}
}
if {[info commands ::tcl::dict::getdef] ne ""} {
@ -85,10 +133,18 @@ if {[info commands ::tcl::dict::getdef] ne ""} {
return [dict getdef $dictval {*}$path $default]
}
proc ::dictn::incr {dictvar path {increment {}} } {
if {$increment eq ""} {
::set increment 1
proc ::dictn::incr {dictvar path {increment 1} } {
upvar 1 $dictvar dvar
if {[llength $path] == 1} {
return [::tcl::dict::incr dvar $path $increment]
}
if {[::tcl::info::exists dvar]} {
::set increment [expr {[::tcl::dict::getdef $dvar {*}$path 0] + $increment}]
}
return [::tcl::dict::set dvar {*}$path $increment]
}
#test - compare disassembly
proc ::dictn::incr2 {dictvar path {increment 1} } {
if {[llength $path] == 1} {
uplevel 1 [list dict incr $dictvar $path $increment]
} else {
@ -233,6 +289,33 @@ proc ::dictn::set {dictvar path newval} {
return [dict set dvar {*}$path $newval]
}
tcl::namespace::eval ::dictn::argdoc {
lappend PUNKARGS [list {
@id -id ::dictn::setn
@cmd -name dictn::setn\
-summary\
"Set one or more paths in a dict to value(s)"\
-help\
""
@values -min 3 -max -1
dictvar -type string
path_newval -type {path newval} -multiple 1
}]
}
proc ::dictn::setn {dictvar args} {
if {[llength $args] == 0} {
error "dictn::setn requires at least one <path> <newval> pair"
}
if {[llength $args] % 2 != 0} {
error "dictn::setn requires trailing <path> <newval> pairs"
}
upvar 1 $dictvar dvar
foreach {p v} $args {
::tcl::dict::set dvar {*}$p $v
}
return $dvar
}
proc ::dictn::size {dictval {path {}}} {
return [dict size [dict get $dictval {*}$path]]
}
@ -312,6 +395,46 @@ proc ::dictn::values {dictval {path {}} {glob {}}} {
}
}
tcl::namespace::eval ::dictn::argdoc {
lappend PUNKARGS [list {
@id -id ::dictn::with
@cmd -name dictn::with\
-summary\
"Execute script for each key at dict path."\
-help\
"Execute the Tcl script in body with the value for each key within the
given key-path mapped to either variables or keys in a specified array.
If the name of an array variable is not supplied for arrayvar,
dictn with behaves like dict with, except that it accepts a list
for the possibly nested key-path instead of separate arguments.
The subkeys of the dict at the given key-path will create variables
in the calling scope.
If an arrayvar is passed, an array of that name in the calling
scope will be populated with keys and values from the subkeys and
values of the dict at the given key-path."
@form -form standard
@values -min 3 -max 3
dictvar -type string
path -type list
body -type string
@form -form array
@values -min 4 -max 4
dictvar -type string
path -type list
arrayvar -type string -help\
"Name of array variable in which key values are
stored for the given dict path.
This prevents key values being used as variable
names in the calling scope, instead capturing them
as keys in the single specified array at the calling
scope."
body -type string
}]
}
# Standard form:
#'dictn with dictVariable path body'
#
@ -351,7 +474,10 @@ proc ::dictn::with {dictvar path args} {
::tcl::namespace::eval ::punk::args::register {
#use fully qualified so 8.6 doesn't find existing var in global namespace
lappend ::punk::args::register::NAMESPACES ::dictn
}

94
src/vfs/_vfscommon.vfs/modules/overtype-1.7.3.tm
Unescape View File

@ -569,9 +569,10 @@ tcl::namespace::eval overtype {
#while {$overidx < [llength $inputchunks]} { }
while {[llength $inputchunks]} {
#set overtext [lindex $inputchunks $overidx]; lset inputchunks $overidx ""
set overtext [lpop inputchunks 0]
if {![tcl::string::length $overtext]} {
set overtext [lpop inputchunks 0] ;#could be a list 'ansisplit' or text 'plain|mixed'
#use eq test with emptystring instead of 'string length' - test for emptiness shouldn't cause shimmering if popped inputchunks member if an 'ansisplit' list
if {$overtext eq ""} {
incr loop
continue
}
@ -582,7 +583,6 @@ tcl::namespace::eval overtype {
#renderline pads each underaly line to width with spaces and should track where end of data is
#set overtext [tcl::string::cat [lindex $replay_codes_overlay $overidx] $overtext]
set overtext $replay_codes_overlay$overtext
if {[tcl::dict::exists $replay_codes_underlay $row]} {
set undertext [tcl::dict::get $replay_codes_underlay $row]$undertext
@ -827,6 +827,9 @@ tcl::namespace::eval overtype {
set foldline [tcl::dict::get $sub_info result]
tcl::dict::set vtstate insert_mode [tcl::dict::get $sub_info insert_mode] ;#probably not needed..?
tcl::dict::set vtstate autowrap_mode [tcl::dict::get $sub_info autowrap_mode] ;#nor this..
#todo!!!
# 2025 fix - this does nothing - so what uses it?? create a test!
linsert outputlines $renderedrow $foldline
#review - row & col set by restore - but not if there was no save..
}
@ -919,9 +922,23 @@ tcl::namespace::eval overtype {
set edit_mode 0
if {$edit_mode} {
set inputchunks [linsert $inputchunks 0 $overflow_right$unapplied]
#set inputchunks [linsert $inputchunks 0 $overflow_right$unapplied]
#JMN
ledit inputchunks -1 -1 $overflow_right$unapplied
set pt_ansi_pt [punk::ansi::ta::split_codes_single $overflow_right]
#join the trailing and leading pt parts of the 2 lists
ledit pt_ansi_pt end end "[lindex $pt_ansi_pt end][lindex $unapplied_list 0]"
lappend pt_ansi_pt [lrange $unapplied_list 1 end]
ledit inputchunks -1 -1 $pt_ansi_pt ;#combined overflow_right and unapplied - in ansisplit form
#JMN 2025
set overtext_type "ansisplit"
set overflow_right ""
set unapplied ""
set unapplied_list [list]
set row $post_render_row
#set col $post_render_col
set col $opt_startcolumn
@ -1311,7 +1328,9 @@ tcl::namespace::eval overtype {
}
if {$nextprefix ne ""} {
set inputchunks [linsert $inputchunks 0 $nextprefix]
#set inputchunks [linsert $inputchunks 0 $nextprefix]
#JMN - assume backwards compat ledit available from punk::lib (for tcl <9)
ledit inputchunks -1 -1 $nextprefix
}
@ -2026,7 +2045,10 @@ tcl::namespace::eval overtype {
-cursor_restore_attributes ""\
-cp437 0\
-experimental {}\
-overtext_type mixed\
]
#-overtext_type plain|mixed|ansisplit
#-cursor_restore_attributes only - for replay stack - position and actual setting/restoring handled by throwback to caller
#cursor_row, when numeric will allow detection of certain row moves that are still within our row - allowing us to avoid an early return
@ -2040,7 +2062,7 @@ tcl::namespace::eval overtype {
switch -- $k {
-experimental - -cp437 - -width - -expand_right - -transparent - -startcolumn - -cursor_column - -cursor_row
- -crm_mode - -insert_mode - -autowrap_mode - -reverse_mode
- -info - -exposed1 - -exposed2 - -cursor_restore_attributes {
- -info - -exposed1 - -exposed2 - -cursor_restore_attributes - -overtext_type {
tcl::dict::set opts $k $v
}
default {
@ -2055,6 +2077,7 @@ tcl::namespace::eval overtype {
set opt_colstart [tcl::dict::get $opts -startcolumn] ;#lhs limit for overlay - an offset to cursor_column - first visible column is 1. 0 or < 0 are before the start of the underlay
set opt_colcursor [tcl::dict::get $opts -cursor_column];#start cursor column relative to overlay
set opt_row_context [tcl::dict::get $opts -cursor_row]
set opt_overtext_type [tcl::dict::get $opts -overtext_type]
if {[string length $opt_row_context]} {
if {![tcl::string::is integer -strict $opt_row_context] || $opt_row_context <1 } {
error "overtype::renderline -cursor_row must be empty for unspecified/unknown or a non-zero positive integer. received: '$opt_row_context'"
@ -2128,9 +2151,16 @@ tcl::namespace::eval overtype {
#set under [textutil::tabify::untabify2 $under]
set under [textutil::tabify::untabifyLine $under $tw]
}
if {[string first \t $over] >= 0} {
#set overdata [textutil::tabify::untabify2 $over]
set overdata [textutil::tabify::untabifyLine $over $tw]
#review - is untabifying sensible at this point??
if {$opt_overtext_type eq "ansisplit"} {
#todo - something for each pt part?
} else {
#plain|mixed
if {[string first \t $over] >= 0} {
#set overdata [textutil::tabify::untabify2 $over]
set overdata [textutil::tabify::untabifyLine $over $tw]
}
}
}
}
@ -2415,11 +2445,21 @@ tcl::namespace::eval overtype {
set startpadding [string repeat " " [expr {$opt_colstart -1}]]
#overdata with left padding spaces based on col-start under will show through for left-padding portion regardless of -transparency
if {$startpadding ne "" || $overdata ne ""} {
if {[punk::ansi::ta::detect $overdata]} {
set overmap [punk::ansi::ta::split_codes_single $startpadding$overdata]
if {$opt_overtext_type eq "ansisplit"} {
set overmap $overdata
lset overmap 0 "$startpadding[lindex $overmap 0]"
} else {
#single plaintext part
set overmap [list $startpadding$overdata]
if {[punk::ansi::ta::detect $overdata]} {
#TODO!! rework this.
#e.g 200K+ input file with no newlines - we are wastefully calling split_codes_single repeatedly on mostly the same data.
#set overmap [punk::ansi::ta::split_codes_single $startpadding$overdata]
set overmap [punk::ansi::ta::split_codes_single $overdata]
lset overmap 0 "$startpadding[lindex $overmap 0]"
} else {
#single plaintext part
set overmap [list $startpadding$overdata]
}
}
} else {
set overmap [list]
@ -2453,8 +2493,13 @@ tcl::namespace::eval overtype {
set pt_overchars ""
set i_o 0
set overlay_grapheme_control_list [list] ;#tag each with g, sgr or other. 'other' are things like cursor-movement or insert-mode or codes we don't recognise/use
#experiment
set overlay_grapheme_control_stacks [list]
#REVIEW - even if we pass in a pre-split overtext (-overtext_type ansisplit)
#we are re-generating the overlay_grapheme_control_stacks list each time
#this is a big issue when overtext is not broken into lines, but is just a big long ansi and/or plain text string.
#todo - return also the unapplied portion of the overlay_grapheme_control_stacks list??
foreach {pt code} $overmap {
if {$pt ne ""} {
#todo - wrap in test for empty pt (we used split_codes_single - and it may be common for sgr sequences to be unmerged and so have empty pts between)
@ -2725,7 +2770,9 @@ tcl::namespace::eval overtype {
if {[llength [split $chars ""]] > 1} {
priv::render_unapplied $overlay_grapheme_control_list $gci
#prefix the unapplied controls with the string version of this control
set unapplied_list [linsert $unapplied_list 0 {*}[split $chars ""]]
#set unapplied_list [linsert $unapplied_list 0 {*}[split $chars ""]]
#JMN - backwards compat ledit from punk::lib for tcl <9
ledit unapplied_list -1 -1 {*}[split $chars ""]
set unapplied [join $unapplied_list ""]
#incr idx_over
break
@ -3085,7 +3132,9 @@ tcl::namespace::eval overtype {
set chars [ansistring VIEW -nul 1 -lf 1 -vt 1 -ff 1 $item]
priv::render_unapplied $overlay_grapheme_control_list $gci
#prefix the unapplied controls with the string version of this control
set unapplied_list [linsert $unapplied_list 0 {*}[split $chars ""]]
#set unapplied_list [linsert $unapplied_list 0 {*}[split $chars ""]]
#JMN
ledit unapplied_list -1 -1 {*}[split $chars ""]
set unapplied [join $unapplied_list ""]
break
@ -4923,13 +4972,18 @@ tcl::namespace::eval overtype::priv {
} else {
#insert of single-width vs double-width when underlying is double-width?
if {$i < $nxt} {
set o [linsert $o $i $c]
#set o [linsert $o $i $c]
#JMN insert via ledit
ledit o $i $i-1 $c
} else {
lappend o $c
}
if {$i < [llength $ustacks]} {
set ustacks [linsert $ustacks $i $sgrstack]
set gxstacks [linsert $gxstacks $i $gx0stack]
#set ustacks [linsert $ustacks $i $sgrstack]
#set gxstacks [linsert $gxstacks $i $gx0stack]
#insert via ledit
ledit ustacks $i $i-1 $sgrstack
ledit gxstacks $i $i-1 $gx0stack
} else {
lappend ustacks $sgrstack
lappend gxstacks $gx0stack

5199
src/vfs/_vfscommon.vfs/modules/overtype-1.7.4.tm
View File

File diff suppressed because it is too large Load Diff

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

@ -751,6 +751,27 @@ namespace eval punk::lib {
# -- ---
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lswap
@cmd -name punk::lib::lswap\
-summary\
"Swap list values in-place"\
-help\
"Similar to struct::list swap, except it fully supports basic
list index expressions such as 7-2 end-1 etc.
struct::list swap doesn't support 'end' offsets, and only
sometimes appears to support basic expressions, depending on the
expression compared to the list length."
@values -min 1 -max 1
lvar -type string -help\
"name of list variable"
a -type indexexpression
z -type indexexpression
}]
}
proc lswap {lvar a z} {
upvar $lvar l
set len [llength $l]
@ -955,181 +976,233 @@ namespace eval punk::lib {
}
}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lzip
@cmd -name punk::lib::lzip\
-summary\
"zip any number of lists together."\
-help\
"Conceptually equivalent to converting a list of rows
to a list of columns.
The number of returned lists (columns) will be equal to
the length of the longest supplied list (row).
If lengths of supplied lists don't match, empty strings
will be inserted in the resulting lists.
e.g lzip {a b c d e} {1 2 3 4} {x y z}
-> {a 1 x} {b 2 y} {c 3 z} {d 4 {}} {3 {} {}}
"
@values -min 1 -max 1
lvar -type string -help\
"name of list variable"
a -type indexexpression
z -type indexexpression
}]
}
proc lzip {args} {
switch -- [llength $args] {
0 {return {}}
1 {return [lindex $args 0]}
2 {return [lzip2lists {*}$args]}
3 {return [lzip3lists {*}$args]}
4 {return [lzip4lists {*}$args]}
5 {return [lzip5lists {*}$args]}
6 {return [lzip6lists {*}$args]}
7 {return [lzip7lists {*}$args]}
8 {return [lzip8lists {*}$args]}
9 {return [lzip9lists {*}$args]}
10 {return [lzip10lists {*}$args]}
0 {return {}}
1 {return [lindex $args 0]}
2 {return [::punk::lib::system::lzip2lists {*}$args]}
3 {return [::punk::lib::system::lzip3lists {*}$args]}
4 {return [::punk::lib::system::lzip4lists {*}$args]}
5 {return [::punk::lib::system::lzip5lists {*}$args]}
6 {return [::punk::lib::system::lzip6lists {*}$args]}
7 {return [::punk::lib::system::lzip7lists {*}$args]}
8 {return [::punk::lib::system::lzip8lists {*}$args]}
9 {return [::punk::lib::system::lzip9lists {*}$args]}
10 {return [::punk::lib::system::lzip10lists {*}$args]}
11 - 12 - 13 - 14 - 15 - 16 - 17 - 18 - 19 - 20 - 21 - 22 - 23 - 24 - 25 - 26 - 27 - 28 - 29 - 30 - 31 - 32 {
set n [llength $args]
if {[info commands ::punk::lib::lzip${n}lists] eq ""} {
puts "calling ::punk::lib::Build_lzipn $n"
::punk::lib::Build_lzipn $n
if {[info commands ::punk::lib::system::lzip${n}lists] eq ""} {
#puts "calling ::punk::lib::system::Build_lzipn $n"
::punk::lib::system::Build_lzipn $n
}
return [lzip${n}lists {*}$args]
return [::punk::lib::system::lzip${n}lists {*}$args]
}
default {
if {[llength $args] < 4000} {
set n [llength $args]
if {[info commands ::punk::lib::lzip${n}lists] eq ""} {
puts "calling ::punk::lib::Build_lzipn $n"
::punk::lib::Build_lzipn $n
if {[info commands ::punk::lib::system::lzip${n}lists] eq ""} {
#puts "calling ::punk::lib::system::Build_lzipn $n"
::punk::lib::system::Build_lzipn $n
}
return [lzip${n}lists {*}$args]
return [::punk::lib::system::lzip${n}lists {*}$args]
} else {
return [lzipn {*}$args]
return [::punk::lib::lzipn {*}$args]
}
}
}
}
proc Build_lzipn {n} {
set arglist [list]
#use punk::lib::range which defers to lseq if available
set vars [lmap i [punk::lib::range 0 $n] {string cat v$i}] ;#v0 v1 v2.. (v0 ignored)
set body "\nlmap "
for {set i 1} {$i <= $n} {incr i} {
lappend arglist l$i
append body "[lindex $vars $i] \$l$i "
}
append body "\{list "
for {set i 1} {$i <= $n} {incr i} {
append body "\$[lindex $vars $i] "
namespace eval system {
proc Build_lzipn {n} {
set arglist [list]
#use punk::lib::range which defers to lseq if available
set vars [lmap i [punk::lib::range 0 $n] {string cat v$i}] ;#v0 v1 v2.. (v0 ignored)
set body "\nlmap "
for {set i 1} {$i <= $n} {incr i} {
lappend arglist l$i
append body "[lindex $vars $i] \$l$i "
}
append body "\{list "
for {set i 1} {$i <= $n} {incr i} {
append body "\$[lindex $vars $i] "
}
append body "\}" \n
#puts "proc punk::lib::system::lzip${n}lists {$arglist} \{"
#puts "$body"
#puts "\}"
proc ::punk::lib::system::lzip${n}lists $arglist $body
}
append body "\}" \n
puts "proc punk::lib::lzip${n}lists {$arglist} \{"
puts "$body"
puts "\}"
proc ::punk::lib::lzip${n}lists $arglist $body
}
#fastest is to know the number of lists to be zipped
proc lzip2lists {l1 l2} {
lmap a $l1 b $l2 {list $a $b}
}
proc lzip3lists {l1 l2 l3} {
lmap a $l1 b $l2 c $l3 {list $a $b $c}
}
proc lzip4lists {l1 l2 l3 l4} {
lmap a $l1 b $l2 c $l3 d $l4 {list $a $b $c $d}
}
proc lzip5lists {l1 l2 l3 l4 l5} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 {list $a $b $c $d $e}
}
proc lzip6lists {l1 l2 l3 l4 l5 l6} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 {list $a $b $c $d $e $f}
}
proc lzip7lists {l1 l2 l3 l4 l5 l6 l7} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 {list $a $b $c $d $e $f $g}
}
proc lzip8lists {l1 l2 l3 l4 l5 l6 l7 l8} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 h $l8 {list $a $b $c $d $e $f $g $h}
}
proc lzip9lists {l1 l2 l3 l4 l5 l6 l7 l8 l9} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 h $l8 i $l9 {list $a $b $c $d $e $f $g $h $i}
}
proc lzip10lists {l1 l2 l3 l4 l5 l6 l7 l8 l9 l10} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 h $l8 i $l9 j $l10 {list $a $b $c $d $e $f $g $h $i $j}
}
#fastest is to know the number of lists to be zipped
proc lzip2lists {l1 l2} {
lmap a $l1 b $l2 {list $a $b}
}
proc lzip3lists {l1 l2 l3} {
lmap a $l1 b $l2 c $l3 {list $a $b $c}
}
proc lzip4lists {l1 l2 l3 l4} {
lmap a $l1 b $l2 c $l3 d $l4 {list $a $b $c $d}
}
proc lzip5lists {l1 l2 l3 l4 l5} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 {list $a $b $c $d $e}
}
proc lzip6lists {l1 l2 l3 l4 l5 l6} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 {list $a $b $c $d $e $f}
}
proc lzip7lists {l1 l2 l3 l4 l5 l6 l7} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 {list $a $b $c $d $e $f $g}
}
proc lzip8lists {l1 l2 l3 l4 l5 l6 l7 l8} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 h $l8 {list $a $b $c $d $e $f $g $h}
}
proc lzip9lists {l1 l2 l3 l4 l5 l6 l7 l8 l9} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 h $l8 i $l9 {list $a $b $c $d $e $f $g $h $i}
}
proc lzip10lists {l1 l2 l3 l4 l5 l6 l7 l8 l9 l10} {
lmap a $l1 b $l2 c $l3 d $l4 e $l5 f $l6 g $l7 h $l8 i $l9 j $l10 {list $a $b $c $d $e $f $g $h $i $j}
}
#neat algorithm - but while lmap seems better than foreach - it seems the script is evaluated a little slowly
# review -
proc lzipn_alt args {
#stackoverflow - courtesy glenn jackman (modified)
foreach l $args {
lappend vars [incr n]
lappend lmap_args $n $l
#neat algorithm - but while lmap seems better than foreach - it seems the script is evaluated a little slowly
# review -
proc lzipn_alt args {
#stackoverflow - courtesy glenn jackman (modified)
foreach l $args {
lappend vars [incr n]
lappend lmap_args $n $l
}
lmap {*}$lmap_args {lmap v $vars {set $v}}
}
lmap {*}$lmap_args {lmap v $vars {set $v}}
}
#2024 - outperforms lmap version - presumably because list sizes reduced as it goes(?)
proc lzipn_tcl8 {args} {
#wiki - courtesy JAL
set list_l $args
set zip_l []
while {1} {
set cur [lmap a_l $list_l { lindex $a_l 0 }]
set list_l [lmap a_l $list_l { lrange $a_l 1 end }]
#2024 - outperforms lmap version - presumably because list sizes reduced as it goes(?)
proc lzipn_tcl8 {args} {
#For tcl pre 9 (without lsearch -stride)
#wiki - courtesy JAL
set list_l $args
set zip_l []
while {1} {
set cur [lmap a_l $list_l { lindex $a_l 0 }]
set list_l [lmap a_l $list_l { lrange $a_l 1 end }]
if {[join $cur {}] eq {}} {
break
if {[join $cur {}] eq {}} {
break
}
lappend zip_l $cur
}
return $zip_l
}
proc lzipn_tcl9a {args} {
#For Tcl 9+ (with lsearch -stride)
#compared to wiki version
#comparable for lists len <3 or number of args < 3
#approx 2x faster for large lists or more lists
#needs -stride single index bug fix to use empty string instead of NULL
if {![llength $args]} {return {}}
set lens [lmap l $args {llength $l}]
set numcolumns [::tcl::mathfunc::max {*}$lens]
set flatlist [lrepeat [expr {$numcolumns * [llength $args]}] {}]
set outlist [lrepeat $numcolumns {}]
set s 0
foreach len $lens list $args {
#ledit flatlist $s $e {*}$l {*}[lrepeat [expr {($numcolumns -([llength $l] % $numcolumns)) % $numcolumns}] NULL]
ledit flatlist $s [expr {$s + $len - 1}] {*}$list
incr s $numcolumns
}
#needs single index lstride bugfix
for {set c 0} {$c < $numcolumns} {incr c} {
ledit outlist $c $c [lsearch -stride $numcolumns -index $c -inline -all -subindices $flatlist *]
}
return $outlist
}
proc lzipn_tcl9b {args} {
if {![llength $args]} {return {}}
set lens [lmap l $args {llength $l}]
set numcolumns [::tcl::mathfunc::max {*}$lens]
set flatlist [list]
foreach len $lens list $args {
lappend flatlist {*}$list {*}[lrepeat [expr {($numcolumns - ($len % $numcolumns)) % $numcolumns}] ""]
}
lmap c [lseq 0 $numcolumns-1] {lsearch -stride $numcolumns -index $c -inline -all -subindices $flatlist *}
}
proc lzipn_tcl9c {args} {
#SLOW
if {![llength $args]} {return {}}
set lens [lmap l $args {llength $l}]
set numcolumns [::tcl::mathfunc::max {*}$lens]
set flatlist [list]
foreach len $lens list $args {
lappend flatlist {*}$list {*}[lrepeat [expr {($numcolumns - ($len % $numcolumns)) % $numcolumns}] ""]
}
set zip_l {}
set cols_remaining $numcolumns
for {set c 0} {$c < $numcolumns} {incr c} {
if {$cols_remaining == 1} {
return [list {*}$zip_l $flatlist]
}
lappend zip_l [lsearch -stride $cols_remaining -index 0 -inline -all -subindices $flatlist *]
set flen [llength $flatlist]
set flatlist [lremove $flatlist {*}[lseq 0 to $flen-1 by $cols_remaining]]
incr cols_remaining -1
}
lappend zip_l $cur
return $zip_l
}
return $zip_l
}
proc lzipn_tcl9a {args} {
#compared to wiki version
#comparable for lists len <3 or number of args < 3
#approx 2x faster for large lists or more lists
#needs -stride single index bug fix to use empty string instead of NULL
if {![llength $args]} {return {}}
set lens [lmap l $args {llength $l}]
set numcolumns [::tcl::mathfunc::max {*}$lens]
set flatlist [lrepeat [expr {$numcolumns * [llength $args]}] {}]
set outlist [lrepeat $numcolumns {}]
set s 0
foreach len $lens list $args {
#ledit flatlist $s $e {*}$l {*}[lrepeat [expr {($numcolumns -([llength $l] % $numcolumns)) % $numcolumns}] NULL]
ledit flatlist $s [expr {$s + $len - 1}] {*}$list
incr s $numcolumns
}
#needs single index lstride bugfix
for {set c 0} {$c < $numcolumns} {incr c} {
ledit outlist $c $c [lsearch -stride $numcolumns -index $c -inline -all -subindices $flatlist *]
}
return $outlist
}
proc lzipn_tcl9b {args} {
if {![llength $args]} {return {}}
set lens [lmap l $args {llength $l}]
set numcolumns [::tcl::mathfunc::max {*}$lens]
set flatlist [list]
foreach len $lens list $args {
lappend flatlist {*}$list {*}[lrepeat [expr {($numcolumns - ($len % $numcolumns)) % $numcolumns}] ""]
}
lmap c [lseq 0 $numcolumns-1] {lsearch -stride $numcolumns -index $c -inline -all -subindices $flatlist *}
}
proc lzipn_tcl9c {args} {
#SLOW
if {![llength $args]} {return {}}
set lens [lmap l $args {llength $l}]
set numcolumns [::tcl::mathfunc::max {*}$lens]
set flatlist [list]
foreach len $lens list $args {
lappend flatlist {*}$list {*}[lrepeat [expr {($numcolumns - ($len % $numcolumns)) % $numcolumns}] ""]
}
set zip_l {}
set cols_remaining $numcolumns
for {set c 0} {$c < $numcolumns} {incr c} {
if {$cols_remaining == 1} {
return [list {*}$zip_l $flatlist]
}
lappend zip_l [lsearch -stride $cols_remaining -index 0 -inline -all -subindices $flatlist *]
set flen [llength $flatlist]
set flatlist [lremove $flatlist {*}[lseq 0 to $flen-1 by $cols_remaining]]
incr cols_remaining -1
}
return $zip_l
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lzipn
@cmd -name punk::lib::lzipn\
-summary\
"zip any number of lists together (unoptimised)."\
-help\
"Conceptually equivalent to converting a list of rows
to a list of columns.
See lzip which provides the same functionality but with
optimisations depending on the number of supplied lists.
"
@values -min 1 -max 1
lvar -type string -help\
"name of list variable"
a -type indexexpression
z -type indexexpression
}]
}
#keep both lzipn_tclX functions available for side-by-side testing in Tcl versions where it's possible
if {![package vsatisfies [package present Tcl] 9.0-] || [dict get [punk::lib::check::has_tclbug_lsearch_strideallinline] bug]} {
#-stride either not available - or has bug preventing use of main algorithm below
proc lzipn {args} [info body ::punk::lib::lzipn_tcl8]
proc lzipn {args} [info body ::punk::lib::system::lzipn_tcl8]
} else {
proc lzipn {args} [info body ::punk::lib::lzipn_tcl9a]
proc lzipn {args} [info body ::punk::lib::system::lzipn_tcl9a]
}
namespace import ::punk::args::lib::tstr
namespace eval argdoc {
@ -2291,13 +2364,31 @@ namespace eval punk::lib {
proc is_list_all_ni_list2 {a b} $body
}
#somewhat like struct::set difference - but order preserving, and doesn't treat as a 'set' so preserves dupes in fromlist
#struct::set difference may happen to preserve ordering when items are integers, but order can't be relied on,
# especially as struct::set has 2 differing implementations (tcl vs critcl) which return results with different ordering to each other and different deduping behaviour in some cases (e.g empty 2nd arg)
proc ldiff {fromlist removeitems} {
if {[llength $removeitems] == 0} {return $fromlist}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::ldiff
@cmd -name punk::lib::ldiff\
-summary\
"Difference consisting of items with removeitems removed."\
-help\
"Somewhat like struct::set difference, but order preserving, and doesn't
treat as a 'set' so preserves any duplicates in items.
struct::set difference may happen to preserve ordering when items are
integers, but order can't be relied on, especially as struct::set has
2 differening implementations (tcl vs critcl) which return results with
different ordering to each other and different deduping behaviour in
some cases (e.g when 2nd arg is empty)"
@values -min 2 -max 2
items -type list
removeitems -type list
}]
}
proc ldiff {items removeitems} {
if {[llength $removeitems] == 0} {return $items}
set result {}
foreach item $fromlist {
foreach item $items {
if {$item ni $removeitems} {
lappend result $item
}
@ -2361,6 +2452,28 @@ namespace eval punk::lib {
return [array names tmp]
}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lunique_unordered
@cmd -name punk::lib::lunique_unordered\
-summary\
"unique values in list"\
-help\
"Return unique values in provided list.
This removes duplicates but *may* rearrange the
order of the returned elements compared to the
original list.
When struct::set is available this will be used
for the implementation, as it can be *slightly*
faster if acceleration is present. When struct::set
is not available it will fallback to lunique and
provide the same functionality with order preserved."
@values -min 1 -max 1
list -type list
}]
}
#default/fallback implementation
proc lunique_unordered {list} {
lunique $list
@ -2371,13 +2484,33 @@ namespace eval punk::lib {
struct::set union $list {}
}
} else {
puts stderr "WARNING: struct::set union <list> <emptylist> no longer dedupes!"
#struct::set union operates on a 'set' - so this probably won't change, and hopefully is
#consistent across unacelerated versions and those implemented in accelerators,
#but if it ever does change - be a little noisy about it.
puts stderr "punk::lib WARNING: struct::set union <list> <emptylist> no longer dedupes!"
#we could also test a sequence of: struct::set add
}
}
#order-preserving
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lunique
@cmd -name punk::lib::lunique\
-summary\
"Order-preserving unique values in list"\
-help\
"Return unique values in provided list.
This removes duplicates whilst preserving the
original order of the provided list.
When struct::set is available with acceleration,
lunique_unordered may be slightly faster."
@values -min 1 -max 1
list -type list
}]
}
proc lunique {list} {
set new {}
foreach item $list {
@ -2569,18 +2702,21 @@ namespace eval punk::lib {
To validate if an indexset is strictly within range, both the length of the data and the base would
need to be considered.
The normal 'range' specifier is ..
The normal 'range' specifier is .. but can be of the form .x. where x is the step value.
The range specifier can appear at the beginning, middle or end, or even alone to indicate the entire
range of valid values.
e.g the following are all valid ranges
1..
(index 1 to 'max')
..10
(index 'base' to 10)
2..11
(index 2 to 11)
..
(all indices)
1..
(index 1 to 'max')
..10
(index 'base' to 10)
2..11
(index 2 to 11)
..
(all indices)
.3.
(1st index and every 3rd index thereafter)
Common whitespace elements space,tab,newlines are ignored.
Each index (or endpoint of an index-range) can be of the forms accepted by Tcl list or string commands,
e.g end-2 or 2+2.
@ -2670,20 +2806,19 @@ namespace eval punk::lib {
.-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
If end is omitted and only the start 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
Like the tcl9 lseq command - a step (by) value of zero produces no results.
@ -2703,7 +2838,7 @@ namespace eval punk::lib {
indexset examples:
These assume the default 0-based indices (base == 0)
These assume the default 0-based indices (-base 0)
1,3..
output the index 1 (2nd item) followed by all from index 3 to the end.
@ -3604,7 +3739,7 @@ namespace eval punk::lib {
@id -id ::punk::lib::gcd
@cmd -name punk::lib::gcd\
-summary\
"Gretest common divisor of m and n."\
"Greatest common divisor of m and n."\
-help\
"Return the greatest common divisor of m and n.
Straight from Lars Hellström's math::numtheory library in Tcllib
@ -3643,12 +3778,22 @@ namespace eval punk::lib {
return $m
}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::lcm
@cmd -name punk::lib::lcm\
-summary\
"Lowest common multiple of m and n."\
-help\
"Return the lowest common multiple of m and n.
Straight from Lars Hellström's math::numtheory library in Tcllib"
@values -min 2 -max 2
m -type integer
n -type integer
}]
}
proc lcm {n m} {
#*** !doctools
#[call [fun gcd] [arg n] [arg m]]
#[para]Return the lowest common multiple of m and n
#[para]Straight from Lars Hellström's math::numtheory library in Tcllib
#[para]
set gcd [gcd $n $m]
return [expr {$n*$m/$gcd}]
}

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

@ -1036,7 +1036,8 @@ namespace eval punk::repl::class {
# set o_rendered_lines [linsert $o_rendered_lines $cursor_row_idx ""]
# incr nextrow -1
#}
set o_rendered_lines [linsert $o_rendered_lines $cursor_row_idx ""]
#set o_rendered_lines [linsert $o_rendered_lines $cursor_row_idx ""]
ledit o_rendered_lines $cursor_row_idx $cursor_row_idx-1 ""
set o_cursor_col 1
}

18
src/vfs/_vfscommon.vfs/modules/punkcheck-0.1.0.tm
Unescape View File

@ -323,7 +323,8 @@ namespace eval punkcheck {
if {$isnew} {
lappend record_list $o_fileset_record
} else {
set record_list [linsert $record_list[unset record_list] $oldposition $o_fileset_record]
#set record_list [linsert $record_list[unset record_list] $oldposition $o_fileset_record]
ledit record_list $oldposition $oldposition-1 $o_fileset_record
}
if {$o_operation ne "QUERY"} {
punkcheck::save_records_to_file $record_list $punkcheck_file
@ -536,7 +537,8 @@ namespace eval punkcheck {
set existing_header_posn [dict get $resultinfo position]
if {$existing_header_posn == -1} {
set this_installer_record [punkcheck::recordlist::new_installer_record $o_name]
set o_record_list [linsert $o_record_list 0 $this_installer_record]
#set o_record_list [linsert $o_record_list 0 $this_installer_record]
ledit o_record_list -1 -1 $this_installer_record
} else {
set this_installer_record [dict get $resultinfo record]
}
@ -616,7 +618,8 @@ namespace eval punkcheck {
set persistedinfo [punkcheck::recordlist::get_installer_record $o_name $file_records]
set existing_header_posn [dict get $persistedinfo position]
if {$existing_header_posn == -1} {
set file_records [linsert $file_records 0 $this_installer_record]
#set file_records [linsert $file_records 0 $this_installer_record]
ledit file_records -1 -1 $this_installer_record
} else {
lset file_records $existing_header_posn $this_installer_record
}
@ -710,7 +713,8 @@ namespace eval punkcheck {
if {$existing_header_posn == -1} {
#not found - prepend
set record_list [linsert $record_list 0 $this_installer_record]
#set record_list [linsert $record_list 0 $this_installer_record]
ledit record_list -1 -1 $this_installer_record
} else {
#replace
lset record_list $existing_header_posn $this_installer_record
@ -791,7 +795,8 @@ namespace eval punkcheck {
if {$isnew} {
lappend record_list $file_record
} else {
set record_list [linsert $record_list[unset record_list] $oldposition $file_record]
#set record_list [linsert $record_list[unset record_list] $oldposition $file_record]
ledit record_list $oldposition $oldposition-1 $file_record
}
save_records_to_file $record_list $punkcheck_file
@ -1191,7 +1196,8 @@ namespace eval punkcheck {
# dst is: base/sub = sub
while {$baselen > 0} {
set dst [linsert $dst 0 ..]
#set dst [linsert $dst 0 ..]
ledit dst -1 -1 ..
incr baselen -1
}
set dst [file join {*}$dst]

32
src/vfs/_vfscommon.vfs/modules/textblock-0.1.3.tm
Unescape View File

@ -4480,7 +4480,8 @@ tcl::namespace::eval textblock {
set code_idx 3
foreach {pt code} [lrange $parts 2 end] {
if {[punk::ansi::codetype::is_sgr_reset $code]} {
set parts [linsert $parts $code_idx+1 $base]
#set parts [linsert $parts $code_idx+1 $base]
ledit parts $code_idx+1 $code_idx $base
}
incr code_idx 2
}
@ -4504,12 +4505,14 @@ tcl::namespace::eval textblock {
#first pt & code
if {$pt ne ""} {
#leading plaintext
set parts [linsert $parts 0 $base]
#set parts [linsert $parts 0 $base]
ledit parts -1 -1 $base
incr offset
}
}
if {[punk::ansi::codetype::is_sgr_reset $code]} {
set parts [linsert $parts [expr {$code_idx+1+$offset}] $base]
#ledit parts [expr {$code_idx+1+$offset}] $code_idx+$offset $base
incr offset
}
incr code_idx 2
@ -5371,6 +5374,9 @@ tcl::namespace::eval textblock {
r-1 {
if {[lindex $line_chunks end] eq ""} {
set line_chunks [linsert $line_chunks end-2 $pad]
#breaks layout e.g subtables in: i i
#why?
#ledit line_chunks end-2 end-3 $pad
} else {
lappend line_chunks $pad
}
@ -5379,13 +5385,16 @@ tcl::namespace::eval textblock {
lappend line_chunks $pad
}
l-0 {
set line_chunks [linsert $line_chunks 0 $pad]
#set line_chunks [linsert $line_chunks 0 $pad]
ledit line_chunks -1 -1 $pad
}
l-1 {
if {[lindex $line_chunks 0] eq ""} {
set line_chunks [linsert $line_chunks 2 $pad]
#set line_chunks [linsert $line_chunks 2 $pad]
ledit line_chunks 2 1 $pad
} else {
set line_chunks [linsert $line_chunks 0 $pad]
#set line_chunks [linsert $line_chunks 0 $pad]
ledit line_chunks -1 -1 $pad
}
}
l-2 {
@ -5393,10 +5402,12 @@ tcl::namespace::eval textblock {
if {[lindex $line_chunks 0] eq ""} {
set line_chunks [linsert $line_chunks 2 $pad]
} else {
set line_chunks [linsert $line_chunks 0 $pad]
#set line_chunks [linsert $line_chunks 0 $pad]
ledit line_chunks -1 -1 $pad
}
} else {
set line_chunks [linsert $line_chunks 0 $pad]
#set line_chunks [linsert $line_chunks 0 $pad]
ledit line_chunks -1 -1 $pad
}
}
}
@ -5466,14 +5477,17 @@ tcl::namespace::eval textblock {
#} else {
# set line_chunks [linsert $line_chunks 0 $pad]
#}
set line_chunks [linsert $line_chunks 0 $pad]
#set line_chunks [linsert $line_chunks 0 $pad]
ledit line_chunks -1 -1 $pad
}
l-1 {
#set line_chunks [linsert $line_chunks 0 $pad]
set line_chunks [_insert_before_text_or_last_ansi $pad $line_chunks]
}
l-2 {
set line_chunks [linsert $line_chunks 0 $pad]
#set line_chunks [linsert $line_chunks 0 $pad]
ledit line_chunks -1 -1 $pad
}
}
}

Write Preview
Loading…
Cancel
Save