@ -402,11 +402,13 @@ namespace eval punk::lib {
proc tstr {args} {
set argd [punk::args::get_dict {
*proc -name punk::lib::tstr -help "A rough equivalent of js template literals"
-allowcommands -default 0 -type none
-allowcommands -default 0 -type none -help "if -allowcommands is true placeholder can contain commands e.g {${plaintext1 [lindex $var 0] plaintext2}}"
-return -default list -choices {dict list string}
*values -min 1 -max 1
templatestring -help "This argument should be a braced string containing placeholders such as ${$var}
where $var will be substituted from the calling context"
templatestring -help "This argument should be a braced string containing placeholders such as ${$var} e.g {The value is ${$var}}
where $var will be substituted from the calling context
The placeholder itself can contain plaintext portions as well as variables.
It can contain commands in square brackets if -allowcommands is true"
} $args]
set templatestring [dict get $argd values templatestring]
set opt_allowcommands [dict get $argd opts -allowcommands]
@ -600,7 +602,10 @@ namespace eval punk::lib {
set isarray [uplevel 1 [list array exists $dvar]]
if {$isarray} {
set dvalue [uplevel 1 [list array get $dvar]]
dict set opts -keytemplates [list ${dvar}(%k%)]
if {![dict exists $opts -keytemplates]} {
set arrdisplay [string map [list %dvar% $dvar] {${[if {[lindex $key 1] eq "query"} {val "%dvar% [lindex $key 0]"} {val "%dvar%($key)"}]}}]
dict set opts -keytemplates [list $arrdisplay]
}
dict set opts -keysorttype dictionary
} else {
set dvalue [uplevel 1 [list set $dvar]]
@ -627,11 +632,11 @@ namespace eval punk::lib {
This can help prevent a single long line that wraps in terminal from making every line wrap due to long rhs padding
"
-separator -default "%sep%" -help "Separator column between keys and values"
-roottype -default "" -help "list,dict,string"
-roottype -default "dict " -help "list,dict,string"
-substructure -default {}
-ansibase_keys -default "" -help "ansi list for each level in -substructure. e.g \[list \[a+ red\] \[a+ web-green\]\]"
-ansibase_values -default ""
-keytemplates -default {%k% } -type list -help "list of templates for keys at each level"
-keytemplates -default {${$key} } -type list -help "list of templates for keys at each level"
-keysorttype -default "none" -choices {none dictionary ascii integer real}
-keysortdirection -default increasing -choices {increasing decreasing}
*values -min 1 -max -1
@ -656,179 +661,256 @@ namespace eval punk::lib {
set pattern_key_index [list] ;#list of pattern_nests, same length as number of keys generated
set pattern_next_substructure [dict create]
set pattern_this_structure [dict create]
set filtered_keys [list]
if {$opt_roottype eq "list" } {
#puts "getting keys for list "
if {$opt_roottype in {dict list string} } {
#puts "getting keys for roottype:$opt_roottype "
if {[llength $dval]} {
set re_numdashnum {^([-+]{0,1}\d+)-([-+]{0,1}\d+)$}
set re_idxdashidx {^([-+]{0,1}\d+|end[-+]{1}\d+|end)-([-+]{0,1}\d+|end[-+]{1}\d+|end)$}
foreach pattern_nest $patterns {
set keyset [list]
set pattern_nest_list [split $patterns /]
set pattern_nest_list [split $pattern_ne st /]
set p [lindex $pattern_nest_list 0]
if {$p eq ""} {
continue
}
if {$p eq "*"} {
lappend keyset {*}[punk::lib::range 0 [llength $dval]-1] ;#compat wrapper around subset of lseq functionality
} else {
if {[string match @* $p]} {
#already in list mode - trim optional list specifier @
set p [string range $p 1 end]
}
if {[string is integer -strict $p]} {
lappend keyset $p
} elseif {[string match "?*-?*" $p]} {
#list indices with tcl8.7 underscores? be careful. Before 8.7 we could have used regexp \d on integers
#now we should map _ to "" first
set p [string map {_ {}} $p]
#lassign [textutil::split::splitx $p {\.\.}] a b
if {![regexp $re_idxdashidx $p _match a b]} {
error "unrecognised pattern $p"
}
set lower_resolve [punk::lib::lindex_resolve $dval $a] ;#-2 for too low, -1 for too high
#keep lower_resolve as separate var to lower for further checks based on which side out-of-bounds
if {${lower_resolve} == -1} {
#lower bound is above upper list range
#match with decreasing indices is still possible
set lower [expr {[llength $dval]-1}] ;#set to max
} elseif {$lower_resolve == -2} {
set lower 0
switch -exact -- $p {
* - "" {
if {$opt_roottype eq "list"} {
lappend keyset {*}[punk::lib::range 0 [llength $dval]-1] ;#compat wrapper around subset of lseq functionality
dict set pattern_this_structure $pattern_nest list
} elseif {$opt_roottype eq "dict"} {
lappend keyset {*}[dict keys $dval]
dict set pattern_this_structure $pattern_nest dict
} else {
set lower $lower_resolve
lappend keyset %string
dict set pattern_this_structure $pattern_nest string
}
set upper [punk::lib::lindex_resolve $dval $b]
if {$upper == -2} {
#upper bound is below list range -
if {$lower_resolve >=-1} {
set upper 0
} else {
continue
}
%# {
dict set pattern_this_structure $pattern_nest string
lappend keyset %#
}
# {
dict set pattern_this_structure $pattern_nest list
lappend keyset #
}
## {
dict set pattern_this_structure $pattern_nest dict
lappend keyset ##
}
@* {
dict set pattern_this_structure $pattern_nest list
lappend keyset {*}[punk::lib::range 0 [llength $dval]-1]
}
@*k@* - @*K@* {
#returns keys only
lappend keyset [list $p query]
dict set pattern_this_structure $pattern_nest dict
}
@*.@* {
lappend keyset {*}[dict keys $dval]
dict set pattern_this_structure $pattern_nest dict
}
default {
#puts stderr "===p:$p"
switch -glob -- $p {
{@k\*@*} - {@K\*@*} {
#value glob return keys
#set search [string range $p 4 end]
#dict for {k v} $dval {
# if {[string match $search $v]} {
# lappend keyset $k
# }
#}
lappend keyset [list $p query]
dict set pattern_this_structure $pattern_nest dict
}
@@* {
#exact match key - review - should raise error to match punk pipe behaviour?
set k [string range $p 2 end]
if {[dict exists $dval $k]} {
lappend keyset $k
}
dict set pattern_this_structure $pattern_nest dict
}
@k@* - @K@* {
set k [string range $p 3 end]
if {[dict exists $dval $k]} {
lappend keyset $k
}
dict set pattern_this_structure $pattern_nest dict
}
{@\*@*} {
#return list of values
#set k [string range $p 3 end]
#lappend keyset {*}[dict keys $dval $k]
lappend keyset [list $p query]
dict set pattern_this_structure $pattern_nest dict
}
{@\*.@*} {
set k [string range $p 4 end]
lappend keyset {*}[dict keys $dval $k]
dict set pattern_this_structure $pattern_nest dict
}
{@v\*@*} - {@V\*@*} {
#value-glob return value
#error "dict value-glob value-return only not supported here - bad pattern '$p' in '$pattern_nest'"
lappend keyset [list $p query]
dict set pattern_this_structure $pattern_nest dict
}
{@\*v@*} - {@\*V@*} {
#key-glob return value
lappend keyset [list $p query]
dict set pattern_this_structure $pattern_nest dict
}
{@\*@*} - {@\*v@*} - {@\*V@} {
#key glob return val
lappend keyset [list $p query]
dict set pattern_this_structure $pattern_nest dict
}
@??@* {
#exact key match - no error
lappend keyset [list $p query]
dict set pattern_this_structure $pattern_nest dict
}
default {
set this_type $opt_roottype
if {[string match @* $p]} {
#list mode - trim optional list specifier @
set p [string range $p 1 end]
dict set pattern_this_structure $pattern_nest list
set this_type list
} elseif {[string match %* $p]} {
dict set pattern_this_structure $pattern_nest string
lappend keyset $p
set this_type string
}
if {$this_type eq "list"} {
dict set pattern_this_structure $pattern_nest list
if {[string is integer -strict $p]} {
lappend keyset $p
} elseif {[string match "?*-?*" $p]} {
#could be either - don't change type
#list indices with tcl8.7 underscores? be careful. Before 8.7 we could have used regexp \d on integers
#now we should map _ to "" first
set p [string map {_ {}} $p]
#lassign [textutil::split::splitx $p {\.\.}] a b
if {![regexp $re_idxdashidx $p _match a b]} {
error "unrecognised pattern $p"
}
set lower_resolve [punk::lib::lindex_resolve $dval $a] ;#-2 for too low, -1 for too high
#keep lower_resolve as separate var to lower for further checks based on which side out-of-bounds
if {${lower_resolve} == -1} {
#lower bound is above upper list range
#match with decreasing indices is still possible
set lower [expr {[llength $dval]-1}] ;#set to max
} elseif {$lower_resolve == -2} {
set lower 0
} else {
set lower $lower_resolve
}
set upper [punk::lib::lindex_resolve $dval $b]
if {$upper == -2} {
#upper bound is below list range -
if {$lower_resolve >=-1} {
set upper 0
} else {
continue
}
} elseif {$upper == -1} {
#use max
set upper [expr {[llength $dval]-1}]
#assert - upper >=0 because we have ruled out empty lists
}
#note lower can legitimately be higher than upper - lib::range, like lseq can produce sequence in reverse order
lappend keyset {*}[punk::lib::range $lower $upper]
} else {
lappend keyset [list @$p query]
}
} elseif {$this_type eq "string"} {
dict set pattern_this_structure $pattern_nest string
} elseif {$this_type eq "dict"} {
#default equivalent to @\*@*
dict set pattern_this_structure $pattern_nest dict
puts "dict: appending keys from index '$p' keys: [dict keys $dval $p]"
lappend keyset {*}[dict keys $dval $p]
} else {
puts stderr "list: unrecognised pattern $p"
}
}
} elseif {$upper == -1} {
#use max
set upper [expr {[llength $dval]-1}]
#assert - upper >=0 because we have ruled out empty lists
}
#note lower can legitimately be higher than upper - lib::range, like lseq can produce sequence in reverse order
lappend keyset {*}[punk::lib::range $lower $upper]
} else {
puts stderr "list: unrecognised pattern $p"
}
}
# -- --- --- ---
#check next pattern for substructure type to use
# -- --- --- ---
set substructure ""
set pnext [lindex $pattern_nest_list 1]
if {$pnext in [list "@*k@*" "@*K@*" "@*.@*" *]} {
set substructure dict
} elseif {[string match "@??@*" $pnext] || [string match "@?@*" $pnext]} {
#all 4 or 3 len prefixes bounded by @ are dict
set substructure dict
} elseif {[string match @@* $pnext]} {
set substructure dict
} elseif {[string match @* $pnext]} {
#if we've ruled out all explicit dict patterns - @* is list
set substructure list
} elseif {$pnext eq ""} {
set substructure "string"
} else {
#plain keys are now dict because there was no list-type pattern to flip the structure type
set substructure dict
switch -exact $pnext {
"" {
set substructure string
}
@*k@* - @*K@* - @*.@* - ## {
set substructure dict
}
# {
set substructure list
}
%# {
set substructure string
}
* {
#set substructure $opt_roottype
set substructure [dict get $pattern_this_structure $pattern_nest]
}
default {
switch -glob -- $pnext {
@??@* - @?@* - @@* {
#all 4 or 3 len prefixes bounded by @ are dict
set substructure dict
}
default {
if {[string match @* $pnext]} {
set substructure list
} elseif {[string match %* $pnext]} {
set substructure string
} else {
#set substructure $opt_roottype
set substructure [dict get $pattern_this_structure $pattern_nest]
}
}
}
}
}
#puts "--pattern_nest: $pattern_nest substructure: $substructure"
dict set pattern_next_substructure $pattern_nest $substructure
# -- --- --- ---
lappend filtered_keys {*}$keyset
set int_keyset 1
foreach k $keyset {
if {![string is integer -strict $k]} {
set int_keyset 0
break
}
}
if {$int_keyset} {
set keyset [lsort -integer $keyset]
} else {
set keyset [lsort -dictionary $keyset]
}
foreach k $keyset {
lappend pattern_key_index $pattern_nest
}
}
}
#puts stderr "list keys: $filtered_keys"
} elseif {$opt_roottype eq "dict"} {
foreach pattern_nest $patterns {
set keyset [list]
set pattern_nest_list [split $pattern_nest /]
set p [lindex $pattern_nest_list 0]
if {$p in [list "@*k@*" "@*K@*" "@*.@*" *]} {
#exact glob-for-all
lappend keyset {*}[dict keys $dval]
} elseif {[string match @@* $p]} {
set k [string range $p 2 end]
lappend keyset {*}[dict keys $dval $k]
} elseif {[string match -nocase {@k\*@*}]} {
set k [string range $p 4 end]
lappend keyset {*}[dict keys $dval $k]
} elseif {[string match {@\*@*} $p]} {
set k [string range $p 3 end]
lappend keyset {*}[dict keys $dval $k]
} elseif {[string match -nocase {@v\*@*} $p] || [string match -nocase {@\*v@*} $p]} {
#don't match @v.@
error "dict value-return only not supported here - bad pattern '$p' in '$pattern_nest'"
} else {
lappend keyset {*}[dict keys $dval $p]
}
# -- --- --- ---
#check next pattern for substructure type to use
# -- --- --- ---
set substructure ""
set pnext [lindex $pattern_nest_list 1]
if {$pnext in [list "@*k@*" "@*K@*" "@*.@*" *]} {
set substructure dict
} elseif {[string match "@??@*" $pnext] || [string match "@?@*" $pnext]} {
#all 4 or 3 len prefixes bounded by @ are dict
set substructure dict
} elseif {[string match @@* $pnext]} {
set substructure dict
} elseif {[string match @* $pnext]} {
#if we've ruled out all explicit dict patterns - @* is list
set substructure list
} elseif {$pnext eq ""} {
set substructure "string"
} else {
#plain keys are now dict because there was no list-type pattern to flip the structure type
set substructure dict
}
#puts "--pattern_nest: $pattern_nest substructure: $substructure"
dict set pattern_next_substructure $pattern_nest $substructure
# -- --- --- ---
#puts stderr "adding [llength $keyset] keys for pattern_nest: $pattern_nest"
#sort only within each pattern for now
if {$opt_keysorttype ne "none"} {
set keyset [lsort -$opt_keysorttype -$opt_keysortdirection $keyset]
}
lappend filtered_keys {*}$keyset
lappend filtered_keys {*}$keyset
foreach k $keyset {
lappend pattern_key_index $pattern_nest
#puts stderr "--->pattern_nest:$pattern_nest keyset:$keyset"
}
}
#todo - fix. sorting keys wrecks pattern_key_index
#if {$opt_keysorttype eq "none"} {
# #we can only get duplicate keys if there are multiple patterns supplied
# #ignore keysortdirection - doesn't apply
# if {[llength $patterns] > 1} {
# #order-maintaining (order of keys as they appear in dict)
# set filtered_keys [punk::lib::lunique $filtered_keys]
# }
#} else {
# set filtered_keys [lsort -unique -$opt_keysorttype -$opt_keysortdirection $filtered_keys]
#}
#puts stderr "[dict get $pattern_this_structure $pattern_nest] keys: $filtered_keys"
} else {
#string
puts stdout "xxxx string"
puts stdout "unrecognised roottype: $opt_roottype"
return $dval
}
@ -845,101 +927,145 @@ namespace eval punk::lib {
set kt [lindex $opt_keytemplates 0]
if {$kt eq ""} {
set kt "%k%"
set kt {${$key}}
}
set display_keys [lmap k $filtered_keys {tcl::string::map [list %k% $k] $kt}]
#set display_keys [lmap k $filtered_keys {tcl::string::map [list %k% $k] $kt}]
set display_keys [lmap key $filtered_keys {tstr -ret string -allowcommands $kt}]
set maxl [::tcl::mathfunc::max {*}[lmap v $display_keys {textblock::width $v}]]
set kidx 0
foreach keydisplay $display_keys key $filtered_keys {
if {$opt_roottype eq "list"} {
set thisval [lindex $dval $key]
} else {
#todo - slower lsearch if -dupes 1 flag set so we can display duplicate 'keys' if var not a proper dict but rather a dict-shaped list that we want to display as a dict
# - default highlight dupes (ansi underline?)
set thisval [tcl::dict::get $dval $key]
}
if {$opt_roottype eq "dict"} {
#set substructure [lrange $opt_structure 1 end]
set nextpatterns [list]
set pattern_nest [lindex $pattern_key_index $kidx]
set nextsub [dict get $pattern_next_substructure $pattern_nest]
#which pattern nest applies to this branch
set pattern_nest_list [split $pattern_nest /]
if {[llength $pattern_nest_list]} {
set tail [lassign $pattern_nest_list parent]
set nest $tail
#if {![llength $tail]} {
# set nest *
#}
lappend nextpatterns [join $nest /]
}
#puts "k:$key dict nextpatterns: $nextpatterns"
set pattern_nest [lindex $pattern_key_index $kidx]
set pattern_nest_list [split $pattern_nest /]
#puts stderr "---> kidx:$kidx key:$key - pattern_nest:$pattern_nest"
set this_type [dict get $pattern_this_structure $pattern_nest]
switch -- $this_type {
dict {
#todo? - slower lsearch if -dupes 1 flag set so we can display duplicate 'keys' if var not a proper dict but rather a dict-shaped list that we want to display as a dict
# - default highlight dupes (ansi underline?)
if {[lindex $key 1] eq "query"} {
set qry [lindex $key 0]
% thisval.= $qry= $dval
} else {
set thisval [tcl::dict::get $dval $key]
}
set subansibasekeys [lrange $opt_ansibase_keys 1 end]
set nextkeytemplates [lrange $opt_keytemplates 1 end]
set nextopts [dict get $argd opts]
#dict set nextopts -substructure $nextsub
dict set nextopts -keytemplates $nextkeytemplates
dict set nextopts -ansibase_keys $subansibasekeys
dict set nextopts -roottype $nextsub
dict set nextopts -channel none
#puts stderr "showdict {*}$nextopts $thisval [lindex $args end]"
#set substructure [lrange $opt_structure 1 end]
set nextpatterns [list]
#which pattern nest applies to this branch
set nextsub [dict get $pattern_next_substructure $pattern_nest]
if {[llength $pattern_nest_list]} {
set nest [lrange $pattern_nest_list 1 end]
lappend nextpatterns [join $nest /]
}
set nextopts [dict get $argd opts]
if {[llength $nextpatterns] && $nextsub ne "string"} {
set thisval [showdict {*}$nextopts -- $thisval {*}$nextpatterns]
}
} elseif {$opt_roottype eq "list"} {
set subansibasekeys [lrange $opt_ansibase_keys 1 end]
set nextkeytemplates [lrange $opt_keytemplates 1 end]
#dict set nextopts -substructure $nextsub
dict set nextopts -keytemplates $nextkeytemplates
dict set nextopts -ansibase_keys $subansibasekeys
dict set nextopts -roottype $nextsub
dict set nextopts -channel none
#puts stderr "showdict {*}$nextopts $thisval [lindex $args end]"
set nextpatterns [list]
set pattern_nest [lindex $pattern_key_index $kidx]
set nextsub [dict get $pattern_next_substructure $pattern_nest]
set pattern_nest_list [split $pattern_nest /]
if {[llength $pattern_nest_list]} {
set nest [lrange $pattern_nest_list 1 end]
if {![llength $nest]} {
set nest *
if {[llength $nextpatterns]} {
set thisval [showdict {*}$nextopts -- $thisval {*}$nextpatterns]
}
lappend nextpatterns [join $nest /]
}
#puts "list nextpattern: $nextpatterns"
list {
if {[string is integer -strict $key]} {
set thisval [lindex $dval $key]
} else {
if {[lindex $key 1] eq "query"} {
set qry [lindex $key 0]
} else {
set qry $key
}
% thisval.= $qry= $dval
}
set nextopts [dict get $argd opts]
#dict set nextopts -substructure $substructure
dict set nextopts -channel none
dict set nextopts -roottype $nextsub
set nextpatterns [list]
#which pattern nest applies to this branch
set nextsub [dict get $pattern_next_substructure $pattern_nest]
if {[llength $pattern_nest_list]} {
set nest [lrange $pattern_nest_list 1 end]
lappend nextpatterns [join $nest /]
}
set nextopts [dict get $argd opts]
dict set nextopts -roottype $nextsub
dict set nextopts -channel none
if {![llength $nextpatterns]} {
set nextpatterns *
#if {![llength $nextpatterns]} {
# set nextpatterns *
#}
if {[llength $nextpatterns]} {
set thisval [showdict {*}$nextopts -- $thisval {*}$nextpatterns]
}
}
if {[llength $nextpatterns] && $nextsub ne "string"} {
set thisval [showdict {*}$nextopts -- $thisval {*}$nextpatterns]
string {
if {$key eq "%string"} {
set thisval $dval
} else {
if {[lindex $key 1] eq "query"} {
set qry [lindex $key 0]
} else {
set qry $key
}
set thisval $dval
if {[string index $key 0] ne "%"} {
set key %$key
}
% thisval.= $key= $thisval
}
set nextpatterns [list]
#which pattern nest applies to this branch
set nextsub [dict get $pattern_next_substructure $pattern_nest]
if {[llength $pattern_nest_list]} {
set nest [lrange $pattern_nest_list 1 end]
lappend nextpatterns [join $nest /]
}
#set nextopts [dict get $argd opts]
dict set nextopts -roottype $nextsub
dict set nextopts -channel none
if {[llength $nextpatterns]} {
set thisval [showdict {*}$nextopts -- $thisval {*}$nextpatterns]
}
}
}
set ansibase_key [lindex $opt_ansibase_keys 0]
lassign [textblock::size $keydisplay] _kw kwidth _kh kheight
lassign [textblock::size $thisval] _vw vwidth _vh vheight
set totalheight [expr {$kheight + $vheight -1}]
set blanks_above [string repeat \n [expr {$kheight -1}]]
set blanks_below [string repeat \n [expr {$vheight -1}]]
set sepwidth [textblock::width $opt_sep]
set kblock [textblock::pad $ansibase_key$keydisplay$RST$blanks_below -width $maxl]
set sblock [textblock::pad $blanks_above$opt_sep$blanks_below -width $sepwidth]
set vblock $blanks_above$opt_ansibase_values$thisval$RST
#only vblock is ragged - we can do a basic join because we don't care about rhs whitespace
append result [textblock::join_basic -- $kblock $sblock $vblock] \n
if {$this_type eq "string" && $key eq "%string"} {
lassign [textblock::size $thisval] _vw vwidth _vh vheight
#set blanks_above [string repeat \n [expr {$kheight -1}]]
set vblock $opt_ansibase_values$thisval$RST
append result [textblock::join_basic -- $vblock] \n
} else {
set ansibase_key [lindex $opt_ansibase_keys 0]
lassign [textblock::size $keydisplay] _kw kwidth _kh kheight
lassign [textblock::size $thisval] _vw vwidth _vh vheight
set totalheight [expr {$kheight + $vheight -1}]
set blanks_above [string repeat \n [expr {$kheight -1}]]
set blanks_below [string repeat \n [expr {$vheight -1}]]
set sepwidth [textblock::width $opt_sep]
set kblock [textblock::pad $ansibase_key$keydisplay$RST$blanks_below -width $maxl]
set sblock [textblock::pad $blanks_above$opt_sep$blanks_below -width $sepwidth]
set vblock $blanks_above$opt_ansibase_values$thisval$RST
#only vblock is ragged - we can do a basic join because we don't care about rhs whitespace
append result [textblock::join_basic -- $kblock $sblock $vblock] \n
}
incr kidx
}
}
"sidebyside" {
#todo
#This is nice for multiline keys and values of reasonable length, will produce unintuitive results when line-wrapping occurs.
#use ansibase_key etc to make the output more comprehensible in that situation.
#This is why it is not the default. (review - terminal width detection and wrapping?)