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 better(?) [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 http://wiki.tcl.tk/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 } ---- !!!!!! %| [Category Application] | [Category GUI] |% !!!!!!