@ -231,6 +231,7 @@ namespace eval textblock {
variable o_opts_table_defaults
variable o_opts_column_defaults
variable o_opts_row_defaults
variable TSUB
constructor {args} {
#*** !doctools
#[call class::table [method constructor] [arg args]]
@ -258,6 +259,7 @@ namespace eval textblock {
set o_rowdefs [dict create] ;#user requested row data e.g -minheight -maxheight
set o_rowstates [dict create] ;#actual row data such as -minheight and -maxheight detected from supplied row data
set TSUB \uF111 ;#should be BMP PUA code to show as either replacement char or nerdfont glyph. See FSUB for comments regarding choices.
}
method Get_seps {} {
set requested_seps [dict get $o_opts_table -show_seps]
@ -594,6 +596,8 @@ namespace eval textblock {
-ansireset "\uFFEF"\
-minwidth ""\
-maxwidth ""\
-blockalign centre\
-textalign left\
]
#initialise -ansireset with replacement char so we can keep in appropriate dict position for initial configure and then treat as read-only
set o_opts_column_defaults $defaults
@ -769,6 +773,16 @@ namespace eval textblock {
error "textblock::table::configure_column -ansireset is read-only. It is present only to prevent unwanted colourised output in configure commands"
}
}
-blockalign - -textalign {
switch -- $v {
left - right {
lappend checked_opts $k $v
}
centre - centre {
lappend checked_opts $k centre
}
}
}
default {
lappend checked_opts $k $v
}
@ -1269,11 +1283,16 @@ namespace eval textblock {
set botseps_v [dict get $sep_elements_vertical bottom$opt_posn]
set onlyseps_v [dict get $sep_elements_vertical only$opt_posn]
#top should work for all header rows regarding vseps - as we only use it to reduce the box elements, and lower headers have same except for tlc which isn't present anyway
set headerseps_v [dict get $sep_elements_vertical top$opt_posn]
lassign [my Get_seps] _h show_seps_h _v show_seps_v
set return_headerheight 0
set return_headerwidth 0
set cidx [lindex [dict keys $o_columndefs] $index_expression]
set colwidth [my column_width $cidx]
set col_blockalign [dict get $o_columndefs $cidx -blockalign]
if {$do_show_header} {
#puts "boxlimitsinfo header $opt_posn: -- boxlimits $header_boxlimits -- boxmap $hdrmap"
set ansibase_header [dict get $o_opts_table -ansibase_header] ;#merged to single during configure
@ -1284,9 +1303,7 @@ namespace eval textblock {
} else {
set ansiborder_final $ansibase_header$ansiborder_header
}
set cidx [lindex [dict keys $o_columndefs] $index_expression]
set RST [punk::ansi::a]
set colwidth [my column_width $cidx]
set hcell_line_blank [string repeat " " $colwidth]
set h 0
@ -1304,6 +1321,8 @@ namespace eval textblock {
set column_width_cache [dict create]
#used for colspan-zero header frames
set framesub_map [list hl $TSUB vll $TSUB vlr $TSUB tlc $TSUB blc $TSUB trc $TSUB brc $TSUB] ;# a debug test
foreach header $header_list {
set headerspans [dict get $all_colspans $h]
@ -1361,21 +1380,33 @@ namespace eval textblock {
}
}
#supporting wrapping in headers might be a step too difficult for little payoff.
#we would need a flag to enable/disable - plus language-based wrapping alg (see tcllib)
#The interaction with colspans and width calculations makes it likely to have a heavy performance impact and make the code even more complex.
#May be better to require user to pre-wrap as needed
##set hval [textblock::renderspace -width $colwidth -wrap 1 "" $hval]
#review - contentwidth of hval can be greater than $colwidth+2 - if so frame function will detect and frame_cache will not be used
set header_cell_startspan [textblock::frame -usecache 1 -width [expr {$colwidth+2}] -type [dict get $ftypes header]\
#This ellipsis 0 makes a difference (unwanted ellipsis at rhs of header column that starts span)
# -width is always +2 - as the boxlimits take into account show_vseps and show_edge
set header_cell_startspan [textblock::frame -ellipsis 0 -usecache 1 -width [expr {$colwidth+2}] -type [dict get $ftypes header]\
-ansibase $ansibase_header -ansiborder $ansiborder_final\
-boxlimits $hlims -boxmap $startmap -joins $header_joins $hval\
]
#JMN
#puts "===>\n$header_cell_startspan\n<==="
set spanned_parts [list $header_cell_startspan]
if {$this_span ne "1"} {
#more parts to append
#assert this_span == "all" or >1 ie a header that spans other columns
#therefore more parts to append
#set remaining_cols [lrange [dict keys $o_columndefs] $cidx end]
set remaining_spans [lrange $headerspans $cidx+1 end]
#puts ">> remaining_spans: $remaining_spans"
set spancol [expr {$cidx + 1}]
set h_lines [lrepeat $rowh ""]
set hcell_blank [::join $h_lines \n]
set hcell_blank [::join $h_lines \n] ;#todo - just use -height option of frame?
@ -1441,22 +1472,26 @@ namespace eval textblock {
dict set column_width_cache $spancol headerwidth $hwidth
} else {
set bwidth [dict get $column_width_cache $spancol bodywidth]
set hwidth [dict get $column_width_cache $spancol headerwidth]
}
#subsequent headers may also span columns - so we will get too wide if we use the headers directly
#but if we don't take into account header widths - they may get truncated.
if {$next_posn eq "right"} {
#This is an unintuitive edge case - review
#spans at tail end are too long when edges are shown if we use bwidth+1 (vlr extends right beyond table)
#spans at tail end are too short if edges are hidden and we use bwidth (short lower horizontal bar)
if {![dict get $o_opts_table -show_edge]} {
set spanwidth [expr {$bwidth+1}]
#spans at tail end are too long when edges are shown if we use bwidth (vlr extends right beyond table)
#spans at tail end are too short if edges are hidden and we use bwidth-1 (short lower horizontal bar)
#test JMN
if {$next_posn eq "right" && [dict get $o_opts_table -show_edge]} {
set spanwidth [expr {$bwidth -1}]
} else {
set spanwidth $bwidth
}
} else {
set spanwidth [expr {$bwidth+1}]
set spanwidth [expr {$bwidth }]
}
set header_cell [textblock::frame -width $spanwidth -type [dict get $ftypes header]\
#JMN - review
set framewidth $spanwidth
incr framewidth 1
set header_cell [textblock::frame -ellipsis 0 -width $framewidth -type [dict get $ftypes header]\
-ansibase $ansibase_header -ansiborder $ansiborder_final\
-boxlimits $hlims -boxmap $this_span_map -joins $header_joins $hcell_blank\
]
@ -1485,8 +1520,9 @@ namespace eval textblock {
set spacemap [list hl " " vl " " tlc " " blc " " trc " " brc " "]
#set spacemap [list hl "\uFFFF" vl "\uFFFF" tlc "\uFFFF" blc "\uFFFF" trc "\uFFFF " brc "\uFFFF"] ;# a debug test
#-usecache 1 ok
set hblock [textblock::frame -type $spacemap -boxlimits $hlims -ansibase $ansibase_header $hval]
set spanned_frame [overtype::left -experimental test_mode -transparent 1 $spanned_frame $hblock]
set hblock [textblock::frame -ellipsis 0 -type $spacemap -boxlimits $hlims -ansibase $ansibase_header $hval]
#set spanned_frame [overtype::renderspace -experimental test_mode -transparent 1 $spanned_frame $hblock]
set spanned_frame [overtype::block -blockalign left -transparent 1 $spanned_frame $hblock]
}
@ -1495,49 +1531,50 @@ namespace eval textblock {
} else {
#zero span header
#JMN
if 0 {
#old version - sort of works
set h_lines [lrepeat $rowh ""]
set hcell_blank [join $h_lines \n]
set spacemap [list hl " " vl " " tlc " " blc " " trc " " brc " "]
set spacemap [list hl "\uFFFF" vl "\uFFFF" tlc "\uFFFF" blc "\uFFFF" trc "\uFFFF " brc "\uFFFF"] ;# a debug test
set header_frame [textblock::frame -width 0 -type [dict get $ftypes header]\
-ansibase $ansibase_header \
-boxlimits $hlims -boxmap $spacemap $hcell_blank\
]
append part_header $header_frame\n
} else {
#test version
set hw1 [dict get $o_columnstates $cidx maxwidthheaderseen] ;#headers may be masked by spans, or empty - width may depend more on spans than headers in current column
set hw2 [textblock::width $part_header] ;#widest so far
set hw3 [expr {max($hw1,$hw2)}]
set bw [dict get $o_columnstates $cidx maxwidthbodyseen]
set padwidth [expr {max($hw3,$bw)}]
if {[dict exists $column_width_cache $cidx]} {
set hwidth [dict get $column_width_cache $cidx headerwidth]
set padwidth [expr {max($padwidth,$hwidth)}]
}
#test hack - wider helps stop the breaks - but leaves junk spaces and ansiresets beyond the rhs border of table
#print function overflow 0 fixes?
set padwidth 20
#set padwidth 20
#This sort of works - but doesn't cater for colspans that don't strictly decrease in size as we go down the header list
#we end up with breaks in some situations
#we don't know the width here, because we would need to look-ahead to see the widest section of frame
#We will adjust the padding below.
#we need the column data width as a minimum or we'll cut lines above from earlier columns
set padwidth [my column_datawidth $cidx -headers 0 -data 1 -cached 1]
#set bline [string repeat \uFFFF $colwidth]
set bline [string repeat \uFFFF $padwidth]
#under assumption we are building table using L frame method and that horizontal borders are only ever 1 high
# - we can avoid using a frame - but we potentially need to manually adjust for show_hpos show_edge etc
#avoiding frame here is faster.. but not by much (<10%? on textblock::spantest2 )
if 0 {
#breaks -show_edge 0
if {$rowpos eq "top" && [dict get $o_opts_table -show_edge]} {
set padheight [expr {$rowh + 2}]
} else {
set padheight [expr {$rowh + 1}]
}
set bline [string repeat $TSUB [expr {$padwidth +1}]]
set h_lines [lrepeat $padheight $bline]
set hcell_blank [::join $h_lines \n]
set header_frame $hcell_blank
} else {
set bline [string repeat $TSUB $padwidth]
set h_lines [lrepeat $rowh $bline]
set hcell_blank [::join $h_lines \n]
set spacemap [list hl "\uFFFF" vll "\uFFFF" vlr "\uFFFF" tlc "\uFFFF" blc "\uFFFF" trc "\uFFFF " brc "\uFFFF"] ;# a debug test
# -usecache 1 ok
set header_frame [textblock::frame -width [expr {$padwidth+2}] -type [dict get $ftypes header]\
-ansibase $ansibase_header \
-boxlimits $hlims -boxmap $spacemap $hcell_blank\
#set header_frame [textblock::frame -ellipsis 0 -width [expr {$padwidth+2}] -type [dict get $ftypes header]\
# -ansibase $ansibase_header \
# -boxlimits $hlims -boxmap $framesub_map $hcell_blank\
# ]
#frame borders will never display - so use the simplest frametype and don't apply any ansi
set header_frame [textblock::frame -ellipsis 0 -width [expr {$padwidth+2}] -type ascii\
-boxlimits $hlims -boxmap $framesub_map $hcell_blank\
]
append part_header $header_frame\n
}
}
append part_header $header_frame\n
}
incr h
}
@ -1558,9 +1595,21 @@ namespace eval textblock {
]
append part_header $header_frame\n
}
set part_header [string trimright $part_header \n]
lassign [textblock::size $part_header] _w return_headerwidth _h return_headerheight
set padline [string repeat $TSUB $return_headerwidth]
set adjusted_lines [list]
foreach ln [split $part_header \n] {
if {[string first $TSUB $ln] >=0} {
lappend adjusted_lines $padline
} else {
lappend adjusted_lines $ln
}
append output $part_header
}
set part_header [join $adjusted_lines \n]
}
append output $part_header \n
set r 0
set rmax [expr {[llength $cells]-1}]
@ -1589,10 +1638,10 @@ namespace eval textblock {
set colidx [lindex [dict keys $o_columndefs] $index_expression] ;#convert possible end-1,2+2 etc expression to >= 0 integer in dict range
set opt_col_ansibase [dict get $o_columndefs $colidx -ansibase] ;#ordinary merge of codes already done in configure_column
#set colwidth [my column_width $colidx]
set body_ansibase [dict get $o_opts_table -ansibase_body]
#set ansibase [punk::ansi::codetype::sgr_merge_singles [list $body_ansibase $opt_col_ansibase]] ;#allow col to override body
set ansibase $body_ansibase$opt_col_ansibase
set body_ansiborder [dict get $o_opts_table -ansiborder_body]
if {[dict get $o_opts_table -frametype] eq "block"} {
#block is the only style where bg colour can fill the frame content area exactly if the L-shaped border elements are styled
@ -1603,44 +1652,65 @@ namespace eval textblock {
set border_ansi $body_ansibase$body_ansiborder
}
set r 0
set ftblock [expr {[dict get $o_opts_table -frametype] eq "block"}]
foreach c $cells {
set ansibase $body_ansibase$opt_col_ansibase
set row_ansibase [dict get $o_rowdefs $r -ansibase]
#todo - joinleft,joinright,joindown based on opts in args
#append output [textblock::frame -boxlimits {vll blc hlb} $c]\n
if {[dict get $o_opts_table -frametype] eq "block"} {
set row_ansibase [dict get $o_rowdefs $r -ansibase]
set cell_ansibase ""
set row_bg ""
if {$row_ansibase ne ""} {
set row_bg [punk::ansi::codetype::sgr_merge_singles [list $row_ansibase] -filter_fg 1]
}
set ansiborder_body_col_row $border_ansi$row_bg
set ansiborder_final $ansiborder_body_col_row
if 1 {
#$c will always have ansi resets due to overtype::left behaviour
#$c will always have ansi resets due to overtype behaviour ?
#todo - review overtype
if {[punk::ansi::ta::detect $c]} {
#if {[textblock::widthtopline $c] == $colwidth} {}
#use only the last ansi sequence in the cell value
#Filter out foreground and use background for ansiborder override
set parts [punk::ansi::ta::split_codes_single $c]
#we have detected ansi - so there will always be at least 3 parts beginning and ending with pt pt,ansi,pt,ansi...,pt
set codes [list]
foreach {pt cd} $parts {
if {$cd ne ""} {
lappend codes $cd
}
}
#set takebg [lindex $parts end-1]
#set cell_bg [punk::ansi::codetype::sgr_merge_singles [list $takebg] -filter_fg 1]
set cell_bg [punk::ansi::codetype::sgr_merge_singles $codes -filter_fg 1]
set cell_bg [punk::ansi::codetype::sgr_merge_singles $codes -filter_fg 1 -filter_reset 1]
#puts --->[ansistring VIEW $codes]
#puts "-->>> [ansistring VIEW $cell_bg] <<<--"
set ansiborder_final $ansiborder_body_col_row$cell_bg
#JMN
if {[punk::ansi::codetype::is_sgr_reset [lindex $codes end]]} {
if {[punk::ansi::codetype::is_sgr_reset [lindex $codes end-1]]} {
#special case double reset at end of content
set cell_ansi_tail [punk::ansi::codetype::sgr_merge_singles $codes] ;#no filters
set ansibase ""
set row_ansibase ""
if {$ftblock} {
set ansiborder_final [punk::ansi::codetype::sgr_merge [list $ansiborder_body_col_row] -filter_bg 1]
}
set cell_ansibase $cell_ansi_tail
} else {
#single trailing reset in content
set cell_ansibase "" ;#cell doesn't contribute to frame's ansibase
}
} else {
set ansiborder_body_col_row $border_ansi
set ansiborder_final $ansiborder_body_col_row
if {$ftblock} {
#no resets use cells bg to extend to the border - only for block frames
set ansiborder_final $ansiborder_body_col_row$cell_bg
}
set cell_ansibase $cell_bg
}
set ansibase_final $ansibase$row_ansibase
}
set ansibase_final $ansibase$row_ansibase$cell_ansibase
if {$r == 0} {
if {$r == $rmax} {
@ -1665,7 +1735,7 @@ namespace eval textblock {
set blims [struct::set difference $blims [dict get $::textblock::class::table_edge_parts top$opt_posn] ]
}
}
set rowframe [textblock::frame -type [dict get $ftypes body] -ansibase $ansibase_final -ansiborder $ansiborder_final -boxlimits $blims -boxmap $bmap -joins $joins $c]
set rowframe [textblock::frame -type [dict get $ftypes body] -width [expr {$colwidth+2}] -blockalign $col_blockalign - ansibase $ansibase_final -ansiborder $ansiborder_final -boxlimits $blims -boxmap $bmap -joins $joins $c]
set return_bodywidth [textblock::width $rowframe]
append part_body $rowframe \n
} else {
@ -1683,7 +1753,7 @@ namespace eval textblock {
set blims [struct::set difference $blims [dict get $::textblock::class::table_edge_parts middle$opt_posn] ]
}
}
append part_body [textblock::frame -type [dict get $ftypes body] -ansibase $ansibase_final -ansiborder $ansiborder_final -boxlimits $blims -boxmap $bmap -joins $joins $c]\n
append part_body [textblock::frame -type [dict get $ftypes body] -width [expr {$colwidth+2}] -blockalign $col_blockalign - ansibase $ansibase_final -ansiborder $ansiborder_final -boxlimits $blims -boxmap $bmap -joins $joins $c]\n
}
incr r
}
@ -1691,7 +1761,6 @@ namespace eval textblock {
if {![llength $cells]} {
set joins [lremove $joins [lsearch $joins down*]]
#we need to know the width of the column to setup the empty cell properly
#(we didn't need it above because get_column_cells_by_index returned values of the correct width)
#even if no header displayed - we should take account of any defined column widths
set colwidth [my column_width $index_expression]
@ -1751,6 +1820,14 @@ namespace eval textblock {
set RST [punk::ansi::a]
set ansibase_body [dict get $o_opts_table -ansibase_body]
set ansibase_col [dict get $cdef -ansibase]
set textalign [dict get $cdef -textalign]
switch -- $textalign {
left {set pad right}
right {set pad left}
default {
set pad "centre" ;#todo?
}
}
set ansibase_header [dict get $o_opts_table -ansibase_header]
@ -1799,15 +1876,18 @@ namespace eval textblock {
set header_underlay [lrepeat $header_maxdataheight $hdr_line_blank]
set header_underlay $ansibase_header[join $header_underlay \n]
if {$hdr ne ""} {
dict lappend output headers [overtype::left -experimental test_mode $header_underlay $ansibase_header$hdr]
dict lappend output headers [overtype::renderspace -experimental test_mode $header_underlay $ansibase_header$hdr]
} else {
dict lappend output headers $header_underlay
}
}
set colwidth [my column_width $cidx]
set cell_line_blank [string repeat " " $colwidth]
#set colwidth [my column_width $cidx]
#set cell_line_blank [string repeat " " $colwidth]
set datawidth [my column_datawidth $cidx -headers 0 -footers 0 -data 1 -cached 1]
set cell_line_blank [string repeat " " $datawidth]
set items [dict get $o_columndata $cidx]
@ -1858,10 +1938,12 @@ namespace eval textblock {
set cval_block [join $cval_lines \n]
#TODO! fix overtype library
#set cell [overtype::left -experimental test_mode $cell_ansibase$cell_blank$RST $cval_block]
#set cell [overtype::left -experimental test_mode $cell_blank $cval_block]
#set cell [overtype::renderspace -experimental test_mode $cell_ansibase$cell_blank$RST $cval_block]
#set cell [overtype::renderspace -experimental test_mode $cell_blank $cval_block]
set cell [textblock::pad $cval_block -width $colwidth -padchar " " -within_ansi 0 -which right]
#set cell [textblock::pad $cval_block -width $colwidth -padchar " " -within_ansi 0 -which right]
set cell [textblock::pad $cval_block -width $datawidth -padchar " " -within_ansi 1 -which $pad]
#set cell [textblock::pad $cval_block -width $colwidth -padchar " " -within_ansi 0 -which left]
dict lappend output cells $cell
@ -2077,10 +2159,11 @@ namespace eval textblock {
-headers 0\
-footers 0\
-data 1\
-cached 1\
]
dict for {k v} $args {
switch -- $k {
-headers - -footers - -data {}
-headers - -footers - -data - -cached {}
default {
error "column_datawidth unrecognised flag '$k'. Known flags: [dict keys $defaults]"
}
@ -2092,6 +2175,24 @@ namespace eval textblock {
if {$cidx eq ""} {
return
}
if {[dict get $opts -cached]} {
set hwidest 0
set bwidest 0
set fwidest 0
if {[dict get $opts -headers]} {
set hwidest [dict get $o_columnstates $cidx maxwidthheaderseen]
}
if {[dict get $opts -data]} {
set bwidest [dict get $o_columnstates $cidx maxwidthbodyseen]
}
if {[dict get $opts -footers]} {
#TODO!
#set bwidest [dict get $o_columnstates $cidx maxwidthfooterseen]
}
return [expr {max($hwidest,$bwidest,$fwidest)}]
}
#assert cidx is >=0 integer in valid range of keys for o_columndefs
set values [list]
if {[dict get $opts -headers]} {
@ -2213,12 +2314,12 @@ namespace eval textblock {
set table $nextcol
set height [textblock::height $table] ;#only need to get height once at start
} else {
set nextcol [textblock::join [textblock::block $padwidth $height "\uFFFF" ] $nextcol]
set table [overtype::left -overflow 1 -experimental test_mode -transparent \uFFFF $table $nextcol]
set nextcol [textblock::join [textblock::block $padwidth $height $TSUB ] $nextcol]
set table [overtype::renderspace -overflow 1 -experimental test_mode -transparent $TSUB $table $nextcol]
#JMN
#set nextcol [textblock::join [textblock::block $padwidth $height "\uFFFF"] $nextcol]
#set table [overtype::left -overflow 1 -experimental test_mode -transparent \uFFFF $table $nextcol]
#set table [overtype::renderspace -overflow 1 -experimental test_mode -transparent \uFFFF $table $nextcol]
}
incr padwidth $bodywidth
incr colposn
@ -2266,6 +2367,21 @@ namespace eval textblock {
$t configure -show_header 1 -ansiborder_header [a+ cyan]
return $t
}
#more complex colspans
proc spantest2 {} {
set t [list_as_table 5 {a b c d e aa bb cc dd ee X Y} -return object]
$t configure_column 0 -headers {span3 span4 span5/5 "span-all etc blah 123 hmmmmm" span2}
$t configure_column 0 -header_colspans {3 4 1 all 1}
$t configure_column 2 -headers {"" "" "" "" c2span2}
$t configure_column 1 -header_colspans {0 0 2 0 1}
$t configure_column 2 -header_colspans {0 0 0 0 2}
$t configure -show_header 1 -ansiborder_header [a+ cyan]
return $t
}
proc periodic {args} {
#For an impressive interactive terminal app (javascript)
# see: https://github.com/spirometaxas/periodic-table-cli
@ -2607,6 +2723,19 @@ namespace eval textblock {
}
return [punk::char::ansifreestring_width $textblock]
}
#when we know the block is uniform in width - just examine topline
proc widthtopline {textblock} {
set firstnl [string first \n $textblock]
if {$firstnl >= 0} {
set tl [string range $textblock 0 $firstnl]
} else {
set tl $textblock
}
if {[punk::ansi::ta::detect $tl]} {
set tl [punk::ansi::stripansi $tl]
}
return [punk::char::ansifreestring_width $tl]
}
#uses tcl's string length on each line. Length will include chars in ansi codes etc - this is not a 'width' determining function.
proc string_length_line_max textblock {
tcl::mathfunc::max {*}[lmap v [split $textblock \n] {string length $v}]
@ -2945,7 +3074,7 @@ namespace eval textblock {
return $t
}
proc pad_test2 {blocklist} {
proc pad_test_blocklist {blocklist} {
set b 0
set blockinfo [dict create]
foreach block $blocklist {
@ -2989,7 +3118,7 @@ namespace eval textblock {
set b2 "[a+ green bold][textblock::block 4 4 x]\n[a+ Green]"
set b3 "[textblock::testblock 4 rainbow]\n[a]"
set b4 "[textblock::testblock 4 rainbow]\n[a+ Green]"
set t [textblock::pad_test2 [list $b1 $b2 $b3 $b4]]
set t [textblock::pad_test_blocklist [list $b1 $b2 $b3 $b4]]
}
@ -3039,6 +3168,7 @@ namespace eval textblock {
}
#for joining 'rendered' blocks of plain or ansi text. Being 'rendered' means they are without ansi movement sequences as these have been processed
#they may however still be 'ragged' ie differing line lengths
proc ::textblock::join {args} {
#lassign [punk::lib::opts_values {
# blocks -type string -multiple 1
@ -4396,9 +4526,27 @@ namespace eval textblock {
}
variable frame_cache
set out ""
if {[catch {
set termwidth [dict get [punk::console::get_size] columns]
}]} {
set termwidth 80
}
dict for {k v} $frame_cache {
lassign $v _f frame _used used
append out [textblock::join $k " " $frame " " $used]\n
#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 {[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
}
if {$action eq "clear"} {
set frame_cache [dict create]
@ -4455,16 +4603,18 @@ namespace eval textblock {
-height ""\
-ansiborder ""\
-ansibase ""\
-align "left"\
-blockalign "centre"\
-textalign "left"\
-ellipsis 1\
-usecache 1\
-buildcache 1\
]
#todo -blockalignbias -textalignbias?
#use -buildcache 1 with -usecache 0 for debugging cache issues so we can inspect using textblock::frame_cache
set opts [dict merge $defaults $arglist]
foreach {k v} $opts {
switch -- $k {
-etabs - -type - -boxlimits - -boxmap - -joins - -title - -subtitle - -width - -height - -ansiborder - -ansibase - -align - -ellipsis - -usecache - -buildcache {}
-etabs - -type - -boxlimits - -boxmap - -joins - -title - -subtitle - -width - -height - -ansiborder - -ansibase - -blockalign - -text align - -ellipsis - -usecache - -buildcache {}
default {
error "frame option '$k' not understood. Valid options are [dict keys $defaults]"
}
@ -4584,16 +4734,24 @@ namespace eval textblock {
set opt_width [dict get $opts -width]
set opt_height [dict get $opts -height]
# -- --- --- --- --- ---
set opt_align [dict get $opts -align]
set opt_align [string tolower $opt_align]
switch -- $opt_align {
set opt_blockalign [dict get $opts -blockalign]
switch -- $opt_blockalign {
left - right - centre - center {}
default {
error "frame option -align must be left|right|centre|center - received: $opt_align"
error "frame option -block align must be left|right|centre|center - received: $opt_block align"
}
}
#these are all valid commands for overtype::<cmd>
# -- --- --- --- --- ---
set opt_textalign [dict get $opts -textalign]
switch -- $opt_textalign {
left - right - centre - center {}
default {
error "frame option -textalign must be left|right|centre|center - received: $opt_textalign"
}
}
# -- --- --- --- --- ---
set opt_ansiborder [dict get $opts -ansiborder]
set opt_ansibase [dict get $opts -ansibase] ;#experimental
set opt_ellipsis [dict get $opts -ellipsis]
@ -4611,7 +4769,7 @@ namespace eval textblock {
}
}
set contents [string map [list \r\n \n] $contents]
set actual_contentwidth [textblock::width $contents]
set actual_contentwidth [textblock::width $contents] ;#length of longest line in contents (contents can be ragged)
set actual_contentheight [textblock::height $contents]
} else {
set actual_contentwidth 0
@ -4627,92 +4785,99 @@ namespace eval textblock {
}
if {$opt_width eq ""} {
set content width $content_or_title_width
set frame_inner_ width $content_or_title_width
} else {
set content width [expr {max(0,$opt_width - 2)}] ;#default
set frame_inner_ width [expr {max(0,$opt_width - 2)}] ;#default
}
if {$opt_height eq ""} {
set content height $actual_contentheight
set frame_inner_ height $actual_contentheight
} else {
set content height [expr {max(0,$opt_height -2)}] ;#default
set frame_inner_ height [expr {max(0,$opt_height -2)}] ;#default
}
if {$contentheight == 0 && $content width == 0} {
if {$frame_inner_height == 0 && $frame_inner_ width == 0} {
set has_contents 0
}
#todo - render it with vertical overflow so we can process ansi moves?
#set linecount [textblock::height $contents]
set linecount $content height
set linecount $frame_inner_ height
# -- --- --- --- --- --- --- --- ---
variable frame_cache
#review - custom frame affects content width - exclude from caching?
#set cache_key [concat $arglist $contentwidth $content height]
set hashables [concat $arglist $contentwidth $content height]
#review - custom frame affects frame_inner_ width - exclude from caching?
#set cache_key [concat $arglist $frame_inner_width $frame_inner_ height]
set hashables [concat $arglist $frame_inner_width $frame_inner_ height]
package require md5
set hash [md5::md5 -hex $hashables]
set cache_key "$hash-$contentwidth-$contentheight-actualcontentwidth:$actual_contentwidth"
set TSUB \u1FFF; #needs to be different to that used in table construction
set cache_key "$hash-$frame_inner_width-$frame_inner_height-actualcontentwidth:$actual_contentwidth"
#should be in a unicode private range different to that used in table construction
#e.g BMP PUA U+E000 -> U+F8FF - although this is commonly used for example by nerdfonts
#also supplementary private use blocks
#however these display double wide on for example cmd terminal despite having wcswidth 1 (makes layout debugging difficult)
#U+F0000 -> U+FFFD
#U+100000 -> U+10FFFD
#FSUB options: \uf0ff \uF1FF \uf2ff (no nerdfont glyphs - should look like standard replacement char) \uF2DD (circular thingy)
#should be something someone is unlikely to use as part of a custom frame character.
#ideally a glyph that doesn't auto-expand into whitespace and is countable when in a string (narrower is better)
#As nerdfont glyphs tend to be mostly equal height & width - circular glyphs tend to be more distinguishable in a string
#terminal settings may need to be adjusted to stop auto glyph resizing - a rather annoying misfeature that some people seem to think they like.
#e.g in wezterm config: allow_square_glyphs_to_overflow_width = "Never"
#review - we could consider wasting a few cycles to check for a conflict and use a different FSUB
set FSUB \uF2DD
#this occurs commonly in table building with colspans - review
if {$actual_contentwidth > $contentwidth || $actual_contentheight != $contentheight} {
if {$actual_contentwidth > $frame_inner_width || $actual_contentheight != $frame_inner_ height} {
set usecache 0
#set buildcache 0 ;#comment out for debug/analysis so we can see
set cache_key [a+ Web-red]$cache_key[a]
#puts "--->> frame_inner_width:$frame_inner_width actual_contentwidth:$actual_contentwidth contents: '$contents'"
set cache_key [a+ Web-red web-white]$cache_key[a]
}
if {$buildcache && $actual_contentwidth < $contentwidth} {
if {$buildcache && $actual_contentwidth < $frame_inner_ width} {
#colourise cache_key to warn
if {$actual_contentwidth == 0} {
#we can still substitue with right length
#we can still substitut e with right length
set cache_key [a+ Web-steelblue web-black]$cache_key[a]
} else {
#actual_contentwidth is shorter - rather than choose an alignment and pad - we will opt out of caching
#actual_contentwidth is narrower than frame - check template's patternwidth
if {[dict exists $frame_cache $cache_key]} {
set cache_patternwidth [dict get $frame_cache $cache_key patternwidth]
} else {
set cache_patternwidth [$actual_contentwidth]
}
if {$actual_contentwidth < $cache_patternwidth} {
set usecache 0
set cache_key [a+ Web-orange web-black]$cache_key[a]
} elseif {$actual_contentwidth == $cache_patternwidth} {
#set usecache 1
} else {
#actual_contentwidth > pattern
set usecache 0
set cache_key [a+ Web-red web-black]$cache_key[a]
}
}
}
#JMN debug
#set usecache 0
set is_cached 0
if {$usecache && [dict exists $frame_cache $cache_key]} {
set cache_patternwidth [dict get $frame_cache $cache_key patternwidth]
set template [dict get $frame_cache $cache_key frame]
set used [dict get $frame_cache $cache_key used]
dict set frame_cache $cache_key used [expr {$used+1}]
dict set frame_cache $cache_key used [expr {$used+1}] ;#update existing record
set is_cached 1
set resultlines [list]
set overwritable [string repeat $TSUB $contentwidth]
set blankset [string repeat " " $contentwidth]
set contentindex 0
set clines [split $contents \n]
if {$actual_contentwidth == 0} {
foreach tline [split $template \n] {
if {[string first $TSUB $tline] >= 0} {
lappend resultlines [string map [list $overwritable $blankset] $tline]
incr contentindex
} else {
lappend resultlines $tline
}
}
} else {
foreach tline [split $template \n] {
if {[string first $TSUB $tline] >= 0} {
#set sublen [string length [lindex [regexp -inline "\[^$TSUB]*($TSUB*).*" $tline] 1]]
#set overwritable [string repeat $TSUB $sublen]
lappend resultlines [string map [list $overwritable [lindex $clines $contentindex]] $tline]
incr contentindex
} else {
lappend resultlines $tline
}
}
}
return [::join $resultlines \n]
}
# -- --- --- --- --- --- --- --- ---
if {!$is_cached} {
set rst [a]
#set column [string repeat " " $content width] ;#default - may need to override for custom frame
set underlayline [string repeat " " $content width]
#set column [string repeat " " $frame_inner_width] ;#default - may need to override for custom frame
set underlayline [string repeat " " $frame_inner_width]
set underlay [::join [lrepeat $linecount $underlayline] \n]
set cache_underlayline [string repeat $TSUB $contentwidth]
set cache_underlay [::join [lrepeat $linecount $cache_underlayline] \n]
set vll_width 1 ;#default for all except custom (printing width)
set vlr_width 1
@ -4751,20 +4916,21 @@ namespace eval textblock {
set brc_width [punk::ansi::printing_length $brc]
set framewidth [expr {$content width + 2}] ;#reverse default assumption
set framewidth [expr {$frame_inner_ width + 2}] ;#reverse default assumption
if {$opt_width eq ""} {
#width wasn't specified - so user is expecting frame to adapt to title/contents
#content shouldn't truncate because of extra wide frame
set contentwidth $content_or_title_width
#review - punk::console::get_size ? wrapping? quite hard to support with colspans
set frame_inner_width $content_or_title_width
set tbarwidth [expr {$content_or_title_width + 2 - $tlc_width - $trc_width - 2 + $vll_width + $vlr_width}] ;#+/2's for difference between border element widths and standard element single-width
set bbarwidth [expr {$content_or_title_width + 2 - $blc_width - $brc_width - 2 + $vll_width + $vlr_width}]
} else {
set content width [expr $opt_width - $vll_width - $vlr_width] ;#content may be truncated
set frame_inner_ width [expr $opt_width - $vll_width - $vlr_width] ;#content may be truncated
set tbarwidth [expr {$opt_width - $tlc_width - $trc_width}]
set bbarwidth [expr {$opt_width - $blc_width - $brc_width}]
}
#set column [string repeat " " $content width]
set underlayline [string repeat " " $content width]
#set column [string repeat " " $frame_inner_ width]
set underlayline [string repeat " " $frame_inner_ width]
set underlay [::join [lrepeat $linecount $underlayline] \n]
#cache?
@ -4797,14 +4963,14 @@ namespace eval textblock {
}
}
altg {
set tbar [string repeat $hlt $content width]
set tbar [string repeat $hlt $frame_inner_ width]
set tbar [cd::groptim $tbar]
set bbar [string repeat $hlb $content width]
set bbar [string repeat $hlb $frame_inner_ width]
set bbar [cd::groptim $bbar]
}
default {
set tbar [string repeat $hlt $content width]
set bbar [string repeat $hlb $content width]
set tbar [string repeat $hlt $frame_inner_ width]
set bbar [string repeat $hlb $frame_inner_ width]
}
}
@ -4932,6 +5098,7 @@ namespace eval textblock {
}
set fs ""
set fscached ""
set cache_patternwidth 0
#todo - output nothing except maybe newlines depending on if opt_height 0 and/or opt_width 0?
if {$topborder} {
if {$leftborder && $rightborder} {
@ -4955,34 +5122,40 @@ namespace eval textblock {
append fs \n
append fscached \n
}
#set inner [overtype::$opt_align -ellipsis $opt_ellipsis $opt_ansibase$underlay$rstbase $opt_ansibase$contents$rstbase]
set inner [overtype::$opt_align -ellipsis $opt_ellipsis $opt_ansibase$underlay$rstbase $contents]
switch -- $opt_textalign {
right {set pad "left"}
left {set pad "right"}
default {set pad $opt_textalign}
}
#set textaligned_contents [textblock::pad $contents -width $actual_contentwidth -which $pad -within_ansi 1]
#set inner [overtype::block -blockalign $opt_blockalign -ellipsis $opt_ellipsis $opt_ansibase$underlay$rstbase $opt_ansibase$textaligned_contents]
#set cache_inner [overtype::$opt_align -ellipsis $opt_ellipsis $opt_ansibase$cache_underlay$rstbase $contents]
#review
set cache_inner $opt_ansibase$cache_underlay$rstbase
set cache_contentline [string repeat $FSUB $actual_contentwidth]
set cache_patternwidth $actual_contentwidth
set cache_contentpattern [::join [lrepeat $linecount $cache_contentline] \n]
set cache_inner [overtype::block -blockalign $opt_blockalign -ellipsis $opt_ellipsis $opt_ansibase$underlay$rstbase $opt_ansibase$cache_contentpattern]
#after overtype::block - our actual patternwidth may be less
set cache_patternwidth [string length [lindex [regexp -inline "\[^$FSUB]*(\[$FSUB]*).*" $cache_inner] 1]]
if {$leftborder && $rightborder} {
set bodyparts [list $lhs $opt_ansibase$inner$rstbase $rhs]
set cache_bodyparts [list $lhs $opt_ansibase$ cache_inner$rstbase $rhs]
# set bodyparts [list $lhs $inner $rhs]
set cache_bodyparts [list $lhs $cache_inner $rhs]
} else {
if {$leftborder} {
set bodyparts [list $lhs $opt_ansibase$ inner$rstbase ]
set cache_bodyparts [list $lhs $opt_ansibase$ cache_inner$rstbase ]
# set bodyparts [list $lhs $inner]
set cache_bodyparts [list $lhs $cache_inner]
} elseif {$rightborder} {
set bodyparts [list $opt_ansibase$ inner$rstbase $rhs]
set cache_bodyparts [list $opt_ansibase$ cache_inner$rstbase $rhs]
# set bodyparts [list $inner $rhs]
set cache_bodyparts [list $cache_inner $rhs]
} else {
set bodyparts [list $opt_ansibase$ inner$rstbase ]
set cache_bodyparts [list $opt_ansibase$ cache_inner$rstbase ]
# set bodyparts [list $inner]
set cache_bodyparts [list $cache_inner]
}
}
set body [textblock::join -- {*}$bodyparts]
if {$buildcache} {
#set body [textblock::join -- {*}$bodyparts]
set cache_body [textblock::join -- {*}$cache_bodyparts]
append fscached $cache_body
}
append fs $body
#append fs $body
}
if {$opt_height eq "" || $opt_height > 1} {
@ -4992,31 +5165,91 @@ namespace eval textblock {
}
if {$bottomborder} {
if {($topborder & $fs ne "xx" ) || ($has_contents || $opt_height > 2)} {
append fs \n
# append fs \n
append fscached \n
}
if {$leftborder && $rightborder} {
append fs $blc$bottombar$brc
# append fs $blc$bottombar$brc
append fscached $blc$bottombar$brc
} else {
if {$leftborder} {
append fs $blc$bottombar
# append fs $blc$bottombar
append fscached $blc$bottombar
} elseif {$rightborder} {
append fs $bottombar$brc
# append fs $bottombar$brc
append fscached $bottombar$brc
} else {
append fs $bottombar
# append fs $bottombar
append fscached $bottombar
}
}
}
}
set template $fscached
;#end !$is_cached
}
#use the same mechanism to build the final frame - whether from cache or template
if {$actual_contentwidth == 0} {
set fs [string map [list $FSUB " "] $template]
} else {
set resultlines [list]
set overwritable [string repeat $FSUB $cache_patternwidth]
set contentindex 0
switch -- $opt_textalign {
left {set pad right}
right {set pad left}
default {set pad $opt_textalign}
}
#review
if {[string is integer -strict $opt_height] && $actual_contentheight < ($opt_height -2)} {
set diff [expr {($opt_height -2) - $actual_contentheight}]
append contents [::join [lrepeat $diff \n] ""]
}
set paddedcontents [textblock::pad $contents -which $pad -within_ansi 1] ;#autowidth to width of content (should match cache_patternwidth)
set paddedwidth [textblock::widthtopline $paddedcontents]
#review - horizontal truncation
if {$paddedwidth > $cache_patternwidth} {
set paddedcontents [overtype::renderspace -width $cache_patternwidth "" $paddedcontents]
}
set contentblock [textblock::join $paddedcontents] ;#make sure each line has ansi replays
set tlines [split $template \n]
#we will need to strip off the leading reset on each line when stitching together with template lines so that ansibase can come into play too.
#after textblock::join the reset will be a separate code ie should be exactly ESC[0m
set R [a]
set rlen [string length $R]
set clines [split $contentblock \n]
foreach tline $tlines {
if {[string first $FSUB $tline] >= 0} {
set content_line [lindex $clines $contentindex]
if {[string first $R $content_line] == 0} {
set content_line [string range $content_line $rlen end]
}
#make sure to replay opt_ansibase to the right of the replacement
lappend resultlines [string map [list $overwritable $content_line$opt_ansibase] $tline]
incr contentindex
} else {
lappend resultlines $tline
}
}
set fs [::join $resultlines \n]
}
if {$is_cached} {
return $fs
} else {
if {$buildcache} {
dict set frame_cache $cache_key [list frame $fscached used 0]
dict set frame_cache $cache_key [list frame $template used 0 patternwidth $cache_patternwidth ]
}
return $fs
}
}
proc gcross {{size 1} args} {
if {$size == 0} {
