Laying out widgets in a grid

12/11/2008

JBR I have always been rather annoyed at the need to name and grid Tk widgets when building an interface. The number of repetitious options to get what you want can be tiresome. Mostly a script doesn't need to know the names of any widget, why should Tk demand user generated names for them all? I only have to do it a few times a year, but eventually I moved to this. It's a little like gub.

For anyone who can remember that far back this code is inspired by the Xmt layout widget.

layout adds two commands "row" and "col", a row is a grid of widgets given row by row with "&" separating the rows, "col" is parsed in the same way but the widget array is transposed before gridding.

Options after widgets commands are collected and applied to that widget. Options may come before a widget command (possibly delineated with "." to show that they are global options). These are applied to any following widgets that accept them. Options may be prefixed with the widet type to apply them only to that class.

Comments begin with "#" and continue to the end of line.

Macro characters are used to supply shortcuts to often used widgets.

  • @ is label
  • ! is button
  • = is entry
  • * is checkbox
  • ~ is radiobutton

Any unknown bareword (not an option) is assumed to be a widget command. It should accept a widget name as its first arg, construct the widget and return the widget name for gridding. If the first argument following a widget command begins with ".", it is passed as the widget name, otherwise one is generated. If first arg (or second following a widget name) begins with "::" it is used as a global variable and the widget name is stored there. If the argument to any option contains "%w" this is replaced with the name of the widget. These hooks to widget names allow callback code to get and set interface widget configurations.

A widget command can be declared as a "Container". This type of widget command is called with an extra arg, that is used by the container to build its contents. Row and column are containers. I have added code to allow the ttk::notebook and the optmenu to be used in the layout spec.

Grid sticky is allowed as an option to all widgets, collected separately and applied when the array is gridded. The grid weight of rows and columns is supplied by -rowweight and -colweight options and applied to the current row or column. The weight options handling isn't quite right yet.


Example:

 grid [row .w -sticky news {
    # Global options
    # Every one is sticky, column 1 is strechy, labels are a little bigger than default
    #
    -sticky news
    -colweight 1
    -label.pady 6

        # A row of a label, "Start" button, "Stop" button and status label.  The
        # widget name of the status label of stored in ::status so that its text
        # can be updated by the script.
        #
        @ Guide ! "Start" -command guide-start ! "Stop"       -command guide-stop @ ::status Status
    &   @ View  ! "Boxes" -command view-boxes  ! "Full Image" -command view-full ! "All Images" -command view-all


        # These radiobuttons all set the fiber and call "set-fiber"
        #
    &   . -radiobutton.variable fiber
        . -radiobutton.command "set-fiber"

        @ Fiber  radiobutton -text Large  -value large
                 radiobutton -text Medium -value medium
                 radiobutton -text Small  -value small
    &   ! "Guide at Offset Position" -command guide-at-offset   x
        row -background red -sticky news {
                -label.pady 6
                -label.padx 4

                -sticky news
                    @ "X Offset" = XOff -width 5
                    @ "Y Offset" = YOff -width 5 } -
    &   ! ::transfer "Transfer Box"  -command guide-transfer x ! "Guide on target" ! "Guide on star"
    &   ! "Guide at Fiber Position"  -command guide-at-fiber
    &   ! "Combine Guide Images" -command guide-combine x = count -width 6 -justify r ! "Clear Images" -command clear-im
    &   x @ "Output Image" = imdir -width 10
    &   @ ""
    &   @ "Exposure Times" -anchor n
       row {

            label -width 7

            . -entry.width 5

              @ "Target"     = box1exp1 ! Set -command "setexp box1 1" = box1exp2 ! Set -command "setexp box1 2"
          & x @ "Guide Star" = box2exp1 ! Set -command "setexp box2 1" = box2exp2 ! Set -command "setexp box2 2"
          & x @ "Full Image" = fullexp1 ! Set -command "setexp full 1" = fullexp2 ! Set -command "setexp full 2"
        } - -

 }] -sticky news

http://cfa-www.harvard.edu/~john/tcl-wiki/tres-layout.png


Here is layout.tcl

 package require Tcl 8.5
 package require Tk
 package require Ttk

 rename lset _lset
 proc lset { listName index value } {

    upvar $listName list

    if { [llength $list] == $index } {
        lappend list $value
        return
    } else {
        _lset list $index $value
    }
 }

 proc transpose {matrix} {               # From https://wiki.tcl-lang.org/2748
    set res {}
    for {set j 0} {$j < [llength [lindex $matrix 0]]} {incr j} {
        set newrow {}
        foreach oldrow $matrix {
            lappend newrow [lindex $oldrow $j]
        }
        lappend res $newrow
    }
    return $res
 }

 proc K { x y } { set x }

 proc shift { V } {
        upvar $V v
        set v [lassign $v value]

        return $value
 }

 proc yank { opt listName { default {} } } {
        upvar $listName list

    if { [set n [lsearch $list $opt]] < 0 } { return $default }

    K [lindex $list $n+1] [set list [lreplace $list $n $n+1]]
 }


 proc char { list char } {
    if { [string length [lindex $list 0]] == 1 } { return 1 }

    string compare [string range [lindex $list 0] 0 [string length $char]-1] $char
 }

 array set Options {
    row  { -sticky -weight -background }
    col  { -sticky -weight -background }
    button      { -text -relief -padx -pady -background -foreground -height -width -justify -anchor -command }
    text        { -text -relief -padx -pady -background -foreground -height -width -justify -anchor }
    label       { -text -relief -padx -pady -background -foreground -height -width -justify -anchor }
    entry       { -text -relief             -background -foreground -height -width -justify         -command }
    radiobutton { -text -relief -padx -pady -background -foreground -height -width -justify -anchor -variable -command }
    checkbutton { -text -relief -padx -pady -background -foreground -height -width -justify -anchor -variable -command }
    optmenu     { -relief -background -foreground }

    ttk::separator { -style -cursor }
    notebook:page { -sticky }
 }
 set Containers { row col notebook optmenu }


 array set Orient { | vertical _ horizontal }
 array set Macro  {
        !    {                                          # Button
            lappend args -text [shift  spec]
            set item button
        }
        @    {                                          # Label
            lappend args -text [shift  spec]
            set item label
        }
        =    {                                          # Entry
            lappend args -textvariable [shift  spec]
            set item entry
        }
        | -                                             # Separators
        _ {
            lappend args -orient $::Orient($item)
            set item ttk::separator
        }                                               # Radio
        ~ {
            lappend args -text [shift  spec]
            set item radiobutton
        }                                               # Check
  • {
            lappend args -text [shift  spec]
            set item checkbutton
        }
 }

 proc row { w args } { layout $w -type row {*}$args }
 proc col { w args } { layout $w -type col {*}$args }

 proc layout { w args } {
    if { $w eq "." } { set w {} }
    set type [yank -type args row]

    set lchild  {};  set llchild  {}
    set lsticky {};  set llsticky {}

    set spec  [lindex $args end]
    set args  [lrange $args 0 end-1]
    set defs(-sticky) [set -sticky [yank -sticky args]]

    if { $w eq "-in" }  { set w [shift args]
    } else {
        if { [lsearch $args -text] >=0 } { ttk::labelframe $w {*}$args
        } else                           { frame      $w {*}$args }
    }

    set rowweights {}
    set colweights {}

    set rowweight 1
    set colweight 1

    set spec [regsub -all -line -- {((^[ \t]*)|([ \t]+))#.*$} $spec { }]        ; # Remove comments

    while { [llength $spec] } {
        set item [shift spec]

        if { ![char $spec .] } { set name $w[shift spec]
        } else {                 set name $w.w[incr n]  }

        if { ![char $spec ::] } { set [shift spec] $name }

        switch -glob -- $item {
            . { continue }
            &    {
                lappend llchild  $lchild;   set lchild  {}
                lappend llsticky $lsticky;  set lsticky {}
                set rowweight 0
                set colweight 0

                continue
            }
            ^ - x - -   {
                lappend lchild  $item
                lappend lsticky {}
                lappend lweight {}
                continue
            }
            +*  { catch { unset defs($item) } }
            -*  {       set defs($item) [shift spec]
                        continue
                }


            default {
                set args {}
                if { [info exists ::Macro($item)] } {
                    eval $::Macro($item)
                }

                set sticky [yank -sticky args $defs(-sticky)]

                while { ![char $spec -] } { lappend  args [shift spec] [string map "%w $name" [shift spec]] }

                if { [info exists ::Options($item)] } {
                    foreach option $::Options($item) {
                        catch { set d($option) $defs($option) }
                        catch { set d($option) $defs(-$item.[string range $option 1 end]) }
                    }
                }

                array set d $args
                set args [array get d]
                if { [lsearch $::Containers $item] >= 0 } { lappend args [shift spec] }

                set child [$item $name {*}$args]
                array unset d
            }
        }

        lset rowweights [llength  $lchild] $rowweight
        lset colweights [llength $llchild] $colweight

        lappend lchild  $child
        lappend lsticky $sticky
    }
    lappend llchild  $lchild;   set lchild  {}
    lappend llsticky $lsticky;  set lsticky {}

    if { $type eq "col" } {
        set llchild  [transpose $llchild]
        set llsticky [transpose $llsticky]

        set tmp $rowweights;  set rowweights  $colweights;  set colweights  $tcp
        set type column
    }

    foreach lchild  $llchild    \
            lsticky $llsticky {
        grid {*}$lchild

        foreach child  $lchild  \
                sticky $lsticky {
            switch -- $child {
             x - ^ - - { }
             default { grid configure $child -sticky $sticky }
            }
        }
    }

    foreach { nrow ncol } [grid size $w] {}

    for { set n 0 } { $n < $ncol } { incr n } { grid columnconfigure $w $n -weight [lindex $colweights $n] }
    for { set n 0 } { $n < $nrow } { incr n } { grid rowconfigure    $w $n -weight [lindex $rowweights $n] }

    return $w
 }

adavis (19th March 2009) GRIDPLUS2 is another grid based widget layout system.