[Keith Vetter] : 2008-04-09 : Every have a problem of trying to
figure out why [grid] layout is not looking right? This little
package is a tool to help you debug grid layout problems.

You invoke it with '''::GridDebugger::Dialog ?master?'''.

It puts up a dialog and lets you choose a master widget which
has gridded slaves. It then displays a mockup of cells corresponding
to the gridded layout of the master (not to scale). On this mockup
you can:

   * mouse into a cell to display the slave widget for that cell along with row span, column span and sticky.
   * click a cell to toggle highlighting '''on the master''' the actual grid bounding box for that cell. 

How it does the highlighting is kind of interesting. The command
'''grid bbox ...''' yields size and position info. I then create
a label of that size which I [place] at the correct location.

----
======

##+##########################################################################
#
# GridDebugger.tcl -- Dialog to investigate grid layout
# by Keith Vetter, April 2008
#

package require Tcl 8.5
package require Tk

namespace eval ::GridDebugger {
    variable S                                  ;# Our state
    variable D                                  ;# Display copy
    
    array unset S
    array unset D
    set S(W) .__gaidDialog
    set S(last) ""
    set S(colors) [list red orange yellow green blue cyan purple violet]
    set D(master) "<no master>"
    set D(size) "? x ?"
    image create photo ::img::griddebugger -width 0 -height 0
}
##+##########################################################################
# 
# ::GridDebugger::Dialog -- our debugging dialog
# 
proc ::GridDebugger::Dialog {{master ""}} {
    variable S

    set W $S(W)
    set S(C) $W.c
    destroy $W
    toplevel $W
    wm title $W "Grid Debugger"
    wm protocol $W WM_DELETE_WINDOW ::GridDebugger::Exit
    
    label $W.lm -text "Master:" -anchor e
    $W.lm configure  -font "[font actual [$W.lm cget -font]] -weight bold"
    set font [$W.lm cget -font]
    
    ::ttk::combobox $W.master \
        -state readonly -textvariable ::GridDebugger::D(master) \
        -postcommand ::GridDebugger::PostCommand \
        -width 20
    bind $W.master <<ComboboxSelected>> ::GridDebugger::NewMaster

    label $W.lsize -text "Size:" -anchor e -font $font
    label $W.size -textvariable ::GridDebugger::D(size) -anchor c -font $font
    grid $W.lm $W.master
    grid $W.lsize $W.size -sticky ew

    frame $S(W).f -bd 2 -relief ridge
    canvas $S(C) -width 500 -height 300 -highlightthickness 0
    label $S(W).who -textvariable ::GridDebugger::D(who) -bd 2 -relief ridge \
         -font $font
    pack $S(W).who -in $S(W).f -side bottom -fill x
    pack $S(C) -in $S(W).f -side left -fill both -expand 1
    bind $S(C) <Configure> [list ::GridDebugger::ReCenter %W %h %w]
    ::ttk::button $S(W).exit -text Exit -command ::GridDebugger::Exit
    
    grid $S(W).f - - -sticky news -padx 5
    grid $S(W).exit - - -pady 10
    grid columnconfigure $W 2 -weight 1
    grid rowconfigure $W 2 -weight 1

    ::GridDebugger::NewMaster $master
}
##+##########################################################################
#
# Recenter -- keeps 0,0 at the center of the canvas during resizing
#
proc ::GridDebugger::ReCenter {W h w} {         ;# Called by configure event
    set h2 [expr {$h / 2}] ; set w2 [expr {$w / 2}]
    $W config -scrollregion [list -$w2 -$h2 $w2 $h2]
    ::GridDebugger::Resize
}
##+##########################################################################
# 
# ::GridDebugger::PostCommand -- fills in our combobox with all
# widgets that have gridded slaves
# 
proc ::GridDebugger::PostCommand {args} {
    variable S
    $S(W).master config -values [::GridDebugger::AllGridMasters $S(W)]
}
##+##########################################################################
# 
# ::GridDebugger::GridBbox -- highlights a grid box on master by 'place'ing
# a label on top of it.
# 
proc ::GridDebugger::GridBbox {master row col {clr yellow}} {
    foreach {x y w h} [grid bbox $master $col $row] break
    set top [winfo toplevel $master]
    set tag "$row,$col"
    set W [expr {$top eq "." ? ".__gaid$tag" : "$top.__gaid$tag"}]
    destroy $W
    label $W -image ::img::griddebugger -width $w -height $h -bg $clr
    $W config -padx 0 -pady 0 -bd 0
    place $W -in $master -x $x -y $y -anchor nw
    bind $W <1> [list ::GridDebugger::UnClick $W $row $col]
    return $W
}
##+##########################################################################
# 
# ::GridDebugger::NewMaster -- called when a new master widget is selected
# 
proc ::GridDebugger::NewMaster {{new ""}} {
    variable S
    variable D

    if {$new eq ""} {
        set new $D(master)
    }
    if {! [winfo exists $new]} { ::GridDebugger::Cleanup; return }

    foreach {cols rows} [grid size $new] break
    set this "$new/$rows/$cols"
    if {$this eq $S(last)} return

    ::GridDebugger::Cleanup                     ;# Remove old stuff

    if {$rows == 0 || $cols == 0} {return}

    set D(master) $new
    set S(master) $new
    set D(size) "$rows x $cols"
    ::GridDebugger::Checkerboard $S(C) $rows $cols
    set S(last) $this
}
##+##########################################################################
# 
# ::GridDebugger::Checkerboard -- draws our mockup of the gridded master
# 
proc ::GridDebugger::Checkerboard {c rows cols} {
    $c delete all

    if {[winfo ismapped $c]} {
        set maxX [winfo width $c] ; set maxY [winfo height $c]
    } else {
        set maxX [winfo reqwidth $c] ; set maxY [winfo reqheight $c]
    }

    set dx [expr {($maxX-10) / $cols}]
    set dy [expr {($maxY-10) / $rows}]
    set dx [set dy [expr {min($dx,$dy)}]]

    set row2 [expr {$rows/2.0}]
    set col2 [expr {$cols/2.0}]
    
    for {set row 0} {$row < $rows} {incr row} {
        for {set col 0} {$col < $cols} {incr col} {
            set x0 [expr {($col - $col2) * $dx}]
            set y0 [expr {($row - $row2) * $dy}]
            set x1 [expr {$x0 + $dx}]
            set y1 [expr {$y0 + $dy}]
            set tag cell,$row,$col
            $c create rect $x0 $y0 $x1 $y1 -tag $tag -fill white -outline black
            $c bind $tag <1> [list ::GridDebugger::Click $c $tag]
            $c bind $tag <Enter> [list ::GridDebugger::GetSlaveInfo $row $col]
        }
    }
}
##+##########################################################################
# 
# ::GridDebugger::Resize -- handles resizing the window
# 
proc ::GridDebugger::Resize {} {
    variable S
    set old $S(master)
    ::GridDebugger::Cleanup                     ;# Blow everything away
    ::GridDebugger::NewMaster $old
}
##+##########################################################################
# 
# ::GridDebugger::Click -- called when clicking on a cell in our
# checkerboard. Toggles the cell and toggles highlighting the grid
# cell on the master.
# 
proc ::GridDebugger::Click {C tag} {
    variable S

    if {! [winfo exists $S(master)] || ! [winfo ismapped $S(master)]} {
        ::GridDebugger::Cleanup
        return
    }
    
    foreach {. row col} [split $tag ","] break
    
    set old [$C itemcget $tag -fill]
    if {$old eq "white"} {                      ;# Turn on
        set S(colors) [lassign $S(colors) clr]
        lappend S(colors) $clr
        $C itemconfigure $tag -fill $clr
        set w [::GridDebugger::GridBbox $S(master) $row $col $clr]
        set S(grid,$row,$col) $w
    } else {
        $C itemconfigure $tag -fill white
        destroy $S(grid,$row,$col)
        unset S(grid,$row,$col)
    }
}
##+##########################################################################
# 
# ::GridDebugger::UnClick -- forces a checkerboard cell to be off
# 
proc ::GridDebugger::UnClick {W row col} {
    variable S
    
    destroy $W
    set tag cell,$row,$col
    $S(C) itemconfigure $tag -fill white
    unset S(grid,$row,$col)
}
##+##########################################################################
# 
# ::GridDebugger::AllGridMasters -- returns all widgets w/ gridded slaves
# 
proc ::GridDebugger::AllGridMasters {{exclude ""}} {
    variable S
    set q .
    set all {}

    while {$q ne {}} {
        set q [lassign $q who]
        if {! [winfo ismapped $who]} continue   ;# Not visible
        if {$who in $exclude} continue          ;# Probably our debugger dialog
        lappend q {*}[winfo child $who]
        if {[grid slaves $who] ne {}} {
            lappend all $who
        }
    }
    return $all
}
##+##########################################################################
# 
# ::GridDebugger::Cleanup -- returns everything back to normal
# 
proc ::GridDebugger::Cleanup {} {
    variable S
    variable D

    foreach arr [array names S grid,*] {
        foreach {. row col} [split $arr ","] break
        ::GridDebugger::UnClick $S($arr) $row $col
    }
    $S(C) delete all
    set D(size) "? x ?"
    set D(master) "<no master>"
    set S(master) ""
    set S(last) ""
}
##+##########################################################################
# 
# ::GridDebugger::Exit -- cleans up and exits our dialog
# 
proc ::GridDebugger::Exit {} {
    variable S
    
    ::GridDebugger::Cleanup
    destroy $S(W)
}
##+##########################################################################
# 
# ::GridDebugger::GetSlaveInfo -- displays info about
# the slave at row/col.
# 
proc ::GridDebugger::GetSlaveInfo {row col} {
    variable S
    variable D

    set D(who) [grid slaves $S(master) -row $row -column $col]
    if {$D(who) ne ""} {
        array set info [grid info $D(who)]
        append D(who) " : $info(-rowspan)/$info(-columnspan) $info(-sticky)"
    } else {
        set D(who) "<empty>"
    }
}
################################################################
#
# Demo code
#
toplevel .top
wm geom . +10+10
wm geom .top +300+10
for {set row 0} {$row < 3} {incr row} {
    for {set col 0} {$col < 6} {incr col} {
        set w .l$row$col
        label $w -text "$row,$col" -bd 1 -relief solid -width 5
        grid $w -row $row -column $col
    }
}

label .top.a1 -text "Three columns" -bd 2 -relief ridge
label .top.b1 -text "Three\nrows" -bd 2 -relief ridge
label .top.b2 -text "ABC" -bd 2 -relief ridge
label .top.b3 -text "ABC" -bd 2 -relief ridge
label .top.c3 -text "XYZ" -bd 2 -relief ridge
label .top.d2 -text "MNO" -bd 2 -relief ridge
label .top.d3 -text "MNO" -bd 2 -relief ridge
label .top.e1 -text "Three columns" -bd 2 -relief ridge
grid .top.a1 - - -sticky ew
grid .top.b1 .top.b2 .top.b3 -sticky ns
grid ^ x .top.c3
grid ^ .top.d2 .top.d3
grid .top.e1 - -
::GridDebugger::Dialog .top

return

======

<<categories>> Debugging | Dev. Tools | GUI