package require Tk
if {[package vcompare [package provide Tk] 4.2] < 0} {
# Changes to [grid] in Tk 4.2:
# * [grid columnconfigure] and [grid rowconfigure] added a
# -pad option and a zero argument form
# * [grid bbox] now takes 0 to 2 ?column row? pairs;
# used to take exactly 1. Compatibility not implemented,
# but more instructive error message provided.
# * [grid remove] is a new subcommand that removes a widget
# from [grid] management, but remembers its configuration
# in case [grid] gets control of it again later. Implemented
# in terms of [grid forget] and with use of a global array to
# remember configurations.
# * [grid $slave ...] started recognizing x and ^ as the first
# $slave in Tk 4.2. Strangely, [grid configure] still does not
# allow this (See Bug 418644) so the (partial) compatibility
# workaround for this is rather complicated.
array set Tk4.1_grid [list "" ""]
unset Tk4.1_grid()
rename grid Tk4.1_grid
# Parse the arguments to [grid configure] to determine where
# $slave arguments end and $option arguments begin
proc Tk4.1_gridParseSlaves {args} {
set firstOption 0
foreach arg $args {
switch -glob -- $arg {
- -
^ -
x -
.* {
incr firstOption
}
default {
break
}
}
}
set slaves [lrange $args 0 $firstOption]
set slaves [lreplace $slaves end end]
set options [lrange $args $firstOption end]
return [list $slaves $options]
}
proc grid {option args} {
global Tk4.1_grid
set myName [lindex [info level 0] 0]
if {[string match .* $option]} {
# Supply optional subcommand 'configure' and re-call
return [uplevel [list $myName configure $option] $args]
}
if {[llength $args] == 0} {
return -code error "wrong # args:\
should be \"$myName option arg ?arg ...?\""
}
if {[string match {[x^]} $option]} {
foreach {slvs opts} [eval \
[list Tk4.1_gridParseSlaves $option] $args] {break}
if {[llength $opts] % 2} {
return -code error "extra option \"[lindex $opts end]\"\
(option with no value?)"
}
array set optArr $opts
set numSlaves [llength $slvs]
set defCol 0
for {set i 0} {$i < $numSlaves} {incr i} {
set slv [lindex $slvs $i]
if {[string match {[x^]} $slv]} {
incr defCol
if {[string match ^ $slv]} {
# Fill in code here to expand the slave in
# the row above, if it ever turns out we need
# that feature.
error "Sorry, '^' not implemented"
}
} elseif {[string match .* $slv]} {
# Found a real window
if {[info exists optArr(-column)]} {
# Column explicitly given; relative placement
# stuff has no effect. Call grid configure
# with first real window moved up to front
return [uplevel Tk4.1_grid configure \
[lrange $slvs $i end] $opts]
}
# No column explicitly given; honor ^ and x
# First collect all trailing -
set rs [list $slv]
incr i
while {[string match - [lindex $slvs $i]]} {
lappend rs -
incr i
}
incr i -1
# grid the real window and its trailing -
uplevel Tk4.1_grid configure $rs [array get optArr] \
-column $defCol
if {![info exists optArr(-row)]} {
# Capture the row to apply to other slaves
array set foo [Tk4.1_grid info $slv]
set optArr(-row) $foo(-row)
}
incr defCol [llength $rs]
} else {
return -code error "Must specify window\
before shortcut '-'."
}
}
return
}
switch -glob -- $option {
b* {
if {[string first $option bbox] != 0} {
return [uplevel [list Tk4.1_grid $option] $args]
}
switch -exact -- [llength $args] {
1 {
return -code error "\[$myName bbox\] syntax not\
supported; Upgrade to Tk 4.2 or higher"
}
5 {
return -code error "\[$myName bbox \$column \$row\
\$column \$row\] syntax not supported;\
Upgrade to Tk 4.2 or higher"
}
default {
uplevel [list Tk4.1_grid bbox] $args
}
}
}
con* {
if {[string first $option configure] != 0} {
return [uplevel [list Tk4.1_grid $option] $args]
}
foreach {slaves opts} \
[eval Tk4.1_gridParseSlaves $args] {break}
# First restore saved options from prior 'remove' if any
foreach slave $slaves {
if {[info exists Tk4.1_grid($slave)]} {
uplevel [list Tk4.1_grid configure $slave] \
[set Tk4.1_grid($slave)]
unset Tk4.1_grid($slave)
}
}
uplevel Tk4.1_grid configure $slaves $opts
}
f* {
if {[string first $option forget] != 0} {
return [uplevel [list Tk4.1_grid $option] $args]
}
foreach slave $args {
catch {unset Tk4.1_grid($slave)}
}
uplevel Tk4.1_grid forget $args
}
re* {
if {[string first $option remove] != 0} {
return [uplevel [list Tk4.1_grid $option] $args]
}
foreach slave $args {
set slaveConf [Tk4.1_grid info $slave]
if {[llength $slaveConf]} {
array set Tk4.1_grid [list $slave $slaveConf]
}
uplevel [list Tk4.1_grid forget $slave]
}
}
ro* -
col* {
if {(([string first $option rowconfigure] != 0)
&& ([string first $option columnconfigure] != 0))
|| ([llength $arg] < 2)} {
return [uplevel [list Tk4.1_grid $option] $args]
}
set master [lindex $args 0]
set index [lindex $args 1]
set options [lrange $args 2 end]
if {[llength $options] == 0} {
set retList [list -minsize]
lappend retList \
[Tk4.1_grid $option $master $index -minsize]
lappend retList -pad 0 -weight
lappend retList \
[Tk4.1_grid $option $master $index -weight]
return $retList
}
if {[llength $options] == 1} {
if {[string match -pad [lindex $options 0]]} {
return 0
} else {
uplevel [list Tk4.1_grid $option] $args
}
} elseif {[llength $options] % 2} {
uplevel [list Tk4.1_grid $option] $args
} else {
# Don't use an array to process options; that
# will not preserve their order.
set passOpts {}
foreach {opt val} $options {
if {[string compare -pad $opt]} {
lappend passOpts $opt $val
}
}
if {[llength $passOpts]} {
uplevel [list Tk4.1_grid $option $master $index] \
$passOpts
}
}
}
default {
uplevel [list Tk4.1_grid $option] $args
}
}
}
}
if {[package vcompare [package provide Tk] 8] < 0} {
# Starting in Tk 8.0, the grid subcommands rowconfigure and
# columnconfigure allowed configuration of
# a list of rows or columns, not just one.
rename grid Tk4.2_grid
proc grid {option args} {
switch -exact -- $option {
ro* -
col* {
if {([string first $option rowconfigure] != 0)
&& ([string first $option columnconfigure] != 0)} {
return [uplevel [list Tk4.2_grid $option] $args]
}
if {([llength $args] < 4)
|| ([llength [lindex $args 1]] <= 1)} {
uplevel [list Tk4.2_grid $option] $args
} else {
set master [lindex $args 0]
set indices [lindex $args 1]
set options [lrange $args 2 end]
foreach index $indices {
uplevel [list Tk4.2_grid $option $master $index] \
$options
}
}
}
default {
uplevel [list Tk4.2_grid $option] $args
}
}
}
}Some old code (relevant time is circa 1997, according to Tcl chronology) to make the grid command in Tk 4 accept idioms added in Tk 8.
Getting started
Home • Recent changes • Help • Create new page • Search • Add comments
• Edit