###################################################################################
#
# supergrid: automatically grids all the widgets of a frame and subframes based
# in information included at widget creation using -grid gridinfo
#
# The information is included as a list with short typing.
# supergrid tries to be clever by automatically assigning the weights to the
# columns and rows
#
# examples:
#
# label .l3 -grid 0 grid this label in column 0
# label .l3 -grid "1 3" grid this label in column 1 with columnspan 3
# label .l3 -grid "1 px3" grid this label in column 1 with padx 3
# label .l3 -grid "1 py2" grid this label in column 1 with pady 2
# label .l3 -grid "1 nw" grid this label in column 1 with sticky nw
# label .l3 -grid "1 nwwe" grid this label in column 1 with sticky nw
# but weight 1 in column
# label .l3 -grid "0 uca" grid this label in column 0 with -uniform a
#
#
# Limitations: A widget cannot be gridded with rowconfigure > 1
#
# Usage:
#
# Add option -grid to all widgets of a frame and subframes
# use: supergrid::go
#
# Additional commands:
#
# supergrid::gridinfo { w gridval } Enters the grid information for widget w
#
# gridinfo:
# This is a TCL list that can contain the following items:
# -One digit it is the column number
# -two digits the first one is the column number, the 2nd is the
# columnspan (optional)
# -any of 'nsew' the sticky option (optional)
# -px{digit} or py{digit} the -padx -pady (optional)
# -ucuniformgroup equivalent to: -uniform uniformgroup in current column
# -uruniformgroup equivalent to: -uniform uniformgroup in current row
#
# Note: Modify the supergrid definition to add new custom widgets
#
# Variable UseGPrefix: if set to one prefix, it is necessary to add that prefix
# to the widgets names
# example: if UseGPrefix is g_ then use g_label .l3 -grid 0
#
###################################################################################
################################################################################
# This software is copyrighted by Ramon Ribó (RAMSAN) ramsan@cimne.upc.es.
# (http://gid.cimne.upc.es/ramsan) The following terms apply to all files
# associated with the software unless explicitly disclaimed in individual files.
# The authors hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose, provided
# that existing copyright notices are retained in all copies and that this
# notice is included verbatim in any distributions. No written agreement,
# license, or royalty fee is required for any of the authorized uses.
# Modifications to this software may be copyrighted by their authors
# and need not follow the licensing terms described here, provided that
# the new terms are clearly indicated on the first page of each file where
# they apply.
# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.
################################################################################
package require Tcl 8.3
package require Tk 8.3
package provide supergrid 1.2
namespace eval supergrid {
variable UseGPrefix ""
variable widgets [list label entry button checkbutton radiobutton frame canvas \
scrollbar text listbox menubutton scale]
variable widgets2 [list panedwindow TitleFrame SpinBox ComboBox date::datefield \
ScrolledWindow PanedWindow ButtonBox MainFrame Button Label NoteBook \
Separator Entry treectrl hugecombo labelframe spinbox]
variable widgets3 [list ttk::button ttk::checkbutton ttk::combobox ttk::entry \
ttk::frame ttk::label ttk::labelframe ttk::menubutton ttk::notebook \
ttk::panedwindow ttk::progressbar ttk::radiobutton ttk::scale ttk::scrollbar \
ttk::separator ttk::sizegrip ttk::treeview]
if { [info command ttk::spinbox] ne "" } {
lappend widgets3 ttk::spinbox
}
variable SubGridClasses [list Frame TFrame Labelframe TLabelframe]
variable HorizontalClasses [list Entry TEntry Text Canvas Listbox PanedWindow TPanedwindow \
TitleFrame ComboBox TCombobox NoteBook TNotebook MainFrame ScrolledWindow \
Panedwindow TPanedwindow TreeCtrl Treeview Labelframe TLabelframe Spinbox TSpinbox Hugecombo]
variable VerticalClasses [list Text Canvas Listbox PanedWindow TPanedwindow TitleFrame \
NoteBook TNotebook MainFrame ScrolledWindow panedwindow Panedwindow TPanedwindow \
TreeCtrl Treeview Labelframe TLabelframe NoteBook TNotebook]
variable ScrollClasses [list Scrollbar TScrollbar]
variable DiscardClasses [list Toplevel Menu]
variable DiscardWidgets {^\.#BWidget}
variable data
}
proc supergrid::init {} {
variable widgets
variable widgets2
variable widgets3
variable data
variable UseGPrefix
if { $UseGPrefix != "" } {
if { [info commands ::$UseGPrefix[lindex $widgets 0]] != "" } { return }
set prefix ::$UseGPrefix
set body {
set ipos [lsearch $args -grid]
if { $ipos != -1 } {
set supergrid::data($w) [lindex $args [expr $ipos+1]]
set args [lreplace $args $ipos [expr $ipos+1]]
}
return [eval [string range [lindex [info level 0] 0] LENGTH end] \
$w $args]
}
regsub LENGTH $body [string length $UseGPrefix] body
} else {
if { [info commands ::[lindex $widgets 0]_supergrid] != "" } { return }
set prefix ::
set body {
set ipos [lsearch $args -grid]
if { $ipos != -1 } {
set supergrid::data($w) [lindex $args [expr $ipos+1]]
set args [lreplace $args $ipos [expr $ipos+1]]
}
return [eval [lindex [info level 0] 0]_supergrid $w $args]
}
}
foreach i $widgets {
if { [info commands ::$i] == "" } { auto_load ::$i }
if { [info commands ::$i] == "" } { error "command ::$i does not exist" }
if { $UseGPrefix == "" } { rename $prefix$i $prefix${i}_supergrid }
proc $prefix$i { w args } $body
}
foreach i $widgets2 {
if { [info commands ::$i] == "" } { auto_load ::$i }
if { [info commands ::$i] == "" } { continue }
if { $UseGPrefix == "" } { rename $prefix$i $prefix${i}_supergrid }
proc $prefix$i { w args } $body
}
foreach i $widgets3 {
if { [info commands ::$i] == "" } { auto_load ::$i }
if { [info commands ::$i] == "" } { error "command ::$i does not exist" }
if { $UseGPrefix == "" } { rename $prefix$i $prefix${i}_supergrid }
proc $prefix$i { w args } $body
}
}
proc supergrid::gridinfo { w gridval } {
variable data
set data($w) $gridval
}
proc supergrid::go { f { isrecursive 0 } } {
variable SubGridClasses
variable HorizontalClasses
variable VerticalClasses
variable ScrollClasses
variable DiscardClasses
variable DiscardWidgets
variable data
if { ![info exists data] } {
error "error: before running supergrid::go it is necessary to use -grid in widgets"
}
# foreach "cols rows" [grid size $f] break
# for { set i 0 } { $i < $cols } { incr i } {
# grid columnconfigure $f $i -weight 0 -minsize 0 -pad 0
# }
# for { set i 0 } { $i < $rows } { incr i } {
# grid rowconfigure $f $i -weight 0 -minsize 0 -pad 0
# }
set needsweightx 0
set needsweighty 0
# doing first pass, horizontal weights only applied for columnspan 1
set maxcolumnspan 0
set currentcol -1
set currentrow 0
foreach i [winfo children $f] {
if { [lsearch $DiscardClasses [winfo class $i]] != -1 } {
continue
}
if { [regexp $DiscardWidgets $i] } { continue }
if { ![info exists data($i)] } {
if { [winfo toplevel $i] ne [winfo toplevel $f] } { continue }
error "error: before running supergrid::go it is necessary to use -grid in widget $i"
}
if { $data($i) == "no" } { continue }
set needsweightxL 0; set needsweightyL 0
if { [lsearch $SubGridClasses [winfo class $i]] != -1 } {
if { [catch {
foreach "needsweightxL needsweightyL" [go $i 1] break
}] } {
set needsweightxL 1
set needsweightyL 1
}
}
set col -1
set columnspan 1
set sticky ""
set padx 0
set pady 0
set uniformc ""
set uniformr ""
foreach item $data($i) {
if { [string is integer -strict $item] } {
if { $col == -1 } {
set col $item
} else {
set columnspan $item
}
} elseif { [string match px* $item] } {
set padx [string range $item 2 end]
} elseif { [string match py* $item] } {
set pady [string range $item 2 end]
} elseif { [string match uc* $item] } {
set uniformc [string range $item 2 end]
} elseif { [string match ur* $item] } {
set uniformr [string range $item 2 end]
} else { set sticky $item }
}
if { $col == -1 } {
error "error bad widget name '$i' for supergrid"
}
if { $col <= $currentcol } { incr currentrow }
set currentcol $col
if { $columnspan > $maxcolumnspan } { set maxcolumnspan $columnspan }
if { [lsearch $HorizontalClasses [winfo class $i]] != -1 } {
set needsweightxL 1
}
if { [lsearch $VerticalClasses [winfo class $i]] != -1 } {
set needsweightyL 1
}
if { [lsearch $ScrollClasses [winfo class $i]] != -1 } {
switch [$i cget -orient] {
horizontal { set needsweightxL 1 }
vertical { set needsweightyL 1 }
}
}
set rsticky ""
foreach j "e w n s" {
set c($j) [llength [regexp -inline -all $j $sticky]]
}
switch $c(w) {
2 {
switch $c(e) {
0 - 2 {
error "invalid sticky '$sticky"
}
}
set needsweightxL 1
append rsticky w
}
1 {
switch $c(e) {
2 { set needsweightxL 1 ; append rsticky e }
1 { set needsweightxL 1 ; append rsticky we }
0 { set needsweightxL 0 ; append rsticky w }
}
}
0 {
switch $c(e) {
2 { error "invalid sticky '$sticky" }
1 { set needsweightxL 0 ; append rsticky e }
0 { if { $needsweightxL } { append rsticky ew } }
}
}
}
switch $c(n) {
2 {
switch $c(s) {
0 - 2 {
error "invalid sticky '$sticky"
}
}
set needsweightyL 1
append rsticky n
}
1 {
switch $c(s) {
2 { set needsweightyL 1 ; append rsticky s }
1 { set needsweightyL 1 ; append rsticky ns }
0 { set needsweightyL 0 ; append rsticky n }
}
}
0 {
switch $c(s) {
2 { error "invalid sticky '$sticky" }
1 { set needsweightyL 0 ; append rsticky s }
0 { if { $needsweightyL } { append rsticky ns } }
}
}
}
grid $i -row $currentrow -column $currentcol -columnspan $columnspan -padx $padx \
-pady $pady -sticky $rsticky
if { $columnspan == 1 && $needsweightxL } {
grid columnconfigure $f $currentcol -weight 1
} else {
grid columnconfigure $f $currentcol -weight 0
}
if { $uniformc != "" } { grid columnconfigure $f $currentcol -uniform $uniformc }
if { $needsweightyL } {
grid rowconfigure $f $currentrow -weight 1
} else {
grid rowconfigure $f $currentrow -weight 0
}
if { $uniformr != "" } { grid rowconfigure $f $currentrow -uniform $uniformr }
if { $needsweightxL } {set needsweightx 1}
if { $needsweightyL } { set needsweighty 1}
}
# doing second pass, horizontal weights applied for columnspan >1
# need to be done as many times as columnspan to find the best resizing
for { set span 2 } { $span <= $maxcolumnspan} { incr span } {
set currentcol -1
set currentrow 0
foreach i [winfo children $f] {
if { [lsearch $DiscardClasses [winfo class $i]] != -1 } {
continue
}
if { [regexp $DiscardWidgets $i] } { continue }
set needsweightxL 0; set needsweightyL 0
if { [lsearch $SubGridClasses [winfo class $i]] != -1 } {
if { [catch {
foreach "needsweightxL needsweightyL" [go $i 1] break
}] } {
set needsweightxL 1
set needsweightyL 1
}
}
set col -1
set columnspan 1
set sticky ""
set padx 0
set pady 0
set uniformc ""
set uniformr ""
foreach item $data($i) {
if { [string is integer -strict $item] } {
if { $col == -1 } {
set col $item
} else {
set columnspan $item
}
} elseif { [string match px* $item] } {
set padx [string range $i 2 end]
} elseif { [string match py* $item] } {
set pady [string range $i 2 end]
} elseif { [string match uc* $item] } {
set uniformc [string range $i 2 end]
} elseif { [string match ur* $item] } {
set uniformr [string range $i 2 end]
} else { set sticky $item }
}
if { $col <= $currentcol } { incr currentrow }
set currentcol $col
if { [lsearch $HorizontalClasses [winfo class $i]] != -1 } {
set needsweightxL 1
}
if { [lsearch $VerticalClasses [winfo class $i]] != -1 } {
set needsweightyL 1
}
if { [lsearch $ScrollClasses [winfo class $i]] != -1 } {
switch [$i cget -orient] {
horizontal { set needsweightxL 1 }
vertical { set needsweightyL 1 }
}
}
set rsticky ""
foreach i "e w n s" {
set c($i) [llength [regexp -inline -all $i $sticky]]
}
switch $c(w) {
2 {
switch $c(e) {
0 - 2 {
error "invalid sticky '$sticky"
}
}
set needsweightxL 1
append rsticky w
}
1 {
switch $c(e) {
2 { set needsweightxL 1 ; append rsticky e }
1 { set needsweightxL 1 ; append rsticky we }
0 { set needsweightxL 0 ; append rsticky w }
}
}
0 {
switch $c(e) {
2 { error "invalid sticky '$sticky" }
1 { set needsweightxL 0 ; append rsticky e }
0 { if { $needsweightxL } { append rsticky ew } }
}
}
}
switch $c(n) {
2 {
switch $c(s) {
0 - 2 {
error "invalid sticky '$sticky"
}
}
set needsweightyL 1
append rsticky n
}
1 {
switch $c(s) {
2 { set needsweightyL 1 ; append rsticky s }
1 { set needsweightyL 1 ; append rsticky ns }
0 { set needsweightyL 0 ; append rsticky n }
}
}
0 {
switch $c(s) {
2 { error "invalid sticky '$sticky" }
1 { set needsweightyL 0 ; append rsticky s }
0 { if { $needsweightyL } { append rsticky ns } }
}
}
}
if { $columnspan == $span && $needsweightxL } {
set found 0
for { set j $currentcol } { $j < [expr $currentcol+$columnspan] } { incr j } {
if { [grid columnconfigure $f $j -weight] > 0 } {
set found 1
break
}
}
if { !$found } {
# grid columnconfigure $f [expr $currentcol+$columnspan-1] -weight 1
for { set j $currentcol } { $j < [expr $currentcol+$columnspan] } { incr j } {
grid columnconfigure $f $j -weight 1
}
}
}
}
}
if { !$isrecursive } { cleandata $f }
if { !$needsweightx } {
grid columnconfigure $f [lindex [grid size $f] 0] -weight 1
}
if { !$needsweighty } {
grid rowconfigure $f [lindex [grid size $f] 1] -weight 1
}
return [list $needsweightx $needsweighty]
}
proc supergrid::cleandata { f } {
variable SubGridClasses
variable DiscardClasses
variable DiscardWidgets
variable data
foreach i [winfo children $f] {
if { [lsearch $DiscardClasses [winfo class $i]] != -1 } {
continue
}
if { [regexp $DiscardWidgets $i] } { continue }
if { [lsearch $SubGridClasses [winfo class $i]] != -1 } {
catch { cleandata $i }
}
catch { unset data($i) }
}
}
################################################################################
# it is necessary to init the game
################################################################################
supergrid::init
################################################################################
# that's all
################################################################################
# # simple example
# toplevel .t
# label .t.l -text "Hello world!" -grid "0 2"
# button .t.b -text OK -width 8 -grid "0 px3"
# button .t.b1 -text Cancel -width 8 -command exit -grid "1 px3"
# supergrid::go .t
# # more complex example
# button .title -text "The TCL-TK poll" -font [list Helvetica 16 bold] \
# -activeforeground red -bd 0 -grid "0 5"
# label .q -text "Do you like TCL?" -grid "0 2"
# radiobutton .r1 -text Yes -var kk2 -value y -grid 2
# radiobutton .r2 -text No -var kk2 -value n -grid 3
# radiobutton .r3 -text "Yes with Supergrid" -var kk2 -value ysg -grid 4
# set kk2 ysg
# label .n -text "Enter the best news group:" -grid "0 2 e"
# entry .e -grid "2 3" ; .e ins end comp.lang.tcl
# label .w -text "Who are you?" -grid 0
# tk_optionMenu .om kk Beginner Advanced Expert
# supergrid::gridinfo .om "1 2"
# frame .f -relief raised -bd 2 -grid "0 5"
# label .f.l -text "Enter your impressions:" -grid "0 2 w"
# text .f.t -xscroll ".f.sh set" -yscroll ".f.sv set" \
# -width 20 -height 4 -grid 0
# scrollbar .f.sv -orient vertical -command ".f.t yview" -grid 1
# scrollbar .f.sh -orient horizontal -command ".f.t xview" -grid 0
# frame .f2 -relief raised -bd 2 -grid "0 5"
# frame .buts -grid "0 5"
# button .buts.ok -text OK -width 8 -grid "0 px2 py3"
# button .buts.cancel -text Cancel -width 8 -command exit -grid "1 px2"
# supergrid::go .
# proc flash { b } {
# $b flash
# after 500 flash $b
# }
# flash .title