Version 3 of grid forward compatibility

Updated 2009-02-02 15:19:32 by lars_h

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
            }
        }
    }
  }