From 7484206820012c9ef3c48a426ef378ff86febdf1 Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Tue, 28 May 2024 02:15:48 +1000 Subject: [PATCH] more textblock::table layout fixes --- src/modules/textblock-999999.0a1.0.tm | 179 +++++++++++++++++++------- 1 file changed, 133 insertions(+), 46 deletions(-) diff --git a/src/modules/textblock-999999.0a1.0.tm b/src/modules/textblock-999999.0a1.0.tm index 58906b1b..b3b73cfa 100644 --- a/src/modules/textblock-999999.0a1.0.tm +++ b/src/modules/textblock-999999.0a1.0.tm @@ -67,6 +67,8 @@ namespace eval textblock { -show_vseps ""\ -show_header ""\ -show_footer ""\ + -minwidth ""\ + -maxwidth ""\ ] #for 'L' shaped table building pattern (tables bigger than 4x4 will be mostly 'L' patterns) #ie only vll,blc,hlb used for cells except top row and right column @@ -519,20 +521,32 @@ namespace eval textblock { error "textblock::table::configure -ansireset is read-only. It is present only to prevent unwanted colourised output in configure commands" } } - -show_edge - -show_hseps { + -show_hseps { if {![string is boolean $v]} { error "textblock::table::configure invalid $k '$v'. Must be a boolean or empty string" } lappend checked_opts $k $v #these don't affect column width calculations } + -show_edge { + if {![string is boolean $v]} { + error "textblock::table::configure invalid $k '$v'. Must be a boolean or empty string" + } + lappend checked_opts $k $v + #these don't affect column width calculations - except if table -minwidth/-maxwidth come into play + set o_calculated_column_widths [list] ;#invalidate cached column widths - a recalc will be forced when needed + } -show_vseps { #we allow empty string - so don't use -strict boolean check if {![string is boolean $v]} { error "textblock::table::configure invalid $k '$v'. Must be a boolean or empty string" } #affects width calculations - set o_calculated_column_widths [list] ;#invalidate cached column widths - a recalc will be forced when needed + set o_calculated_column_widths [list] + lappend checked_opts $k $v + } + -minwidth - -maxwidth { + set o_calculated_column_widths [list] lappend checked_opts $k $v } default { @@ -1097,6 +1111,10 @@ namespace eval textblock { if {[llength $v] > [dict size $o_columndefs]} { error "textblock::table::configure_header -colspans length ([llength $v]) is longer than number of columns ([dict size $o_columndefs])" } + if {[llength $v] < [dict size $o_columndefs]} { + puts stderr "textblock::table::configure_header warning - only [llength $v] spans specified for [dict size $o_columndefs] columns." + puts stderr "It is recommended to set all spans explicitly. (auto-calc not implemented)" + } if {[llength $v]} { set firstspan [lindex $v 0] set first_is_ok 0 @@ -1204,9 +1222,8 @@ namespace eval textblock { if {$hidx > [llength $colspans]-1} { set colspans_by_header [my header_colspans] #puts ">>>>>?$colspans_by_header" - #sanity check - we are allowed to lset only one beyond the current length to append + #we are allowed to lset only one beyond the current length to append #but there may be even less or no entries present in a column - #error "configure_header $hidx Unable to update -colspans for column $c with value $span from the set '$v' - review" # - the ability to underspecify and calculate the missing values makes setting the values complicated. #use the header_colspans calculation to update only those entries necessary set spanlist [list] @@ -1757,9 +1774,21 @@ namespace eval textblock { #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 {$hcolwidth+2}] -type [dict get $ftypes header]\ + #set header_cell_startspan [textblock::frame -ellipsis 0 -usecache 1 -width [expr {$hcolwidth+2}] -type [dict get $ftypes header]\ + # -ansibase $ansibase_header -ansiborder $ansiborder_final\ + # -boxlimits $hlims -boxmap $startmap -joins $header_joins $hval\ + # ] + + if {$this_span eq "1"} { + #write the actual value now + set cellcontents $hval + } else { + #just write an empty vertical placeholder. The spanned value will be overtyped below + set cellcontents [join [lrepeat [llength [split $hval \n]] ""] \n] + } + set header_cell_startspan [textblock::frame -blockalign $col_blockalign -ellipsis 0 -usecache 1 -width [expr {$hcolwidth+2}] -type [dict get $ftypes header]\ -ansibase $ansibase_header -ansiborder $ansiborder_final\ - -boxlimits $hlims -boxmap $startmap -joins $header_joins $hval\ + -boxlimits $hlims -boxmap $startmap -joins $header_joins $cellcontents\ ] if {$this_span ne "1"} { @@ -1869,7 +1898,9 @@ namespace eval textblock { #puts "==>hval:'$hval'[a]" #puts "==>hval:'[ansistring VIEW $hval]'" #set spanned_frame [overtype::renderspace -experimental test_mode -transparent 1 $spanned_frame $hblock] - set spanned_frame [overtype::block -blockalign left -overflow 1 -transparent 1 $spanned_frame $hblock] + + #spanned values default left - todo make configurable + set spanned_frame [overtype::block -blockalign $col_blockalign -overflow 1 -transparent 1 $spanned_frame $hblock] } else { #this_span == 1 @@ -2187,45 +2218,25 @@ namespace eval textblock { set output [dict create] dict set output headers [list] + + set showing_vseps [my Showing_vseps] for {set hrow 0} {$hrow < $num_header_rows} {incr hrow} { set hdr [lindex $headerlist $hrow] set header_maxdataheight [my header_height $hrow] ;#from cached headerstates set headerrow_colspans [dict get $all_colspans $hrow] set this_span [lindex $headerrow_colspans $cidx] - set this_hdrwidth [lindex $configured_widths $cidx] - set spanned_hdrwidth 0 - - if {$this_span eq "0"} { - set this_hdrwidth 0 - set spanned_hdrwidth 0 - } elseif {$this_span eq "all"} { - #all means up to next non-zero - set s "0" - set idx [expr {$cidx +1}] - while {$s eq "0" && $idx < [llength $headerrow_colspans]} { - incr spanned_hdrwidth [lindex $configured_widths $idx] - incr idx - set s [lindex $headerrow_colspans $idx] - } - } else { - set spanned_cols [list] - for {set sc [expr {$cidx+1}]} {$sc < ($cidx + $this_span)} {incr sc} { - lappend spanned_cols $sc - } - foreach c $spanned_cols { - incr spanned_hdrwidth [lindex $configured_widths $c] - } - } - set hdrwidth [expr {max($this_hdrwidth,$spanned_hdrwidth)}] - set hdr_line_blank [string repeat " " $hdrwidth] - set headercell_underlay [lrepeat $header_maxdataheight $hdr_line_blank] - set headercell_underlay $ansibase_header[join $headercell_underlay \n] - if {$hdr ne ""} { - dict lappend output headers [overtype::renderspace -experimental test_mode $headercell_underlay $ansibase_header$hdr] - } else { - dict lappend output headers $headercell_underlay - } + #set this_hdrwidth [lindex $configured_widths $cidx] + set this_hdrwidth [my column_datawidth $cidx -headers 1 -colspan $this_span] ;#widest of headers in this col with same span - allows textalign to work with blockalign + + set hcell_line_blank [string repeat " " $this_hdrwidth] + set hcell_lines [lrepeat $header_maxdataheight $hcell_line_blank] + set hval_lines [split $hdr \n] + set hval_lines [concat $hval_lines $hcell_lines] + set hval_lines [lrange $hval_lines 0 $header_maxdataheight-1] ;#vertical align top + set hval_block [::join $hval_lines \n] + set hcell [textblock::pad $hval_block -width $this_hdrwidth -padchar " " -within_ansi 1 -which $pad] + dict lappend output headers $hcell } @@ -2274,13 +2285,13 @@ namespace eval textblock { } set cell_lines [lrepeat $rowh $cell_line_blank] - set cell_blank [join $cell_lines \n] + #set cell_blank [join $cell_lines \n] set cval_lines [split $cval \n] set cval_lines [concat $cval_lines $cell_lines] set cval_lines [lrange $cval_lines 0 $rowh-1] - set cval_block [join $cval_lines \n] + set cval_block [::join $cval_lines \n] set cell [textblock::pad $cval_block -width $datawidth -padchar " " -within_ansi 1 -which $pad] @@ -2445,6 +2456,8 @@ namespace eval textblock { } else { #set widest [my column_datawidth $cidx -headers 1 -data 1 -footers 1] set hwidest [dict get $o_columnstates $cidx maxwidthheaderseen] + #set hwidest [my column_datawidth $cidx -headers 1 -colspan 1 -data 0 -footers 1] + #set hwidest_singlespan ?? set bwidest [dict get $o_columnstates $cidx maxwidthbodyseen] set widest [expr {max($hwidest,$bwidest)}] #todo - predetermine if any items in column contain newlines and are truncated vertically due to o_rowdefs configuration. @@ -2486,8 +2499,22 @@ namespace eval textblock { } return $o_calculated_column_widths } + + #width of a table includes borders and seps + #whereas width of a column refers to the borderless width (inner width) method width {} { #calculate width based on assumption frame verticals are 1-wide - review - what about custom unicode double-wide frame? + set colwidths [my column_widths] + set contentwidth [tcl::mathop::+ {*}$colwidths] + set twidth $contentwidth + if {[my Showing_vseps]} { + incr twidth [llength $colwidths] + incr twidth -1 + } + if {[dict get $o_opts_table -show_edge]} { + incr twidth 2 + } + return $twidth } #column *body* content width @@ -2627,18 +2654,22 @@ namespace eval textblock { set defaults [dict create\ -headers 0\ -footers 0\ + -colspan *\ -data 1\ -cached 1\ ] + #-colspan is relevant to header/footer data only dict for {k v} $args { switch -- $k { - -headers - -footers - -data - -cached {} + -headers - -footers - -colspan - -data - -cached {} default { error "column_datawidth unrecognised flag '$k'. Known flags: [dict keys $defaults]" } } } set opts [dict merge $defaults $args] + set opt_colspan [dict get $opts -colspan] + set cidx [lindex [dict keys $o_columndefs] $index_expression] if {$cidx eq ""} { @@ -2650,7 +2681,27 @@ namespace eval textblock { set bwidest 0 set fwidest 0 if {[dict get $opts -headers]} { - set hwidest [dict get $o_columnstates $cidx maxwidthheaderseen] + if {$opt_colspan eq "*"} { + set hwidest [dict get $o_columnstates $cidx maxwidthheaderseen] + } else { + set colheaders [dict get $o_columndefs $cidx -headers] + set all_colspans_by_header [my header_colspans] + set hlist [list] + dict for {hrow cspans} $all_colspans_by_header { + set s [lindex $cspans $cidx] + #todo - map 'all' entries to a number? + #we should build a version of header_colspans that does this + if {$s eq $opt_colspan} { + lappend hlist [lindex $colheaders $hrow] + } + } + #set widest1 [tcl::mathfunc::max {*}[lmap v $cmds {string length $v}]] + if {[llength $hlist]} { + set hwidest [tcl::mathfunc::max {*}[lmap v $hlist {textblock::width $v}]] + } else { + set hwidest 0 + } + } } if {[dict get $opts -data]} { set bwidest [dict get $o_columnstates $cidx maxwidthbodyseen] @@ -2834,8 +2885,42 @@ namespace eval textblock { } } + set column_widths [dict values $colwidths] + #todo - -maxwidth etc + set table_minwidth [dict get $o_opts_table -minwidth] ;#min width including frame elements + if {[string is integer -strict $table_minwidth]} { + set contentwidth [tcl::mathop::+ {*}$column_widths] + set twidth $contentwidth + if {[my Showing_vseps]} { + incr twidth [llength $column_widths] + incr twidth -1 + } + if {[dict get $o_opts_table -show_edge]} { + incr twidth 2 + } + # + set shortfall [expr {$table_minwidth - $twidth}] + if {$shortfall > 0} { + set space_to_alloc $shortfall + while {$space_to_alloc > 0} { + set ordered_colspace_added [lsort -stride 2 -index 1 -integer $colspace_added] + set ordered_colids [dict keys $ordered_colspace_added] + + foreach col $ordered_colids { + dict incr colwidths $col + dict incr colspace_added $col + incr space_to_alloc -1 + if {$space_to_alloc == 0} { + break + } + } + } + set column_widths [dict values $colwidths] + } + + } - return [list ordered_spans $ordered_spans colwidths [dict values $colwidths]] + return [list ordered_spans $ordered_spans colwidths $column_widths adjustments $colspace_added] } #spangroups keyed by column @@ -3249,7 +3334,9 @@ namespace eval textblock { foreach e $elements { if {[dict exists $ecat $e]} { set ansi [dict get $ecat $e ansi] - lappend elements1 [textblock::pad $ansi$e -width 2 -which right] + #lappend elements1 [textblock::pad $ansi$e -width 2 -which right] + #no need to pad here - table column_configure -textalign default of left will do the work of padding right anyway + lappend elements1 $ansi$e } else { lappend elements1 $e }