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

punk pipeline rework - list return, pdict fixes, ansistrip performance

master
Julian Noble 6 months ago
parent
ad3ca5b9a9
commit
c65942ef2e
6 changed files with 214 additions and 57 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 2
      src/modules/patternpunk-1.1.tm
  2. 61
      src/modules/punk-0.1.tm
  3. 39
      src/modules/punk/ansi-999999.0a1.0.tm
  4. 84
      src/modules/punk/lib-999999.0a1.0.tm
  5. 4
      src/modules/punk/mix/commandset/debug-999999.0a1.0.tm
  6. 81
      src/modules/textblock-999999.0a1.0.tm

2
src/modules/patternpunk-1.1.tm
Unescape View File

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

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

@ -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 <keyglob> $v]} {
if {![string match "<keyglob>" $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 <keyglob> $v]} {
if {[string match "<keyglob>" $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 ,<something> or <something>,,<something>)
#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
}

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

@ -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 <re> $::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 <re> $::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 {<re>}
}]
proc stripansiraw {text} [string map [list <re> $::punk::ansi::ta::re_ansi_split] {
proc stripansiraw3 {text} [string map [list <re> $::punk::ansi::ta::re_ansi_split] {
#*** !doctools
#[call [fun stripansi] [arg text] ]
#[para]Return a string with ansi codes stripped out

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

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

4
src/modules/punk/mix/commandset/debug-999999.0a1.0.tm
Unescape View File

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

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

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

Write Preview
Loading…
Cancel
Save