From d9d771100b9b46bc58c37edd1db6ce99e8c9dd43 Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Wed, 15 May 2024 03:38:10 +1000 Subject: [PATCH] textblock table header colspans --- src/bootsupport/modules/punk/lib-0.1.1.tm | 11 + src/bootsupport/modules/textblock-0.1.1.tm | 1914 +++++++++++++++----- src/modules/punk-0.1.tm | 13 +- src/modules/punk/lib-999999.0a1.0.tm | 11 + src/modules/textblock-999999.0a1.0.tm | 1914 +++++++++++++++----- 5 files changed, 2995 insertions(+), 868 deletions(-) diff --git a/src/bootsupport/modules/punk/lib-0.1.1.tm b/src/bootsupport/modules/punk/lib-0.1.1.tm index 9e9f0b3..a29f305 100644 --- a/src/bootsupport/modules/punk/lib-0.1.1.tm +++ b/src/bootsupport/modules/punk/lib-0.1.1.tm @@ -197,6 +197,17 @@ namespace eval punk::lib { #[list_begin definitions] + proc dict_getdef {dictValue args} { + if {[llength $args] < 1} { + error {wrong # args: should be "dict_getdef dictValue ?key ...? key default"} + } + set keys [lrange $args -1 end-1] + if {[dict exists $dictValue {*}$keys]} { + return [dict get $dictValue {*}$keys] + } else { + return [lindex $args end] + } + } #proc sample1 {p1 n args} { # #*** !doctools diff --git a/src/bootsupport/modules/textblock-0.1.1.tm b/src/bootsupport/modules/textblock-0.1.1.tm index 798d2c8..215f3dc 100644 --- a/src/bootsupport/modules/textblock-0.1.1.tm +++ b/src/bootsupport/modules/textblock-0.1.1.tm @@ -90,11 +90,11 @@ namespace eval textblock { middleleft [struct::set intersect $L $lefts]\ middleinner [list]\ middleright [struct::set intersect $U $rights]\ - middlesolo [struct::set intersect $U [concat $lefts $bottoms $rights]]\ - bottomleft [struct::set intersect $L [concat $lefts]]\ - bottominner [list]\ - bottomright [struct::set intersect $U $rights]\ - bottomsolo [struct::set intersect $U [concat $lefts $rights]]\ + middlesolo [struct::set intersect $U [concat $lefts $rights]]\ + bottomleft [struct::set intersect $L [concat $lefts $bottoms]]\ + bottominner [struct::set intersect $L $bottoms]\ + bottomright [struct::set intersect $U [concat $bottoms $rights]]\ + bottomsolo [struct::set intersect $U [concat $lefts $bottoms $rights]]\ onlyleft [struct::set intersect $C [concat $tops $lefts $bottoms]]\ onlyinner [struct::set intersect $C [concat $tops $bottoms]]\ onlyright [struct::set intersect $O [concat $tops $bottoms $rights]]\ @@ -112,7 +112,7 @@ namespace eval textblock { middleleft [struct::set intersect $L $lefts]\ middleinner [list]\ middleright [struct::set intersect $U $rights]\ - middlesolo [struct::set intersect $U [concat $lefts $bottoms $rights]]\ + middlesolo [struct::set intersect $U [concat $lefts $rights]]\ bottomleft [struct::set intersect $L [concat $lefts]]\ bottominner [list]\ bottomright [struct::set intersect $U $rights]\ @@ -219,6 +219,9 @@ namespace eval textblock { variable o_columndefs variable o_columndata + variable o_columnstates + variable o_headerstates + variable o_rowdefs variable o_rowstates @@ -247,6 +250,8 @@ namespace eval textblock { my configure {*}[dict merge $o_opts_table_defaults $args] set o_columndefs [dict create] set o_columndata [dict create] ;#we store data by column even though it is often added row by row + set o_columnstates [dict create] ;#store the maxwidthbodyseen as we add rows and maxwidthheaderseen as we add headers - it is needed often and expensive to calculate repeatedly + set o_headerstates [dict create] 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 @@ -534,6 +539,8 @@ namespace eval textblock { } } } + #ansireset exception + dict set o_opts_table -ansireset [dict get $o_opts_table_effective -ansireset] return $o_opts_table } @@ -544,7 +551,7 @@ namespace eval textblock { set table_colcount [my column_count] if {$table_colcount == 0} { for {set c 0} {$c < $matrix_colcount} {incr c} { - my add_column -header "" + my add_column -headers "" } } set table_colcount [my column_count] @@ -576,8 +583,10 @@ namespace eval textblock { #*** !doctools #[call class::table [method add_column] [arg args]] set defaults [dict create\ - -header ""\ - -footer ""\ + -headers [list]\ + -header_colspans [list]\ + -footers [list]\ + -defaultvalue ""\ -ansibase ""\ -ansireset "\uFFEF"\ -minwidth ""\ @@ -598,14 +607,25 @@ namespace eval textblock { dict set o_columndata $colcount [list] dict set o_columndefs $colcount $defaults ;#ensure record exists + dict set o_columnstates $colcount [dict create maxwidthbodyseen 0 maxwidthheaderseen 0] if {[catch { my configure_column $colcount {*}$opts } errMsg]} { - #configure failed - ensure o_columndata and o_columdefs entries are removed + #configure failed - ensure o_columndata and o_columndefs entries are removed dict unset o_columndata $colcount dict unset o_columndefs $colcount + dict unset o_columnstates $colcount error "add_column failed to configure with supplied options $opts. Err:\n$errMsg" - } + } + set numrows [my row_count] + if {$numrows > 0} { + #fill column with default values + #puts ">>> adding default values for column $colcount" + set dval [dict get $opts -defaultvalue] + set width [textblock::width $dval] + dict set o_columndata $colcount [lrepeat $numrows $dval] + dict set o_columnstates $colcount [maxwidthbodyseen $width] + } return $colcount } method column_count {} { @@ -628,13 +648,99 @@ namespace eval textblock { } } set checked_opts [list] + set hstates $o_headerstates ;#operate on a copy + set colstate [dict get $o_columnstates $cidx] dict for {k v} $args { switch -- $k { - -header { + -headers { #todo - multiline header - if {[string is integer -strict $v]} { - #review - this is inconvenient - error "textblock::table::configure_column invalid value '$v' -header cannot be an integer" + set i 0 + foreach hdr $v { + set currentmax [my header_height_calc $i $cidx] ;#exclude current column - ie look at heights for this header in all other columns + #set this_header_height [textblock::height $hdr] + lassign [textblock::size $hdr] _w this_header_width _h this_header_height + + if {$this_header_height >= $currentmax} { + dict set hstates $i -maxheight $this_header_height + } else { + dict set hstates $i -maxheight $currentmax + } + if {$this_header_width > [dict get $colstate maxwidthheaderseen]} { + dict set colstate maxwidthheaderseen $this_header_width + } + incr i + } + lappend checked_opts $k $v + } + -header_colspans { + #check columns to left to make sure each new colspan for this column makes sense in the overall context + #user may have to adjust colspans in order left to right to avoid these check errors + #note that 'all' represents span all up to the next non-zero defined colspan. + set cspans [my header_colspans] + set h 0 + if {[llength $v] > [dict size $cspans]} { + error "configure_column $cidx -header_colspans. Only [dict size $cspans] headers exist. Too many values supplied" + } + foreach s $v { + if {$cidx == 0} { + if {[string is integer -strict $s]} { + if {$s < 1} { + error "configure_column $cidx -header_colspans bad first value '$s' for header '$h' . First column cannot have span less than 1. use 'all' or a positive integer" + } + } else { + if {$s ne "all" && $s ne ""} { + error "configure_column $cidx -header_colspans unrecognised value '$s' for header '$h' - must be a positive integer or the keyword 'all'" + } + } + } else { + #if {![string is integer -strict $s]} { + # if {$s ne "all" && $s ne ""} { + # error "configure_column $cidx -header_colspans unrecognised value '$s' for header '$h' - must be a positive integer or the keyword 'all'" + # } + #} else { + set header_spans [dict get $cspans $h] + set remaining [lindex $header_spans 0] + if {$remaining ne "all"} { + incr remaining -1 + } + #look at spans defined for previous cols + #we are presuming previous column entries are valid - and only validating if our new entry is ok under that assumption + for {set c 0} {$c < $cidx} {incr c} { + set span [lindex $header_spans $c] + if {$span eq "all"} { + set remaining "all" + } else { + if {$remaining eq "all"} { + if {$span ne "0"} { + #a previous column has ended the 'all' span + set remaining [expr {$span -1}] + } + } else { + if {$span eq "0"} { + incr remaining -1 + } else { + set remaining [expr {$span -1}] + } + #allow to go negative + } + } + } + if {$remaining eq "all"} { + #any int >0 ok - what about 'all' immediately following all? + } else { + if {$remaining > 0} { + if {$s ne "0" && $s ne ""} { + error "configure_column $cidx -header_colspans bad span $s for header '$h'. Remaining span is '$remaining' - so a zero colspan is required" + } + } else { + if {$s == 0} { + error "configure_column $cidx -header_colspans bad span $s for header '$h'. No span in place - need >=1 or 'all'" + } + } + } + #} + } + incr h } lappend checked_opts $k $v } @@ -665,18 +771,131 @@ namespace eval textblock { } } } + #args checked - ok to update headerstates and columndefs and columnstates + set o_headerstates $hstates + dict set o_columnstates $cidx $colstate set current_opts [dict get $o_columndefs $cidx] set opts [dict merge $current_opts $checked_opts] dict set o_columndefs $cidx $opts + if {"-headers" in [dict keys $args]} { + #if the headerlist length for this column has shrunk,and it was the longest - we may now have excess entries in o_headerstates + set zero_heights [list] + dict for {hidx _v} $o_headerstates { + #pass empty string for exclude_column so we don't exclude our own column + if {[my header_height_calc $hidx ""] == 0} { + lappend zero_heights $hidx + } + } + foreach zidx $zero_heights { + dict unset o_headerstates $zidx + } + } + if {"-headers" in [dict keys $args] || "-header_colspans" in [dict keys $args]} { + #check and adjust header_colspans for all columns + + } + + return [dict get $o_columndefs $cidx] + } + } + + method header_count {} { + return [dict size $o_headerstates] + } + method header_count_calc {} { + set max_headers 0 + dict for {k cdef} $o_columndefs { + set num_headers [llength [dict get $cdef -headers]] + set max_headers [expr {max($max_headers,$num_headers)}] + } + return $max_headers + } + method header_height {header_index} { + set idx [lindex [dict keys $o_headerstates $header_index]] + return [dict get $o_headerstates $idx -maxheight] + } + + #review - use maxwidth (considering colspans) of each column to determine height after wrapping + # -need to consider whether vertical expansion allowed / maxheight? + method header_height_calc {header_index {exclude_column ""}} { + set dataheight 0 + if {$exclude_column eq ""} { + set exclude_colidx "" + } else { + set exclude_colidx [lindex [dict keys $o_columndefs] $exclude_column] + } + dict for {cidx cdef} $o_columndefs { + if {$exclude_colidx == $cidx} { + continue + } + set headerlist [dict get $cdef -headers] + if {$header_index < [llength $headerlist]} { + set this_height [textblock::height [lindex $headerlist $header_index]] + set dataheight [expr {max($dataheight,$this_height)}] + } + } + return $dataheight + } + + #return a dict keyed on header index with values representing colspans + #e.g + # 0 {all 0 0 0} 1 {1 1 1 1} 2 {2 0 1 1} 3 {3 0 0 1} + # + method header_colspans {} { + set num_headers [my header_count_calc] + set colspans_by_header [dict create] + dict for {cidx cdef} $o_columndefs { + set headerlist [dict get $cdef -headers] + set colspans_for_column [dict get $cdef -header_colspans] + for {set h 0} {$h < $num_headers} {incr h} { + set headerspans [punk::lib::dict_getdef $colspans_by_header $h [list]] + set defined_span [lindex $colspans_for_column $h] + set i 0 + set spanremaining [lindex $headerspans 0] + if {$spanremaining ne "all"} { + if {$spanremaining eq ""} { + set spanremaining 1 + } + incr spanremaining -1 + } + foreach s $headerspans { + if {$s eq "all"} { + set spanremaining "all" + } elseif {$s == 0} { + if {$spanremaining ne "all"} { + incr spanremaining -1 + } + } else { + set spanremaining [expr {$s - 1}] + } + incr i + } + if {$defined_span eq ""} { + if {$spanremaining eq "0"} { + lappend headerspans 1 + } else { + #"all" or an integer + lappend headerspans 0 + } + } else { + lappend headerspans $defined_span + } + dict set colspans_by_header $h $headerspans + } } + return $colspans_by_header } method add_row {valuelist args} { #*** !doctools #[call class::table [method add_row] [arg args]] - if {[dict size $o_columndefs] > 0 && ([llength $valuelist] != [dict size $o_columndefs])} { - error "invalid number of values in row - Must match existing column count: [dict size $o_columndefs]" + if {[dict size $o_columndefs] > 0 && ([llength $valuelist] && [llength $valuelist] != [dict size $o_columndefs])} { + error "add_row - invalid number of values in row - Must match existing column count: [dict size $o_columndefs]" + } + if {[dict size $o_columndefs] == 0 && ![llength $valuelist]} { + error "add_row - no values supplied, and no columns defined, so cannot use default column values" } + set defaults [dict create\ -minheight 1\ -maxheight ""\ @@ -698,6 +917,22 @@ namespace eval textblock { } set opts [dict merge $defaults $args] + set auto_columns 0 + if {[dict size $o_columndefs] == 0} { + set auto_columns 1 + #no columns defined - auto define with defaults for each column in first supplied row + #auto define columns only valid if no existing columns + #the autocolumns must be added before configure_row - but if configure_row fails - we need to remove them! + foreach el $valuelist { + my add_column + } + } else { + if {![llength $valuelist]} { + dict for {k coldef} $o_columndefs { + lappend valuelist [dict get $coldef -defaultvalue] + } + } + } set rowcount [dict size $o_rowdefs] dict set o_rowdefs $rowcount $defaults ;# ensure record exists before configure @@ -706,15 +941,14 @@ namespace eval textblock { } errMsg]} { #undo anything we saved before configure_row dict unset o_rowdefs $rowcount + #remove auto_columns + if {$auto_columns} { + set o_columndata [dict create] + set o_columndefs [dict create] + } error "add_row failed to configure with supplied options $opts. Err:\n$errMsg" } - if {[dict size $o_columndefs] == 0} { - #no columns defined - auto define with defaults for each column in first supplied row - foreach el $valuelist { - my add_column - } - } set c 0 @@ -725,6 +959,10 @@ namespace eval textblock { if {$valheight > $max_height_seen} { set max_height_seen $valheight } + set width [textblock::width $v] + if {$width > [dict get $o_columnstates $c maxwidthbodyseen]} { + dict set o_columnstates $c maxwidthbodyseen $width + } incr c } set opt_maxh [dict get $o_rowdefs $rowcount -maxheight] @@ -733,6 +971,8 @@ namespace eval textblock { } else { dict set o_rowstates $rowcount -maxheight $max_height_seen } + + return $rowcount } method configure_row {index_expression args} { set ridx [lindex [dict keys $o_rowdefs] $index_expression] @@ -810,12 +1050,14 @@ namespace eval textblock { #The data values are stored by column regardless of whether added row by row dict for {cidx records} $o_columndata { dict set o_columndata $cidx [list] + dict set o_columnstates $cidx [dict create maxbodywidthseen 0 maxheaderwidthseen 0] } } method clear {} { my row_clear - set o_columndefs [dict create] - set o_columndata [dict create] + set o_columndefs [dict create] + set o_columndata [dict create] + set o_columnstates [dict create] } method Get_columns_by_name {namematch_list} { @@ -832,35 +1074,86 @@ namespace eval textblock { } } } + method Get_boxlimits_and_joins {position fname_body} { + #fname_body will be "custom" or one of the predefined types light,heavy etc + switch -- $position { + left { + #set header_boxlimits {hlb hlt tlc blc vll} + set header_body_joins [list down-$fname_body] + set boxlimits_position {hlb blc vll} + set boxlimits_toprow [concat $boxlimits_position {hlt tlc}] + set joins {down} + } + inner { + #set header_boxlimits {hlb hlt tlc blc vll} + set header_body_joins [list left down-$fname_body] + set boxlimits_position {hlb blc vll} + set boxlimits_toprow [concat $boxlimits_position {hlt tlc}] + set joins {down left} + } + right { + #set header_boxlimits {hlb hlt tlc blc vll vlr trc brc} + set header_body_joins [list left down-$fname_body] + set boxlimits_position {hlb blc vll vlr brc} + set boxlimits_toprow [concat $boxlimits_position {hlt tlc trc}] + set joins {down left} + } + solo { + #set header_boxlimits {hlb hlt tlc blc vll vlr trc brc} + set header_body_joins [list down-$fname_body] + set boxlimits_position {hlb blc vll vlr brc} + set boxlimits_toprow [concat $boxlimits_position {hlt tlc trc}] + set joins {down} + } + } + return [dict create boxlimits $boxlimits_position boxlimits_top $boxlimits_toprow joins $joins bodyjoins $header_body_joins ] + } method get_column_by_index {index_expression args} { #index_expression may be something like end-1 or 2+2 - we can't directly use it as a lookup for dicts. set defaults [dict create\ - -positiontype "inner"\ + -position "inner"\ + -return "string"\ ] - set valid_positiontypes [list left inner right solo] dict for {k v} $args { - if {$k ni [dict keys $defaults]} { - error "[namespace::current]::table::get_column_by_index error invalid option '$k'. Known options [dict keys $defaults]" + switch -- $k { + -position - -return {} + default { + error "[namespace current]::table::get_column_by_index error invalid option '$k'. Known options [dict keys $defaults]" + } } } - set opts [dict merge $defaults $args] - set opt_posn [dict get $opts -positiontype] + set opts [dict merge $defaults $args] + set opt_posn [dict get $opts -position] + set opt_return [dict get $opts -return] - if {$opt_posn ni $valid_positiontypes} { - error "[namespace::current]::table::get_column_by_index error invalid value '$opt_posn' for -positiontype. Valid values $valid_positiontypes" + set valid_positions [list left inner right solo] + switch -- $opt_posn { + left - inner - right - solo {} + default { + error "[namespace current]::table::get_column_by_index error invalid value '$opt_posn' for -position. Valid values: $valid_positions" + } + } + switch -- $opt_return { + string - dict {} + default { + error "[namespace current]::table::get_column_by_index error invalid value '$opt_return' for -return. Valid values: string dict" + } } set columninfo [my get_column_cells_by_index $index_expression] - set header [dict get $columninfo header] + set header_list [dict get $columninfo headers] + #puts "===== header_list: $header_list" set cells [dict get $columninfo cells] - set columninfo [my get_column_cells_by_index $index_expression] set topt_show_header [dict get $o_opts_table -show_header] if {$topt_show_header eq ""} { set allheaders "" set all_cols [dict keys $o_columndefs] foreach c $all_cols { - append allheaders [dict get $o_columndefs $c -header] + set headerset [dict get $o_columndefs $c -headers] + foreach hdr $headerset { + append allheaders $hdr + } } if {$allheaders eq ""} { set do_show_header 0 @@ -873,79 +1166,85 @@ namespace eval textblock { set topt_show_footer [dict get $o_opts_table -show_footer] - set ftypes [my Get_frametypes] set output "" + set part_header "" + set part_body "" + set part_footer "" + set boxlimits "" set joins "" set header_boxlimits [list] - set header_joins [list] + set header_body_joins [list] + + + set ftypes [my Get_frametypes] set ftype_body [dict get $ftypes body] if {[llength $ftype_body] >= 2} { - set ftype_body "custom" + set fname_body "custom" + } else { + set fname_body $ftype_body + } + set ftype_header [dict get $ftypes header] + if {[llength $ftype_header] >= 2} { + set fname_header "custom" + } else { + set fname_header $ftype_header } + switch -- $opt_posn { left { - set header_boxlimits {hlb hlt tlc blc vll} - set header_joins [list down-$ftype_body] + #set header_boxlimits {hlb hlt tlc blc vll} + set header_body_joins [list down-$fname_body] set boxlimits_position {hlb blc vll} - set boxlimits_headerless [concat $boxlimits_position {hlt tlc}] + set boxlimits_toprow [concat $boxlimits_position {hlt tlc}] set joins {down} } inner { - set header_boxlimits {hlb hlt tlc blc vll} - set header_joins [list left down-$ftype_body] + #set header_boxlimits {hlb hlt tlc blc vll} + set header_body_joins [list left down-$fname_body] set boxlimits_position {hlb blc vll} - set boxlimits_headerless [concat $boxlimits_position {hlt tlc}] + set boxlimits_toprow [concat $boxlimits_position {hlt tlc}] set joins {down left} } right { - set header_boxlimits {hlb hlt tlc blc vll vlr trc brc} - set header_joins [list left down-$ftype_body] + #set header_boxlimits {hlb hlt tlc blc vll vlr trc brc} + set header_body_joins [list left down-$fname_body] set boxlimits_position {hlb blc vll vlr brc} - set boxlimits_headerless [concat $boxlimits_position {hlt tlc trc}] + set boxlimits_toprow [concat $boxlimits_position {hlt tlc trc}] set joins {down left} } solo { - set header_boxlimits {hlb hlt tlc blc vll vlr trc brc} - set header_joins [list down-$ftype_body] + #set header_boxlimits {hlb hlt tlc blc vll vlr trc brc} + set header_body_joins [list down-$fname_body] set boxlimits_position {hlb blc vll vlr brc} - set boxlimits_headerless [concat $boxlimits_position {hlt tlc trc}] + set boxlimits_toprow [concat $boxlimits_position {hlt tlc trc}] set joins {down} } } + set limj [my Get_boxlimits_and_joins $opt_posn $fname_body] + set header_body_joins [dict get $limj bodyjoins] + set joins [dict get $limj joins] + set boxlimits_position [dict get $limj boxlimits] + set boxlimits_toprow [dict get $limj boxlimits_top] #use struct::set instead of simple for loop - will be faster at least when critcl available set boxlimits [struct::set intersect [dict get $o_opts_table_effective -framelimits_body] $boxlimits_position] - set boxlimits_headerless [struct::set intersect [dict get $o_opts_table_effective -framelimits_body] $boxlimits_headerless] - set header_boxlimits [struct::set intersect [dict get $o_opts_table_effective -framelimits_header] $header_boxlimits] - - #upvar ::textblock::class::opts_table_defaults tdefaults - #set default_bmap [dict get $tdefaults -framemap_body] - #set default_hmap [dict get $tdefaults -framemap_header] - #set fmap $default_bmap - #set hmap $default_hmap - #dict for {k v} $fmap { - # if {[dict exists $o_opts_table -framemap_body $k]} { - # dict set fmap $k [dict merge $v [dict get $o_opts_table -framemap_body $k]] - # } - #} - #dict for {k v} $hmap { - # if {[dict exists $o_opts_table -framemap_header $k]} { - # dict set hmap $k [dict merge $v [dict get $o_opts_table -framemap_header $k]] - # } - #} + set boxlimits_headerless [struct::set intersect [dict get $o_opts_table_effective -framelimits_body] $boxlimits_toprow] + set header_boxlimits [struct::set intersect [dict get $o_opts_table_effective -framelimits_header] $boxlimits_position] + set header_boxlimits_toprow [struct::set intersect [dict get $o_opts_table_effective -framelimits_header] $boxlimits_toprow] + set fmap [dict get $o_opts_table_effective -framemap_body] set hmap [dict get $o_opts_table_effective -framemap_header] - if {![dict get $o_opts_table -show_edge]} { - set body_edgemap [textblock::class::table_edge_map ""] - dict for {k v} $fmap { - dict set fmap $k [dict merge $v [dict get $body_edgemap $k]] - } - set header_edgemap [textblock::class::header_edge_map ""] - dict for {k v} $hmap { - dict set hmap $k [dict merge $v [dict get $header_edgemap $k]] - } - } + #if {![dict get $o_opts_table -show_edge]} { + # set body_edgemap [textblock::class::table_edge_map ""] + # dict for {k v} $fmap { + # #dict set fmap $k [dict merge $v [dict get $body_edgemap $k]] + # } + # set header_edgemap [textblock::class::header_edge_map ""] + # dict for {k v} $hmap { + # #dict set hmap $k [dict merge $v [dict get $header_edgemap $k]] + # } + #} set sep_elements_horizontal $::textblock::class::table_hseps set sep_elements_vertical $::textblock::class::table_vseps @@ -966,7 +1265,8 @@ namespace eval textblock { 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 if {$do_show_header} { #puts "boxlimitsinfo header $opt_posn: -- boxlimits $header_boxlimits -- boxmap $hdrmap" set ansibase_header [dict get $o_opts_table -ansibase_header] @@ -981,30 +1281,239 @@ namespace eval textblock { set RST [a] set colwidth [my column_width $cidx] set hcell_line_blank [string repeat " " $colwidth] - set hval $ansibase_header$header ;#no reset - set rowh 1 ;#todo - set h_lines [lrepeat $rowh $hcell_line_blank] - set hcell_blank [join $h_lines \n] - - set hval_lines [split $hval \n] - set hval_lines [lrange $hval_lines 0 $rowh-1] - set hval_block [join $hval_lines \n] - set headercell [overtype::left -experimental test_mode $ansibase_header$hcell_blank$RST $hval_block] - - set hlims $header_boxlimits - if {!$show_seps_v} { - set hlims [struct::set difference $header_boxlimits $headerseps_v] - } - #todo - multiline header cells + multiple header lines (will be more useful when colspans implemented) - set header_frame [textblock::frame -width [expr {$colwidth+2}] -type [dict get $ftypes header]\ - -ansibase $ansibase_header -ansiborder $ansiborder_final\ - -boxlimits $hlims -boxmap $hdrmap -joins $header_joins $hval\ + + set h 0 + set hmax [expr {[llength $header_list] -1}] + set all_colspans [my header_colspans] + + #default span_extend_map - used as base to customise with specific joins + set fdef_header [textblock::framedef $ftype_header] + set span_extend_map [dict create \ + vll " "\ + tlc [dict get $fdef_header hlt]\ + blc [dict get $fdef_header hlb]\ ] - - #puts ">> '[ansistring VIEW $hval]' -> $header_frame" + set framedef_leftbox [textblock::framedef $ftype_header left] + + set column_body_width_cache [dict create] + + + foreach header $header_list { + set headerspans [dict get $all_colspans $h] + set this_span [lindex $headerspans $cidx] + set hval $ansibase_header$header ;#no reset + set rowh [my header_height $h] + + #set h_lines [lrepeat $rowh $hcell_line_blank] + #set hcell_blank [join $h_lines \n] + #set hval_lines [split $hval \n] + #set hval_lines [lrange $hval_lines 0 $rowh-1] + #set hval_block [join $hval_lines \n] + #set headercell [overtype::left -experimental test_mode $ansibase_header$hcell_blank$RST $hval_block] + + if {$h == 0} { + set hlims $header_boxlimits_toprow + set rowpos "top" + if {$h == $hmax} { + set rowpos "only" + } + } else { + set hlims $header_boxlimits + set rowpos "middle" + if {$h == $hmax} { + set rowpos "bottom" + } + } + if {!$show_seps_v} { + set hlims [struct::set difference $hlims $headerseps_v] + } + if {$h == $hmax} { + set header_joins $header_body_joins + } else { + set header_joins $joins + } + if {![dict get $o_opts_table -show_edge]} { + set hlims [struct::set difference $hlims [dict get $::textblock::class::header_edge_parts $rowpos$opt_posn] ] + } + #puts ">>> headerspans: $headerspans cidx: $cidx" + if {$this_span eq "all" || $this_span > 0} { + + + set startmap [dict get $hmap $rowpos${opt_posn}] + #look at spans in header below to determine joins required at blc + if {$show_seps_v} { + if {[dict exists $all_colspans [expr {$h+1}]]} { + set next_spanlist [dict get $all_colspans [expr {$h+1}]] + set spanbelow [lindex $next_spanlist $cidx] + if {$spanbelow == 0} { + #we don't want a down-join for blc - retrieve a framedef with only left joins + dict set startmap blc [dict get $framedef_leftbox blc] + } + } else { + set next_spanlist [list] + } + } + + #todo - multiline header cells + multiple header lines (will be more useful when colspans implemented) + set header_cell_startspan [textblock::frame -width [expr {$colwidth+2}] -type [dict get $ftypes header]\ + -ansibase $ansibase_header -ansiborder $ansiborder_final\ + -boxlimits $hlims -boxmap $startmap -joins $header_joins $hval\ + ] + set spanned_parts [list $header_cell_startspan] + + if {$this_span ne "1"} { + #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 last [expr {[llength $remaining_spans] -1}] + set i 0 + foreach s $remaining_spans { + if {$s == 0} { + if {$i == $last} { + set next_posn right + #set next_posn inner + } else { + set next_posn inner + } + + set limj [my Get_boxlimits_and_joins $next_posn $fname_body] + set span_joins_body [dict get $limj bodyjoins] + set span_joins [dict get $limj joins] + set span_boxlimits [dict get $limj boxlimits] + set span_boxlimits_top [dict get $limj boxlimits_top] + #use struct::set instead of simple for loop - will be faster at least when critcl available + #set span_boxlimits [struct::set intersect [dict get $o_opts_table_effective -framelimits_body] $span_boxlimits] + #set span_boxlimits_top [struct::set intersect [dict get $o_opts_table_effective -framelimits_body] $span_boxlimits_top] + set header_span_boxlimits [struct::set intersect [dict get $o_opts_table_effective -framelimits_header] $span_boxlimits] + set header_span_boxlimits_top [struct::set intersect [dict get $o_opts_table_effective -framelimits_header] $span_boxlimits_top] + if {$h == 0} { + set hlims $header_span_boxlimits_top + } else { + set hlims $header_span_boxlimits + } + + set this_span_map $span_extend_map + if {!$show_seps_v} { + set hlims [struct::set difference $hlims $headerseps_v] + } else { + if {[llength $next_spanlist]} { + set spanbelow [lindex $next_spanlist $spancol] + if {$spanbelow != 0} { + set downbox [textblock::framedef $ftype_header {down}] + dict set this_span_map blc [dict get $downbox hlbj] ;#horizontal line bottom with down join - to same frametype + } + } else { + #join to body + set downbox [textblock::framedef $ftype_header [list down-$fname_body]] + dict set this_span_map blc [dict get $downbox hlbj] ;#horizontal line bottom with down join - from header frametype to body frametype + } + } + + if {$h == $hmax} { + set header_joins $span_joins_body + } else { + set header_joins $span_joins + } + if {![dict get $o_opts_table -show_edge]} { + set hlims [struct::set difference $hlims [dict get $::textblock::class::header_edge_parts $rowpos$next_posn] ] + } + + if {![dict exists $column_body_width_cache $spancol]} { + #puts "-----> get_column_by_index $spancol -position $next_posn" + set spancolinfo [my get_column_by_index $spancol -position $next_posn -return dict] + set cwidth [dict get $spancolinfo bodywidth] + dict set column_body_width_cache $spancol $cwidth + } else { + set cwidth [dict get $column_body_width_cache $spancol] + } - append output $header_frame\n + 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 cwidth+1 (vlr extends right beyond table) + #spans at tail end are too short if edges are hidden and we use cwidth (short lower horizontal bar) + if {![dict get $o_opts_table -show_edge]} { + set spanwidth [expr {$cwidth+1}] + } else { + set spanwidth $cwidth + } + } else { + set spanwidth [expr {$cwidth+1}] + } + + set header_cell [textblock::frame -width $spanwidth -type [dict get $ftypes header]\ + -ansibase $ansibase_header -ansiborder $ansiborder_final\ + -boxlimits $hlims -boxmap $this_span_map -joins $header_joins $hcell_blank\ + ] + lappend spanned_parts $header_cell + } else { + break + } + incr spancol + incr i + } + } + set spanned_frame [textblock::join {*}$spanned_parts] + if {$this_span eq "all" || $this_span > 1} { + if {$h == 0} { + set hlims $header_boxlimits_toprow + } else { + set hlims $header_boxlimits + } + if {!$show_seps_v} { + set hlims [struct::set difference $hlims $headerseps_v] + } + if {![dict get $o_opts_table -show_edge]} { + #use the edge_parts corresponding to the column being written to ie use opt_posn + set hlims [struct::set difference $hlims [dict get $::textblock::class::header_edge_parts $rowpos$opt_posn] ] + } + set spacemap [list hl " " vl " " tlc " " blc " " trc " " brc " "] + 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] + } + + + append part_header $spanned_frame + append part_header \n + } else { + set h_lines [lrepeat $rowh ""] + set hcell_blank [join $h_lines \n] + set spacemap [list hl " " vl " " tlc " " blc " " trc " " brc " "] + 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 + } + incr h + } + if {![llength $header_list]} { + #no headers - but we've been asked to show_header + #display a zero content-height header (ie outline if edge is being shown - or bottom bar) + set hlims $header_boxlimits_toprow + if {!$show_seps_v} { + set hlims [struct::set difference $hlims $headerseps_v] + } + if {![dict get $o_opts_table -show_edge]} { + set hlims [struct::set difference $hlims [dict get $::textblock::class::header_edge_parts only$opt_posn] ] + } + set header_joins $header_body_joins + set header_frame [textblock::frame -width [expr {$colwidth+2}] -type [dict get $ftypes header]\ + -ansibase $ansibase_header -ansiborder $ansiborder_final\ + -boxlimits $hlims -boxmap $hdrmap -joins $header_joins\ + ] + append part_header $header_frame\n + } + lassign [textblock::size $part_header] _w return_headerwidth _h return_headerheight } + append output $part_header + set r 0 set rmax [expr {[llength $cells]-1}] @@ -1068,6 +1577,9 @@ namespace eval textblock { } else { set blims $blims_only_headerless } + if {![dict get $o_opts_table -show_edge]} { + set blims [struct::set difference $blims [dict get $::textblock::class::table_edge_parts only$opt_posn] ] + } } else { set bmap $topmap if {$do_show_header} { @@ -1075,18 +1587,29 @@ namespace eval textblock { } else { set blims $blims_top_headerless } + if {![dict get $o_opts_table -show_edge]} { + set blims [struct::set difference $blims [dict get $::textblock::class::table_edge_parts top$opt_posn] ] + } } - append output [textblock::frame -type [dict get $ftypes body] -ansibase $ansibase -ansiborder $border_ansi_final -boxlimits $blims -boxmap $bmap -joins $joins $c]\n + set rowframe [textblock::frame -type [dict get $ftypes body] -ansibase $ansibase -ansiborder $border_ansi_final -boxlimits $blims -boxmap $bmap -joins $joins $c] + set return_bodywidth [textblock::width $rowframe] + append part_body $rowframe \n } else { if {$r == $rmax} { set joins [lremove $joins [lsearch $joins down*]] set bmap $botmap set blims $blims_bot + if {![dict get $o_opts_table -show_edge]} { + set blims [struct::set difference $blims [dict get $::textblock::class::table_edge_parts bottom$opt_posn] ] + } } else { set bmap $midmap set blims $blims_mid ;#will only be reduced from boxlimits if -show_seps was processed above + if {![dict get $o_opts_table -show_edge]} { + set blims [struct::set difference $blims [dict get $::textblock::class::table_edge_parts middle$opt_posn] ] + } } - append output [textblock::frame -type [dict get $ftypes body] -ansibase $ansibase -ansiborder $border_ansi_final -boxlimits $blims -boxmap $bmap -joins $joins $c]\n + append part_body [textblock::frame -type [dict get $ftypes body] -ansibase $ansibase -ansiborder $border_ansi_final -boxlimits $blims -boxmap $bmap -joins $joins $c]\n } incr r } @@ -1097,15 +1620,42 @@ namespace eval textblock { #(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] - #note that if show_edge is 0 - then for this empty line - we will not see any vertical bars - #This is because the frame with no data is made entirely of corner elements + if {$do_show_header} { - append output [textblock::frame -width [expr {$colwidth + 2}] -type [dict get $ftypes body] -boxlimits $blims_only -boxmap $onlymap -joins $joins]\n + set blims $blims_only + } else { + append part_body \n + set blims $blims_only_headerless + } + #note that if show_edge is 0 - then for this empty line - we will not expect to see any bars + #This is because the frame with no data had vertical components made entirely of corner elements + #we could just append a newline when -show_edge is zero, but we want the correct width even when empty - for proper column joins when there are colspanned headers. + # + if {![dict get $o_opts_table -show_edge]} { + #set blims [struct::set difference $blims [dict get $::textblock::class::table_edge_parts only$opt_posn] ] + #append output [textblock::frame -width [expr {$colwidth + 2}] -type [dict get $ftypes body] -boxlimits $blims -boxmap $onlymap -joins $joins]\n + append part_body [string repeat " " $colwidth] \n + set return_bodywidth $colwidth } else { - append output [textblock::frame -width [expr {$colwidth + 2}] -type [dict get $ftypes body] -boxlimits $blims_only_headerless -boxmap $onlymap -joins $joins] \n + set emptyframe [textblock::frame -width [expr {$colwidth + 2}] -type [dict get $ftypes body] -boxlimits $blims -boxmap $onlymap -joins $joins] + append part_body $emptyframe \n + set return_bodywidth [textblock::width $emptyframe] } } - return [string trimright $output \n] + #assert bodywidth is integer >=0 whether there are rows or not + + #trim only 1 newline + if {[string index $part_body end] eq "\n"} { + set part_body [string range $part_body 0 end-1] + } + set return_bodyheight [textblock::height $part_body] + append output $part_body + + if {$opt_return eq "string"} { + return $output + } else { + return [dict create column $output headerwidth $return_headerwidth headerheight $return_headerheight bodywidth $return_bodywidth bodyheight $return_bodyheight] + } } method get_column_cells_by_index {index_expression} { @@ -1121,24 +1671,74 @@ namespace eval textblock { } #assert cidx is integer >=0 set cdef [dict get $o_columndefs $cidx] - set t [dict get $cdef -header] ;#may be empty string - set t_maxdataheight 1 - set items [dict get $o_columndata $cidx] + set headerlist [dict get $cdef -headers] + set num_headers [my header_count] + set RST [punk::ansi::a] set ansibase_body [dict get $o_opts_table -ansibase_body] set ansibase_col [dict get $cdef -ansibase] - set RST [punk::ansi::a] - set colwidth [my column_width $cidx] set ansibase_header [dict get $o_opts_table -ansibase_header] - set cell_line_blank [string repeat " " $colwidth] - set header_underlay $ansibase_header$cell_line_blank + + #set header_underlay $ansibase_header$cell_line_blank + + #set hdrwidth [my column_width_configured $cidx] + set all_colspans [my header_colspans] + + #store configured widths so we don't look up for each header line + set configured_widths [list] + foreach c [dict keys $o_columndefs] { + lappend configured_widths [my column_width_configured $c] + } + set output [dict create] - if {$t ne ""} { - dict set output header [overtype::left -experimental test_mode $header_underlay $ansibase_header$t] - } else { - dict set output header $header_underlay + dict set output headers [list] + for {set i 0} {$i < $num_headers} {incr i} { + set hdr [lindex $headerlist $i] + set header_maxdataheight [my header_height $i] + set header_colspans [dict get $all_colspans $i] + set this_span [lindex $header_colspans $cidx] + set hdrwidth 0 + if {$this_span eq "0"} { + set hdrwidth 0 + } elseif {$this_span eq "all"} { + #all means up to next non-zero + set s "0" + set idx $cidx + while {$s eq "0" && $idx < [llength $header_colspans]} { + incr hdrwidth [lindex $configured_widths $idx] + incr idx + set s [lindex $header_colspans $idx] + } + } else { + set spanned_cols [list] + for {set sc $cidx} {$sc < ($cidx + $this_span)} {incr sc} { + lappend spanned_cols $sc + } + #spanned_cols here includes self + foreach c $spanned_cols { + incr hdrwidth [lindex $configured_widths $c] + } + } + + set hdr_line_blank [string repeat " " $hdrwidth] + 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] + } else { + dict lappend output headers $header_underlay + } } + + + set colwidth [my column_width $cidx] + set cell_line_blank [string repeat " " $colwidth] + + + set items [dict get $o_columndata $cidx] + #puts "---> columndata $o_columndata" + dict set output cells [list];#ensure we return something for cells key if no items in list set r 0 foreach cval $items { @@ -1194,15 +1794,22 @@ namespace eval textblock { return [dict get $o_columndata $cidx] } method debug {} { - puts stdout "rowdefs: $o_rowdefs" - puts stdout "rowstates: $o_rowstates" - puts stdout "columndefs: $o_columndefs" + puts stdout "rowdefs: $o_rowdefs" + puts stdout "rowstates: $o_rowstates" + puts stdout "columndefs: $o_columndefs" + puts stdout "columnstates: $o_columnstates" + puts stdout "headerstates: $o_headerstates" dict for {k coldef} $o_columndefs { if {[dict exists $o_columndata $k]} { - set header [dict get $coldef -header] + set headerlist [dict get $coldef -headers] set coldata [dict get $o_columndata $k] set colinfo "rowcount: [llength $coldata]" - set widest [tcl::mathfunc::max {*}[lmap v [concat [list $header] $coldata] {textblock::width $v}]] + set allfields [concat $headerlist $coldata] + if {[llength $allfields]} { + set widest [tcl::mathfunc::max {*}[lmap v $allfields {textblock::width $v}]] + } else { + set widest 0 + } append colinfo " widest: $widest" } else { set colinfo "WARNING - no columndata record for column key '$k'" @@ -1210,27 +1817,31 @@ namespace eval textblock { puts stdout "column $k columndata info: $colinfo" } } - method column_width {index_expression} { + #column width including headers - but without colspan consideration + method column_width_configured {index_expression} { set cidx [lindex [dict keys $o_columndefs] $index_expression] if {$cidx eq ""} { return } #assert cidx is now >=0 integer within the range of defined columns - set cdef [dict get $o_columndefs $cidx] + set cdef [dict get $o_columndefs $cidx] set defminw [dict get $cdef -minwidth] set defmaxw [dict get $cdef -maxwidth] if {"$defminw$defmaxw" ne "" && $defminw eq $defmaxw} { #an exact width is defined for the column - no need to look at data width set colwidth $defminw } else { - set widest [my column_datawidth $cidx -header 1 -data 1 -footer 1] + #set widest [my column_datawidth $cidx -headers 1 -data 1 -footers 1] + set hwidest [dict get $o_columnstates $cidx maxwidthheaderseen] + 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. #if so - a truncated line shouldn't be included in our width calculation if {$defminw eq ""} { if {$defmaxw eq ""} { set colwidth $widest } else { - set colwidth [expr {min(1,$defmaxw,$widest)}] + set colwidth [expr {min($defmaxw,$widest)}] } } else { if {$defmaxw eq ""} { @@ -1250,47 +1861,176 @@ namespace eval textblock { } return $colwidth } - method column_datawidth {index_expression args} { - set defaults [dict create\ - -header 0\ - -footer 0\ - -data 1\ - ] - dict for {k v} $args { - switch -- $k { - -header - -footer - -data {} - default { - error "column_datawidth unrecognised flag '$k'. Known flags: [dict keys $defaults]" - } - } - } - set opts [dict merge $defaults $args] + #column *body* content width + method column_width {index_expression} { set cidx [lindex [dict keys $o_columndefs] $index_expression] if {$cidx eq ""} { return } - #assert cidx is >=0 integer in valid range of keys for o_columndefs - set values [list] - if {[dict get $opts -header]} { - lappend values [dict get $o_columndefs $cidx -header] - } - if {[dict get $opts -data]} { - if {[dict exists $o_columndata $cidx]} { - lappend values {*}[dict get $o_columndata $cidx] - } - } - if {[dict get $opts -footer]} { - lappend values [dict get $o_columndefs $cidx -footer] - } - if {[llength $values]} { - set widest [tcl::mathfunc::max {*}[lmap v $values {textblock::width $v}]] + #puts "===column_width $index_expression" + #assert cidx is now >=0 integer within the range of defined columns + set cdef [dict get $o_columndefs $cidx] + set defminw [dict get $cdef -minwidth] + set defmaxw [dict get $cdef -maxwidth] + if {"$defminw$defmaxw" ne "" && $defminw eq $defmaxw} { + #an exact width is defined for the column - no need to look at data width + set colwidth $defminw } else { - set widest 0 - } + #set widest [my column_datawidth $cidx -headers 0 -data 1 -footers 0] + set widest [dict get $o_columnstates $cidx maxwidthbodyseen] + #todo - predetermine if any items in column contain newlines and are truncated vertically due to o_rowdefs configuration. + #if so - a truncated line shouldn't be included in our width calculation + if {$defminw eq ""} { + if {$defmaxw eq ""} { + set colwidth $widest + } else { + set colwidth [expr {min($defmaxw,$widest)}] + } + } else { + if {$defmaxw eq ""} { + set colwidth [expr {max($defminw,$widest)}] + } else { + if {$widest < $defminw} { + set colwidth $defminw + } else { + if {$widest > $defmaxw} { + set colwidth $defmaxw + } else { + set colwidth [expr {max($defminw,$widest)}] + } + } + } + } + } + set configured_widths [list] + foreach c [dict keys $o_columndefs] { + lappend configured_widths [my column_width_configured $c] + } + set header_colspans [my header_colspans] + set width_max $colwidth + set test_width $colwidth + set showing_vseps [my Showing_vseps] + dict for {h colspans} $header_colspans { + set spanc [lindex $colspans $cidx] + #set headers [dict get $cdef -headers] + #set thiscol_widest_header 0 + #if {[llength $headers] > 0} { + # set thiscol_widest_header [tcl::mathfunc::max {*}[lmap v $headers {textblock::width $v}]] + #} + set thiscol_widest_header [dict get $o_columnstates $cidx maxwidthheaderseen] + if {$spanc eq "1"} { + if {$thiscol_widest_header > $colwidth} { + set test_width [expr {max($thiscol_widest_header,$colwidth)}] + if {$defmaxw ne ""} { + set test_width [expr {min($colwidth,$defmaxw)}] + } + } + set width_max [expr {max($test_width,$width_max)}] + continue + } + if {$spanc eq "all" || $spanc > 1} { + set spanned [list] ;#spanned is other columns spanned - not including this one + set cnext [expr {$cidx +1}] + set spanlength [lindex $colspans $cnext] + while {$spanlength eq "0" && $cnext < [llength $colspans]} { + lappend spanned $cnext + incr cnext + set spanlength [lindex $colspans $cnext] + } + set others_width 0 + foreach col $spanned { + incr others_width [lindex $configured_widths $col] + if {$showing_vseps} { + incr others_width 1 + } + } + set total_spanned_width [expr {$width_max + $others_width}] + if {$thiscol_widest_header > $total_spanned_width} { + set needed [expr {$thiscol_widest_header - $total_spanned_width}] + #puts "-->>col $cidx needed ($thiscol_widest_header - $total_spanned_width): $needed (spanned $spanned)" + if {$defmaxw ne ""} { + set test_width [expr {min($colwidth+$needed,$defmaxw)}] + } else { + set test_width [expr {$colwidth + $needed}] + } + } + } + set width_max [expr {max($test_width,$width_max)}] + } + + #alternative to all the above shennanigans.. let the body cell data determine the size and just wrap the headers + #could also split the needed width amongst the spanned columns? configurable for whether cells expand? + set expand_first_column 1 + if {$expand_first_column} { + set colwidth $width_max + } + + #puts "---column_width $cidx = $colwidth" + return $colwidth + } + method Showing_vseps {} { + #review - show_seps and override mechanism for show_vseps show_hseps - document. + set seps [dict get $o_opts_table -show_seps] + set vseps [dict get $o_opts_table -show_vseps] + if {$seps eq ""} { + if {$vseps eq "" || $vseps} { + return true + } + } elseif {$seps} { + if {$vseps eq "" || $vseps} { + return true + } + } else { + if {$vseps ne "" && $vseps} { + return true + } + } + return false + } + + method column_datawidth {index_expression args} { + set defaults [dict create\ + -headers 0\ + -footers 0\ + -data 1\ + ] + dict for {k v} $args { + switch -- $k { + -headers - -footers - -data {} + default { + error "column_datawidth unrecognised flag '$k'. Known flags: [dict keys $defaults]" + } + } + } + set opts [dict merge $defaults $args] + + set cidx [lindex [dict keys $o_columndefs] $index_expression] + if {$cidx eq ""} { + return + } + #assert cidx is >=0 integer in valid range of keys for o_columndefs + set values [list] + if {[dict get $opts -headers]} { + lappend values {*}[dict get $o_columndefs $cidx -headers] + } + if {[dict get $opts -data]} { + if {[dict exists $o_columndata $cidx]} { + lappend values {*}[dict get $o_columndata $cidx] + } + } + if {[dict get $opts -footers]} { + lappend values {*}[dict get $o_columndefs $cidx -footers] + } + if {[llength $values]} { + set widest [tcl::mathfunc::max {*}[lmap v $values {textblock::width $v}]] + } else { + set widest 0 + } return $widest } - method print {args} { + #print1 uses basic column joining - useful for testing/debug especially with colspans + method print1 {args} { if {![llength $args]} { set cols [dict keys $o_columndata] } else { @@ -1303,12 +2043,9 @@ namespace eval textblock { error "[namespace::current]::table error invalid print specification '$colspec'" } lassign $parts from _dd to - if {$from eq ""} { - set from 0 - } - if {$to eq ""} { - set to end - } + if {$from eq ""} {set from 0 } + if {$to eq ""} {set to end} + set indices [lrange $allcols $from $to] lappend cols {*}$indices } else { @@ -1325,13 +2062,13 @@ namespace eval textblock { foreach c $cols { set flags [list] if {$colposn == 0 && $colposn == $numposns-1} { - set flags [list -positiontype solo] + set flags [list -position solo] } elseif {$colposn == 0} { - set flags [list -positiontype left] + set flags [list -position left] } elseif {$colposn == $numposns-1} { - set flags [list -positiontype right] + set flags [list -position right] } else { - set flags [list -positiontype inner] + set flags [list -position inner] } lappend blocks [my get_column_by_index $c {*}$flags] incr colposn @@ -1342,6 +2079,71 @@ namespace eval textblock { return "No columns matched" } } + method print {args} { + if {![llength $args]} { + set cols [dict keys $o_columndata] + } else { + set cols [list] + foreach colspec $args { + set allcols [dict keys $o_columndata] + if {[string first .. $colspec] >=0} { + set parts [punk::ansi::ta::_perlish_split {\.\.} $colspec] + if {[llength $parts] != 3} { + error "[namespace::current]::table error invalid print specification '$colspec'" + } + lassign $parts from _dd to + if {$from eq ""} {set from 0} + if {$to eq ""} {set to end} + + set indices [lrange $allcols $from $to] + lappend cols {*}$indices + } else { + set c [lindex $allcols $colspec] + if {$c ne ""} { + lappend cols $c + } + } + } + } + set blocks [list] + set colposn 0 + set numposns [llength $cols] + set padwidth 0 + set table "" + foreach c $cols { + set flags [list] + if {$colposn == 0 && $colposn == $numposns-1} { + set flags [list -position solo] + } elseif {$colposn == 0} { + set flags [list -position left] + } elseif {$colposn == $numposns-1} { + set flags [list -position right] + } else { + set flags [list -position inner] + } + #lappend blocks [my get_column_by_index $c {*}$flags] + set columninfo [my get_column_by_index $c -return dict {*}$flags] + set nextcol [dict get $columninfo column] + set bodywidth [dict get $columninfo bodywidth] + + if {$table eq ""} { + 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 " "] $nextcol] + set table [overtype::left -overflow 1 -experimental test_mode -transparent 1 $table $nextcol] + } + incr padwidth $bodywidth + incr colposn + } + + if {[llength $cols]} { + #return [textblock::join {*}$blocks] + return $table + } else { + return "No columns matched" + } + } #*** !doctools #[list_end] @@ -1364,7 +2166,15 @@ namespace eval textblock { namespace import ::term::ansi::code::macros::cd::* namespace eval ::term::ansi::code::macros::cd {namespace export -clear} } - + proc spantest {} { + 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 5 all 2} + $t configure_column 2 -headers {"" "" "" "" c2span2} + $t configure_column 2 -header_colspans {0 0 0 0 2} + $t configure -show_header 1 -ansiborder_header [a+ cyan] + return $t + } proc list_as_table {table_or_colcount datalist args} { set defaults [dict create\ -return string\ @@ -1400,7 +2210,7 @@ namespace eval textblock { } set t [textblock::class::table new -show_header 0 -show_edge [dict get $opts -show_edge] -frametype [dict get $opts -frametype] -show_seps [dict get $opts -show_seps]] for {set c 0} {$c < $cols} {incr c} { - $t add_column -header c$c + $t add_column -headers [list $c] } } else { if {[namespace tail [info object class $table_or_colcount]] ne "table"} { @@ -1797,7 +2607,9 @@ namespace eval textblock { append out $2frames_a \n set 2frames_b [textblock::join [textblock::frame -ansiborder $cyanb -title "plainpunks" $punks] [textblock::frame -ansiborder $greenb -title "fancypunks" $cpunks]] append out [textblock::frame -title "punks" $2frames_b\n$RST$2frames_a] \n - append out [overtype::right [overtype::left [textblock::frame -ansiborder [a+ green bold] -type heavy -title ${redb}PATTERN$RST -subtitle ${redb}PUNK$RST $prightair_cyanb] "$blueb\n\n\P\nU\nN\nK$RST"] "$blueb\n\nL\nI\nF\nE"] \n + set fancy [overtype::right [overtype::left [textblock::frame -ansiborder [a+ green bold] -type heavy -title ${redb}PATTERN$RST -subtitle ${redb}PUNK$RST $prightair_cyanb] "$blueb\n\n\P\nU\nN\nK$RST"] "$blueb\n\nL\nI\nF\nE"]] + set spantable [[spantest] print] + append out [textblock::join $fancy $spantable] \n #append out [textblock::frame -title gr $gr0] return $out } @@ -1842,7 +2654,7 @@ namespace eval textblock { set t [textblock::class::table new {*}$topts] foreach h $opt_headers { - $t add_column -header $h + $t add_column -headers [list $h] } if {[$t column_count] == 0} { if {[llength $opt_rows]} { @@ -1904,289 +2716,93 @@ namespace eval textblock { return [dict create category predefined type $f] } } - proc frame {args} { - variable frametypes - set expect_optval 0 - set argposn 0 - set pmax [expr {[llength $args]-1}] - set has_contents 0 ;#differentiate between empty string and no content supplied - set contents "" - set arglist [list] - foreach a $args { - if {!$expect_optval} { - if {$argposn < $pmax} { - if {[string match -* $a]} { - set expect_optval 1 - lappend arglist $a - } else { - error "textblock::frame expects -option pairs" - } - } else { - set has_contents 1 - set contents $a - } - } else { - lappend arglist $a - set expect_optval 0 - } - incr argposn - } - - #set contents [lindex $args end] - #set arglist [lrange $args 0 end-1] - if {[llength $arglist] % 2 != 0} { - error "Usage frame ?-type unicode|altg|ascii|? ?-title ? ?-subtitle ? ?-width ? ?-ansiborder ? ?-boxlimits hl|hlt|hlb|vl|vll|vlr|tlc|blc|brc? ?-joins left|right|up|down? " - } - #todo args -justify left|centre|right (center) + proc framedef {f {joins ""}} { + #unicode box drawing only provides enough characters for seamless joining of unicode boxes light and heavy. + #e.g with characters such as \u2539 Box Drawings Right Light and Left Up Heavy. + #the double glyphs in box drawing can do a limited set of joins to light lines - but not enough for seamless table layouts. + #the arc set can't even join to itself e.g with curved equivalents of T-like shapes + + #sorted order down left right up + #1 x choose 4 + #4 x choose 3 + #6 x choose 2 + #4 x choose 1 + #15 combos - set defaults [dict create\ - -etabs 0\ - -type light\ - -boxlimits [list hl vl tlc blc trc brc]\ - -boxmap {}\ - -joins [list]\ - -title ""\ - -subtitle ""\ - -width ""\ - -height ""\ - -ansiborder ""\ - -ansibase ""\ - -align "left"\ - -ellipsis 1\ - ] - 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 {} - default { - error "frame option '$k' not understood. Valid options are [dict keys $defaults]" - } + set join_directions [list] + #targets - light,heavy (double?) - seem to be some required glyphs missing from unicode + #e.g down-light, up-heavy + set join_targets [dict create left "" down "" right "" up ""] + foreach jt $joins { + lassign [split $jt -] direction target + if {$target ne ""} { + dict set join_targets $direction $target } + lappend join_directions $direction } - # -- --- --- --- --- --- - set opt_etabs [dict get $opts -etabs] - set opt_type [dict get $opts -type] - set opt_boxlimits [dict get $opts -boxlimits] - set opt_joins [dict get $opts -joins] - set opt_boxmap [dict get $opts -boxmap] - set custom_keys [list hl hlt hlb vl vll vlr tlc trc blc brc] - - set known_frametypes $frametypes ;# light, heavey etc as defined in textblock::frametypes variable - set default_custom [dict create hl " " vl " " tlc " " trc " " blc " " brc " "] + set join_directions [lsort -unique $join_directions] + set do_joins [::join $join_directions _] - lassign [textblock::frametype $opt_type] _cat category _type ftype - if {$category eq "custom"} { - set custom_frame $ftype - set frameset "custom" - } else { - #category = predefined - set frameset $ftype ;# light,heavy etc - } - set is_boxlimits_ok 1 - set exact_boxlimits [list] - foreach v $opt_boxlimits { - switch -- $v { - hl { - lappend exact_boxlimits hlt hlb - } - vl { - lappend exact_boxlimits vll vlr - } - hlt - hlb - vll - vlr - tlc - trc - blc - brc { - lappend exact_boxlimits $v - } - default { - #k not in custom_keys - set is_boxlimits_ok 0 - break - } - } - } - if {!$is_boxlimits_ok} { - error "frame option -boxlimits '$opt_boxlimits' must contain only values from the set: hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc" - } - set exact_boxlimits [lsort -unique $exact_boxlimits] + switch -- $f { + "altg" { + #old style ansi escape sequences with alternate graphics page G0 + set hl [cd::hl] + set hlt $hl + set hlb $hl + set vl [cd::vl] + set vll $vl + set vlr $vl + set tlc [cd::tlc] + set trc [cd::trc] + set blc [cd::blc] + set brc [cd::brc] - set is_joins_ok 1 - foreach v $opt_joins { - lassign [split $v -] direction target - switch -- $direction { - left - right - up - down {} - default { - set is_joins_ok 0 - break - } - } - switch -- $target { - "" - light - heavy - ascii - altg - arc - double - custom - block - block1 {} - default { - set is_joins_ok 0 - break - } - } - } - if {!$is_joins_ok} { - error "frame option -joins '$opt_joins' must contain only values from the set: left,right,up,down with targets heavy,light,ascii,altg,arc,double,block,block1,custom e.g down-light" - } - set is_boxmap_ok 1 - dict for {boxelement subst} $opt_boxmap { - switch -- $boxelement { - hl - hlt - hlb - vl - vll - vlr - tlc - trc - blc - brc {} - default { - set is_boxmap_ok 0 - break - } - } - } - if {!$is_boxmap_ok} { - error "frame option -boxmap '$opt_boxmap' must contain only keys from the set: hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc" - } - #sorted order down left right up - #1 x choose 4 - #4 x choose 3 - #6 x choose 2 - #4 x choose 1 - #15 combos - set join_directions [list] - #targets - light,heavy (double?) - seem to be some required glyphs missing from unicode - #e.g down-light, up-heavy - set join_targets [dict create left "" down "" right "" up ""] - foreach jt $opt_joins { - lassign [split $jt -] direction target - if {$target ne ""} { - dict set join_targets $direction $target - } - lappend join_directions $direction - } - set join_directions [lsort -unique $join_directions] - set do_joins [::join $join_directions _] - - - # -- --- --- --- --- --- - set opt_title [dict get $opts -title] - set opt_subtitle [dict get $opts -subtitle] - 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 { - left - right - centre - center {} - default { - error "frame option -align must be left|right|centre|center - received: $$opt_align" - } - } - #these are all valid commands for overtype:: - # -- --- --- --- --- --- - set opt_ansiborder [dict get $opts -ansiborder] - set opt_ansibase [dict get $opts -ansibase] ;#experimental - set opt_ellipsis [dict get $opts -ellipsis] - # -- --- --- --- --- --- - - if {$has_contents} { - if {[string last \t $contents] >= 0} { - if {[info exists punk::console::tabwidth]} { - set tw $::punk::console::tabwidth - } else { - set tw 8 - } - if {$opt_etabs} { - set contents [textutil::tabify::untabify2 $contents $tw] - } - } - set contents [string map [list \r\n \n] $contents] - set actual_contentwidth [textblock::width $contents] - set actual_contentheight [textblock::height $contents] - } else { - set actual_contentwidth 0 - set actual_contentheight 0 - } - - if {$opt_title ne ""} { - set titlewidth [punk::ansi::printing_length $opt_title] - set content_or_title_width [expr {max($actual_contentwidth,$titlewidth)}] - } else { - set titlewith 0 - set content_or_title_width $actual_contentwidth - } - - if {$opt_width eq ""} { - set contentwidth $content_or_title_width - } else { - set contentwidth [expr {max(0,$opt_width - 2)}] ;#default - } - - if {$opt_height eq ""} { - set contentheight $actual_contentheight - } else { - set contentheight [expr {max(0,$opt_height -2)}] ;#default - } - if {$contentheight == 0} { - set has_contents 0 - } - - #todo - render it with vertical overflow so we can process ansi moves? - #set linecount [textblock::height $contents] - set linecount $contentheight - set rst [a] - #set column [string repeat " " $contentwidth] ;#default - may need to override for custom frame - set underlayline [string repeat " " $contentwidth] - set underlay [::join [lrepeat $linecount $underlayline] \n] - - set vll_width 1 ;#default for all except custom (printing width) - set vlr_width 1 - - #unicode box drawing only provides enough characters for seamless joining of unicode boxes light and heavy. - #e.g with characters such as \u2539 Box Drawings Right Light and Left Up Heavy. - #the double glyphs in box drawing can do a limited set of joins to light lines - but not enough for seamless table layouts. - #the arc set can't even join to itself e.g with curved equivalents of T-like shapes - #I guess - switch -- $frameset { - "altg" { - #old style ansi escape sequences with alternate graphics page G0 - set hl [cd::hl] - set hlt $hl - set hlb $hl - set vl [cd::vl] - set vll $vl - set vlr $vl - set tlc [cd::tlc] - set trc [cd::trc] - set blc [cd::blc] - set brc [cd::brc] + #horizontal and vertical bar joins + set hltj $hlt + set hlbj $hlb + set vllj $vll + set vlrj $vlr #No join targets available to join altg to other box styles switch -- $do_joins { down { #1 set blc [punk::ansi::g0 t] ;#(ltj) set brc [punk::ansi::g0 u] ;#(rtj) + set hlbj [punk::ansi::g0 w] ;#(ttj) } left { #2 set tlc [punk::ansi::g0 w] ;#(ttj) set blc [punk::ansi::g0 v] ;#(btj) + set vllj [punk::ansi::g0 u] ;#(rtj) } right { #3 set trc [punk::ansi::g0 w] ;#(ttj) set brc [punk::ansi::g0 v] ;#(btj) + set vlrj [punk::ansi::g0 t] ;#(ltj) } up { #4 set tlc [punk::ansi::g0 t] ;#(ltj) set trc [punk::ansi::g0 u] ;#(rtj) + set hltj [punk::ansi::g0 v];#(btj) } down_left { #5 set blc [punk::ansi::g0 n] ;#(fwj) set tlc [punk::ansi::g0 w] ;#(ttj) set brc [punk::ansi::g0 u] ;#(rtj) + set hlbj [punk::ansi::g0 w] ;#(ttj) + set vllj [punk::ansi::g0 u] ;#(rtj) } down_right { #6 set blc [punk::ansi::g0 t] ;#(ltj) set trc [punk::ansi::g0 w] ;#(ttj) set brc [punk::ansi::g0 n] ;#(fwj) + set hlbj [punk::ansi::g0 w] ;#(ttj) + set vlrj [punk::ansi::g0 t] ;#(ltj) } down_up { #7 @@ -2195,6 +2811,8 @@ namespace eval textblock { set tlc [punk::ansi::g0 t] ;#(ltj) set trc [punk::ansi::g0 u] ;#(rtj) + set hlbj [punk::ansi::g0 w] ;#(ttj) + set hltj [punk::ansi::g0 v];#(btj) } left_right { #8 @@ -2204,18 +2822,23 @@ namespace eval textblock { #from3 set trc [punk::ansi::g0 w] ;#(ttj) set brc [punk::ansi::g0 v] ;#(btj) + set vllj [punk::ansi::g0 u] ;#(rtj) + set vlrj [punk::ansi::g0 t] ;#(ltj) } left_up { #9 set tlc [punk::ansi::g0 n] ;#(fwj) set trc [punk::ansi::g0 u] ;#(rtj) set blc [punk::ansi::g0 v] ;#(btj) + set vllj [punk::ansi::g0 u] ;#(rtj) } right_up { #10 set tlc [punk::ansi::g0 t] ;#(ltj) set trc [punk::ansi::g0 n] ;#(fwj) set brc [punk::ansi::g0 v] ;#(btj) + set hltj [punk::ansi::g0 v];#(btj) + set vlrj [punk::ansi::g0 t] ;#(ltj) } down_left_right { #11 @@ -2223,6 +2846,9 @@ namespace eval textblock { set brc [punk::ansi::g0 n] ;#(fwj) set trc [punk::ansi::g0 w] ;#(ttj) set tlc [punk::ansi::g0 w] ;#(ttj) + set vllj [punk::ansi::g0 u] ;#(rtj) + set vlrj [punk::ansi::g0 t] ;#(ltj) + set hlbj [punk::ansi::g0 w] ;#(ttj) } down_left_up { #12 @@ -2230,7 +2856,9 @@ namespace eval textblock { set blc [punk::ansi::g0 n] ;#(fwj) set trc [punk::ansi::g0 u] ;#(rtj) set brc [punk::ansi::g0 u] ;#(rtj) - + set vllj [punk::ansi::g0 u] ;#(rtj) + set hltj [punk::ansi::g0 v];#(btj) + set hlbj [punk::ansi::g0 w] ;#(ttj) } down_right_up { #13 @@ -2238,6 +2866,9 @@ namespace eval textblock { set blc [punk::ansi::g0 t] ;#(ltj) set trc [punk::ansi::g0 n] ;#(fwj) set brc [punk::ansi::g0 n] ;#(fwj) + set hltj [punk::ansi::g0 v];#(btj) + set vlrj [punk::ansi::g0 t] ;#(ltj) + set hlbj [punk::ansi::g0 w] ;#(ttj) } left_right_up { #14 @@ -2245,7 +2876,9 @@ namespace eval textblock { set trc [punk::ansi::g0 n] ;#(fwj) set blc [punk::ansi::g0 v] ;#(btj) set brc [punk::ansi::g0 v] ;#(btj) - + set vllj [punk::ansi::g0 u] ;#(rtj) + set hltj [punk::ansi::g0 v];#(btj) + set vlrj [punk::ansi::g0 t] ;#(ltj) } down_left_right_up { #15 @@ -2253,6 +2886,10 @@ namespace eval textblock { set blc [punk::ansi::g0 n] ;#(fwj) set trc [punk::ansi::g0 n] ;#(fwj) set brc [punk::ansi::g0 n] ;#(fwj) + set vllj [punk::ansi::g0 u] ;#(rtj) + set hltj [punk::ansi::g0 v];#(btj) + set vlrj [punk::ansi::g0 t] ;#(ltj) + set hlbj [punk::ansi::g0 w] ;#(ttj) } } @@ -2269,6 +2906,18 @@ namespace eval textblock { set trc + set blc + set brc + + #horizontal and vertical bar joins + #set hltj $hlt + #set hlbj $hlb + #set vllj $vll + #set vlrj $vlr + #ascii + is small - can reasonably be considered a join to anything? + set hltj + + set hlbj + + set vllj + + set vlrj + + #our corners are all + already - so we won't do anything for directions or targets + } "light" { #unicode box drawing set @@ -2282,6 +2931,13 @@ namespace eval textblock { set trc [punk::char::charshort boxd_ldl] set blc [punk::char::charshort boxd_lur] set brc [punk::char::charshort boxd_lul] + + #horizontal and vertical bar joins + set hltj $hlt + set hlbj $hlb + set vllj $vll + set vlrj $vlr + #15 combos #sort order: down left right up #ltj,rtj,ttj,btj e.g left T junction etc. @@ -2313,10 +2969,12 @@ namespace eval textblock { heavy { set blc [punk::char::charshort boxd_dhrul] ;#\u251f down hieavy and right up light (ltj) set brc \u2527 ;#boxd_dhlul down heavy and left up light (rtj) + set hlbj \u2530 ;# down heavy (ttj) } light { set blc \u251c ;#[punk::char::charshort boxd_lvr] light vertical and right (ltj) set brc [punk::char::charshort boxd_lvl] ;#light vertical and left (rtj) + set hlbj \u252c ;# (ttj) } } } @@ -2326,10 +2984,12 @@ namespace eval textblock { heavy { set tlc \u252d ;# Left Heavy and Right Down Light (ttj) set blc \u2535 ;# Left Heavy and Right Up Light (btj) + set vllj \u2525 ;# left heavy (rtj) } light { set tlc [punk::char::charshort boxd_ldhz] ;#T shape (ttj) - joinleft set blc [punk::char::charshort boxd_luhz] ;#upside down T shape (btj) + set vllj \u2524 ;# (rtj) } } } @@ -2339,17 +2999,27 @@ namespace eval textblock { heavy { set trc \u252e ;#Right Heavy and Left Down Light (ttj) set brc \u2536 ;#Right Heavy and Left up Light (btj) + set vlrj \u251d;#right heavy (ltj) } light { set trc [punk::char::charshort boxd_ldhz] ;#T shape (ttj) set brc [punk::char::charshort boxd_luhz] ;#upside down T shape (btj) + set vlrj \u251c;# (ltj) } } } up { #4 - set tlc [punk::char::charshort boxd_lvr] ;#light vertical and right (ltj) - set trc [punk::char::charshort boxd_lvl] ;#light vertical and left (rtj) + switch -- $targetup { + heavy { + set tlc \u251e ;#up heavy (ltj) + set trc \u2526 ;#up heavy (rtj) + } + light { + set tlc [punk::char::charshort boxd_lvr] ;#light vertical and right (ltj) + set trc [punk::char::charshort boxd_lvl] ;#light vertical and left (rtj) + } + } } down_left { #5 @@ -2357,7 +3027,8 @@ namespace eval textblock { other-light { set blc \u2534 ;#(btj) set tlc \u252c ;#(ttj) - #brc - default corner + #brc - default corner + set vllj \u2524 ;# (rtj) } other-other { #default corners @@ -2366,36 +3037,47 @@ namespace eval textblock { set blc \u2535 ;# heavy left (btj) set tlc \u252d ;#heavy left (ttj) #brc default corner + set vllj \u2525 ;# heavy left (rtj) } heavy-light { set blc \u2541 ;# heavy down (fwj) set tlc \u252c ;# light (ttj) set brc \u2527 ;# heavy down (rtj) + set vllj \u2524 ;# (rtj) + set hlbj \u2530 ;# heavy down (ttj) } heavy-other { set blc \u251f ;#heavy down (ltj) #tlc - default corner set brc \u2527 ;#heavy down (rtj) + set hlbj \u2530 ;# heavy down (ttj) } heavy-heavy { set blc \u2545 ;#heavy down and left (fwj) set tlc \u252d ;#heavy left (ttj) set brc \u2527 ;#heavy down (rtj) + set vllj \u2525 ;# heavy left (rtj) + set hlbj \u2530 ;# heavy down (ttj) } light-light { set blc \u253c ;# [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) set tlc \u252c ;# boxd_ldhz (ttj) set brc \u2524 ;# boxd_lvl light vertical and left(rtj) + set vllj \u2524 ;# (rtj) + set hlbj \u252c ;# (ttj) } light-other { set blc \u251c ;# (ltj) #tlc - default corner set brc \u2524 ;# boxd_lvl (rtj) + set hlbj \u252c ;# (ttj) } light-heavy { set blc \u253d ;# heavy left (fwj) set tlc \u252d ;# heavy left (ttj) set brc \u2524 ;# light (rtj) + set vllj \u2525 ;# heavy left (rtj) + set hlbj \u252c ;# (ttj) } default { set blc \u253c ;# [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) @@ -2492,6 +3174,12 @@ namespace eval textblock { set trc [punk::char::charshort boxd_hdl] set blc [punk::char::charshort boxd_hur] set brc [punk::char::charshort boxd_hul] + #horizontal and vertical bar joins + set hltj $hlt + set hlbj $hlb + set vllj $vll + set vlrj $vlr + #set targetdown,targetleft,targetright,targetup vars #default empty targets to current box type 'heavy' foreach dir {down left right up} { @@ -2515,10 +3203,12 @@ namespace eval textblock { light { set blc [punk::char::charshort boxd_dlruh] ;#\u2521 down light and right up heavy (ltj) set brc [punk::char::charshort boxd_dlluh] ;#\u2529 down light and left up heavy (rtj) + set hlbj \u252F ;#down light (ttj) } heavy { set blc [punk::char::charshort boxd_hvr] ;# (ltj) set brc [punk::char::charshort boxd_hvl] ;# (rtj) + set hlbj \u2533 ;# down heavy (ttj) } } } @@ -2528,10 +3218,12 @@ namespace eval textblock { light { set tlc [punk::char::charshort boxd_llrdh] ;#\u2532 Left Light and Right Down Heavy (ttj) set blc [punk::char::charshort boxd_llruh] ;#\u253a Left Light and Right Up Heavy (btj) + set vllj \u2528 ;# left light (rtj) } heavy { set tlc [punk::char::charshort boxd_hdhz] ;# (ttj) set blc [punk::char::charshort boxd_huhz] ;# (btj) + set vllj \u252b ;#(rtj) } } } @@ -2541,10 +3233,12 @@ namespace eval textblock { light { set trc [punk::char::charshort boxd_rlldh] ;#\u2531 Right Light and Left Down Heavy (ttj) set brc [punk::char::charshort boxd_rlluh] ;#\u2539 Right Light and Left Up Heavy(btj) + set vlrj \u2520 ;#right light (ltj) } heavy { set trc [punk::char::charshort boxd_hdhz] ;#T shape (ttj) set brc [punk::char::charshort boxd_huhz] ;# (btj) + set vlrj \u2523 ;# (ltj) } } } @@ -2554,10 +3248,12 @@ namespace eval textblock { light { set tlc [punk::char::charshort boxd_ulrdh] ;#\u2522 Up Light and Right Down Heavy (ltj) set trc [punk::char::charshort boxd_ulldh] ;#\u252a Up Light and Left Down Heavy (rtj) + set hltj \u2537 ;# up light (btj) } heavy { set tlc [punk::char::charshort boxd_hvr] ;# (ltj) set trc [punk::char::charshort boxd_hvl] ;# (rtj) + set hltj \u253b ;# (btj) } } } @@ -2569,42 +3265,57 @@ namespace eval textblock { set blc [punk::char::charshort boxd_dluhzh] ;#down light and up horizontal heavy (fwj) set brc [punk::char::charshort boxd_dlluh] ;#\u2529 down light and left up heavy (rtj) set tlc [punk::char::charshort boxd_hdhz] ;# (ttj) (at tlc down stays heavy) + set hlbj \u252F ;# down light (ttj) + set vllj \u252b ;#(rtj) } down-heavy-left-light { set blc [punk::char::charshort boxd_llrvh] ;# left light and right Vertical Heavy (fwj) set brc [punk::char::charshort boxd_hvl] ;# (rtj) (at brc left must stay heavy) set tlc [punk::char::charshort boxd_llrdh] ;#\u2532 Left Light and Right Down Heavy (ttj) + set hlbj \u2533 ;# down heavy (ttj) + set vllj \u2528 ;# left light (rtj) } down-light-left-light { set blc [punk::char::charshort boxd_ruhldl] ;#\u2544 right up heavy and left down light (fwj) set brc [punk::char::charshort boxd_dlluh] ;#\u2529 Down Light and left Up Heavy (rtj) (left must stay heavy) set tlc [punk::char::charshort boxd_llrdh] ;#\u2532 Left Light and Right Down Heavy (ttj) (we are in heavy - so down must stay heavy at tlc) + set hlbj \u252F ;# down light (ttj) + set vllj \u2528 ;# left light (rtj) } down-heavy-left-heavy { set blc [punk::char::charshort boxd_hvhz] ;# (fwj) set brc [punk::char::charshort boxd_hvl] ;# (rtj) set tlc [punk::char::charshort boxd_hdhz] ;# (ttj) + set hlbj \u2533 ;#(ttj) + set vllj \u252b ;#(rtj) } down-other-left-heavy { set blc \u253b ;#boxd_huhz Heavy Up and Horizontal (btj) #leave brc default corner set tlc \u2533 ;#hdhz Heavy Down and Horizontal (ttj) + set vllj \u252b ;#(rtj) } down-other-left-light { set blc \u253a ;#llruh Left Light and Right Up Heavy (btj) #leave brc default corner set tlc \u2532 ;#llrdh Left Light and Right Down Heavy (ttj) + + set vllj \u2528 ;# left light (rtj) } down-heavy-left-other { set blc \u2523 ;#hvr Heavy Vertical and Right (ltj) set brc \u252b ;#hvl Heavy Veritcal and Left (rtj) #leave tlc default corner + + set hlbj \u2533 ;#(ttj) } down-light-left-other { set blc \u2521 ;#dlruh Down Light and Right Up Heavy (ltj) set brc \u2529 ;#dlluh Down Light and Left Up Heavy (rtj) #leave tlc default corner + + set hlbj \u252F ;# down light (ttj) } } } @@ -2696,6 +3407,12 @@ namespace eval textblock { set blc [punk::char::charshort boxd_dur] ;#double up and right \U255A set brc [punk::char::charshort boxd_dul] ;#double up and left \U255D + #horizontal and vertical bar joins + set hltj $hlt + set hlbj $hlb + set vllj $vll + set vlrj $vlr + # \u256c (fwj) #set targetdown,targetleft,targetright,targetup vars @@ -2706,6 +3423,9 @@ namespace eval textblock { "" - double { set target$dir double } + light { + set target$dir light + } default { set target$dir other } @@ -2721,6 +3441,10 @@ namespace eval textblock { double { set blc \u2560 ;# (ltj) set brc \u2563 ;# (rtj) + set hlbj \u2566 ;# (ttj) + } + light { + set hlbj \u2564 ;# down light (ttj) } } } @@ -2730,6 +3454,10 @@ namespace eval textblock { double { set tlc \u2566 ;# (ttj) set blc \u2569 ;# (btj) + set vllj \u2563 ;# (rtj) + } + light { + set vllj \u2562 ;# light left (rtj) } } } @@ -2740,6 +3468,9 @@ namespace eval textblock { set trc \u2566 ;# (ttj) set brc \u2569 ;# (btj) } + light { + set vlrj \u255F ;# light right (ltj) + } } } up { @@ -2748,6 +3479,10 @@ namespace eval textblock { double { set tlc \u2560 ;# (ltj) set trc \u2563 ;# (rtj) + set hltj \u2569 ;# (btj) + } + light { + set hltj \u2567 ;#up light (btj) } } } @@ -2758,12 +3493,36 @@ namespace eval textblock { set blc \u256c ;# (fwj) set brc \u2563 ;# (rtj) set tlc \u2566 ;# (ttj) + set hlbj \u2566 ;# (ttj) + } + double-light { + #no corner joins treat corners like 'other' + set blc \u2560 ;# (ltj) + set brc \u2563 ;# (rtj) + + set hlbj \u2566 ;# (ttj) + set vllj \u2562 ;# light left (rtj) + } double-other { set blc \u2560 ;# (ltj) set brc \u2563 ;# (rtj) #leave tlc as ordinary double corner } + light-double { + + set vllj \u2563 ;# (rtj) + set hlbj \u2564 ;# light down (ttj) + + } + light-light { + + set vllj \u2562 ;# light left (rtj) + set hlbj \u2564 ;# light down (ttj) + } + other-light { + set vllj \u2562 ;# light left (rtj) + } other-double { set blc \u2569 ;# (btj) #leave brc as ordinary double corner @@ -2778,6 +3537,7 @@ namespace eval textblock { set blc \u2560 ;# (ltj) set trc \u2566 ;# (ttj) set brc \u256c ;# (fwj) + set hlbj \u2566 ;# (ttj) } double-other { set blc \u2560 ;# (ltj) @@ -2799,6 +3559,8 @@ namespace eval textblock { set brc \u2563 ;# (rtj) set tlc \u2560 ;# (ltj) set trc \u2563 ;# (rtj) + set hltj \u2569 ;# (btj) + set hlbj \u2566 ;# (ttj) } } } @@ -2817,12 +3579,16 @@ namespace eval textblock { set tlc [punk::char::charshort boxd_hvhz] ;# (fwj) set trc [punk::char::charshort boxd_hvl] ;# (rtj) set blc [punk::char::charshort boxd_huhz] ;# (btj) + set hltj \u2569 ;# (btj) + set vllj \u2563 ;# (rtj) } right_up { #10 set tlc [punk::char::charshort boxd_hvr] ;# (ltj) set trc [punk::char::charshort boxd_hvhz] ;# (fwj) set brc [punk::char::charshort boxd_huhz] ;# (btj) + set hltj \u2569 ;# (btj) + set vlrj \u2560 ;# (ltj) } down_left_right { #11 @@ -2830,6 +3596,8 @@ namespace eval textblock { set brc [punk::char::charshort boxd_hvhz] ;# (fwj) set trc [punk::char::charshort boxd_hdhz] ;# (ttj) set tlc [punk::char::charshort boxd_hdhz] ;# (ttj) + set hlbj \u2566 ;# (ttj) + set vlrj \u2560 ;# (ltj) } down_left_up { @@ -2838,6 +3606,8 @@ namespace eval textblock { set blc [punk::char::charshort boxd_hvhz] ;# (fwj) set trc [punk::char::charshort boxd_hvl] ;# (rtj) set brc [punk::char::charshort boxd_hvl] ;# (rtj) + set hltj \u2569 ;# (btj) + set hlbj \u2566 ;# (ttj) } down_right_up { @@ -2846,6 +3616,8 @@ namespace eval textblock { set blc [punk::char::charshort boxd_hvr] ;# (ltj) set trc [punk::char::charshort boxd_hvhz] ;# (fwj) set brc [punk::char::charshort boxd_hvhz] ;# (fwj) + set hltj \u2569 ;# (btj) + set hlbj \u2566 ;# (ttj) } left_right_up { #14 @@ -2853,6 +3625,7 @@ namespace eval textblock { set trc [punk::char::charshort boxd_hvhz] ;# (fwj) set blc [punk::char::charshort boxd_huhz] ;# (btj) set brc [punk::char::charshort boxd_huhz] ;# (btj) + set hltj \u2569 ;# (btj) } down_left_right_up { @@ -2861,6 +3634,8 @@ namespace eval textblock { set blc [punk::char::charshort boxd_hvhz] ;# (fwj) set trc [punk::char::charshort boxd_hvhz] ;# (fwj) set brc [punk::char::charshort boxd_hvhz] ;# (fwj) + set hltj \u2569 ;# (btj) + set hlbj \u2566 ;# (ttj) } } @@ -2880,6 +3655,12 @@ namespace eval textblock { set blc [punk::char::charshort boxd_laur] ;#light arc up and right \U2570 set brc [punk::char::charshort boxd_laul] ;#light arc up and left \U256F + #horizontal and vertical bar joins + set hltj $hlt + set hlbj $hlb + set vllj $vll + set vlrj $vlr + #set targetdown,targetleft,targetright,targetup vars #default empty targets to current box type 'arc' foreach dir {down left right up} { @@ -2971,6 +3752,12 @@ namespace eval textblock { set blc \u2594 ;# upper one eighth block set brc \u2594 ;# upper one eight block + #horizontal and vertical bar joins + set hltj $hlt + set hlbj $hlb + set vllj $vll + set vlrj $vlr + } blockxx { set hlt \u2594 ;# upper one eighth block @@ -2984,6 +3771,12 @@ namespace eval textblock { set blc \u2595 ;# right one eighth block set brc \u258f ;# left one eighth block + #horizontal and vertical bar joins + set hltj $hlt + set hlbj $hlb + set vllj $vll + set vlrj $vlr + } block { set hlt \u2580 ;#upper half @@ -2995,9 +3788,18 @@ namespace eval textblock { set trc \u259c set blc \u2599 set brc \u259f + + #horizontal and vertical bar joins + set hltj $hlt + set hlbj $hlb + set vllj $vll + set vlrj $vlr } - custom { + default { + set default_custom [dict create hl " " vl " " tlc " " trc " " blc " " brc " "] + set custom_frame [dict merge $default_custom $f] dict with custom_frame {} ;#extract keys as vars + if {[dict exists $custom_frame hlt]} { set hlt [dict get $custom_frame hlt] } else { @@ -3019,12 +3821,264 @@ namespace eval textblock { } else { set vlr $vl } + #horizontal and vertical bar joins + set hltj $hlt + set hlbj $hlb + set vllj $vll + set vlrj $vlr + } + } + return [dict create\ + tlc $tlc hlt $hlt trc $trc\ + vll $vll vlr $vlr\ + blc $blc hlb $hlb brc $brc\ + hltj $hltj\ + hlbj $hlbj\ + vllj $vllj\ + vlrj $vlrj\ + ] + } + proc frame {args} { + variable frametypes + set expect_optval 0 + set argposn 0 + set pmax [expr {[llength $args]-1}] + set has_contents 0 ;#differentiate between empty string and no content supplied + set contents "" + set arglist [list] + foreach a $args { + if {!$expect_optval} { + if {$argposn < $pmax} { + if {[string match -* $a]} { + set expect_optval 1 + lappend arglist $a + } else { + error "textblock::frame expects -option pairs" + } + } else { + set has_contents 1 + set contents $a + } + } else { + lappend arglist $a + set expect_optval 0 + } + incr argposn + } + #set contents [lindex $args end] + #set arglist [lrange $args 0 end-1] + if {[llength $arglist] % 2 != 0} { + error "Usage frame ?-type unicode|altg|ascii|? ?-title ? ?-subtitle ? ?-width ? ?-ansiborder ? ?-boxlimits hl|hlt|hlb|vl|vll|vlr|tlc|blc|brc? ?-joins left|right|up|down? " + } + #todo args -justify left|centre|right (center) + + set defaults [dict create\ + -etabs 0\ + -type light\ + -boxlimits [list hl vl tlc blc trc brc]\ + -boxmap {}\ + -joins [list]\ + -title ""\ + -subtitle ""\ + -width ""\ + -height ""\ + -ansiborder ""\ + -ansibase ""\ + -align "left"\ + -ellipsis 1\ + ] + 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 {} + default { + error "frame option '$k' not understood. Valid options are [dict keys $defaults]" + } + } + } + # -- --- --- --- --- --- + set opt_etabs [dict get $opts -etabs] + set opt_type [dict get $opts -type] + set opt_boxlimits [dict get $opts -boxlimits] + set opt_joins [dict get $opts -joins] + set opt_boxmap [dict get $opts -boxmap] + set custom_keys [list hl hlt hlb vl vll vlr tlc trc blc brc] + set known_frametypes $frametypes ;# light, heavey etc as defined in textblock::frametypes variable + set default_custom [dict create hl " " vl " " tlc " " trc " " blc " " brc " "] + lassign [textblock::frametype $opt_type] _cat category _type ftype + if {$category eq "custom"} { + set custom_frame $ftype + set frameset "custom" + set framedef $custom_frame + } else { + #category = predefined + set frameset $ftype ;# light,heavy etc + set framedef $ftype + } + + set is_boxlimits_ok 1 + set exact_boxlimits [list] + foreach v $opt_boxlimits { + switch -- $v { + hl { + lappend exact_boxlimits hlt hlb + } + vl { + lappend exact_boxlimits vll vlr + } + hlt - hlb - vll - vlr - tlc - trc - blc - brc { + lappend exact_boxlimits $v + } + default { + #k not in custom_keys + set is_boxlimits_ok 0 + break + } } } + if {!$is_boxlimits_ok} { + error "frame option -boxlimits '$opt_boxlimits' must contain only values from the set: hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc" + } + set exact_boxlimits [lsort -unique $exact_boxlimits] + + set is_joins_ok 1 + foreach v $opt_joins { + lassign [split $v -] direction target + switch -- $direction { + left - right - up - down {} + default { + set is_joins_ok 0 + break + } + } + switch -- $target { + "" - light - heavy - ascii - altg - arc - double - custom - block - block1 {} + default { + set is_joins_ok 0 + break + } + } + } + if {!$is_joins_ok} { + error "frame option -joins '$opt_joins' must contain only values from the set: left,right,up,down with targets heavy,light,ascii,altg,arc,double,block,block1,custom e.g down-light" + } + set is_boxmap_ok 1 + dict for {boxelement subst} $opt_boxmap { + switch -- $boxelement { + hl - hlt - hlb - vl - vll - vlr - tlc - trc - blc - brc {} + default { + set is_boxmap_ok 0 + break + } + } + } + if {!$is_boxmap_ok} { + error "frame option -boxmap '$opt_boxmap' must contain only keys from the set: hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc" + } + + #sorted order down left right up + #1 x choose 4 + #4 x choose 3 + #6 x choose 2 + #4 x choose 1 + #15 combos + + set join_directions [list] + #targets - light,heavy (double?) - seem to be some required glyphs missing from unicode + #e.g down-light, up-heavy + set join_targets [dict create left "" down "" right "" up ""] + foreach jt $opt_joins { + lassign [split $jt -] direction target + if {$target ne ""} { + dict set join_targets $direction $target + } + lappend join_directions $direction + } + set join_directions [lsort -unique $join_directions] + set do_joins [::join $join_directions _] + + + # -- --- --- --- --- --- + set opt_title [dict get $opts -title] + set opt_subtitle [dict get $opts -subtitle] + 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 { + left - right - centre - center {} + default { + error "frame option -align must be left|right|centre|center - received: $$opt_align" + } + } + #these are all valid commands for overtype:: + # -- --- --- --- --- --- + set opt_ansiborder [dict get $opts -ansiborder] + set opt_ansibase [dict get $opts -ansibase] ;#experimental + set opt_ellipsis [dict get $opts -ellipsis] + # -- --- --- --- --- --- + + if {$has_contents} { + if {[string last \t $contents] >= 0} { + if {[info exists punk::console::tabwidth]} { + set tw $::punk::console::tabwidth + } else { + set tw 8 + } + if {$opt_etabs} { + set contents [textutil::tabify::untabify2 $contents $tw] + } + } + set contents [string map [list \r\n \n] $contents] + set actual_contentwidth [textblock::width $contents] + set actual_contentheight [textblock::height $contents] + } else { + set actual_contentwidth 0 + set actual_contentheight 0 + } + + if {$opt_title ne ""} { + set titlewidth [punk::ansi::printing_length $opt_title] + set content_or_title_width [expr {max($actual_contentwidth,$titlewidth)}] + } else { + set titlewith 0 + set content_or_title_width $actual_contentwidth + } + + if {$opt_width eq ""} { + set contentwidth $content_or_title_width + } else { + set contentwidth [expr {max(0,$opt_width - 2)}] ;#default + } + + if {$opt_height eq ""} { + set contentheight $actual_contentheight + } else { + set contentheight [expr {max(0,$opt_height -2)}] ;#default + } + if {$contentheight == 0 && $contentwidth == 0} { + set has_contents 0 + } + + #todo - render it with vertical overflow so we can process ansi moves? + #set linecount [textblock::height $contents] + set linecount $contentheight + set rst [a] + #set column [string repeat " " $contentwidth] ;#default - may need to override for custom frame + set underlayline [string repeat " " $contentwidth] + set underlay [::join [lrepeat $linecount $underlayline] \n] + + set vll_width 1 ;#default for all except custom (printing width) + set vlr_width 1 + + set framedef [textblock::framedef $framedef $opt_joins] + dict with framedef {} ;#extract vll,hlt,tlc etc vars + #puts "---> $opt_boxmap" dict for {boxelement sub} $opt_boxmap { if {$boxelement eq "vl"} { set vll $sub @@ -3233,6 +4287,7 @@ namespace eval textblock { set topborder 1 } set fs "" + #todo - output nothing except maybe newlines depending on if opt_height 0 and/or opt_width 0? if {$topborder} { if {$leftborder && $rightborder} { append fs $tlc$topbar$trc @@ -3247,7 +4302,10 @@ namespace eval textblock { } } if {$has_contents || $opt_height > 2} { - if {$topborder && $fs ne ""} { + #if {$topborder && $fs ne "xx"} { + # append fs \n + #} + if {$topborder} { append fs \n } #set inner [overtype::$opt_align -ellipsis $opt_ellipsis $opt_ansibase$underlay$rstbase $opt_ansibase$contents$rstbase] @@ -3273,7 +4331,7 @@ namespace eval textblock { set bottomborder 1 } if {$bottomborder} { - if {($topborder & $fs ne "" ) || ($has_contents || $opt_height > 2)} { + if {($topborder & $fs ne "xx" ) || ($has_contents || $opt_height > 2)} { append fs \n } if {$leftborder && $rightborder} { diff --git a/src/modules/punk-0.1.tm b/src/modules/punk-0.1.tm index e10ba7f..2cb6c91 100644 --- a/src/modules/punk-0.1.tm +++ b/src/modules/punk-0.1.tm @@ -7056,7 +7056,7 @@ namespace eval punk { ] set t [textblock::class::table new -show_seps 0] - $t add_column -header "Topic" + $t add_column -headers [list "Topic"] $t add_column foreach {k v} $topics { $t add_row [list $k $v] @@ -7216,17 +7216,6 @@ namespace eval punk { interp alias {} a? {} punk::console::code_a? - proc dict_getdef {dictValue args} { - if {[llength $args] < 2} { - error {wrong # args: should be "dict_getdef dictValue ?key ...? key default"} - } - set keys [lrange $args 0 end-1] - if {[dict exists $dictValue {*}$keys]} { - return [dict get $dictValue {*}$keys] - } else { - return [lindex $args end] - } - } diff --git a/src/modules/punk/lib-999999.0a1.0.tm b/src/modules/punk/lib-999999.0a1.0.tm index 52fc4ab..00218d0 100644 --- a/src/modules/punk/lib-999999.0a1.0.tm +++ b/src/modules/punk/lib-999999.0a1.0.tm @@ -197,6 +197,17 @@ namespace eval punk::lib { #[list_begin definitions] + proc dict_getdef {dictValue args} { + if {[llength $args] < 1} { + error {wrong # args: should be "dict_getdef dictValue ?key ...? key default"} + } + set keys [lrange $args -1 end-1] + if {[dict exists $dictValue {*}$keys]} { + return [dict get $dictValue {*}$keys] + } else { + return [lindex $args end] + } + } #proc sample1 {p1 n args} { # #*** !doctools diff --git a/src/modules/textblock-999999.0a1.0.tm b/src/modules/textblock-999999.0a1.0.tm index 51dcc4e..17bc244 100644 --- a/src/modules/textblock-999999.0a1.0.tm +++ b/src/modules/textblock-999999.0a1.0.tm @@ -90,11 +90,11 @@ namespace eval textblock { middleleft [struct::set intersect $L $lefts]\ middleinner [list]\ middleright [struct::set intersect $U $rights]\ - middlesolo [struct::set intersect $U [concat $lefts $bottoms $rights]]\ - bottomleft [struct::set intersect $L [concat $lefts]]\ - bottominner [list]\ - bottomright [struct::set intersect $U $rights]\ - bottomsolo [struct::set intersect $U [concat $lefts $rights]]\ + middlesolo [struct::set intersect $U [concat $lefts $rights]]\ + bottomleft [struct::set intersect $L [concat $lefts $bottoms]]\ + bottominner [struct::set intersect $L $bottoms]\ + bottomright [struct::set intersect $U [concat $bottoms $rights]]\ + bottomsolo [struct::set intersect $U [concat $lefts $bottoms $rights]]\ onlyleft [struct::set intersect $C [concat $tops $lefts $bottoms]]\ onlyinner [struct::set intersect $C [concat $tops $bottoms]]\ onlyright [struct::set intersect $O [concat $tops $bottoms $rights]]\ @@ -112,7 +112,7 @@ namespace eval textblock { middleleft [struct::set intersect $L $lefts]\ middleinner [list]\ middleright [struct::set intersect $U $rights]\ - middlesolo [struct::set intersect $U [concat $lefts $bottoms $rights]]\ + middlesolo [struct::set intersect $U [concat $lefts $rights]]\ bottomleft [struct::set intersect $L [concat $lefts]]\ bottominner [list]\ bottomright [struct::set intersect $U $rights]\ @@ -219,6 +219,9 @@ namespace eval textblock { variable o_columndefs variable o_columndata + variable o_columnstates + variable o_headerstates + variable o_rowdefs variable o_rowstates @@ -247,6 +250,8 @@ namespace eval textblock { my configure {*}[dict merge $o_opts_table_defaults $args] set o_columndefs [dict create] set o_columndata [dict create] ;#we store data by column even though it is often added row by row + set o_columnstates [dict create] ;#store the maxwidthbodyseen as we add rows and maxwidthheaderseen as we add headers - it is needed often and expensive to calculate repeatedly + set o_headerstates [dict create] 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 @@ -534,6 +539,8 @@ namespace eval textblock { } } } + #ansireset exception + dict set o_opts_table -ansireset [dict get $o_opts_table_effective -ansireset] return $o_opts_table } @@ -544,7 +551,7 @@ namespace eval textblock { set table_colcount [my column_count] if {$table_colcount == 0} { for {set c 0} {$c < $matrix_colcount} {incr c} { - my add_column -header "" + my add_column -headers "" } } set table_colcount [my column_count] @@ -576,8 +583,10 @@ namespace eval textblock { #*** !doctools #[call class::table [method add_column] [arg args]] set defaults [dict create\ - -header ""\ - -footer ""\ + -headers [list]\ + -header_colspans [list]\ + -footers [list]\ + -defaultvalue ""\ -ansibase ""\ -ansireset "\uFFEF"\ -minwidth ""\ @@ -598,14 +607,25 @@ namespace eval textblock { dict set o_columndata $colcount [list] dict set o_columndefs $colcount $defaults ;#ensure record exists + dict set o_columnstates $colcount [dict create maxwidthbodyseen 0 maxwidthheaderseen 0] if {[catch { my configure_column $colcount {*}$opts } errMsg]} { - #configure failed - ensure o_columndata and o_columdefs entries are removed + #configure failed - ensure o_columndata and o_columndefs entries are removed dict unset o_columndata $colcount dict unset o_columndefs $colcount + dict unset o_columnstates $colcount error "add_column failed to configure with supplied options $opts. Err:\n$errMsg" - } + } + set numrows [my row_count] + if {$numrows > 0} { + #fill column with default values + #puts ">>> adding default values for column $colcount" + set dval [dict get $opts -defaultvalue] + set width [textblock::width $dval] + dict set o_columndata $colcount [lrepeat $numrows $dval] + dict set o_columnstates $colcount [maxwidthbodyseen $width] + } return $colcount } method column_count {} { @@ -628,13 +648,99 @@ namespace eval textblock { } } set checked_opts [list] + set hstates $o_headerstates ;#operate on a copy + set colstate [dict get $o_columnstates $cidx] dict for {k v} $args { switch -- $k { - -header { + -headers { #todo - multiline header - if {[string is integer -strict $v]} { - #review - this is inconvenient - error "textblock::table::configure_column invalid value '$v' -header cannot be an integer" + set i 0 + foreach hdr $v { + set currentmax [my header_height_calc $i $cidx] ;#exclude current column - ie look at heights for this header in all other columns + #set this_header_height [textblock::height $hdr] + lassign [textblock::size $hdr] _w this_header_width _h this_header_height + + if {$this_header_height >= $currentmax} { + dict set hstates $i -maxheight $this_header_height + } else { + dict set hstates $i -maxheight $currentmax + } + if {$this_header_width > [dict get $colstate maxwidthheaderseen]} { + dict set colstate maxwidthheaderseen $this_header_width + } + incr i + } + lappend checked_opts $k $v + } + -header_colspans { + #check columns to left to make sure each new colspan for this column makes sense in the overall context + #user may have to adjust colspans in order left to right to avoid these check errors + #note that 'all' represents span all up to the next non-zero defined colspan. + set cspans [my header_colspans] + set h 0 + if {[llength $v] > [dict size $cspans]} { + error "configure_column $cidx -header_colspans. Only [dict size $cspans] headers exist. Too many values supplied" + } + foreach s $v { + if {$cidx == 0} { + if {[string is integer -strict $s]} { + if {$s < 1} { + error "configure_column $cidx -header_colspans bad first value '$s' for header '$h' . First column cannot have span less than 1. use 'all' or a positive integer" + } + } else { + if {$s ne "all" && $s ne ""} { + error "configure_column $cidx -header_colspans unrecognised value '$s' for header '$h' - must be a positive integer or the keyword 'all'" + } + } + } else { + #if {![string is integer -strict $s]} { + # if {$s ne "all" && $s ne ""} { + # error "configure_column $cidx -header_colspans unrecognised value '$s' for header '$h' - must be a positive integer or the keyword 'all'" + # } + #} else { + set header_spans [dict get $cspans $h] + set remaining [lindex $header_spans 0] + if {$remaining ne "all"} { + incr remaining -1 + } + #look at spans defined for previous cols + #we are presuming previous column entries are valid - and only validating if our new entry is ok under that assumption + for {set c 0} {$c < $cidx} {incr c} { + set span [lindex $header_spans $c] + if {$span eq "all"} { + set remaining "all" + } else { + if {$remaining eq "all"} { + if {$span ne "0"} { + #a previous column has ended the 'all' span + set remaining [expr {$span -1}] + } + } else { + if {$span eq "0"} { + incr remaining -1 + } else { + set remaining [expr {$span -1}] + } + #allow to go negative + } + } + } + if {$remaining eq "all"} { + #any int >0 ok - what about 'all' immediately following all? + } else { + if {$remaining > 0} { + if {$s ne "0" && $s ne ""} { + error "configure_column $cidx -header_colspans bad span $s for header '$h'. Remaining span is '$remaining' - so a zero colspan is required" + } + } else { + if {$s == 0} { + error "configure_column $cidx -header_colspans bad span $s for header '$h'. No span in place - need >=1 or 'all'" + } + } + } + #} + } + incr h } lappend checked_opts $k $v } @@ -665,18 +771,131 @@ namespace eval textblock { } } } + #args checked - ok to update headerstates and columndefs and columnstates + set o_headerstates $hstates + dict set o_columnstates $cidx $colstate set current_opts [dict get $o_columndefs $cidx] set opts [dict merge $current_opts $checked_opts] dict set o_columndefs $cidx $opts + if {"-headers" in [dict keys $args]} { + #if the headerlist length for this column has shrunk,and it was the longest - we may now have excess entries in o_headerstates + set zero_heights [list] + dict for {hidx _v} $o_headerstates { + #pass empty string for exclude_column so we don't exclude our own column + if {[my header_height_calc $hidx ""] == 0} { + lappend zero_heights $hidx + } + } + foreach zidx $zero_heights { + dict unset o_headerstates $zidx + } + } + if {"-headers" in [dict keys $args] || "-header_colspans" in [dict keys $args]} { + #check and adjust header_colspans for all columns + + } + + return [dict get $o_columndefs $cidx] + } + } + + method header_count {} { + return [dict size $o_headerstates] + } + method header_count_calc {} { + set max_headers 0 + dict for {k cdef} $o_columndefs { + set num_headers [llength [dict get $cdef -headers]] + set max_headers [expr {max($max_headers,$num_headers)}] + } + return $max_headers + } + method header_height {header_index} { + set idx [lindex [dict keys $o_headerstates $header_index]] + return [dict get $o_headerstates $idx -maxheight] + } + + #review - use maxwidth (considering colspans) of each column to determine height after wrapping + # -need to consider whether vertical expansion allowed / maxheight? + method header_height_calc {header_index {exclude_column ""}} { + set dataheight 0 + if {$exclude_column eq ""} { + set exclude_colidx "" + } else { + set exclude_colidx [lindex [dict keys $o_columndefs] $exclude_column] + } + dict for {cidx cdef} $o_columndefs { + if {$exclude_colidx == $cidx} { + continue + } + set headerlist [dict get $cdef -headers] + if {$header_index < [llength $headerlist]} { + set this_height [textblock::height [lindex $headerlist $header_index]] + set dataheight [expr {max($dataheight,$this_height)}] + } + } + return $dataheight + } + + #return a dict keyed on header index with values representing colspans + #e.g + # 0 {all 0 0 0} 1 {1 1 1 1} 2 {2 0 1 1} 3 {3 0 0 1} + # + method header_colspans {} { + set num_headers [my header_count_calc] + set colspans_by_header [dict create] + dict for {cidx cdef} $o_columndefs { + set headerlist [dict get $cdef -headers] + set colspans_for_column [dict get $cdef -header_colspans] + for {set h 0} {$h < $num_headers} {incr h} { + set headerspans [punk::lib::dict_getdef $colspans_by_header $h [list]] + set defined_span [lindex $colspans_for_column $h] + set i 0 + set spanremaining [lindex $headerspans 0] + if {$spanremaining ne "all"} { + if {$spanremaining eq ""} { + set spanremaining 1 + } + incr spanremaining -1 + } + foreach s $headerspans { + if {$s eq "all"} { + set spanremaining "all" + } elseif {$s == 0} { + if {$spanremaining ne "all"} { + incr spanremaining -1 + } + } else { + set spanremaining [expr {$s - 1}] + } + incr i + } + if {$defined_span eq ""} { + if {$spanremaining eq "0"} { + lappend headerspans 1 + } else { + #"all" or an integer + lappend headerspans 0 + } + } else { + lappend headerspans $defined_span + } + dict set colspans_by_header $h $headerspans + } } + return $colspans_by_header } method add_row {valuelist args} { #*** !doctools #[call class::table [method add_row] [arg args]] - if {[dict size $o_columndefs] > 0 && ([llength $valuelist] != [dict size $o_columndefs])} { - error "invalid number of values in row - Must match existing column count: [dict size $o_columndefs]" + if {[dict size $o_columndefs] > 0 && ([llength $valuelist] && [llength $valuelist] != [dict size $o_columndefs])} { + error "add_row - invalid number of values in row - Must match existing column count: [dict size $o_columndefs]" + } + if {[dict size $o_columndefs] == 0 && ![llength $valuelist]} { + error "add_row - no values supplied, and no columns defined, so cannot use default column values" } + set defaults [dict create\ -minheight 1\ -maxheight ""\ @@ -698,6 +917,22 @@ namespace eval textblock { } set opts [dict merge $defaults $args] + set auto_columns 0 + if {[dict size $o_columndefs] == 0} { + set auto_columns 1 + #no columns defined - auto define with defaults for each column in first supplied row + #auto define columns only valid if no existing columns + #the autocolumns must be added before configure_row - but if configure_row fails - we need to remove them! + foreach el $valuelist { + my add_column + } + } else { + if {![llength $valuelist]} { + dict for {k coldef} $o_columndefs { + lappend valuelist [dict get $coldef -defaultvalue] + } + } + } set rowcount [dict size $o_rowdefs] dict set o_rowdefs $rowcount $defaults ;# ensure record exists before configure @@ -706,15 +941,14 @@ namespace eval textblock { } errMsg]} { #undo anything we saved before configure_row dict unset o_rowdefs $rowcount + #remove auto_columns + if {$auto_columns} { + set o_columndata [dict create] + set o_columndefs [dict create] + } error "add_row failed to configure with supplied options $opts. Err:\n$errMsg" } - if {[dict size $o_columndefs] == 0} { - #no columns defined - auto define with defaults for each column in first supplied row - foreach el $valuelist { - my add_column - } - } set c 0 @@ -725,6 +959,10 @@ namespace eval textblock { if {$valheight > $max_height_seen} { set max_height_seen $valheight } + set width [textblock::width $v] + if {$width > [dict get $o_columnstates $c maxwidthbodyseen]} { + dict set o_columnstates $c maxwidthbodyseen $width + } incr c } set opt_maxh [dict get $o_rowdefs $rowcount -maxheight] @@ -733,6 +971,8 @@ namespace eval textblock { } else { dict set o_rowstates $rowcount -maxheight $max_height_seen } + + return $rowcount } method configure_row {index_expression args} { set ridx [lindex [dict keys $o_rowdefs] $index_expression] @@ -810,12 +1050,14 @@ namespace eval textblock { #The data values are stored by column regardless of whether added row by row dict for {cidx records} $o_columndata { dict set o_columndata $cidx [list] + dict set o_columnstates $cidx [dict create maxbodywidthseen 0 maxheaderwidthseen 0] } } method clear {} { my row_clear - set o_columndefs [dict create] - set o_columndata [dict create] + set o_columndefs [dict create] + set o_columndata [dict create] + set o_columnstates [dict create] } method Get_columns_by_name {namematch_list} { @@ -832,35 +1074,86 @@ namespace eval textblock { } } } + method Get_boxlimits_and_joins {position fname_body} { + #fname_body will be "custom" or one of the predefined types light,heavy etc + switch -- $position { + left { + #set header_boxlimits {hlb hlt tlc blc vll} + set header_body_joins [list down-$fname_body] + set boxlimits_position {hlb blc vll} + set boxlimits_toprow [concat $boxlimits_position {hlt tlc}] + set joins {down} + } + inner { + #set header_boxlimits {hlb hlt tlc blc vll} + set header_body_joins [list left down-$fname_body] + set boxlimits_position {hlb blc vll} + set boxlimits_toprow [concat $boxlimits_position {hlt tlc}] + set joins {down left} + } + right { + #set header_boxlimits {hlb hlt tlc blc vll vlr trc brc} + set header_body_joins [list left down-$fname_body] + set boxlimits_position {hlb blc vll vlr brc} + set boxlimits_toprow [concat $boxlimits_position {hlt tlc trc}] + set joins {down left} + } + solo { + #set header_boxlimits {hlb hlt tlc blc vll vlr trc brc} + set header_body_joins [list down-$fname_body] + set boxlimits_position {hlb blc vll vlr brc} + set boxlimits_toprow [concat $boxlimits_position {hlt tlc trc}] + set joins {down} + } + } + return [dict create boxlimits $boxlimits_position boxlimits_top $boxlimits_toprow joins $joins bodyjoins $header_body_joins ] + } method get_column_by_index {index_expression args} { #index_expression may be something like end-1 or 2+2 - we can't directly use it as a lookup for dicts. set defaults [dict create\ - -positiontype "inner"\ + -position "inner"\ + -return "string"\ ] - set valid_positiontypes [list left inner right solo] dict for {k v} $args { - if {$k ni [dict keys $defaults]} { - error "[namespace::current]::table::get_column_by_index error invalid option '$k'. Known options [dict keys $defaults]" + switch -- $k { + -position - -return {} + default { + error "[namespace current]::table::get_column_by_index error invalid option '$k'. Known options [dict keys $defaults]" + } } } - set opts [dict merge $defaults $args] - set opt_posn [dict get $opts -positiontype] + set opts [dict merge $defaults $args] + set opt_posn [dict get $opts -position] + set opt_return [dict get $opts -return] - if {$opt_posn ni $valid_positiontypes} { - error "[namespace::current]::table::get_column_by_index error invalid value '$opt_posn' for -positiontype. Valid values $valid_positiontypes" + set valid_positions [list left inner right solo] + switch -- $opt_posn { + left - inner - right - solo {} + default { + error "[namespace current]::table::get_column_by_index error invalid value '$opt_posn' for -position. Valid values: $valid_positions" + } + } + switch -- $opt_return { + string - dict {} + default { + error "[namespace current]::table::get_column_by_index error invalid value '$opt_return' for -return. Valid values: string dict" + } } set columninfo [my get_column_cells_by_index $index_expression] - set header [dict get $columninfo header] + set header_list [dict get $columninfo headers] + #puts "===== header_list: $header_list" set cells [dict get $columninfo cells] - set columninfo [my get_column_cells_by_index $index_expression] set topt_show_header [dict get $o_opts_table -show_header] if {$topt_show_header eq ""} { set allheaders "" set all_cols [dict keys $o_columndefs] foreach c $all_cols { - append allheaders [dict get $o_columndefs $c -header] + set headerset [dict get $o_columndefs $c -headers] + foreach hdr $headerset { + append allheaders $hdr + } } if {$allheaders eq ""} { set do_show_header 0 @@ -873,79 +1166,85 @@ namespace eval textblock { set topt_show_footer [dict get $o_opts_table -show_footer] - set ftypes [my Get_frametypes] set output "" + set part_header "" + set part_body "" + set part_footer "" + set boxlimits "" set joins "" set header_boxlimits [list] - set header_joins [list] + set header_body_joins [list] + + + set ftypes [my Get_frametypes] set ftype_body [dict get $ftypes body] if {[llength $ftype_body] >= 2} { - set ftype_body "custom" + set fname_body "custom" + } else { + set fname_body $ftype_body + } + set ftype_header [dict get $ftypes header] + if {[llength $ftype_header] >= 2} { + set fname_header "custom" + } else { + set fname_header $ftype_header } + switch -- $opt_posn { left { - set header_boxlimits {hlb hlt tlc blc vll} - set header_joins [list down-$ftype_body] + #set header_boxlimits {hlb hlt tlc blc vll} + set header_body_joins [list down-$fname_body] set boxlimits_position {hlb blc vll} - set boxlimits_headerless [concat $boxlimits_position {hlt tlc}] + set boxlimits_toprow [concat $boxlimits_position {hlt tlc}] set joins {down} } inner { - set header_boxlimits {hlb hlt tlc blc vll} - set header_joins [list left down-$ftype_body] + #set header_boxlimits {hlb hlt tlc blc vll} + set header_body_joins [list left down-$fname_body] set boxlimits_position {hlb blc vll} - set boxlimits_headerless [concat $boxlimits_position {hlt tlc}] + set boxlimits_toprow [concat $boxlimits_position {hlt tlc}] set joins {down left} } right { - set header_boxlimits {hlb hlt tlc blc vll vlr trc brc} - set header_joins [list left down-$ftype_body] + #set header_boxlimits {hlb hlt tlc blc vll vlr trc brc} + set header_body_joins [list left down-$fname_body] set boxlimits_position {hlb blc vll vlr brc} - set boxlimits_headerless [concat $boxlimits_position {hlt tlc trc}] + set boxlimits_toprow [concat $boxlimits_position {hlt tlc trc}] set joins {down left} } solo { - set header_boxlimits {hlb hlt tlc blc vll vlr trc brc} - set header_joins [list down-$ftype_body] + #set header_boxlimits {hlb hlt tlc blc vll vlr trc brc} + set header_body_joins [list down-$fname_body] set boxlimits_position {hlb blc vll vlr brc} - set boxlimits_headerless [concat $boxlimits_position {hlt tlc trc}] + set boxlimits_toprow [concat $boxlimits_position {hlt tlc trc}] set joins {down} } } + set limj [my Get_boxlimits_and_joins $opt_posn $fname_body] + set header_body_joins [dict get $limj bodyjoins] + set joins [dict get $limj joins] + set boxlimits_position [dict get $limj boxlimits] + set boxlimits_toprow [dict get $limj boxlimits_top] #use struct::set instead of simple for loop - will be faster at least when critcl available set boxlimits [struct::set intersect [dict get $o_opts_table_effective -framelimits_body] $boxlimits_position] - set boxlimits_headerless [struct::set intersect [dict get $o_opts_table_effective -framelimits_body] $boxlimits_headerless] - set header_boxlimits [struct::set intersect [dict get $o_opts_table_effective -framelimits_header] $header_boxlimits] - - #upvar ::textblock::class::opts_table_defaults tdefaults - #set default_bmap [dict get $tdefaults -framemap_body] - #set default_hmap [dict get $tdefaults -framemap_header] - #set fmap $default_bmap - #set hmap $default_hmap - #dict for {k v} $fmap { - # if {[dict exists $o_opts_table -framemap_body $k]} { - # dict set fmap $k [dict merge $v [dict get $o_opts_table -framemap_body $k]] - # } - #} - #dict for {k v} $hmap { - # if {[dict exists $o_opts_table -framemap_header $k]} { - # dict set hmap $k [dict merge $v [dict get $o_opts_table -framemap_header $k]] - # } - #} + set boxlimits_headerless [struct::set intersect [dict get $o_opts_table_effective -framelimits_body] $boxlimits_toprow] + set header_boxlimits [struct::set intersect [dict get $o_opts_table_effective -framelimits_header] $boxlimits_position] + set header_boxlimits_toprow [struct::set intersect [dict get $o_opts_table_effective -framelimits_header] $boxlimits_toprow] + set fmap [dict get $o_opts_table_effective -framemap_body] set hmap [dict get $o_opts_table_effective -framemap_header] - if {![dict get $o_opts_table -show_edge]} { - set body_edgemap [textblock::class::table_edge_map ""] - dict for {k v} $fmap { - dict set fmap $k [dict merge $v [dict get $body_edgemap $k]] - } - set header_edgemap [textblock::class::header_edge_map ""] - dict for {k v} $hmap { - dict set hmap $k [dict merge $v [dict get $header_edgemap $k]] - } - } + #if {![dict get $o_opts_table -show_edge]} { + # set body_edgemap [textblock::class::table_edge_map ""] + # dict for {k v} $fmap { + # #dict set fmap $k [dict merge $v [dict get $body_edgemap $k]] + # } + # set header_edgemap [textblock::class::header_edge_map ""] + # dict for {k v} $hmap { + # #dict set hmap $k [dict merge $v [dict get $header_edgemap $k]] + # } + #} set sep_elements_horizontal $::textblock::class::table_hseps set sep_elements_vertical $::textblock::class::table_vseps @@ -966,7 +1265,8 @@ namespace eval textblock { 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 if {$do_show_header} { #puts "boxlimitsinfo header $opt_posn: -- boxlimits $header_boxlimits -- boxmap $hdrmap" set ansibase_header [dict get $o_opts_table -ansibase_header] @@ -981,30 +1281,239 @@ namespace eval textblock { set RST [a] set colwidth [my column_width $cidx] set hcell_line_blank [string repeat " " $colwidth] - set hval $ansibase_header$header ;#no reset - set rowh 1 ;#todo - set h_lines [lrepeat $rowh $hcell_line_blank] - set hcell_blank [join $h_lines \n] - - set hval_lines [split $hval \n] - set hval_lines [lrange $hval_lines 0 $rowh-1] - set hval_block [join $hval_lines \n] - set headercell [overtype::left -experimental test_mode $ansibase_header$hcell_blank$RST $hval_block] - - set hlims $header_boxlimits - if {!$show_seps_v} { - set hlims [struct::set difference $header_boxlimits $headerseps_v] - } - #todo - multiline header cells + multiple header lines (will be more useful when colspans implemented) - set header_frame [textblock::frame -width [expr {$colwidth+2}] -type [dict get $ftypes header]\ - -ansibase $ansibase_header -ansiborder $ansiborder_final\ - -boxlimits $hlims -boxmap $hdrmap -joins $header_joins $hval\ + + set h 0 + set hmax [expr {[llength $header_list] -1}] + set all_colspans [my header_colspans] + + #default span_extend_map - used as base to customise with specific joins + set fdef_header [textblock::framedef $ftype_header] + set span_extend_map [dict create \ + vll " "\ + tlc [dict get $fdef_header hlt]\ + blc [dict get $fdef_header hlb]\ ] - - #puts ">> '[ansistring VIEW $hval]' -> $header_frame" + set framedef_leftbox [textblock::framedef $ftype_header left] + + set column_body_width_cache [dict create] + + + foreach header $header_list { + set headerspans [dict get $all_colspans $h] + set this_span [lindex $headerspans $cidx] + set hval $ansibase_header$header ;#no reset + set rowh [my header_height $h] + + #set h_lines [lrepeat $rowh $hcell_line_blank] + #set hcell_blank [join $h_lines \n] + #set hval_lines [split $hval \n] + #set hval_lines [lrange $hval_lines 0 $rowh-1] + #set hval_block [join $hval_lines \n] + #set headercell [overtype::left -experimental test_mode $ansibase_header$hcell_blank$RST $hval_block] + + if {$h == 0} { + set hlims $header_boxlimits_toprow + set rowpos "top" + if {$h == $hmax} { + set rowpos "only" + } + } else { + set hlims $header_boxlimits + set rowpos "middle" + if {$h == $hmax} { + set rowpos "bottom" + } + } + if {!$show_seps_v} { + set hlims [struct::set difference $hlims $headerseps_v] + } + if {$h == $hmax} { + set header_joins $header_body_joins + } else { + set header_joins $joins + } + if {![dict get $o_opts_table -show_edge]} { + set hlims [struct::set difference $hlims [dict get $::textblock::class::header_edge_parts $rowpos$opt_posn] ] + } + #puts ">>> headerspans: $headerspans cidx: $cidx" + if {$this_span eq "all" || $this_span > 0} { + + + set startmap [dict get $hmap $rowpos${opt_posn}] + #look at spans in header below to determine joins required at blc + if {$show_seps_v} { + if {[dict exists $all_colspans [expr {$h+1}]]} { + set next_spanlist [dict get $all_colspans [expr {$h+1}]] + set spanbelow [lindex $next_spanlist $cidx] + if {$spanbelow == 0} { + #we don't want a down-join for blc - retrieve a framedef with only left joins + dict set startmap blc [dict get $framedef_leftbox blc] + } + } else { + set next_spanlist [list] + } + } + + #todo - multiline header cells + multiple header lines (will be more useful when colspans implemented) + set header_cell_startspan [textblock::frame -width [expr {$colwidth+2}] -type [dict get $ftypes header]\ + -ansibase $ansibase_header -ansiborder $ansiborder_final\ + -boxlimits $hlims -boxmap $startmap -joins $header_joins $hval\ + ] + set spanned_parts [list $header_cell_startspan] + + if {$this_span ne "1"} { + #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 last [expr {[llength $remaining_spans] -1}] + set i 0 + foreach s $remaining_spans { + if {$s == 0} { + if {$i == $last} { + set next_posn right + #set next_posn inner + } else { + set next_posn inner + } + + set limj [my Get_boxlimits_and_joins $next_posn $fname_body] + set span_joins_body [dict get $limj bodyjoins] + set span_joins [dict get $limj joins] + set span_boxlimits [dict get $limj boxlimits] + set span_boxlimits_top [dict get $limj boxlimits_top] + #use struct::set instead of simple for loop - will be faster at least when critcl available + #set span_boxlimits [struct::set intersect [dict get $o_opts_table_effective -framelimits_body] $span_boxlimits] + #set span_boxlimits_top [struct::set intersect [dict get $o_opts_table_effective -framelimits_body] $span_boxlimits_top] + set header_span_boxlimits [struct::set intersect [dict get $o_opts_table_effective -framelimits_header] $span_boxlimits] + set header_span_boxlimits_top [struct::set intersect [dict get $o_opts_table_effective -framelimits_header] $span_boxlimits_top] + if {$h == 0} { + set hlims $header_span_boxlimits_top + } else { + set hlims $header_span_boxlimits + } + + set this_span_map $span_extend_map + if {!$show_seps_v} { + set hlims [struct::set difference $hlims $headerseps_v] + } else { + if {[llength $next_spanlist]} { + set spanbelow [lindex $next_spanlist $spancol] + if {$spanbelow != 0} { + set downbox [textblock::framedef $ftype_header {down}] + dict set this_span_map blc [dict get $downbox hlbj] ;#horizontal line bottom with down join - to same frametype + } + } else { + #join to body + set downbox [textblock::framedef $ftype_header [list down-$fname_body]] + dict set this_span_map blc [dict get $downbox hlbj] ;#horizontal line bottom with down join - from header frametype to body frametype + } + } + + if {$h == $hmax} { + set header_joins $span_joins_body + } else { + set header_joins $span_joins + } + if {![dict get $o_opts_table -show_edge]} { + set hlims [struct::set difference $hlims [dict get $::textblock::class::header_edge_parts $rowpos$next_posn] ] + } + + if {![dict exists $column_body_width_cache $spancol]} { + #puts "-----> get_column_by_index $spancol -position $next_posn" + set spancolinfo [my get_column_by_index $spancol -position $next_posn -return dict] + set cwidth [dict get $spancolinfo bodywidth] + dict set column_body_width_cache $spancol $cwidth + } else { + set cwidth [dict get $column_body_width_cache $spancol] + } - append output $header_frame\n + 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 cwidth+1 (vlr extends right beyond table) + #spans at tail end are too short if edges are hidden and we use cwidth (short lower horizontal bar) + if {![dict get $o_opts_table -show_edge]} { + set spanwidth [expr {$cwidth+1}] + } else { + set spanwidth $cwidth + } + } else { + set spanwidth [expr {$cwidth+1}] + } + + set header_cell [textblock::frame -width $spanwidth -type [dict get $ftypes header]\ + -ansibase $ansibase_header -ansiborder $ansiborder_final\ + -boxlimits $hlims -boxmap $this_span_map -joins $header_joins $hcell_blank\ + ] + lappend spanned_parts $header_cell + } else { + break + } + incr spancol + incr i + } + } + set spanned_frame [textblock::join {*}$spanned_parts] + if {$this_span eq "all" || $this_span > 1} { + if {$h == 0} { + set hlims $header_boxlimits_toprow + } else { + set hlims $header_boxlimits + } + if {!$show_seps_v} { + set hlims [struct::set difference $hlims $headerseps_v] + } + if {![dict get $o_opts_table -show_edge]} { + #use the edge_parts corresponding to the column being written to ie use opt_posn + set hlims [struct::set difference $hlims [dict get $::textblock::class::header_edge_parts $rowpos$opt_posn] ] + } + set spacemap [list hl " " vl " " tlc " " blc " " trc " " brc " "] + 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] + } + + + append part_header $spanned_frame + append part_header \n + } else { + set h_lines [lrepeat $rowh ""] + set hcell_blank [join $h_lines \n] + set spacemap [list hl " " vl " " tlc " " blc " " trc " " brc " "] + 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 + } + incr h + } + if {![llength $header_list]} { + #no headers - but we've been asked to show_header + #display a zero content-height header (ie outline if edge is being shown - or bottom bar) + set hlims $header_boxlimits_toprow + if {!$show_seps_v} { + set hlims [struct::set difference $hlims $headerseps_v] + } + if {![dict get $o_opts_table -show_edge]} { + set hlims [struct::set difference $hlims [dict get $::textblock::class::header_edge_parts only$opt_posn] ] + } + set header_joins $header_body_joins + set header_frame [textblock::frame -width [expr {$colwidth+2}] -type [dict get $ftypes header]\ + -ansibase $ansibase_header -ansiborder $ansiborder_final\ + -boxlimits $hlims -boxmap $hdrmap -joins $header_joins\ + ] + append part_header $header_frame\n + } + lassign [textblock::size $part_header] _w return_headerwidth _h return_headerheight } + append output $part_header + set r 0 set rmax [expr {[llength $cells]-1}] @@ -1068,6 +1577,9 @@ namespace eval textblock { } else { set blims $blims_only_headerless } + if {![dict get $o_opts_table -show_edge]} { + set blims [struct::set difference $blims [dict get $::textblock::class::table_edge_parts only$opt_posn] ] + } } else { set bmap $topmap if {$do_show_header} { @@ -1075,18 +1587,29 @@ namespace eval textblock { } else { set blims $blims_top_headerless } + if {![dict get $o_opts_table -show_edge]} { + set blims [struct::set difference $blims [dict get $::textblock::class::table_edge_parts top$opt_posn] ] + } } - append output [textblock::frame -type [dict get $ftypes body] -ansibase $ansibase -ansiborder $border_ansi_final -boxlimits $blims -boxmap $bmap -joins $joins $c]\n + set rowframe [textblock::frame -type [dict get $ftypes body] -ansibase $ansibase -ansiborder $border_ansi_final -boxlimits $blims -boxmap $bmap -joins $joins $c] + set return_bodywidth [textblock::width $rowframe] + append part_body $rowframe \n } else { if {$r == $rmax} { set joins [lremove $joins [lsearch $joins down*]] set bmap $botmap set blims $blims_bot + if {![dict get $o_opts_table -show_edge]} { + set blims [struct::set difference $blims [dict get $::textblock::class::table_edge_parts bottom$opt_posn] ] + } } else { set bmap $midmap set blims $blims_mid ;#will only be reduced from boxlimits if -show_seps was processed above + if {![dict get $o_opts_table -show_edge]} { + set blims [struct::set difference $blims [dict get $::textblock::class::table_edge_parts middle$opt_posn] ] + } } - append output [textblock::frame -type [dict get $ftypes body] -ansibase $ansibase -ansiborder $border_ansi_final -boxlimits $blims -boxmap $bmap -joins $joins $c]\n + append part_body [textblock::frame -type [dict get $ftypes body] -ansibase $ansibase -ansiborder $border_ansi_final -boxlimits $blims -boxmap $bmap -joins $joins $c]\n } incr r } @@ -1097,15 +1620,42 @@ namespace eval textblock { #(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] - #note that if show_edge is 0 - then for this empty line - we will not see any vertical bars - #This is because the frame with no data is made entirely of corner elements + if {$do_show_header} { - append output [textblock::frame -width [expr {$colwidth + 2}] -type [dict get $ftypes body] -boxlimits $blims_only -boxmap $onlymap -joins $joins]\n + set blims $blims_only + } else { + append part_body \n + set blims $blims_only_headerless + } + #note that if show_edge is 0 - then for this empty line - we will not expect to see any bars + #This is because the frame with no data had vertical components made entirely of corner elements + #we could just append a newline when -show_edge is zero, but we want the correct width even when empty - for proper column joins when there are colspanned headers. + # + if {![dict get $o_opts_table -show_edge]} { + #set blims [struct::set difference $blims [dict get $::textblock::class::table_edge_parts only$opt_posn] ] + #append output [textblock::frame -width [expr {$colwidth + 2}] -type [dict get $ftypes body] -boxlimits $blims -boxmap $onlymap -joins $joins]\n + append part_body [string repeat " " $colwidth] \n + set return_bodywidth $colwidth } else { - append output [textblock::frame -width [expr {$colwidth + 2}] -type [dict get $ftypes body] -boxlimits $blims_only_headerless -boxmap $onlymap -joins $joins] \n + set emptyframe [textblock::frame -width [expr {$colwidth + 2}] -type [dict get $ftypes body] -boxlimits $blims -boxmap $onlymap -joins $joins] + append part_body $emptyframe \n + set return_bodywidth [textblock::width $emptyframe] } } - return [string trimright $output \n] + #assert bodywidth is integer >=0 whether there are rows or not + + #trim only 1 newline + if {[string index $part_body end] eq "\n"} { + set part_body [string range $part_body 0 end-1] + } + set return_bodyheight [textblock::height $part_body] + append output $part_body + + if {$opt_return eq "string"} { + return $output + } else { + return [dict create column $output headerwidth $return_headerwidth headerheight $return_headerheight bodywidth $return_bodywidth bodyheight $return_bodyheight] + } } method get_column_cells_by_index {index_expression} { @@ -1121,24 +1671,74 @@ namespace eval textblock { } #assert cidx is integer >=0 set cdef [dict get $o_columndefs $cidx] - set t [dict get $cdef -header] ;#may be empty string - set t_maxdataheight 1 - set items [dict get $o_columndata $cidx] + set headerlist [dict get $cdef -headers] + set num_headers [my header_count] + set RST [punk::ansi::a] set ansibase_body [dict get $o_opts_table -ansibase_body] set ansibase_col [dict get $cdef -ansibase] - set RST [punk::ansi::a] - set colwidth [my column_width $cidx] set ansibase_header [dict get $o_opts_table -ansibase_header] - set cell_line_blank [string repeat " " $colwidth] - set header_underlay $ansibase_header$cell_line_blank + + #set header_underlay $ansibase_header$cell_line_blank + + #set hdrwidth [my column_width_configured $cidx] + set all_colspans [my header_colspans] + + #store configured widths so we don't look up for each header line + set configured_widths [list] + foreach c [dict keys $o_columndefs] { + lappend configured_widths [my column_width_configured $c] + } + set output [dict create] - if {$t ne ""} { - dict set output header [overtype::left -experimental test_mode $header_underlay $ansibase_header$t] - } else { - dict set output header $header_underlay + dict set output headers [list] + for {set i 0} {$i < $num_headers} {incr i} { + set hdr [lindex $headerlist $i] + set header_maxdataheight [my header_height $i] + set header_colspans [dict get $all_colspans $i] + set this_span [lindex $header_colspans $cidx] + set hdrwidth 0 + if {$this_span eq "0"} { + set hdrwidth 0 + } elseif {$this_span eq "all"} { + #all means up to next non-zero + set s "0" + set idx $cidx + while {$s eq "0" && $idx < [llength $header_colspans]} { + incr hdrwidth [lindex $configured_widths $idx] + incr idx + set s [lindex $header_colspans $idx] + } + } else { + set spanned_cols [list] + for {set sc $cidx} {$sc < ($cidx + $this_span)} {incr sc} { + lappend spanned_cols $sc + } + #spanned_cols here includes self + foreach c $spanned_cols { + incr hdrwidth [lindex $configured_widths $c] + } + } + + set hdr_line_blank [string repeat " " $hdrwidth] + 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] + } else { + dict lappend output headers $header_underlay + } } + + + set colwidth [my column_width $cidx] + set cell_line_blank [string repeat " " $colwidth] + + + set items [dict get $o_columndata $cidx] + #puts "---> columndata $o_columndata" + dict set output cells [list];#ensure we return something for cells key if no items in list set r 0 foreach cval $items { @@ -1194,15 +1794,22 @@ namespace eval textblock { return [dict get $o_columndata $cidx] } method debug {} { - puts stdout "rowdefs: $o_rowdefs" - puts stdout "rowstates: $o_rowstates" - puts stdout "columndefs: $o_columndefs" + puts stdout "rowdefs: $o_rowdefs" + puts stdout "rowstates: $o_rowstates" + puts stdout "columndefs: $o_columndefs" + puts stdout "columnstates: $o_columnstates" + puts stdout "headerstates: $o_headerstates" dict for {k coldef} $o_columndefs { if {[dict exists $o_columndata $k]} { - set header [dict get $coldef -header] + set headerlist [dict get $coldef -headers] set coldata [dict get $o_columndata $k] set colinfo "rowcount: [llength $coldata]" - set widest [tcl::mathfunc::max {*}[lmap v [concat [list $header] $coldata] {textblock::width $v}]] + set allfields [concat $headerlist $coldata] + if {[llength $allfields]} { + set widest [tcl::mathfunc::max {*}[lmap v $allfields {textblock::width $v}]] + } else { + set widest 0 + } append colinfo " widest: $widest" } else { set colinfo "WARNING - no columndata record for column key '$k'" @@ -1210,27 +1817,31 @@ namespace eval textblock { puts stdout "column $k columndata info: $colinfo" } } - method column_width {index_expression} { + #column width including headers - but without colspan consideration + method column_width_configured {index_expression} { set cidx [lindex [dict keys $o_columndefs] $index_expression] if {$cidx eq ""} { return } #assert cidx is now >=0 integer within the range of defined columns - set cdef [dict get $o_columndefs $cidx] + set cdef [dict get $o_columndefs $cidx] set defminw [dict get $cdef -minwidth] set defmaxw [dict get $cdef -maxwidth] if {"$defminw$defmaxw" ne "" && $defminw eq $defmaxw} { #an exact width is defined for the column - no need to look at data width set colwidth $defminw } else { - set widest [my column_datawidth $cidx -header 1 -data 1 -footer 1] + #set widest [my column_datawidth $cidx -headers 1 -data 1 -footers 1] + set hwidest [dict get $o_columnstates $cidx maxwidthheaderseen] + 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. #if so - a truncated line shouldn't be included in our width calculation if {$defminw eq ""} { if {$defmaxw eq ""} { set colwidth $widest } else { - set colwidth [expr {min(1,$defmaxw,$widest)}] + set colwidth [expr {min($defmaxw,$widest)}] } } else { if {$defmaxw eq ""} { @@ -1250,47 +1861,176 @@ namespace eval textblock { } return $colwidth } - method column_datawidth {index_expression args} { - set defaults [dict create\ - -header 0\ - -footer 0\ - -data 1\ - ] - dict for {k v} $args { - switch -- $k { - -header - -footer - -data {} - default { - error "column_datawidth unrecognised flag '$k'. Known flags: [dict keys $defaults]" - } - } - } - set opts [dict merge $defaults $args] + #column *body* content width + method column_width {index_expression} { set cidx [lindex [dict keys $o_columndefs] $index_expression] if {$cidx eq ""} { return } - #assert cidx is >=0 integer in valid range of keys for o_columndefs - set values [list] - if {[dict get $opts -header]} { - lappend values [dict get $o_columndefs $cidx -header] - } - if {[dict get $opts -data]} { - if {[dict exists $o_columndata $cidx]} { - lappend values {*}[dict get $o_columndata $cidx] - } - } - if {[dict get $opts -footer]} { - lappend values [dict get $o_columndefs $cidx -footer] - } - if {[llength $values]} { - set widest [tcl::mathfunc::max {*}[lmap v $values {textblock::width $v}]] + #puts "===column_width $index_expression" + #assert cidx is now >=0 integer within the range of defined columns + set cdef [dict get $o_columndefs $cidx] + set defminw [dict get $cdef -minwidth] + set defmaxw [dict get $cdef -maxwidth] + if {"$defminw$defmaxw" ne "" && $defminw eq $defmaxw} { + #an exact width is defined for the column - no need to look at data width + set colwidth $defminw } else { - set widest 0 - } + #set widest [my column_datawidth $cidx -headers 0 -data 1 -footers 0] + set widest [dict get $o_columnstates $cidx maxwidthbodyseen] + #todo - predetermine if any items in column contain newlines and are truncated vertically due to o_rowdefs configuration. + #if so - a truncated line shouldn't be included in our width calculation + if {$defminw eq ""} { + if {$defmaxw eq ""} { + set colwidth $widest + } else { + set colwidth [expr {min($defmaxw,$widest)}] + } + } else { + if {$defmaxw eq ""} { + set colwidth [expr {max($defminw,$widest)}] + } else { + if {$widest < $defminw} { + set colwidth $defminw + } else { + if {$widest > $defmaxw} { + set colwidth $defmaxw + } else { + set colwidth [expr {max($defminw,$widest)}] + } + } + } + } + } + set configured_widths [list] + foreach c [dict keys $o_columndefs] { + lappend configured_widths [my column_width_configured $c] + } + set header_colspans [my header_colspans] + set width_max $colwidth + set test_width $colwidth + set showing_vseps [my Showing_vseps] + dict for {h colspans} $header_colspans { + set spanc [lindex $colspans $cidx] + #set headers [dict get $cdef -headers] + #set thiscol_widest_header 0 + #if {[llength $headers] > 0} { + # set thiscol_widest_header [tcl::mathfunc::max {*}[lmap v $headers {textblock::width $v}]] + #} + set thiscol_widest_header [dict get $o_columnstates $cidx maxwidthheaderseen] + if {$spanc eq "1"} { + if {$thiscol_widest_header > $colwidth} { + set test_width [expr {max($thiscol_widest_header,$colwidth)}] + if {$defmaxw ne ""} { + set test_width [expr {min($colwidth,$defmaxw)}] + } + } + set width_max [expr {max($test_width,$width_max)}] + continue + } + if {$spanc eq "all" || $spanc > 1} { + set spanned [list] ;#spanned is other columns spanned - not including this one + set cnext [expr {$cidx +1}] + set spanlength [lindex $colspans $cnext] + while {$spanlength eq "0" && $cnext < [llength $colspans]} { + lappend spanned $cnext + incr cnext + set spanlength [lindex $colspans $cnext] + } + set others_width 0 + foreach col $spanned { + incr others_width [lindex $configured_widths $col] + if {$showing_vseps} { + incr others_width 1 + } + } + set total_spanned_width [expr {$width_max + $others_width}] + if {$thiscol_widest_header > $total_spanned_width} { + set needed [expr {$thiscol_widest_header - $total_spanned_width}] + #puts "-->>col $cidx needed ($thiscol_widest_header - $total_spanned_width): $needed (spanned $spanned)" + if {$defmaxw ne ""} { + set test_width [expr {min($colwidth+$needed,$defmaxw)}] + } else { + set test_width [expr {$colwidth + $needed}] + } + } + } + set width_max [expr {max($test_width,$width_max)}] + } + + #alternative to all the above shennanigans.. let the body cell data determine the size and just wrap the headers + #could also split the needed width amongst the spanned columns? configurable for whether cells expand? + set expand_first_column 1 + if {$expand_first_column} { + set colwidth $width_max + } + + #puts "---column_width $cidx = $colwidth" + return $colwidth + } + method Showing_vseps {} { + #review - show_seps and override mechanism for show_vseps show_hseps - document. + set seps [dict get $o_opts_table -show_seps] + set vseps [dict get $o_opts_table -show_vseps] + if {$seps eq ""} { + if {$vseps eq "" || $vseps} { + return true + } + } elseif {$seps} { + if {$vseps eq "" || $vseps} { + return true + } + } else { + if {$vseps ne "" && $vseps} { + return true + } + } + return false + } + + method column_datawidth {index_expression args} { + set defaults [dict create\ + -headers 0\ + -footers 0\ + -data 1\ + ] + dict for {k v} $args { + switch -- $k { + -headers - -footers - -data {} + default { + error "column_datawidth unrecognised flag '$k'. Known flags: [dict keys $defaults]" + } + } + } + set opts [dict merge $defaults $args] + + set cidx [lindex [dict keys $o_columndefs] $index_expression] + if {$cidx eq ""} { + return + } + #assert cidx is >=0 integer in valid range of keys for o_columndefs + set values [list] + if {[dict get $opts -headers]} { + lappend values {*}[dict get $o_columndefs $cidx -headers] + } + if {[dict get $opts -data]} { + if {[dict exists $o_columndata $cidx]} { + lappend values {*}[dict get $o_columndata $cidx] + } + } + if {[dict get $opts -footers]} { + lappend values {*}[dict get $o_columndefs $cidx -footers] + } + if {[llength $values]} { + set widest [tcl::mathfunc::max {*}[lmap v $values {textblock::width $v}]] + } else { + set widest 0 + } return $widest } - method print {args} { + #print1 uses basic column joining - useful for testing/debug especially with colspans + method print1 {args} { if {![llength $args]} { set cols [dict keys $o_columndata] } else { @@ -1303,12 +2043,9 @@ namespace eval textblock { error "[namespace::current]::table error invalid print specification '$colspec'" } lassign $parts from _dd to - if {$from eq ""} { - set from 0 - } - if {$to eq ""} { - set to end - } + if {$from eq ""} {set from 0 } + if {$to eq ""} {set to end} + set indices [lrange $allcols $from $to] lappend cols {*}$indices } else { @@ -1325,13 +2062,13 @@ namespace eval textblock { foreach c $cols { set flags [list] if {$colposn == 0 && $colposn == $numposns-1} { - set flags [list -positiontype solo] + set flags [list -position solo] } elseif {$colposn == 0} { - set flags [list -positiontype left] + set flags [list -position left] } elseif {$colposn == $numposns-1} { - set flags [list -positiontype right] + set flags [list -position right] } else { - set flags [list -positiontype inner] + set flags [list -position inner] } lappend blocks [my get_column_by_index $c {*}$flags] incr colposn @@ -1342,6 +2079,71 @@ namespace eval textblock { return "No columns matched" } } + method print {args} { + if {![llength $args]} { + set cols [dict keys $o_columndata] + } else { + set cols [list] + foreach colspec $args { + set allcols [dict keys $o_columndata] + if {[string first .. $colspec] >=0} { + set parts [punk::ansi::ta::_perlish_split {\.\.} $colspec] + if {[llength $parts] != 3} { + error "[namespace::current]::table error invalid print specification '$colspec'" + } + lassign $parts from _dd to + if {$from eq ""} {set from 0} + if {$to eq ""} {set to end} + + set indices [lrange $allcols $from $to] + lappend cols {*}$indices + } else { + set c [lindex $allcols $colspec] + if {$c ne ""} { + lappend cols $c + } + } + } + } + set blocks [list] + set colposn 0 + set numposns [llength $cols] + set padwidth 0 + set table "" + foreach c $cols { + set flags [list] + if {$colposn == 0 && $colposn == $numposns-1} { + set flags [list -position solo] + } elseif {$colposn == 0} { + set flags [list -position left] + } elseif {$colposn == $numposns-1} { + set flags [list -position right] + } else { + set flags [list -position inner] + } + #lappend blocks [my get_column_by_index $c {*}$flags] + set columninfo [my get_column_by_index $c -return dict {*}$flags] + set nextcol [dict get $columninfo column] + set bodywidth [dict get $columninfo bodywidth] + + if {$table eq ""} { + 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 " "] $nextcol] + set table [overtype::left -overflow 1 -experimental test_mode -transparent 1 $table $nextcol] + } + incr padwidth $bodywidth + incr colposn + } + + if {[llength $cols]} { + #return [textblock::join {*}$blocks] + return $table + } else { + return "No columns matched" + } + } #*** !doctools #[list_end] @@ -1364,7 +2166,15 @@ namespace eval textblock { namespace import ::term::ansi::code::macros::cd::* namespace eval ::term::ansi::code::macros::cd {namespace export -clear} } - + proc spantest {} { + 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 5 all 2} + $t configure_column 2 -headers {"" "" "" "" c2span2} + $t configure_column 2 -header_colspans {0 0 0 0 2} + $t configure -show_header 1 -ansiborder_header [a+ cyan] + return $t + } proc list_as_table {table_or_colcount datalist args} { set defaults [dict create\ -return string\ @@ -1400,7 +2210,7 @@ namespace eval textblock { } set t [textblock::class::table new -show_header 0 -show_edge [dict get $opts -show_edge] -frametype [dict get $opts -frametype] -show_seps [dict get $opts -show_seps]] for {set c 0} {$c < $cols} {incr c} { - $t add_column -header c$c + $t add_column -headers [list $c] } } else { if {[namespace tail [info object class $table_or_colcount]] ne "table"} { @@ -1797,7 +2607,9 @@ namespace eval textblock { append out $2frames_a \n set 2frames_b [textblock::join [textblock::frame -ansiborder $cyanb -title "plainpunks" $punks] [textblock::frame -ansiborder $greenb -title "fancypunks" $cpunks]] append out [textblock::frame -title "punks" $2frames_b\n$RST$2frames_a] \n - append out [overtype::right [overtype::left [textblock::frame -ansiborder [a+ green bold] -type heavy -title ${redb}PATTERN$RST -subtitle ${redb}PUNK$RST $prightair_cyanb] "$blueb\n\n\P\nU\nN\nK$RST"] "$blueb\n\nL\nI\nF\nE"] \n + set fancy [overtype::right [overtype::left [textblock::frame -ansiborder [a+ green bold] -type heavy -title ${redb}PATTERN$RST -subtitle ${redb}PUNK$RST $prightair_cyanb] "$blueb\n\n\P\nU\nN\nK$RST"] "$blueb\n\nL\nI\nF\nE"]] + set spantable [[spantest] print] + append out [textblock::join $fancy $spantable] \n #append out [textblock::frame -title gr $gr0] return $out } @@ -1842,7 +2654,7 @@ namespace eval textblock { set t [textblock::class::table new {*}$topts] foreach h $opt_headers { - $t add_column -header $h + $t add_column -headers [list $h] } if {[$t column_count] == 0} { if {[llength $opt_rows]} { @@ -1904,289 +2716,93 @@ namespace eval textblock { return [dict create category predefined type $f] } } - proc frame {args} { - variable frametypes - set expect_optval 0 - set argposn 0 - set pmax [expr {[llength $args]-1}] - set has_contents 0 ;#differentiate between empty string and no content supplied - set contents "" - set arglist [list] - foreach a $args { - if {!$expect_optval} { - if {$argposn < $pmax} { - if {[string match -* $a]} { - set expect_optval 1 - lappend arglist $a - } else { - error "textblock::frame expects -option pairs" - } - } else { - set has_contents 1 - set contents $a - } - } else { - lappend arglist $a - set expect_optval 0 - } - incr argposn - } - - #set contents [lindex $args end] - #set arglist [lrange $args 0 end-1] - if {[llength $arglist] % 2 != 0} { - error "Usage frame ?-type unicode|altg|ascii|? ?-title ? ?-subtitle ? ?-width ? ?-ansiborder ? ?-boxlimits hl|hlt|hlb|vl|vll|vlr|tlc|blc|brc? ?-joins left|right|up|down? " - } - #todo args -justify left|centre|right (center) + proc framedef {f {joins ""}} { + #unicode box drawing only provides enough characters for seamless joining of unicode boxes light and heavy. + #e.g with characters such as \u2539 Box Drawings Right Light and Left Up Heavy. + #the double glyphs in box drawing can do a limited set of joins to light lines - but not enough for seamless table layouts. + #the arc set can't even join to itself e.g with curved equivalents of T-like shapes + + #sorted order down left right up + #1 x choose 4 + #4 x choose 3 + #6 x choose 2 + #4 x choose 1 + #15 combos - set defaults [dict create\ - -etabs 0\ - -type light\ - -boxlimits [list hl vl tlc blc trc brc]\ - -boxmap {}\ - -joins [list]\ - -title ""\ - -subtitle ""\ - -width ""\ - -height ""\ - -ansiborder ""\ - -ansibase ""\ - -align "left"\ - -ellipsis 1\ - ] - 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 {} - default { - error "frame option '$k' not understood. Valid options are [dict keys $defaults]" - } + set join_directions [list] + #targets - light,heavy (double?) - seem to be some required glyphs missing from unicode + #e.g down-light, up-heavy + set join_targets [dict create left "" down "" right "" up ""] + foreach jt $joins { + lassign [split $jt -] direction target + if {$target ne ""} { + dict set join_targets $direction $target } + lappend join_directions $direction } - # -- --- --- --- --- --- - set opt_etabs [dict get $opts -etabs] - set opt_type [dict get $opts -type] - set opt_boxlimits [dict get $opts -boxlimits] - set opt_joins [dict get $opts -joins] - set opt_boxmap [dict get $opts -boxmap] - set custom_keys [list hl hlt hlb vl vll vlr tlc trc blc brc] - - set known_frametypes $frametypes ;# light, heavey etc as defined in textblock::frametypes variable - set default_custom [dict create hl " " vl " " tlc " " trc " " blc " " brc " "] + set join_directions [lsort -unique $join_directions] + set do_joins [::join $join_directions _] - lassign [textblock::frametype $opt_type] _cat category _type ftype - if {$category eq "custom"} { - set custom_frame $ftype - set frameset "custom" - } else { - #category = predefined - set frameset $ftype ;# light,heavy etc - } - set is_boxlimits_ok 1 - set exact_boxlimits [list] - foreach v $opt_boxlimits { - switch -- $v { - hl { - lappend exact_boxlimits hlt hlb - } - vl { - lappend exact_boxlimits vll vlr - } - hlt - hlb - vll - vlr - tlc - trc - blc - brc { - lappend exact_boxlimits $v - } - default { - #k not in custom_keys - set is_boxlimits_ok 0 - break - } - } - } - if {!$is_boxlimits_ok} { - error "frame option -boxlimits '$opt_boxlimits' must contain only values from the set: hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc" - } - set exact_boxlimits [lsort -unique $exact_boxlimits] + switch -- $f { + "altg" { + #old style ansi escape sequences with alternate graphics page G0 + set hl [cd::hl] + set hlt $hl + set hlb $hl + set vl [cd::vl] + set vll $vl + set vlr $vl + set tlc [cd::tlc] + set trc [cd::trc] + set blc [cd::blc] + set brc [cd::brc] - set is_joins_ok 1 - foreach v $opt_joins { - lassign [split $v -] direction target - switch -- $direction { - left - right - up - down {} - default { - set is_joins_ok 0 - break - } - } - switch -- $target { - "" - light - heavy - ascii - altg - arc - double - custom - block - block1 {} - default { - set is_joins_ok 0 - break - } - } - } - if {!$is_joins_ok} { - error "frame option -joins '$opt_joins' must contain only values from the set: left,right,up,down with targets heavy,light,ascii,altg,arc,double,block,block1,custom e.g down-light" - } - set is_boxmap_ok 1 - dict for {boxelement subst} $opt_boxmap { - switch -- $boxelement { - hl - hlt - hlb - vl - vll - vlr - tlc - trc - blc - brc {} - default { - set is_boxmap_ok 0 - break - } - } - } - if {!$is_boxmap_ok} { - error "frame option -boxmap '$opt_boxmap' must contain only keys from the set: hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc" - } - #sorted order down left right up - #1 x choose 4 - #4 x choose 3 - #6 x choose 2 - #4 x choose 1 - #15 combos - set join_directions [list] - #targets - light,heavy (double?) - seem to be some required glyphs missing from unicode - #e.g down-light, up-heavy - set join_targets [dict create left "" down "" right "" up ""] - foreach jt $opt_joins { - lassign [split $jt -] direction target - if {$target ne ""} { - dict set join_targets $direction $target - } - lappend join_directions $direction - } - set join_directions [lsort -unique $join_directions] - set do_joins [::join $join_directions _] - - - # -- --- --- --- --- --- - set opt_title [dict get $opts -title] - set opt_subtitle [dict get $opts -subtitle] - 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 { - left - right - centre - center {} - default { - error "frame option -align must be left|right|centre|center - received: $$opt_align" - } - } - #these are all valid commands for overtype:: - # -- --- --- --- --- --- - set opt_ansiborder [dict get $opts -ansiborder] - set opt_ansibase [dict get $opts -ansibase] ;#experimental - set opt_ellipsis [dict get $opts -ellipsis] - # -- --- --- --- --- --- - - if {$has_contents} { - if {[string last \t $contents] >= 0} { - if {[info exists punk::console::tabwidth]} { - set tw $::punk::console::tabwidth - } else { - set tw 8 - } - if {$opt_etabs} { - set contents [textutil::tabify::untabify2 $contents $tw] - } - } - set contents [string map [list \r\n \n] $contents] - set actual_contentwidth [textblock::width $contents] - set actual_contentheight [textblock::height $contents] - } else { - set actual_contentwidth 0 - set actual_contentheight 0 - } - - if {$opt_title ne ""} { - set titlewidth [punk::ansi::printing_length $opt_title] - set content_or_title_width [expr {max($actual_contentwidth,$titlewidth)}] - } else { - set titlewith 0 - set content_or_title_width $actual_contentwidth - } - - if {$opt_width eq ""} { - set contentwidth $content_or_title_width - } else { - set contentwidth [expr {max(0,$opt_width - 2)}] ;#default - } - - if {$opt_height eq ""} { - set contentheight $actual_contentheight - } else { - set contentheight [expr {max(0,$opt_height -2)}] ;#default - } - if {$contentheight == 0} { - set has_contents 0 - } - - #todo - render it with vertical overflow so we can process ansi moves? - #set linecount [textblock::height $contents] - set linecount $contentheight - set rst [a] - #set column [string repeat " " $contentwidth] ;#default - may need to override for custom frame - set underlayline [string repeat " " $contentwidth] - set underlay [::join [lrepeat $linecount $underlayline] \n] - - set vll_width 1 ;#default for all except custom (printing width) - set vlr_width 1 - - #unicode box drawing only provides enough characters for seamless joining of unicode boxes light and heavy. - #e.g with characters such as \u2539 Box Drawings Right Light and Left Up Heavy. - #the double glyphs in box drawing can do a limited set of joins to light lines - but not enough for seamless table layouts. - #the arc set can't even join to itself e.g with curved equivalents of T-like shapes - #I guess - switch -- $frameset { - "altg" { - #old style ansi escape sequences with alternate graphics page G0 - set hl [cd::hl] - set hlt $hl - set hlb $hl - set vl [cd::vl] - set vll $vl - set vlr $vl - set tlc [cd::tlc] - set trc [cd::trc] - set blc [cd::blc] - set brc [cd::brc] + #horizontal and vertical bar joins + set hltj $hlt + set hlbj $hlb + set vllj $vll + set vlrj $vlr #No join targets available to join altg to other box styles switch -- $do_joins { down { #1 set blc [punk::ansi::g0 t] ;#(ltj) set brc [punk::ansi::g0 u] ;#(rtj) + set hlbj [punk::ansi::g0 w] ;#(ttj) } left { #2 set tlc [punk::ansi::g0 w] ;#(ttj) set blc [punk::ansi::g0 v] ;#(btj) + set vllj [punk::ansi::g0 u] ;#(rtj) } right { #3 set trc [punk::ansi::g0 w] ;#(ttj) set brc [punk::ansi::g0 v] ;#(btj) + set vlrj [punk::ansi::g0 t] ;#(ltj) } up { #4 set tlc [punk::ansi::g0 t] ;#(ltj) set trc [punk::ansi::g0 u] ;#(rtj) + set hltj [punk::ansi::g0 v];#(btj) } down_left { #5 set blc [punk::ansi::g0 n] ;#(fwj) set tlc [punk::ansi::g0 w] ;#(ttj) set brc [punk::ansi::g0 u] ;#(rtj) + set hlbj [punk::ansi::g0 w] ;#(ttj) + set vllj [punk::ansi::g0 u] ;#(rtj) } down_right { #6 set blc [punk::ansi::g0 t] ;#(ltj) set trc [punk::ansi::g0 w] ;#(ttj) set brc [punk::ansi::g0 n] ;#(fwj) + set hlbj [punk::ansi::g0 w] ;#(ttj) + set vlrj [punk::ansi::g0 t] ;#(ltj) } down_up { #7 @@ -2195,6 +2811,8 @@ namespace eval textblock { set tlc [punk::ansi::g0 t] ;#(ltj) set trc [punk::ansi::g0 u] ;#(rtj) + set hlbj [punk::ansi::g0 w] ;#(ttj) + set hltj [punk::ansi::g0 v];#(btj) } left_right { #8 @@ -2204,18 +2822,23 @@ namespace eval textblock { #from3 set trc [punk::ansi::g0 w] ;#(ttj) set brc [punk::ansi::g0 v] ;#(btj) + set vllj [punk::ansi::g0 u] ;#(rtj) + set vlrj [punk::ansi::g0 t] ;#(ltj) } left_up { #9 set tlc [punk::ansi::g0 n] ;#(fwj) set trc [punk::ansi::g0 u] ;#(rtj) set blc [punk::ansi::g0 v] ;#(btj) + set vllj [punk::ansi::g0 u] ;#(rtj) } right_up { #10 set tlc [punk::ansi::g0 t] ;#(ltj) set trc [punk::ansi::g0 n] ;#(fwj) set brc [punk::ansi::g0 v] ;#(btj) + set hltj [punk::ansi::g0 v];#(btj) + set vlrj [punk::ansi::g0 t] ;#(ltj) } down_left_right { #11 @@ -2223,6 +2846,9 @@ namespace eval textblock { set brc [punk::ansi::g0 n] ;#(fwj) set trc [punk::ansi::g0 w] ;#(ttj) set tlc [punk::ansi::g0 w] ;#(ttj) + set vllj [punk::ansi::g0 u] ;#(rtj) + set vlrj [punk::ansi::g0 t] ;#(ltj) + set hlbj [punk::ansi::g0 w] ;#(ttj) } down_left_up { #12 @@ -2230,7 +2856,9 @@ namespace eval textblock { set blc [punk::ansi::g0 n] ;#(fwj) set trc [punk::ansi::g0 u] ;#(rtj) set brc [punk::ansi::g0 u] ;#(rtj) - + set vllj [punk::ansi::g0 u] ;#(rtj) + set hltj [punk::ansi::g0 v];#(btj) + set hlbj [punk::ansi::g0 w] ;#(ttj) } down_right_up { #13 @@ -2238,6 +2866,9 @@ namespace eval textblock { set blc [punk::ansi::g0 t] ;#(ltj) set trc [punk::ansi::g0 n] ;#(fwj) set brc [punk::ansi::g0 n] ;#(fwj) + set hltj [punk::ansi::g0 v];#(btj) + set vlrj [punk::ansi::g0 t] ;#(ltj) + set hlbj [punk::ansi::g0 w] ;#(ttj) } left_right_up { #14 @@ -2245,7 +2876,9 @@ namespace eval textblock { set trc [punk::ansi::g0 n] ;#(fwj) set blc [punk::ansi::g0 v] ;#(btj) set brc [punk::ansi::g0 v] ;#(btj) - + set vllj [punk::ansi::g0 u] ;#(rtj) + set hltj [punk::ansi::g0 v];#(btj) + set vlrj [punk::ansi::g0 t] ;#(ltj) } down_left_right_up { #15 @@ -2253,6 +2886,10 @@ namespace eval textblock { set blc [punk::ansi::g0 n] ;#(fwj) set trc [punk::ansi::g0 n] ;#(fwj) set brc [punk::ansi::g0 n] ;#(fwj) + set vllj [punk::ansi::g0 u] ;#(rtj) + set hltj [punk::ansi::g0 v];#(btj) + set vlrj [punk::ansi::g0 t] ;#(ltj) + set hlbj [punk::ansi::g0 w] ;#(ttj) } } @@ -2269,6 +2906,18 @@ namespace eval textblock { set trc + set blc + set brc + + #horizontal and vertical bar joins + #set hltj $hlt + #set hlbj $hlb + #set vllj $vll + #set vlrj $vlr + #ascii + is small - can reasonably be considered a join to anything? + set hltj + + set hlbj + + set vllj + + set vlrj + + #our corners are all + already - so we won't do anything for directions or targets + } "light" { #unicode box drawing set @@ -2282,6 +2931,13 @@ namespace eval textblock { set trc [punk::char::charshort boxd_ldl] set blc [punk::char::charshort boxd_lur] set brc [punk::char::charshort boxd_lul] + + #horizontal and vertical bar joins + set hltj $hlt + set hlbj $hlb + set vllj $vll + set vlrj $vlr + #15 combos #sort order: down left right up #ltj,rtj,ttj,btj e.g left T junction etc. @@ -2313,10 +2969,12 @@ namespace eval textblock { heavy { set blc [punk::char::charshort boxd_dhrul] ;#\u251f down hieavy and right up light (ltj) set brc \u2527 ;#boxd_dhlul down heavy and left up light (rtj) + set hlbj \u2530 ;# down heavy (ttj) } light { set blc \u251c ;#[punk::char::charshort boxd_lvr] light vertical and right (ltj) set brc [punk::char::charshort boxd_lvl] ;#light vertical and left (rtj) + set hlbj \u252c ;# (ttj) } } } @@ -2326,10 +2984,12 @@ namespace eval textblock { heavy { set tlc \u252d ;# Left Heavy and Right Down Light (ttj) set blc \u2535 ;# Left Heavy and Right Up Light (btj) + set vllj \u2525 ;# left heavy (rtj) } light { set tlc [punk::char::charshort boxd_ldhz] ;#T shape (ttj) - joinleft set blc [punk::char::charshort boxd_luhz] ;#upside down T shape (btj) + set vllj \u2524 ;# (rtj) } } } @@ -2339,17 +2999,27 @@ namespace eval textblock { heavy { set trc \u252e ;#Right Heavy and Left Down Light (ttj) set brc \u2536 ;#Right Heavy and Left up Light (btj) + set vlrj \u251d;#right heavy (ltj) } light { set trc [punk::char::charshort boxd_ldhz] ;#T shape (ttj) set brc [punk::char::charshort boxd_luhz] ;#upside down T shape (btj) + set vlrj \u251c;# (ltj) } } } up { #4 - set tlc [punk::char::charshort boxd_lvr] ;#light vertical and right (ltj) - set trc [punk::char::charshort boxd_lvl] ;#light vertical and left (rtj) + switch -- $targetup { + heavy { + set tlc \u251e ;#up heavy (ltj) + set trc \u2526 ;#up heavy (rtj) + } + light { + set tlc [punk::char::charshort boxd_lvr] ;#light vertical and right (ltj) + set trc [punk::char::charshort boxd_lvl] ;#light vertical and left (rtj) + } + } } down_left { #5 @@ -2357,7 +3027,8 @@ namespace eval textblock { other-light { set blc \u2534 ;#(btj) set tlc \u252c ;#(ttj) - #brc - default corner + #brc - default corner + set vllj \u2524 ;# (rtj) } other-other { #default corners @@ -2366,36 +3037,47 @@ namespace eval textblock { set blc \u2535 ;# heavy left (btj) set tlc \u252d ;#heavy left (ttj) #brc default corner + set vllj \u2525 ;# heavy left (rtj) } heavy-light { set blc \u2541 ;# heavy down (fwj) set tlc \u252c ;# light (ttj) set brc \u2527 ;# heavy down (rtj) + set vllj \u2524 ;# (rtj) + set hlbj \u2530 ;# heavy down (ttj) } heavy-other { set blc \u251f ;#heavy down (ltj) #tlc - default corner set brc \u2527 ;#heavy down (rtj) + set hlbj \u2530 ;# heavy down (ttj) } heavy-heavy { set blc \u2545 ;#heavy down and left (fwj) set tlc \u252d ;#heavy left (ttj) set brc \u2527 ;#heavy down (rtj) + set vllj \u2525 ;# heavy left (rtj) + set hlbj \u2530 ;# heavy down (ttj) } light-light { set blc \u253c ;# [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) set tlc \u252c ;# boxd_ldhz (ttj) set brc \u2524 ;# boxd_lvl light vertical and left(rtj) + set vllj \u2524 ;# (rtj) + set hlbj \u252c ;# (ttj) } light-other { set blc \u251c ;# (ltj) #tlc - default corner set brc \u2524 ;# boxd_lvl (rtj) + set hlbj \u252c ;# (ttj) } light-heavy { set blc \u253d ;# heavy left (fwj) set tlc \u252d ;# heavy left (ttj) set brc \u2524 ;# light (rtj) + set vllj \u2525 ;# heavy left (rtj) + set hlbj \u252c ;# (ttj) } default { set blc \u253c ;# [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) @@ -2492,6 +3174,12 @@ namespace eval textblock { set trc [punk::char::charshort boxd_hdl] set blc [punk::char::charshort boxd_hur] set brc [punk::char::charshort boxd_hul] + #horizontal and vertical bar joins + set hltj $hlt + set hlbj $hlb + set vllj $vll + set vlrj $vlr + #set targetdown,targetleft,targetright,targetup vars #default empty targets to current box type 'heavy' foreach dir {down left right up} { @@ -2515,10 +3203,12 @@ namespace eval textblock { light { set blc [punk::char::charshort boxd_dlruh] ;#\u2521 down light and right up heavy (ltj) set brc [punk::char::charshort boxd_dlluh] ;#\u2529 down light and left up heavy (rtj) + set hlbj \u252F ;#down light (ttj) } heavy { set blc [punk::char::charshort boxd_hvr] ;# (ltj) set brc [punk::char::charshort boxd_hvl] ;# (rtj) + set hlbj \u2533 ;# down heavy (ttj) } } } @@ -2528,10 +3218,12 @@ namespace eval textblock { light { set tlc [punk::char::charshort boxd_llrdh] ;#\u2532 Left Light and Right Down Heavy (ttj) set blc [punk::char::charshort boxd_llruh] ;#\u253a Left Light and Right Up Heavy (btj) + set vllj \u2528 ;# left light (rtj) } heavy { set tlc [punk::char::charshort boxd_hdhz] ;# (ttj) set blc [punk::char::charshort boxd_huhz] ;# (btj) + set vllj \u252b ;#(rtj) } } } @@ -2541,10 +3233,12 @@ namespace eval textblock { light { set trc [punk::char::charshort boxd_rlldh] ;#\u2531 Right Light and Left Down Heavy (ttj) set brc [punk::char::charshort boxd_rlluh] ;#\u2539 Right Light and Left Up Heavy(btj) + set vlrj \u2520 ;#right light (ltj) } heavy { set trc [punk::char::charshort boxd_hdhz] ;#T shape (ttj) set brc [punk::char::charshort boxd_huhz] ;# (btj) + set vlrj \u2523 ;# (ltj) } } } @@ -2554,10 +3248,12 @@ namespace eval textblock { light { set tlc [punk::char::charshort boxd_ulrdh] ;#\u2522 Up Light and Right Down Heavy (ltj) set trc [punk::char::charshort boxd_ulldh] ;#\u252a Up Light and Left Down Heavy (rtj) + set hltj \u2537 ;# up light (btj) } heavy { set tlc [punk::char::charshort boxd_hvr] ;# (ltj) set trc [punk::char::charshort boxd_hvl] ;# (rtj) + set hltj \u253b ;# (btj) } } } @@ -2569,42 +3265,57 @@ namespace eval textblock { set blc [punk::char::charshort boxd_dluhzh] ;#down light and up horizontal heavy (fwj) set brc [punk::char::charshort boxd_dlluh] ;#\u2529 down light and left up heavy (rtj) set tlc [punk::char::charshort boxd_hdhz] ;# (ttj) (at tlc down stays heavy) + set hlbj \u252F ;# down light (ttj) + set vllj \u252b ;#(rtj) } down-heavy-left-light { set blc [punk::char::charshort boxd_llrvh] ;# left light and right Vertical Heavy (fwj) set brc [punk::char::charshort boxd_hvl] ;# (rtj) (at brc left must stay heavy) set tlc [punk::char::charshort boxd_llrdh] ;#\u2532 Left Light and Right Down Heavy (ttj) + set hlbj \u2533 ;# down heavy (ttj) + set vllj \u2528 ;# left light (rtj) } down-light-left-light { set blc [punk::char::charshort boxd_ruhldl] ;#\u2544 right up heavy and left down light (fwj) set brc [punk::char::charshort boxd_dlluh] ;#\u2529 Down Light and left Up Heavy (rtj) (left must stay heavy) set tlc [punk::char::charshort boxd_llrdh] ;#\u2532 Left Light and Right Down Heavy (ttj) (we are in heavy - so down must stay heavy at tlc) + set hlbj \u252F ;# down light (ttj) + set vllj \u2528 ;# left light (rtj) } down-heavy-left-heavy { set blc [punk::char::charshort boxd_hvhz] ;# (fwj) set brc [punk::char::charshort boxd_hvl] ;# (rtj) set tlc [punk::char::charshort boxd_hdhz] ;# (ttj) + set hlbj \u2533 ;#(ttj) + set vllj \u252b ;#(rtj) } down-other-left-heavy { set blc \u253b ;#boxd_huhz Heavy Up and Horizontal (btj) #leave brc default corner set tlc \u2533 ;#hdhz Heavy Down and Horizontal (ttj) + set vllj \u252b ;#(rtj) } down-other-left-light { set blc \u253a ;#llruh Left Light and Right Up Heavy (btj) #leave brc default corner set tlc \u2532 ;#llrdh Left Light and Right Down Heavy (ttj) + + set vllj \u2528 ;# left light (rtj) } down-heavy-left-other { set blc \u2523 ;#hvr Heavy Vertical and Right (ltj) set brc \u252b ;#hvl Heavy Veritcal and Left (rtj) #leave tlc default corner + + set hlbj \u2533 ;#(ttj) } down-light-left-other { set blc \u2521 ;#dlruh Down Light and Right Up Heavy (ltj) set brc \u2529 ;#dlluh Down Light and Left Up Heavy (rtj) #leave tlc default corner + + set hlbj \u252F ;# down light (ttj) } } } @@ -2696,6 +3407,12 @@ namespace eval textblock { set blc [punk::char::charshort boxd_dur] ;#double up and right \U255A set brc [punk::char::charshort boxd_dul] ;#double up and left \U255D + #horizontal and vertical bar joins + set hltj $hlt + set hlbj $hlb + set vllj $vll + set vlrj $vlr + # \u256c (fwj) #set targetdown,targetleft,targetright,targetup vars @@ -2706,6 +3423,9 @@ namespace eval textblock { "" - double { set target$dir double } + light { + set target$dir light + } default { set target$dir other } @@ -2721,6 +3441,10 @@ namespace eval textblock { double { set blc \u2560 ;# (ltj) set brc \u2563 ;# (rtj) + set hlbj \u2566 ;# (ttj) + } + light { + set hlbj \u2564 ;# down light (ttj) } } } @@ -2730,6 +3454,10 @@ namespace eval textblock { double { set tlc \u2566 ;# (ttj) set blc \u2569 ;# (btj) + set vllj \u2563 ;# (rtj) + } + light { + set vllj \u2562 ;# light left (rtj) } } } @@ -2740,6 +3468,9 @@ namespace eval textblock { set trc \u2566 ;# (ttj) set brc \u2569 ;# (btj) } + light { + set vlrj \u255F ;# light right (ltj) + } } } up { @@ -2748,6 +3479,10 @@ namespace eval textblock { double { set tlc \u2560 ;# (ltj) set trc \u2563 ;# (rtj) + set hltj \u2569 ;# (btj) + } + light { + set hltj \u2567 ;#up light (btj) } } } @@ -2758,12 +3493,36 @@ namespace eval textblock { set blc \u256c ;# (fwj) set brc \u2563 ;# (rtj) set tlc \u2566 ;# (ttj) + set hlbj \u2566 ;# (ttj) + } + double-light { + #no corner joins treat corners like 'other' + set blc \u2560 ;# (ltj) + set brc \u2563 ;# (rtj) + + set hlbj \u2566 ;# (ttj) + set vllj \u2562 ;# light left (rtj) + } double-other { set blc \u2560 ;# (ltj) set brc \u2563 ;# (rtj) #leave tlc as ordinary double corner } + light-double { + + set vllj \u2563 ;# (rtj) + set hlbj \u2564 ;# light down (ttj) + + } + light-light { + + set vllj \u2562 ;# light left (rtj) + set hlbj \u2564 ;# light down (ttj) + } + other-light { + set vllj \u2562 ;# light left (rtj) + } other-double { set blc \u2569 ;# (btj) #leave brc as ordinary double corner @@ -2778,6 +3537,7 @@ namespace eval textblock { set blc \u2560 ;# (ltj) set trc \u2566 ;# (ttj) set brc \u256c ;# (fwj) + set hlbj \u2566 ;# (ttj) } double-other { set blc \u2560 ;# (ltj) @@ -2799,6 +3559,8 @@ namespace eval textblock { set brc \u2563 ;# (rtj) set tlc \u2560 ;# (ltj) set trc \u2563 ;# (rtj) + set hltj \u2569 ;# (btj) + set hlbj \u2566 ;# (ttj) } } } @@ -2817,12 +3579,16 @@ namespace eval textblock { set tlc [punk::char::charshort boxd_hvhz] ;# (fwj) set trc [punk::char::charshort boxd_hvl] ;# (rtj) set blc [punk::char::charshort boxd_huhz] ;# (btj) + set hltj \u2569 ;# (btj) + set vllj \u2563 ;# (rtj) } right_up { #10 set tlc [punk::char::charshort boxd_hvr] ;# (ltj) set trc [punk::char::charshort boxd_hvhz] ;# (fwj) set brc [punk::char::charshort boxd_huhz] ;# (btj) + set hltj \u2569 ;# (btj) + set vlrj \u2560 ;# (ltj) } down_left_right { #11 @@ -2830,6 +3596,8 @@ namespace eval textblock { set brc [punk::char::charshort boxd_hvhz] ;# (fwj) set trc [punk::char::charshort boxd_hdhz] ;# (ttj) set tlc [punk::char::charshort boxd_hdhz] ;# (ttj) + set hlbj \u2566 ;# (ttj) + set vlrj \u2560 ;# (ltj) } down_left_up { @@ -2838,6 +3606,8 @@ namespace eval textblock { set blc [punk::char::charshort boxd_hvhz] ;# (fwj) set trc [punk::char::charshort boxd_hvl] ;# (rtj) set brc [punk::char::charshort boxd_hvl] ;# (rtj) + set hltj \u2569 ;# (btj) + set hlbj \u2566 ;# (ttj) } down_right_up { @@ -2846,6 +3616,8 @@ namespace eval textblock { set blc [punk::char::charshort boxd_hvr] ;# (ltj) set trc [punk::char::charshort boxd_hvhz] ;# (fwj) set brc [punk::char::charshort boxd_hvhz] ;# (fwj) + set hltj \u2569 ;# (btj) + set hlbj \u2566 ;# (ttj) } left_right_up { #14 @@ -2853,6 +3625,7 @@ namespace eval textblock { set trc [punk::char::charshort boxd_hvhz] ;# (fwj) set blc [punk::char::charshort boxd_huhz] ;# (btj) set brc [punk::char::charshort boxd_huhz] ;# (btj) + set hltj \u2569 ;# (btj) } down_left_right_up { @@ -2861,6 +3634,8 @@ namespace eval textblock { set blc [punk::char::charshort boxd_hvhz] ;# (fwj) set trc [punk::char::charshort boxd_hvhz] ;# (fwj) set brc [punk::char::charshort boxd_hvhz] ;# (fwj) + set hltj \u2569 ;# (btj) + set hlbj \u2566 ;# (ttj) } } @@ -2880,6 +3655,12 @@ namespace eval textblock { set blc [punk::char::charshort boxd_laur] ;#light arc up and right \U2570 set brc [punk::char::charshort boxd_laul] ;#light arc up and left \U256F + #horizontal and vertical bar joins + set hltj $hlt + set hlbj $hlb + set vllj $vll + set vlrj $vlr + #set targetdown,targetleft,targetright,targetup vars #default empty targets to current box type 'arc' foreach dir {down left right up} { @@ -2971,6 +3752,12 @@ namespace eval textblock { set blc \u2594 ;# upper one eighth block set brc \u2594 ;# upper one eight block + #horizontal and vertical bar joins + set hltj $hlt + set hlbj $hlb + set vllj $vll + set vlrj $vlr + } blockxx { set hlt \u2594 ;# upper one eighth block @@ -2984,6 +3771,12 @@ namespace eval textblock { set blc \u2595 ;# right one eighth block set brc \u258f ;# left one eighth block + #horizontal and vertical bar joins + set hltj $hlt + set hlbj $hlb + set vllj $vll + set vlrj $vlr + } block { set hlt \u2580 ;#upper half @@ -2995,9 +3788,18 @@ namespace eval textblock { set trc \u259c set blc \u2599 set brc \u259f + + #horizontal and vertical bar joins + set hltj $hlt + set hlbj $hlb + set vllj $vll + set vlrj $vlr } - custom { + default { + set default_custom [dict create hl " " vl " " tlc " " trc " " blc " " brc " "] + set custom_frame [dict merge $default_custom $f] dict with custom_frame {} ;#extract keys as vars + if {[dict exists $custom_frame hlt]} { set hlt [dict get $custom_frame hlt] } else { @@ -3019,12 +3821,264 @@ namespace eval textblock { } else { set vlr $vl } + #horizontal and vertical bar joins + set hltj $hlt + set hlbj $hlb + set vllj $vll + set vlrj $vlr + } + } + return [dict create\ + tlc $tlc hlt $hlt trc $trc\ + vll $vll vlr $vlr\ + blc $blc hlb $hlb brc $brc\ + hltj $hltj\ + hlbj $hlbj\ + vllj $vllj\ + vlrj $vlrj\ + ] + } + proc frame {args} { + variable frametypes + set expect_optval 0 + set argposn 0 + set pmax [expr {[llength $args]-1}] + set has_contents 0 ;#differentiate between empty string and no content supplied + set contents "" + set arglist [list] + foreach a $args { + if {!$expect_optval} { + if {$argposn < $pmax} { + if {[string match -* $a]} { + set expect_optval 1 + lappend arglist $a + } else { + error "textblock::frame expects -option pairs" + } + } else { + set has_contents 1 + set contents $a + } + } else { + lappend arglist $a + set expect_optval 0 + } + incr argposn + } + #set contents [lindex $args end] + #set arglist [lrange $args 0 end-1] + if {[llength $arglist] % 2 != 0} { + error "Usage frame ?-type unicode|altg|ascii|? ?-title ? ?-subtitle ? ?-width ? ?-ansiborder ? ?-boxlimits hl|hlt|hlb|vl|vll|vlr|tlc|blc|brc? ?-joins left|right|up|down? " + } + #todo args -justify left|centre|right (center) + + set defaults [dict create\ + -etabs 0\ + -type light\ + -boxlimits [list hl vl tlc blc trc brc]\ + -boxmap {}\ + -joins [list]\ + -title ""\ + -subtitle ""\ + -width ""\ + -height ""\ + -ansiborder ""\ + -ansibase ""\ + -align "left"\ + -ellipsis 1\ + ] + 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 {} + default { + error "frame option '$k' not understood. Valid options are [dict keys $defaults]" + } + } + } + # -- --- --- --- --- --- + set opt_etabs [dict get $opts -etabs] + set opt_type [dict get $opts -type] + set opt_boxlimits [dict get $opts -boxlimits] + set opt_joins [dict get $opts -joins] + set opt_boxmap [dict get $opts -boxmap] + set custom_keys [list hl hlt hlb vl vll vlr tlc trc blc brc] + set known_frametypes $frametypes ;# light, heavey etc as defined in textblock::frametypes variable + set default_custom [dict create hl " " vl " " tlc " " trc " " blc " " brc " "] + lassign [textblock::frametype $opt_type] _cat category _type ftype + if {$category eq "custom"} { + set custom_frame $ftype + set frameset "custom" + set framedef $custom_frame + } else { + #category = predefined + set frameset $ftype ;# light,heavy etc + set framedef $ftype + } + + set is_boxlimits_ok 1 + set exact_boxlimits [list] + foreach v $opt_boxlimits { + switch -- $v { + hl { + lappend exact_boxlimits hlt hlb + } + vl { + lappend exact_boxlimits vll vlr + } + hlt - hlb - vll - vlr - tlc - trc - blc - brc { + lappend exact_boxlimits $v + } + default { + #k not in custom_keys + set is_boxlimits_ok 0 + break + } } } + if {!$is_boxlimits_ok} { + error "frame option -boxlimits '$opt_boxlimits' must contain only values from the set: hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc" + } + set exact_boxlimits [lsort -unique $exact_boxlimits] + + set is_joins_ok 1 + foreach v $opt_joins { + lassign [split $v -] direction target + switch -- $direction { + left - right - up - down {} + default { + set is_joins_ok 0 + break + } + } + switch -- $target { + "" - light - heavy - ascii - altg - arc - double - custom - block - block1 {} + default { + set is_joins_ok 0 + break + } + } + } + if {!$is_joins_ok} { + error "frame option -joins '$opt_joins' must contain only values from the set: left,right,up,down with targets heavy,light,ascii,altg,arc,double,block,block1,custom e.g down-light" + } + set is_boxmap_ok 1 + dict for {boxelement subst} $opt_boxmap { + switch -- $boxelement { + hl - hlt - hlb - vl - vll - vlr - tlc - trc - blc - brc {} + default { + set is_boxmap_ok 0 + break + } + } + } + if {!$is_boxmap_ok} { + error "frame option -boxmap '$opt_boxmap' must contain only keys from the set: hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc" + } + + #sorted order down left right up + #1 x choose 4 + #4 x choose 3 + #6 x choose 2 + #4 x choose 1 + #15 combos + + set join_directions [list] + #targets - light,heavy (double?) - seem to be some required glyphs missing from unicode + #e.g down-light, up-heavy + set join_targets [dict create left "" down "" right "" up ""] + foreach jt $opt_joins { + lassign [split $jt -] direction target + if {$target ne ""} { + dict set join_targets $direction $target + } + lappend join_directions $direction + } + set join_directions [lsort -unique $join_directions] + set do_joins [::join $join_directions _] + + + # -- --- --- --- --- --- + set opt_title [dict get $opts -title] + set opt_subtitle [dict get $opts -subtitle] + 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 { + left - right - centre - center {} + default { + error "frame option -align must be left|right|centre|center - received: $$opt_align" + } + } + #these are all valid commands for overtype:: + # -- --- --- --- --- --- + set opt_ansiborder [dict get $opts -ansiborder] + set opt_ansibase [dict get $opts -ansibase] ;#experimental + set opt_ellipsis [dict get $opts -ellipsis] + # -- --- --- --- --- --- + + if {$has_contents} { + if {[string last \t $contents] >= 0} { + if {[info exists punk::console::tabwidth]} { + set tw $::punk::console::tabwidth + } else { + set tw 8 + } + if {$opt_etabs} { + set contents [textutil::tabify::untabify2 $contents $tw] + } + } + set contents [string map [list \r\n \n] $contents] + set actual_contentwidth [textblock::width $contents] + set actual_contentheight [textblock::height $contents] + } else { + set actual_contentwidth 0 + set actual_contentheight 0 + } + + if {$opt_title ne ""} { + set titlewidth [punk::ansi::printing_length $opt_title] + set content_or_title_width [expr {max($actual_contentwidth,$titlewidth)}] + } else { + set titlewith 0 + set content_or_title_width $actual_contentwidth + } + + if {$opt_width eq ""} { + set contentwidth $content_or_title_width + } else { + set contentwidth [expr {max(0,$opt_width - 2)}] ;#default + } + + if {$opt_height eq ""} { + set contentheight $actual_contentheight + } else { + set contentheight [expr {max(0,$opt_height -2)}] ;#default + } + if {$contentheight == 0 && $contentwidth == 0} { + set has_contents 0 + } + + #todo - render it with vertical overflow so we can process ansi moves? + #set linecount [textblock::height $contents] + set linecount $contentheight + set rst [a] + #set column [string repeat " " $contentwidth] ;#default - may need to override for custom frame + set underlayline [string repeat " " $contentwidth] + set underlay [::join [lrepeat $linecount $underlayline] \n] + + set vll_width 1 ;#default for all except custom (printing width) + set vlr_width 1 + + set framedef [textblock::framedef $framedef $opt_joins] + dict with framedef {} ;#extract vll,hlt,tlc etc vars + #puts "---> $opt_boxmap" dict for {boxelement sub} $opt_boxmap { if {$boxelement eq "vl"} { set vll $sub @@ -3233,6 +4287,7 @@ namespace eval textblock { set topborder 1 } set fs "" + #todo - output nothing except maybe newlines depending on if opt_height 0 and/or opt_width 0? if {$topborder} { if {$leftborder && $rightborder} { append fs $tlc$topbar$trc @@ -3247,7 +4302,10 @@ namespace eval textblock { } } if {$has_contents || $opt_height > 2} { - if {$topborder && $fs ne ""} { + #if {$topborder && $fs ne "xx"} { + # append fs \n + #} + if {$topborder} { append fs \n } #set inner [overtype::$opt_align -ellipsis $opt_ellipsis $opt_ansibase$underlay$rstbase $opt_ansibase$contents$rstbase] @@ -3273,7 +4331,7 @@ namespace eval textblock { set bottomborder 1 } if {$bottomborder} { - if {($topborder & $fs ne "" ) || ($has_contents || $opt_height > 2)} { + if {($topborder & $fs ne "xx" ) || ($has_contents || $opt_height > 2)} { append fs \n } if {$leftborder && $rightborder} {