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. ====== 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 } } } } ====== <> Oldies