Multi-column display in text widget

Peter Berger wrote:

> I have been charged with the task of presenting data.  I recieve a list in
> alphabetical order such as: a b c d e f g h i j, and need to present it in a
> dialog and organized in rows or columns such as:
> a    e    i
> b    f    j
> c    g
> d    h
> If the dialog expands the number of columns should increase.  Currently I
> use this code:
> 
> pack [text .text -wrap word -tabs "1.25i left" -setgrid 0]
> set alist "apple bear cow dear elephant fine grape hello idol"
> foreach a $alist {.text insert end "$a\t"}
> 
> but this orginizes data as:
> a    b    c
> d    e    ...
> Anyone have any ideas on how I can switch to the other format?

KBK replies (20 Feb 2001):

Are you really trying, instead, to do a multi-column listbox? If so, then Bwidget and Tix both have them, and you should probably just pick up one of them. (DKF: In Tk 8.5 or Tile, you can also use the ttk::treeview widget.)

If you really need multi-column display in a text widget, read on...

I started to code this, and it turned out to be more interesting than I thought. I assume that you don't know the height of the text in advance, so you have to bind to the <Configure> event and adjust your columns on the fly. The code I came up with is shown below. Check out what happens when you resize the window.


# Schedule to lay out the columns of the text from the idle loop

proc repackWhenIdle { w args } {
    variable repackPending
    if { ! [info exists repackPending($w)] } {
        set repackPending($w) {}
        after idle [list [namespace code repack] $w]
    }
    return
}

# Lay out the columns of the text.

proc repack { w } {

    variable repackPending
    variable list

    # Reset the flag that keeps this from being repeat-scheduled.

    catch { [unset repackPending($w)] }

    # Clear the old content of the widget

    $w configure -state normal
    $w delete 1.0 end

    # Calculate number of lines to display

    set lineHeight [font metrics [$w cget -font] -linespace]
    set textHeight [expr { [winfo height $w] - 2 * [$w cget -borderwidth] }]
    set numLines [expr { int( $textHeight / $lineHeight ) }]

    # Bail out if the widget is too small to display anything

    if { $numLines < 1 } {
        return
    }

    # Insert the requisite number of newlines, plus one

    for { set i 0 } { $i < $numLines } { incr i } {
        $w insert end \n {}
    }

    # Build up the list, in columns

    set line 1
    set sep {}
    foreach item $list {
        incr line
        $w insert "${line}.0-1c" $sep {} $item {}
        if { $line > $numLines } {
            set line 1
            set sep "\t"
        }
    }

    # Delete the excess newline

    $w delete end-1l end
    $w configure -state disabled

    return
}

# Set up the text

grid [text .t \
          -state disabled \
          -wrap none \
          -font {Helvetica 12} \
          -width 40 -height 7 \
          -tabs {1.25i left} ] \
   -sticky nsew
grid rowconfigure . 0 -weight 1
grid columnconfigure . 0 -weight 1

# Arrange to repack the text when either the text geometry or the
# list content changes

trace variable list w [list repackWhenIdle .t]
bind .t <Configure> [list repackWhenIdle %W]

# Set initial content of the list

set list {
    apple blackberry blueberry cherry grape grapefruit kiwi kumquat
    lemon nectarine orange peach pear plum prune
    raisin raspberry strawberry tangerine
}

WJG (28/Jan/10) This is a simple solution that I came up with. With a little adjustment it could be adapted to become a stand-alone proc.

#!/bin/sh
# the next line restarts using tclsh \
exec tclsh "$0" "$@"
#---------------

package require Gnocl

set txt1 [gnocl::text]
gnocl::window -child $txt1 -defaultWidth 320 -defaultHeight 200

set data {a b c d e f g h i j k l m n o p q r s t u v w x y z
          A B C D E F G H I J K L M N O P Q R S T U V W X Y Z}

set rows(max) 6

set r 0 ;# row counter

# initialise array to hold output strings
for {set i 0 } {$i < $rows(max) } {incr i} { set rows($i) {} }

# build up the output strings
for {set i 0} {$i < [llength $data] } {incr i} {
    set rows($r) "$rows($r)\t[lindex $data $i]"
    incr r
    if {$r ==  $rows(max) } {set r 0}
}

# insert into the text
for {set i 0 } {$i < $rows(max) } {incr i} {
    $txt1 insert end $rows($i)\n
}

And this is what it produces:

http://lh6.ggpht.com/_yaFgKvuZ36o/S2IZn5HoDXI/AAAAAAAAAN0/psR2JKiNa3g/s800/Screenshot-columns.tcl.png

WJG Reworked this whilst drinking my first cup of tea of the (working) day. Here's it in proc form. It will return a list of the strings which can be subsequently inserted or processed elsewhere. The leading tabs on the first column are not included which, of course, can be added if needed on insertion.

#!/bin/sh
# the next line restarts using tclsh \
exec tclsh "$0" "$@"
#---------------

package require Gnocl

# args:
#   data = list items to be formatted into colums
#   nrow = maximum number of rows to produce
# returns
#   list of formatted row strings
# note
#   tcl only
proc tabulate_Columns {data nrows} {

    set r 0 ;# row counter
    set str {} ;# list contain final, formatted list, returned by proc

    # initialise an array to hold output strings
    for {set i 0 } {$i < $nrows } {incr i} { set rows($i) {} }

    # build up the output strings
    for {set i 0} {$i < [llength $data] } {incr i} {
        if {$rows($r) == {} } {
            set rows($r) "[lindex $data $i]"
        } else {
            set rows($r) "$rows($r)\t[lindex $data $i]"
        }
        incr r
        if {$r ==  $nrows } {set r 0}
    }

    # insert int the text
    for {set i 0 } {$i < $nrows } {incr i} {
        lappend str $rows($i)
    }

    return $str
}

# the uniquitous demo script
set txt1 [gnocl::text]
gnocl::window -child $txt1 -defaultWidth 320 -defaultHeight 200

set data {a b c d e f g h i j k l m n o p q r s t u v w x y z
          A B C D E F G H I J K L M N O P Q R S T U V W X Y Z}

foreach row [tabulate_Columns $data 5] {
    $txt1 insert end ${row}\n
}

TR thought a little about this and made it more generic and versatile, while still being easy to use. Just specify your data, the number of columns, some header and son on. This proc makes use of named fonts and {*}, but can easily be changed to use Tk8.4 commands only. Note, that changing the tableHeader or tableContent tags for coloured background is not supported here (it will color the whole line, not only the table part). Also, no error checking is going on. Enjoy!

And here is the code

package require Tk 8.5

proc textTabulate {win data args} {
        #
        # transforms a list of strings into tabular format
        # that can be inserted as a table into the text widget
        #
        # Returns: a list that needs to be inserted into the text widget like this:
        # $text insert end {*}[textTabulate $win $data ....]
        #
        # Side effects: defines two new text tags 'tableHeader' and 'tableContent'
        #               (existing tags with these names will be overwritten)
        #
        # win - the path to the text widget
        # data - list of strings to format as table (can be in two different formats; see below)
        # args - additional options:
        #    -indent = amount of indentation from the left border of the text widget
        #              to the left border of the table (default = 0)
        #    -columns = number of columns for the table (default = 1)
        #    -headers = list of columns headers/titles (default = no headers)
        #    -font = the font for the column content (default = TkTextFont)
        #    -dataformat = format of the data:
        #       'flat' -> a flat list with all values (default)
        #       'nested' -> a nested list where each element itself is a list wth the row data
        #
        # option defaults:
        array set options {-indent 0 -columns 1 -headers {} -font TkTextFont        -dataformat flat}
        # user supplied options:
        array set options $args
        # convert indentation to screen distance:
        set options(-indent) [winfo pixels $win $options(-indent)]
        # some extra space for each column:
        set addSpace [font measure $options(-font) "--"]
        if {$options(-dataformat) eq "flat"} {
                # convert to nested format:
                set tmpData [list]
                set valCount [llength $data]
                set startIndex 0
                while {$startIndex < $valCount} {
                        set endIndex [expr {$startIndex + $options(-columns) - 1}]
                        lappend tmpData [lrange $data $startIndex $endIndex]
                        incr startIndex $options(-columns)
                }
                set data $tmpData
        }
        # preset the column width to the width of the header
        # and format the header text for the text widget:
        set widgetData [list]
        for {set colIndex 0} {$colIndex < $options(-columns)} {incr colIndex} {
                # preset column widths:
                set colWidth($colIndex) [font measure $options(-font) [lindex $options(-headers) $colIndex]]
                # start the text widget data with the header row:
                if {$options(-headers) ne ""} {
                        if {$colIndex == 0 && $options(-indent) == 0} {
                                lappend widgetData "[lindex $options(-headers) $colIndex]" tableHeader
                        } else {
                                lappend widgetData "\t[lindex $options(-headers) $colIndex]" tableHeader
                        }
                }
        }
        if {$options(-headers) ne ""} {lset widgetData end-1 "[lindex $widgetData end-1]\n"}
        # process all data, row for row, adjusting the column width as it goes:
        foreach row $data {
                for {set colIndex 0} {$colIndex < $options(-columns)} {incr colIndex} {
                        set colContent [lindex $row $colIndex]
                        set stringLength [font measure $options(-font) $colContent]
                        # adjust column widths:
                        if {$stringLength > $colWidth($colIndex)} {set colWidth($colIndex) $stringLength}
                        # add content to the text widget list:
                        if {$colIndex == 0 && $options(-indent) == 0} {
                                lappend widgetData $colContent tableContent
                        } else {
                                lappend widgetData "\t$colContent" tableContent
                        }
                }
                lset widgetData end-1 "[lindex $widgetData end-1]\n"
        }
        # calculate the tab positions:
        if {$options(-indent)} {
                set tabList [list $options(-indent) left]
        } else {
                set tabList [list]
        }
        set distance $options(-indent)
        for {set colIndex 0} {$colIndex < $options(-columns)} {incr colIndex} {
                # each new tab is adding the column width + fixed extra space:
                set distance [expr {$distance + $colWidth($colIndex) + $addSpace}]
                lappend tabList $distance left
        }
        $win tag configure tableHeader -font $options(-font) -foreground #7f7f7f -tabs $tabList
        $win tag configure tableContent -font $options(-font) -tabs $tabList
   return $widgetData
}

# main code for demonstration

set t [text .txt1 -font TkTextFont -tabs {2c left 8c left}]
pack $t -fill both -expand yes

set data {
        3 "Famous Tcl books" "Mr. Lee"
        4 "Brave Tcl'ers" "Tcl Core Team"
        5 "Doing Tcl at night" "Jenny Redefin"
        122 "The long way to Tk" anonymous
}
$t insert end \tTab1 {} \tTab2\n\n {} "This is a table coming here:\n\n" {}
$t insert end {*}[textTabulate $t $data -columns 3 -headers {id title author} -indent 4.5c -font TkTextFont]

daapp Simple table to text formatter. Result of tableToText can be inserted into text widget.

package require Tcl 8.6
package require lambda

# table - list of lists (table of data)
# align - list of align instruction: left or right
# separator - between columns
# rowPrefix - string before first column
# rowSuffix - string after last column
proc tableToText {table aligns {separator " "} {rowPrefix ""} {rowSuffix ""}} {
    set row2lengths [lambda {row} {lmap val $row {string length $val}}]
    set selectMax [lambda {l1 l2} {lmap a $l1 b $l2 {expr {max($a, $b)}}}]
    set sizes [{*}$row2lengths [lindex $table 0]]
    
    foreach row [lrange $table 1 end] {
        set lengths [{*}$row2lengths $row]
        set sizes [{*}$selectMax $sizes $lengths]
    }

    set formats [list]
    foreach size $sizes align $aligns {
        switch -- $align {
            left {
                lappend formats %-${size}s
            }
            right {
                lappend formats %${size}s
            }
            default {
                error "invalid align \"$align\": should be left or right"
            }
        }
    }
    set rowFormat "$rowPrefix[join $formats $separator]$rowSuffix"

    return [join [lmap row $table { format $rowFormat {*}$row }] \n]
}


set tab {
    {Name:        init}
    {Umask:        0022}
    {Tgid:        1}
    {Ngid:        0}
    {Pid:        1}
    {PPid:        0}
    {TracerPid:        0}
    {FDSize:        64}
    {NStgid:        1}
    {NSpid:        1}
    {NSpgid:        1}
    {NSsid:        1}
    {CoreDumping:        0}
    {Threads:        1}
    {SigQ:        0/62779}
    {SigPnd:        0000000000000000}
    {ShdPnd:        0000000000000000}
    {SigBlk:        0000000000000000}
    {SigIgn:        fffffffe57f0d0fc}
    {SigCgt:        00000001a80b2e03}
    {CapInh:        0000000000000000}
    {CapPrm:        0000003fffffffff}
    {CapEff:        0000003fffffffff}
    {CapBnd:        0000003fffffffff}
    {CapAmb:        0000000000000000}
    {NoNewPrivs:        0}
    {Seccomp:        0}
    {Cpus_allowed:        ff}
    {Cpus_allowed_list:        0-7}
    {Mems_allowed:        00000000,00000001}
    {Mems_allowed_list:        0}
    {voluntary_ctxt_switches:        13900}
    {nonvoluntary_ctxt_switches:        146}
}

puts [tableToText $tab {left right} " | " {| } { |}]\n