# tko_grid --
#
#   Implementation of ::tko::grid command.
#
# Copyright (c) 2021 <r.zaumseil@freenet.de>

# Extended functionality for the ::grid() command.
# args - ?row column ?option value? ..? widget path ?widgetoptions?
#   row             - Row number in ::grid() command
#   column          - Column number in ::grid() command
#   options         - "::grid" options and additional "tko::grid" options.
#       -column     - "::grid" option
#       -columnspan - "::grid" option
#       -in         - "::grid" option
#       -ipadx      - "::grid" option
#       -ipady      - "::grid" option
#       -row        - "::grid" option
#       -rowspan    - "::grid" option
#       -sticky     - "::grid" option
#       -rminsize   - "::grid rowconfigure" option
#       -rweight    - "::grid rowconfigure" option
#       -runiform   - "::grid rowconfigure" option
#       -rpad       - "::grid rowconfigure" option
#       -cminsize   - "::grid columnconfigure" option
#       -cweight    - "::grid columnconfigure" option
#       -cuniform   - "::grid columnconfigure" option
#       -cpad       - "::grid columnconfigure" option
#       -tip        - Tooltip widget text
#       -tipinfo    - Tooltip widget additional info text
#       -tipimage   - Tooltip widget image
#       -statevar   - Name of statevar to use
#       -sb ?neswa? - Create widgets with scrollbars.
#   widget          - Widget creation command. Should return widget path.
#   path            - Path name of "widget" to create
#   widgetoptions   - Configuration options of "widget"
# If the first parameter in "args" is widget then the normal ::grid() command
# is called.
#
proc ::tko::grid {args} {
    set row     [lindex $args 0]
    if {![string is integer -strict $row]} {
        return [::grid {*}$args]
    }
    set col     [lindex $args 1]
    set args    [lrange $args 2 end]
    array set my {
        -tip        {}
        -tipinfo    {}
        -tipimage   {}
        -statevar   {}
        -sb         {}
        gridopts    {}
        rowopts     {}
        colopts     {}
    }
    set i 0
    foreach {myOpt myArg} $args {
        switch -- $myOpt {
        -columnspan - -in - -ipadx - -ipady - -padx - -pady - -rowspan - -sticky {
            lappend my(gridopts) $myOpt $myArg
        }
        -rminsize - -rweight - -runiform - -rpad {
            lappend my(rowopts) -[string range $myOpt 2 end] $myArg
        }
        -cminsize - -cweight - -cuniform - -cpad {
            lappend my(colopts) -[string range $myOpt 2 end] $myArg
        }
        -sb - -tip - -tipinfo - -tipimage - -statevar {
            set my($myOpt) $myArg
        }
        -column - -row {}
        default {break}
        }
        incr i 2
    }
    # build widget with scrollbars
    if {$my(-sb) ne {}} {
        set myWdg   [lindex $args [expr {$i+1}]]
        ::grid [::ttk::frame $myWdg] -row $row -column $col {*}$my(gridopts)
        ::grid rowconfigure $myWdg 2 -weight 1
        ::grid columnconfigure $myWdg 2 -weight 1
        # rename internal frame widget
        rename $myWdg ::tko::grid_$myWdg
        # alias command to real widget
        interp alias {} $myWdg {} $myWdg.0
        set myWdg0 [[lindex $args $i] $myWdg.0 {*}[lrange $args [expr {$i+2}] end]]
        ::grid $myWdg0 -in $myWdg -row 2 -column 2 -sticky nesw
        set myList {}
        set myAuto 0
        foreach myDir [lsort [split $my(-sb) {}]] {;# "a" comes first
            switch -- $myDir {
            a { set myAuto 1 }
            w {
                ::grid [::ttk::scrollbar $myWdg.w] -row 2 -column 1 -sticky ns
                lappend myList $myAuto vertical y $myWdg.w
            }
            e {
                ::grid [::ttk::scrollbar $myWdg.e] -row 2 -column 3 -sticky ns
                lappend myList $myAuto vertical y $myWdg.e
            }
            n {
                ::grid [::ttk::scrollbar $myWdg.n] -row 1 -column 2 -sticky ew
                lappend myList $myAuto horizontal x $myWdg.n
            }
            s {
                ::grid [::ttk::scrollbar $myWdg.s] -row 3 -column 2 -sticky ew
                lappend myList $myAuto horizontal x $myWdg.s
            }
            default {
return -code error "wrong -sb char '$myDir', should be one of a, w, e, n or s"
            }
            }
        }
        foreach {myAuto myOri myXy mySb} $myList {
            bind $mySb <Map>\
            {wm geometry [winfo toplevel %W] [wm geometry [winfo toplevel %W]]}
            $mySb configure -orient $myOri -command [list $myWdg0 ${myXy}view]
            if {$myAuto} {
                set myBody "if {\$x <=0 && \$y >=1} {::grid remove $mySb} else {::grid $mySb} ; $mySb set \$x \$y"
            } else {
                set myBody "$mySb set \$x \$y"
            }
            $myWdg0 configure -${myXy}scrollcommand "apply {{x y} {$myBody}}"
        }
        # provide clean up 
        bindtags $myWdg [list ::tko::grid$myWdg {*}[bindtags $myWdg]]
        bind ::tko::grid$myWdg <Destroy> "interp alias {} $myWdg {}"
    } else {
        set myWdg [uplevel 1 [lrange $args $i end]]
    }
    # use grid manager for widget
    ::grid $myWdg -row $row -column $col {*}$my(gridopts)
    # configure grid manager (grid info .. -> -in <manager> ..)
    if {$my(rowopts) ne {}} {
        ::grid rowconfigure    [lindex [::grid info $myWdg] 1] $myWdg {*}$my(rowopts)
    }
    if {$my(colopts) ne {}} {
        ::grid columnconfigure [lindex [::grid info $myWdg] 1] $myWdg {*}$my(colopts)
    }
    # tip help strings
    if {$my(-tip) ne {}} {
        if {$my(-tipimage) eq {}} {catch {set my(-tipimage) [$myWdg cget -image]}}
        ::tko::tip $myWdg -image $my(-tipimage) -info $my(-tipinfo) -text $my(-tip)
    }
    # state configuration
    if {$my(-statevar) ne {}} {
        set myCmd [list $myWdg configure -state]
        ::tko::state bind $my(-statevar) $myCmd
        bind $myWdg <Destroy> +[list ::tko::state unbind $my(-statevar) $myCmd]
    }
    return $myWdg
}

# vim: set ts=4 sw=4 sts=4 et :
