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

pdict fixes

master
Julian Noble 5 months ago
parent
25ed96003c
commit
ad3ca5b9a9
2 changed files with 393 additions and 224 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 53
      src/modules/punk-0.1.tm
  2. 562
      src/modules/punk/lib-999999.0a1.0.tm

53
src/modules/punk-0.1.tm
Unescape View File

@ -513,7 +513,12 @@ namespace eval punk {
} }
set varlist [list] set varlist [list]
set var_terminals [list "@" "/" "#" "!" ">" "<"] ;# (> required for insertionspecs at rhs of = & .= ) # @ @@ - list and dict functions
# / level separator
# # list count, ## dict size
# % string functions
# ! not
set var_terminals [list "@" "/" "#" "%" "!" ">" "<"] ;# (> required for insertionspecs at rhs of = & .= )
#except when prefixed directly by pin classifier ^ #except when prefixed directly by pin classifier ^
set protect_terminals [list "^"] ;# e.g sequence ^# set protect_terminals [list "^"] ;# e.g sequence ^#
#also - an atom usually doesn't need the / as a terminal - because it can't match a missing element unless it's empty string #also - an atom usually doesn't need the / as a terminal - because it can't match a missing element unless it's empty string
@ -1228,7 +1233,7 @@ namespace eval punk {
set tpl_return_mismatch_not_a_list {return [dict create -assigned $leveldata -action ?mismatch-not-a-list -lhs $lhs -rhs xxx -index_operations {${$INDEX_OPERATIONS}}]} set tpl_return_mismatch_not_a_list {return [dict create -assigned $leveldata -action ?mismatch-not-a-list -lhs $lhs -rhs xxx -index_operations {${$INDEX_OPERATIONS}}]}
set tpl_return_mismatch_list_index_out_of_range {return [dict create -assigned $leveldata -action ?mismatch-list-index-out-of-range -lhs $lhs -rhs xxx -index_operations {${$INDEX_OPERATIONS}}]} set tpl_return_mismatch_list_index_out_of_range {return [dict create -assigned $leveldata -action ?mismatch-list-index-out-of-range -lhs $lhs -rhs xxx -index_operations {${$INDEX_OPERATIONS}}]}
set tpl_return_mismatch_list_index_out_of_range_empty {return [dict create -assigned $leveldata -action ?mismatch-list-index-out-of-range-empty -lhs $lhs -rhs xxx -index_operations {${$INDEX_OPERATIONS}}]} set tpl_return_mismatch_list_index_out_of_range_empty {return [dict create -assigned $leveldata -action ?mismatch-list-index-out-of-range-empty -lhs $lhs -rhs xxx -index_operations {${$INDEX_OPERATIONS}}]}
set tpl_return_mismatch_not_a_dict {return [dict create -assigned $leveldata -action ?mismatch-not-a-dict - -lhs $lhs -rhs xxx -index_operations {${$INDEX_OPERATIONS}}]} set tpl_return_mismatch_not_a_dict {return [dict create -assigned $leveldata -action ?mismatch-not-a-dict -lhs $lhs -rhs xxx -index_operations {${$INDEX_OPERATIONS}}]}
#dict 'index' when using stateful @@ etc to iterate over dict instead of by key #dict 'index' when using stateful @@ etc to iterate over dict instead of by key
set tpl_return_mismatch_dict_index_out_of_range {return [dict create -assigned $leveldata -action ?mismatch-dict-index-out-of-range -lhs $lhs -rhs xxx -index_operations {${$INDEX_OPERATIONS}}]} set tpl_return_mismatch_dict_index_out_of_range {return [dict create -assigned $leveldata -action ?mismatch-dict-index-out-of-range -lhs $lhs -rhs xxx -index_operations {${$INDEX_OPERATIONS}}]}
set tpl_return_mismatch_dict_key_not_found {return [dict create -assigned $leveldata -action ?mismatch-dict-key-not-found -lhs $lhs -rhs xxx -index_operations {${$INDEX_OPERATIONS}}]} set tpl_return_mismatch_dict_key_not_found {return [dict create -assigned $leveldata -action ?mismatch-dict-key-not-found -lhs $lhs -rhs xxx -index_operations {${$INDEX_OPERATIONS}}]}
@ -1379,12 +1384,13 @@ namespace eval punk {
} }
set level_script_complete 1 set level_script_complete 1
} }
#? { %# {
set active_key_type "string"
if $get_not { if $get_not {
error "!#? not string length is not supported" error "!%# not string length is not supported"
} }
#string length - REVIEW - #string length - REVIEW -
set index_operation string-length lappend INDEX_OPERATIONS string-length
append script \n {# set active_key_type "" index_operation: string-length} append script \n {# set active_key_type "" index_operation: string-length}
append script \n {set assigned [string length $leveldata]} append script \n {set assigned [string length $leveldata]}
set level_script_complete 1 set level_script_complete 1
@ -1964,6 +1970,15 @@ namespace eval punk {
set index <idx> set index <idx>
}] }]
} }
%* {
set active_key_type "string"
set do_bounds_check 0
set index [string range $index 1 end]
append script \n [string map [list <idx> $index] {
# set active_key_type "string" index_operation: ?
set index <idx>
}]
}
default { default {
puts "destructure_func_build_body unmatched index $index" puts "destructure_func_build_body unmatched index $index"
} }
@ -2496,6 +2511,34 @@ namespace eval punk {
} }
} }
} }
} elseif {$active_key_type eq "string"} {
if {[string match *-* $index]} {
lappend INDEX_OPERATIONS string-range
set re_idxdashidx {^([-+]{0,1}\d+|end[-+]{1}\d+|end)-([-+]{0,1}\d+|end[-+]{1}\d+|end)$}
#todo - support more complex indices: 0-end-1 etc
lassign [split $index -] a b
append script \n [tstr -return string -allowcommands {
# set active_key_type "string"
set assigned [string range $leveldata ${$a} ${$b}]
}]
} else {
if {$index eq "*"} {
lappend INDEX_OPERATIONS string-all
append script \n [tstr -return string -allowcommands {
# set active_key_type "string"
set assigned $leveldata
}]
} else {
lappend INDEX_OPERATIONS string-index
append script \n [tstr -return string -allowcommands {
# set active_key_type "string"
set assigned [string index $leveldata ${$index}]
}]
}
}
} else { } else {
#treat as dict key #treat as dict key
if {$get_not} { if {$get_not} {

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

@ -402,11 +402,13 @@ namespace eval punk::lib {
proc tstr {args} { proc tstr {args} {
set argd [punk::args::get_dict { set argd [punk::args::get_dict {
*proc -name punk::lib::tstr -help "A rough equivalent of js template literals" *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} -return -default list -choices {dict list string}
*values -min 1 -max 1 *values -min 1 -max 1
templatestring -help "This argument should be a braced string containing placeholders such as ${$var} 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" 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] } $args]
set templatestring [dict get $argd values templatestring] set templatestring [dict get $argd values templatestring]
set opt_allowcommands [dict get $argd opts -allowcommands] set opt_allowcommands [dict get $argd opts -allowcommands]
@ -600,7 +602,10 @@ namespace eval punk::lib {
set isarray [uplevel 1 [list array exists $dvar]] set isarray [uplevel 1 [list array exists $dvar]]
if {$isarray} { if {$isarray} {
set dvalue [uplevel 1 [list array get $dvar]] 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 dict set opts -keysorttype dictionary
} else { } else {
set dvalue [uplevel 1 [list set $dvar]] 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 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" -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 {} -substructure -default {}
-ansibase_keys -default "" -help "ansi list for each level in -substructure. e.g \[list \[a+ red\] \[a+ web-green\]\]" -ansibase_keys -default "" -help "ansi list for each level in -substructure. e.g \[list \[a+ red\] \[a+ web-green\]\]"
-ansibase_values -default "" -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} -keysorttype -default "none" -choices {none dictionary ascii integer real}
-keysortdirection -default increasing -choices {increasing decreasing} -keysortdirection -default increasing -choices {increasing decreasing}
*values -min 1 -max -1 *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_key_index [list] ;#list of pattern_nests, same length as number of keys generated
set pattern_next_substructure [dict create] set pattern_next_substructure [dict create]
set pattern_this_structure [dict create]
set filtered_keys [list] set filtered_keys [list]
if {$opt_roottype eq "list"} { if {$opt_roottype in {dict list string}} {
#puts "getting keys for list" #puts "getting keys for roottype:$opt_roottype"
if {[llength $dval]} { if {[llength $dval]} {
set re_numdashnum {^([-+]{0,1}\d+)-([-+]{0,1}\d+)$} 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)$} set re_idxdashidx {^([-+]{0,1}\d+|end[-+]{1}\d+|end)-([-+]{0,1}\d+|end[-+]{1}\d+|end)$}
foreach pattern_nest $patterns { foreach pattern_nest $patterns {
set keyset [list] set keyset [list]
set pattern_nest_list [split $patterns /] set pattern_nest_list [split $pattern_nest /]
set p [lindex $pattern_nest_list 0] set p [lindex $pattern_nest_list 0]
if {$p eq ""} { switch -exact -- $p {
continue * - "" {
} if {$opt_roottype eq "list"} {
if {$p eq "*"} { lappend keyset {*}[punk::lib::range 0 [llength $dval]-1] ;#compat wrapper around subset of lseq functionality
lappend keyset {*}[punk::lib::range 0 [llength $dval]-1] ;#compat wrapper around subset of lseq functionality dict set pattern_this_structure $pattern_nest list
} else { } elseif {$opt_roottype eq "dict"} {
if {[string match @* $p]} { lappend keyset {*}[dict keys $dval]
#already in list mode - trim optional list specifier @ dict set pattern_this_structure $pattern_nest dict
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
} else { } 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 - dict set pattern_this_structure $pattern_nest string
if {$lower_resolve >=-1} { lappend keyset %#
set upper 0 }
} else { # {
continue 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 #check next pattern for substructure type to use
# -- --- --- --- # -- --- --- ---
set substructure "" set substructure ""
set pnext [lindex $pattern_nest_list 1] set pnext [lindex $pattern_nest_list 1]
if {$pnext in [list "@*k@*" "@*K@*" "@*.@*" *]} { switch -exact $pnext {
set substructure dict "" {
} elseif {[string match "@??@*" $pnext] || [string match "@?@*" $pnext]} { set substructure string
#all 4 or 3 len prefixes bounded by @ are dict }
set substructure dict @*k@* - @*K@* - @*.@* - ## {
} elseif {[string match @@* $pnext]} { set substructure dict
set substructure dict }
} elseif {[string match @* $pnext]} { # {
#if we've ruled out all explicit dict patterns - @* is list set substructure list
set substructure list }
} elseif {$pnext eq ""} { %# {
set substructure "string" set substructure string
} else { }
#plain keys are now dict because there was no list-type pattern to flip the structure type * {
set substructure dict #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" #puts "--pattern_nest: $pattern_nest substructure: $substructure"
dict set pattern_next_substructure $pattern_nest $substructure dict set pattern_next_substructure $pattern_nest $substructure
# -- --- --- --- # -- --- --- ---
set int_keyset 1
foreach k $keyset {
lappend filtered_keys {*}$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 { foreach k $keyset {
lappend pattern_key_index $pattern_nest 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 { #puts stderr "--->pattern_nest:$pattern_nest keyset:$keyset"
lappend pattern_key_index $pattern_nest
} }
} }
#puts stderr "[dict get $pattern_this_structure $pattern_nest] keys: $filtered_keys"
#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]
#}
} else { } else {
#string puts stdout "unrecognised roottype: $opt_roottype"
puts stdout "xxxx string"
return $dval return $dval
} }
@ -845,101 +927,145 @@ namespace eval punk::lib {
set kt [lindex $opt_keytemplates 0] set kt [lindex $opt_keytemplates 0]
if {$kt eq ""} { 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 maxl [::tcl::mathfunc::max {*}[lmap v $display_keys {textblock::width $v}]]
set kidx 0 set kidx 0
foreach keydisplay $display_keys key $filtered_keys { foreach keydisplay $display_keys key $filtered_keys {
if {$opt_roottype eq "list"} { set pattern_nest [lindex $pattern_key_index $kidx]
set thisval [lindex $dval $key] set pattern_nest_list [split $pattern_nest /]
} else { #puts stderr "---> kidx:$kidx key:$key - pattern_nest:$pattern_nest"
#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 set this_type [dict get $pattern_this_structure $pattern_nest]
# - default highlight dupes (ansi underline?)
set thisval [tcl::dict::get $dval $key] switch -- $this_type {
} dict {
if {$opt_roottype eq "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
#set substructure [lrange $opt_structure 1 end] # - default highlight dupes (ansi underline?)
if {[lindex $key 1] eq "query"} {
set nextpatterns [list] set qry [lindex $key 0]
set pattern_nest [lindex $pattern_key_index $kidx] % thisval.= $qry= $dval
set nextsub [dict get $pattern_next_substructure $pattern_nest] } else {
#which pattern nest applies to this branch set thisval [tcl::dict::get $dval $key]
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 substructure [lrange $opt_structure 1 end]
set subansibasekeys [lrange $opt_ansibase_keys 1 end] set nextpatterns [list]
set nextkeytemplates [lrange $opt_keytemplates 1 end] #which pattern nest applies to this branch
set nextopts [dict get $argd opts] set nextsub [dict get $pattern_next_substructure $pattern_nest]
#dict set nextopts -substructure $nextsub if {[llength $pattern_nest_list]} {
dict set nextopts -keytemplates $nextkeytemplates set nest [lrange $pattern_nest_list 1 end]
dict set nextopts -ansibase_keys $subansibasekeys lappend nextpatterns [join $nest /]
dict set nextopts -roottype $nextsub }
dict set nextopts -channel none set nextopts [dict get $argd opts]
#puts stderr "showdict {*}$nextopts $thisval [lindex $args end]"
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]"
if {[llength $nextpatterns] && $nextsub ne "string"} { if {[llength $nextpatterns]} {
set thisval [showdict {*}$nextopts -- $thisval {*}$nextpatterns] set thisval [showdict {*}$nextopts -- $thisval {*}$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
}
} elseif {$opt_roottype eq "list"} { 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]
set nextpatterns [list] dict set nextopts -roottype $nextsub
set pattern_nest [lindex $pattern_key_index $kidx] dict set nextopts -channel none
set nextsub [dict get $pattern_next_substructure $pattern_nest]
set pattern_nest_list [split $pattern_nest /] #if {![llength $nextpatterns]} {
if {[llength $pattern_nest_list]} { # set nextpatterns *
set nest [lrange $pattern_nest_list 1 end] #}
if {![llength $nest]} { if {[llength $nextpatterns]} {
set nest * set thisval [showdict {*}$nextopts -- $thisval {*}$nextpatterns]
} }
lappend nextpatterns [join $nest /]
} }
#puts "list nextpattern: $nextpatterns" string {
if {$key eq "%string"} {
set nextopts [dict get $argd opts] set thisval $dval
#dict set nextopts -substructure $substructure } else {
dict set nextopts -channel none if {[lindex $key 1] eq "query"} {
dict set nextopts -roottype $nextsub 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]
}
if {![llength $nextpatterns]} {
set nextpatterns *
}
if {[llength $nextpatterns] && $nextsub ne "string"} {
set thisval [showdict {*}$nextopts -- $thisval {*}$nextpatterns]
} }
} }
set ansibase_key [lindex $opt_ansibase_keys 0] if {$this_type eq "string" && $key eq "%string"} {
lassign [textblock::size $thisval] _vw vwidth _vh vheight
lassign [textblock::size $keydisplay] _kw kwidth _kh kheight #set blanks_above [string repeat \n [expr {$kheight -1}]]
lassign [textblock::size $thisval] _vw vwidth _vh vheight set vblock $opt_ansibase_values$thisval$RST
append result [textblock::join_basic -- $vblock] \n
set totalheight [expr {$kheight + $vheight -1}] } else {
set blanks_above [string repeat \n [expr {$kheight -1}]] set ansibase_key [lindex $opt_ansibase_keys 0]
set blanks_below [string repeat \n [expr {$vheight -1}]]
set sepwidth [textblock::width $opt_sep] lassign [textblock::size $keydisplay] _kw kwidth _kh kheight
set kblock [textblock::pad $ansibase_key$keydisplay$RST$blanks_below -width $maxl] lassign [textblock::size $thisval] _vw vwidth _vh vheight
set sblock [textblock::pad $blanks_above$opt_sep$blanks_below -width $sepwidth]
set vblock $blanks_above$opt_ansibase_values$thisval$RST set totalheight [expr {$kheight + $vheight -1}]
#only vblock is ragged - we can do a basic join because we don't care about rhs whitespace set blanks_above [string repeat \n [expr {$kheight -1}]]
append result [textblock::join_basic -- $kblock $sblock $vblock] \n 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 incr kidx
} }
} }
"sidebyside" { "sidebyside" {
#todo
#This is nice for multiline keys and values of reasonable length, will produce unintuitive results when line-wrapping occurs. #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. #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?) #This is why it is not the default. (review - terminal width detection and wrapping?)

Write Preview
Loading…
Cancel
Save