[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
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
======----
!!!!!!
%| [C<<categoryies>> Debugging] | [Category Dev. Tools] | [Category GUI] |%
!!!!!!