Version 4 of Taming Wild Windows

Updated 2002-07-25 17:18:03

Diagrams, and an explanation of the algorithm:

Page 1

http://www.rohanpall.com/gfx/taming_wild_windows/page01.jpg

Page 2

http://www.rohanpall.com/gfx/taming_wild_windows/page02.jpg

Page 3

http://www.rohanpall.com/gfx/taming_wild_windows/page03.jpg

Code

 if {[string equal "windows" $::tcl_platform(platform)]} {console show}

 proc snap2screen {W} {

   # so unmaximizing a toplevel on windows works
   if {[string equal "zoomed" [wm state $W]]} return

   # always returns the same on windows once prog is started - bug in Tk!
   set sw [winfo screenwidth $W]
   set sh [winfo screenheight $W]

   foreach {w h x y} [string map {x " " + " "} [winfo geometry $W]] break

   set sensi 40  ;# the magnetic border sensitivity

   set snapped 0    ;# do we need to snap the window anywhere?

   # Trick: Only do one of the snapping for each axis, we dont want a big
   #        window to be pulled from one side to the other... thats dumb ;)

   set yt  0
   set syt $y
   set yb  [expr {$sh - 54}]  ;# add some space coz of the taskbar on windows
   set syb [expr {$h + $y}]

   if {$syt <= ($yt + $sensi)} {

     puts "snapping to yt"
     set snapped 1 ; set y $yt

   } elseif {$syb >= ($yb - $sensi)} {

     puts "snapping to yb"
     set snapped 1 ; set y [expr {$yb - $h}]

   }

   set xr  [expr {$sw - 8}] ;# add some pixel padding to look nice on windows
   set sxr [expr {$w + $x}]
   set xl  0
   set sxl $x

   if {$sxr >= ($xr - $sensi)} {

     puts "snapping to xr"
     set snapped 1 ; set x [expr {$xr - $w}]

   } elseif {$sxl <= ($xl + $sensi)} {

     puts "snapping to xl"
     set snapped 1 ; set x $xl

   }

   if {$snapped} {
     # drop the configure binding for a sec so we dont get into recursive hell!
     set cscript [bind $W <Configure>]
     bind $W <Configure> {}
     wm geometry $W [join [list $w x $h + $x + $y] ""]  ;# do the snap
     update  ;# so that the window gets moved now, without this there is trouble
     bind $W <Configure> $cscript
   } else {
     puts "not snapped"
   }

 }

 bind . <Configure> {snap2screen %W}
 toplevel .top
 bind .top <Configure> {snap2screen %W}