From c65942ef2ece45dbccf4b70a87669b05fb752ecd Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Wed, 3 Jul 2024 06:39:23 +1000 Subject: [PATCH] punk pipeline rework - list return, pdict fixes, ansistrip performance --- src/modules/patternpunk-1.1.tm | 2 +- src/modules/punk-0.1.tm | 61 +++++++++++++- src/modules/punk/ansi-999999.0a1.0.tm | 39 ++++++++- src/modules/punk/lib-999999.0a1.0.tm | 84 ++++++++++++++----- .../punk/mix/commandset/debug-999999.0a1.0.tm | 4 +- src/modules/textblock-999999.0a1.0.tm | 81 +++++++++++------- 6 files changed, 214 insertions(+), 57 deletions(-) diff --git a/src/modules/patternpunk-1.1.tm b/src/modules/patternpunk-1.1.tm index 8c72e67..58c9e27 100644 --- a/src/modules/patternpunk-1.1.tm +++ b/src/modules/patternpunk-1.1.tm @@ -264,7 +264,7 @@ v_ /|\/ / } \n] >punk .. Method gcross {{size 1} args} { package require textblock - textblock::gcross $size {*}$args + textblock::gcross {*}$args $size } >punk .. Method dumpProperties {{object ::>punk}} { diff --git a/src/modules/punk-0.1.tm b/src/modules/punk-0.1.tm index fee53bd..6821acc 100644 --- a/src/modules/punk-0.1.tm +++ b/src/modules/punk-0.1.tm @@ -1395,6 +1395,36 @@ namespace eval punk { append script \n {set assigned [string length $leveldata]} set level_script_complete 1 } + %str { + set active_key_type "string" + if $get_not { + error "!%# not string-get is not supported" + } + lappend INDEX_OPERATIONS string-get + append script \n {# set active_key_type "" index_operation: string-get} + append script \n {set assigned $leveldata} + set level_script_complete 1 + } + %ansiview { + set active_key_type "string" + if $get_not { + error "!%# not string-ansiview is not supported" + } + lappend INDEX_OPERATIONS string-ansiview + append script \n {# set active_key_type "" index_operation: string-ansiview} + append script \n {set assigned [ansistring VIEW $leveldata]} + set level_script_complete 1 + } + %ansiviewstyle { + set active_key_type "string" + if $get_not { + error "!%# not string-ansiviewstyle is not supported" + } + lappend INDEX_OPERATIONS string-ansiviewstyle + append script \n {# set active_key_type "" index_operation: string-ansiviewstyle} + append script \n {set assigned [ansistring VIEWSTYLE $leveldata]} + set level_script_complete 1 + } @ { #as this is a stateful list next index operation - we use not (!@) to mean there is no element at the next index (instead of returning the complement ie all elements except next) #This is in contrast to other not operations on indices e.g /!2 which returns all elements except that at index 2 @@ -1849,7 +1879,7 @@ namespace eval punk { # set active_key_type "dict" index_operation: globvalue-get-keys-not set assigned [list] tcl::dict::for {k v} $leveldata { - if {![string match $v]} { + if {![string match "" $v]} { lappend assigned $k } } @@ -1860,7 +1890,7 @@ namespace eval punk { # set active_key_type "dict" index_operation: globvalue-get-keys set assigned [list] tcl::dict::for {k v} $leveldata { - if {[string match $v]} { + if {[string match "" $v]} { lappend assigned $k } } @@ -2745,7 +2775,9 @@ namespace eval punk { #'ismatch' must always be first element of dict - as we dispatch on ismatch 0 or ismatch 1 if {![string length $multivar]} { #treat the absence of a pattern as a match to anything + #JMN2 - changed to list based destructuring return [dict create ismatch 1 result $data setvars {} script {}] + #return [dict create ismatch 1 result [list $data] setvars {} script {}] } set returndict [dict create ismatch 0 result "" setvars {}] set script "" @@ -2848,7 +2880,14 @@ namespace eval punk { if {[string length $v]} { dict set returndict_setvars $v $assigned } - lappend assigned_values $assigned + + #JMN2 + #special case expansion for empty varspec (e.g , or ,,) + #if {$vspec eq ""} { + # lappend assigned_values {*}$assigned + #} else { + lappend assigned_values $assigned + #} incr i } @@ -3374,7 +3413,13 @@ namespace eval punk { incr i } - set returnval [lindex $assigned_values 0] + #JMN2 + #set returnval [lindex $assigned_values 0] + if {[llength $assigned_values] == 1} { + set returnval [join $assigned_values] + } else { + set returnval $assigned_values + } #puts stdout "----> > rep returnval: [rep $returnval]" @@ -3492,6 +3537,8 @@ namespace eval punk { if {![llength $var_names]} { #var_name entries can be blank - but it will still be a list + #JMN2 + #dict set returndict result [list $data] dict set returndict result $data } else { assert {$i == [llength $var_names]} assertion_fail _multi_bind_result condition {$i == [llength $var_names]} @@ -4764,7 +4811,9 @@ namespace eval punk { } #set forward_result $segment_result + #JMN2 set previous_result $segment_result + #set previous_result [join $segment_result] } else { debug.punk.pipe {[a+ cyan bold]End of pipe segments ($i)[a]} 4 #output pipe spec at tail of pipeline @@ -4783,12 +4832,16 @@ namespace eval punk { #the segment_result is based on the leftmost var on the lhs of the .= #whereas forward_result is always the entire output of the segment + #JMN2 + #lappend segment_result_list [join $segment_result] lappend segment_result_list $segment_result incr i incr j } ;# end while return [lindex $segment_result_list end] + #JMN2 + #return $segment_result_list #return $forward_result } diff --git a/src/modules/punk/ansi-999999.0a1.0.tm b/src/modules/punk/ansi-999999.0a1.0.tm index 5f8484b..8017b5e 100644 --- a/src/modules/punk/ansi-999999.0a1.0.tm +++ b/src/modules/punk/ansi-999999.0a1.0.tm @@ -2261,7 +2261,15 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu set sgr_cache [tcl::dict::create] #sgr_cache clear called by punk::console::ansi when set to off - proc sgr_cache {{action ""}} { + proc sgr_cache {args} { + set argd [punk::args::get_dict { + -action -default "" -choices "clear" + -pretty -default 1 -help "use 'pdict punk::ansi::sgr_cache */%str,%ansiview' output" + *values -min 0 -max 0 + } $args] + set action [dict get $argd opts -action] + set pretty [dict get $argd opts -pretty] + variable sgr_cache if {$action ni {"" clear}} { error "sgr_cache action '$action' not understood. Valid actions: clear" @@ -2270,6 +2278,10 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu set sgr_cache [tcl::dict::create] return "sgr_cache cleared" } + if {$pretty} { + return [pdict -channel none sgr_cache */%str,%ansiview] + } + if {[catch { set termwidth [tcl::dict::get [punk::console::get_size] columns] } errM]} { @@ -5439,7 +5451,28 @@ tcl::namespace::eval punk::ansi::class { } } tcl::namespace::eval punk::ansi { - proc stripansi {text} [string map [list $::punk::ansi::ta::re_ansi_split] { + proc stripansi {text} { + #ever so slightly slower on short strings - much faster than split_at_codes version for large/complex ansi blocks + if {[punk::ansi::ta::detect_g0 $text]} { + set text [convert_g0 $text];#Convert ansi borders to unicode line drawing instead of ascii letters + } + set parts [punk::ansi::ta::split_codes $text] + set out "" + foreach {pt code} $parts { + append out $pt + } + return $out + } + proc stripansiraw {text} { + #slightly slower on short strings - much faster than split_at_codes version for large/complex ansi blocks + set parts [punk::ansi::ta::split_codes $text] + set out "" + foreach {pt code} $parts { + append out $pt + } + return $out + } + proc stripansi3 {text} [string map [list $::punk::ansi::ta::re_ansi_split] { #*** !doctools #[call [fun stripansi] [arg text] ] #[para]Return a string with ansi codes stripped out @@ -5459,7 +5492,7 @@ tcl::namespace::eval punk::ansi { punk::ansi::ta::Do_split_at_codes_join $text {} }] - proc stripansiraw {text} [string map [list $::punk::ansi::ta::re_ansi_split] { + proc stripansiraw3 {text} [string map [list $::punk::ansi::ta::re_ansi_split] { #*** !doctools #[call [fun stripansi] [arg text] ] #[para]Return a string with ansi codes stripped out diff --git a/src/modules/punk/lib-999999.0a1.0.tm b/src/modules/punk/lib-999999.0a1.0.tm index 3b1f4e9..4a8a373 100644 --- a/src/modules/punk/lib-999999.0a1.0.tm +++ b/src/modules/punk/lib-999999.0a1.0.tm @@ -696,12 +696,17 @@ namespace eval punk::lib { } ## { dict set pattern_this_structure $pattern_nest dict - lappend keyset ## + lappend keyset [list ## query] } @* { dict set pattern_this_structure $pattern_nest list lappend keyset {*}[punk::lib::range 0 [llength $dval]-1] } + @@ { + #get first k v from dict + dict set pattern_this_structure $pattern_nest dict + lappend keyset [list @@ query] + } @*k@* - @*K@* { #returns keys only lappend keyset [list $p query] @@ -832,7 +837,7 @@ namespace eval punk::lib { } 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]" + #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" @@ -857,6 +862,9 @@ namespace eval punk::lib { # { set substructure list } + ## { + set substructure dict + } %# { set substructure string } @@ -887,18 +895,21 @@ namespace eval punk::lib { dict set pattern_next_substructure $pattern_nest $substructure # -- --- --- --- - set int_keyset 1 - foreach k $keyset { - if {![string is integer -strict $k]} { - set int_keyset 0 - break + if {$opt_keysorttype ne "none"} { + 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 -$opt_keysorttype $keyset] } } - if {$int_keyset} { - set keyset [lsort -integer $keyset] - } else { - set keyset [lsort -dictionary $keyset] - } + foreach k $keyset { lappend pattern_key_index $pattern_nest } @@ -935,11 +946,13 @@ namespace eval punk::lib { set kidx 0 foreach keydisplay $display_keys key $filtered_keys { + set hidekey 0 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] + set is_match 1 ;#whether to display the normal separator or bad-match separator 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 @@ -958,7 +971,7 @@ namespace eval punk::lib { 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 /] + lappend nextpatterns {*}[join $nest /] } set nextopts [dict get $argd opts] @@ -973,7 +986,12 @@ namespace eval punk::lib { #puts stderr "showdict {*}$nextopts $thisval [lindex $args end]" if {[llength $nextpatterns]} { - set thisval [showdict {*}$nextopts -- $thisval {*}$nextpatterns] + if {[catch { + set thisval [showdict {*}$nextopts -- $thisval {*}$nextpatterns] + } errMsg]} { + #puts stderr ">>> nextpatterns:'$nextpatterns' nextopts:'$nextopts'" + set is_match 0 + } } } list { @@ -993,7 +1011,7 @@ namespace eval punk::lib { 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 /] + lappend nextpatterns {*}[join $nest /] } set nextopts [dict get $argd opts] @@ -1004,12 +1022,32 @@ namespace eval punk::lib { # set nextpatterns * #} if {[llength $nextpatterns]} { + if {[catch { set thisval [showdict {*}$nextopts -- $thisval {*}$nextpatterns] + } errMsg]} { + set is_match 0 + } } } string { + set hidekey 0 if {$key eq "%string"} { + set hidekey 1 set thisval $dval + } elseif {$key eq "%ansiview"} { + set thisval [ansistring VIEW -lf 1 $dval] + } elseif {$key eq "%ansiviewstyle"} { + set thisval [ansistring VIEWSTYLE -lf 1 $dval] + } elseif {[string match *lpad-* $key]} { + set hidekey 1 + lassign [split $key -] _ extra + set width [expr {[textblock::width $dval] + $extra}] + set thisval [textblock::pad $dval -which left -width $width] + } elseif {[string match *rpad-* $key]} { + set hidekey 1 + lassign [split $key -] _ extra + set width [expr {[textblock::width $dval] + $extra}] + set thisval [textblock::pad $dval -which right -width $width] } else { if {[lindex $key 1] eq "query"} { set qry [lindex $key 0] @@ -1028,7 +1066,7 @@ namespace eval punk::lib { 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 /] + lappend nextpatterns {*}[join $nest /] } #set nextopts [dict get $argd opts] dict set nextopts -roottype $nextsub @@ -1040,7 +1078,7 @@ namespace eval punk::lib { } } - if {$this_type eq "string" && $key eq "%string"} { + if {$this_type eq "string" && $hidekey} { lassign [textblock::size $thisval] _vw vwidth _vh vheight #set blanks_above [string repeat \n [expr {$kheight -1}]] set vblock $opt_ansibase_values$thisval$RST @@ -1054,9 +1092,17 @@ namespace eval punk::lib { 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] + + if {$is_match} { + set use_sep $opt_sep + } else { + set use_sep " [a+ Web-red undercurly underline undert-white]mismatch[a] " + } + + + set sepwidth [textblock::width $use_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 sblock [textblock::pad $blanks_above$use_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 diff --git a/src/modules/punk/mix/commandset/debug-999999.0a1.0.tm b/src/modules/punk/mix/commandset/debug-999999.0a1.0.tm index 9a1f612..dc9d93a 100644 --- a/src/modules/punk/mix/commandset/debug-999999.0a1.0.tm +++ b/src/modules/punk/mix/commandset/debug-999999.0a1.0.tm @@ -31,7 +31,7 @@ namespace eval punk::mix::commandset::debug { set out "" puts stdout "find_repos output:" set pathinfo [punk::repo::find_repos [pwd]] - pdict $pathinfo + pdict pathinfo set projectdir [dict get $pathinfo closest] set modulefolders [lib::find_source_module_paths $projectdir] @@ -39,7 +39,7 @@ namespace eval punk::mix::commandset::debug { set template_base_dict [punk::mix::base::lib::get_template_basefolders] puts stdout "get_template_basefolders output:" - pdict $template_base_dict + pdict template_base_dict */* return } diff --git a/src/modules/textblock-999999.0a1.0.tm b/src/modules/textblock-999999.0a1.0.tm index bf9f116..05ad5bc 100644 --- a/src/modules/textblock-999999.0a1.0.tm +++ b/src/modules/textblock-999999.0a1.0.tm @@ -29,6 +29,7 @@ package require textutil tcl::namespace::eval textblock { #review - what about ansi off in punk::console? tcl::namespace::import ::punk::ansi::a ::punk::ansi::a+ + tcl::namespace::export block frame frame_cache framedef frametypes gcross height width widthtopline join join_basic list_as_table pad testblock tcl::namespace::eval class { variable opts_table_defaults @@ -3733,7 +3734,6 @@ tcl::namespace::eval textblock { #Note: A textblock does not necessarily have lines the same length - either in number of characters or print-width # tcl::namespace::eval textblock { - tcl::namespace::export block width tcl::namespace::eval cd { #todo - save and restore existing tcl::namespace::export in case macros::cd has default exports in future tcl::namespace::eval ::term::ansi::code::macros::cd {tcl::namespace::export *} @@ -3799,6 +3799,7 @@ tcl::namespace::eval textblock { -choices {table tableobject}\ -help "default choice 'table' returns the displayable table output" -compact -default 1 -type boolean -help "compact true defaults: -show_vseps 0 -show_header 0 -show_edge 0" + -frame -default 1 -type boolean -show_vseps -default "" -type boolean -show_header -default "" -type boolean -show_edge -default "" -type boolean @@ -3950,7 +3951,11 @@ tcl::namespace::eval textblock { -frametype block if {$opt_return eq "table"} { - set output [textblock::frame -ansiborder [a+ {*}$fc Web-black web-cornflowerblue] -type heavy -title "[a+ {*}$fc Web-black] Periodic Table " [$t print]] + if {[dict get $opts -frame]} { + set output [textblock::frame -ansiborder [a+ {*}$fc Web-black web-cornflowerblue] -type heavy -title "[a+ {*}$fc Web-black] Periodic Table " [$t print]] + } else { + set output [$t print] + } $t destroy return $output } @@ -6288,33 +6293,44 @@ tcl::namespace::eval textblock { variable frame_cache set frame_cache [tcl::dict::create] - proc frame_cache {{action ""}} { + proc frame_cache {args} { + set argd [punk::args::get_dict { + -action -default "" -choices {clear} -help "Clear the textblock::frame_cache dictionary" + -pretty -default 1 -help "Use 'pdict textblock::frame_cache */*' for prettier output" + *values -min 0 -max 0 + } $args] + set action [dict get $argd opts -action] + if {$action ni [list clear ""]} { error "frame_cache action '$action' not understood. Valid actions: clear" } variable frame_cache - set out "" - if {[catch { - set termwidth [tcl::dict::get [punk::console::get_size] columns] - }]} { - set termwidth 80 - } + if {[dict get $argd opts -pretty]} { + set out [pdict -chan none frame_cache */*] + } else { + set out "" + if {[catch { + set termwidth [tcl::dict::get [punk::console::get_size] columns] + }]} { + set termwidth 80 + } - tcl::dict::for {k v} $frame_cache { - lassign $v _f frame _used used - set fwidth [textblock::widthtopline $frame] - #review - are cached frames uniform width lines? - #set fwidth [textblock::width $frame] - set frameinfo "$k used:$used " - set allinone_width [expr {[tcl::string::length $frameinfo] + $fwidth}] - if {$allinone_width >= $termwidth} { - #split across 2 lines - append out "$frameinfo\n" - append out $frame \n - } else { - append out [textblock::join -- $frameinfo $frame]\n + tcl::dict::for {k v} $frame_cache { + lassign $v _f frame _used used + set fwidth [textblock::widthtopline $frame] + #review - are cached frames uniform width lines? + #set fwidth [textblock::width $frame] + set frameinfo "$k used:$used " + set allinone_width [expr {[tcl::string::length $frameinfo] + $fwidth}] + if {$allinone_width >= $termwidth} { + #split across 2 lines + append out "$frameinfo\n" + append out $frame \n + } else { + append out [textblock::join -- $frameinfo $frame]\n + } + append out \n ;# frames used to build tables often have joins - keep a line in between for clarity } - append out \n ;# frames used to build tables often have joins - keep a line in between for clarity } if {$action eq "clear"} { set frame_cache [tcl::dict::create] @@ -7038,15 +7054,24 @@ tcl::namespace::eval textblock { return $fs } } - proc gcross {{size 1} args} { + proc gcross {args} { + set argd [punk::args::get_dict { + -max_cross_size -default 0 -type integer -help "Largest size cross to use to make up the block + Only cross sizes that divide the size of the overall block will be used. + e.g if the 'size' chosen is 19 (a prime number) - only 1 or the full size of 19 can be used as the crosses to make up the block. + Whereas for a block size of 24, -max_cross_size of 1,2,3,4,6,8,12 or 24 will work. (all divisors) + If a number chosen for -max_cross_size isn't a divisor, the largest divisor below the chosen value will be used. + " + *values -min 1 + size -default 1 -type integer + } $args] + set size [dict get $argd values size] + set opts [dict get $argd opts] + if {$size == 0} { return "" } - set defaults [list\ - -max_cross_size 0 - ] - set opts [tcl::dict::merge $defaults $args] set opt_max_cross_size [tcl::dict::get $opts -max_cross_size] #set fit_size [punk::lib::greatestOddFactor $size]