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
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.