grid forward compatibility

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 1 [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 1 [
                            list Tk4.2_grid $option $master $index] $options
                    }
                }
            }
            default {
                uplevel 1 [list Tk4.2_grid $option] $args
            }
        }
    }
}