Toplevel Geometry Manager

#The following is my initial stab at tying multiple toplevels together in such a way that MOVE and RESIZE configuration events are coordinated among the grouped toplevels. In the example included, the "main" windows resize and move events affect the associated windows. Long chains of such associations may be created. Here's the code:

   #I wish this were standard...
   proc setlist {vnames vvals} {
       set i -1
       foreach n $vnames {
           uplevel 1 [list set $n [lindex $vvals [incr i]]]
       }
       return [lrange $vvals 0 $i]
   }
   
   #Attempt to get the *real* geometry of a window
   proc true_geom {w} {
       update
       catch {
           if {[regexp -- {-geometry +([0-9x+-]+)} [exec xwininfo -id [wm frame $w]] - geom]} {
               return $geom
           }
       }
       #attempt to guess decoration sizes if xwininfo call fails...
       setlist {dx dy x0 y0} [parse_geom [wm geom $w]]
       set rx [winfo rootx $w] ; set ry [winfo rooty $w]
       set left [expr $rx - $x0] ; set top [expr $ry - $y0]
   
       #*assume* that the bottom and right edges match the left edge in size
       return [expr $dx + 2*$left]x[expr $dy + $top + $left]+[expr $x0 - $left]+[expr $y0 - $top]
   }
   
   #extract geometry info from a geometry string
   proc parse_geom {geom} {
       set screenheight [winfo screenheight .]
       set screenwidth  [winfo screenwidth .]
       regexp {^([0-9]+)x([0-9]+)([+-])([+-]?[0-9]+)([+-])([+-]?[0-9]+)} $geom - dx dy xs xpos ys ypos
       if {$xs == {-}} {
           set xpos [expr $screenwidth - $xpos]
       }
       if {$ys == {-}} {
           set ypos [expr $screenwidth - $ypos]
       }
       return [list $dx $dy $xpos $ypos]
   }
   
   #adjust t's geometry so that tside fits against the windows in args
   proc adjust_geom {t tside args} {
       update
       foreach w [linsert $args 0 $t] {
           set wm_geom [wm geom $w] ; set winfo_geom [winfo geom $w]
           #wm geom $w $wm_geom
           #if {$wm_geom != $winfo_geom} { wm geom $w $winfo_geom }  ;#force internal geometry update
           setlist {dx dy xpos ypos} [parse_geom [wm geometry $w]]
           set x0 [expr $xpos] ; set x1 [expr $x0 + $dx]
           set y0 [expr $ypos] ; set y1 [expr $y0 + $dy]
           set geom($w) [list $x0 $y0 $x1 $y1 $dx $dy]
   
           #calculate decoration sizes
           setlist {dX dY Xpos Ypos} [parse_geom [true_geom $w]]
           set left [expr $x0 - $Xpos]
           set right [expr ($Xpos + $dX) - $x1]
           set top [expr $y0 - $Ypos]
           set bottom [expr ($Ypos + $dY) - $y1]
   
           lappend geom($w) $left $top $right $bottom
       }
       setlist {gx0 gy0 gx1 gy1 dx dy gleft gtop gright gbottom} $geom([lindex $args 0])
       foreach w [lrange $args 1 end] {
           setlist {x0 y0 x1 y1 dx dy left top right bottom} $geom($w)
           if {$x0 < $gx0} { set gx0 $x0 }
           if {$y0 < $gy0} { set gy0 $y0 }
           if {$x1 > $gx1} { set gx1 $x1 }
           if {$y1 > $gy1} { set gy1 $y1 }
           if {$left > $gleft} {set gleft $left}
           if {$top > $gtop} {set gtop $top}
           if {$right > $gright} {set gright $right}
           if {$bottom > $gbottom} {set gbottom $bottom}
       }
       set gdx [expr $gx1 - $gx0] ; set gdy [expr $gy1 - $gy0]
       setlist {tx0 ty0 tx1 ty1 tdx tdy tleft ttop tright tbottom} $geom($t)
       switch -regexp $tside {
           n|N|t|T {
               wm geometry $t [set gdx]x$tdy+[set gx0]+[expr $gy1 + $ttop + $gbottom]
           }
           s|S|b|B {
               wm geometry $t [set gdx]x$tdy+[set gx0]+[expr $gy0 - $tdy - $tbottom + $gtop]
           }
           e|E|r|R {
               wm geometry $t [set tdx]x$gdy+[expr $gx0 - $tdx - $tright + $gleft]+$gy0
           }
           w|W|l|L {
               wm geometry $t [set tdx]x$gdy+[expr $gx1 + $tleft + $gright]+$gy0
           }
       }
       update
   }
   
   #the config event handler
   proc winconfig {w} {
       #only respond to first of a Configure sequence...
       bind $w <Configure> {}
       update
   
       set geom [wm geom $w]
       if {$::Config($w) != $geom} {
           puts "$w - $geom"
   
           setlist {ldx ldy lxpos lypos} [parse_geom $::Config($w)]
           setlist {dx dy xpos ypos} [parse_geom $geom]
   
           #ignore moves outside of the visible screen, as they are probably
           #window manager related (e.g. virtual screen changes)
           if {$xpos != $lxpos || $ypos != $lypos} {
               if {($xpos + $dx) < 0 || $xpos > [winfo screenwidth $w] ||
                   ($ypos + $dy) < 0 || $ypos > [winfo screenheight $w]} {
                   bind $w <Configure> "winconfig $w"
                   return
               }
           }
           if {$ldx == $dx && $ldy == $dy} {
               win_move $w [expr $xpos - $lxpos] [expr $ypos - $lypos]
           } else {
               set lx1 [expr $lxpos + $ldx] ; set ly1 [expr $lypos + $ldy]
               set x1 [expr $xpos + $dx] ; set y1 [expr $ypos + $dy]
               win_resize $w [expr $xpos - $lxpos] [expr $ypos - $lypos] [expr $x1 - $lx1] [expr $y1 - $ly1]
           }
   
           set ::Config($w) $geom
       }
   
       #re-bind Configure
       bind $w <Configure> "winconfig $w"
   
       update
   }
   
   #move a window and its group
   proc win_move {w deltax deltay} {
       puts "moved $w - $deltax $deltay"
       if {[info exists ::MoveGroup($w)]} {
           foreach w $::MoveGroup($w) {
               set conf [bind $w <Configure>]
               bind $w <Configure> {}
               setlist {dx dy xpos ypos} [parse_geom [wm geom $w]]
               incr xpos $deltax ; incr ypos $deltay
               wm geom $w [set dx]x$dy+$xpos+$ypos
               bind $w <Configure> $conf
           }
       }
   }
   
   #resize a window and its group
   proc win_resize {w dx0 dy0 dx1 dy1} {
       puts "resized $w - $dx0 $dy0  $dx1 $dy1"
       if {$dx0 != 0} {
           if {[info exists ::ResizeGroup(w\ $w)]} {
               foreach {ts tw} $::ResizeGroup(w\ $w) {
                   if {![info exists resize($tw)]} {set resize($tw) {0 0 0 0}}
                   if {$ts == {e}} {set idx 2} else {set idx 0}
                   set resize($tw) [lreplace $resize($tw) $idx $idx $dx0]
               }
           }
       }
       if {$dx1 != 0} {
           if {[info exists ::ResizeGroup(e\ $w)]} {
               foreach {ts tw} $::ResizeGroup(e\ $w) {
                   if {![info exists resize($tw)]} {set resize($tw) {0 0 0 0}}
                   if {$ts == {e}} {set idx 2} else {set idx 0}
                   set resize($tw) [lreplace $resize($tw) $idx $idx $dx1]
               }
           }
       }
       if {$dy0 != 0} {
           if {[info exists ::ResizeGroup(n\ $w)]} {
               foreach {ts tw} $::ResizeGroup(n\ $w) {
                   if {![info exists resize($tw)]} {set resize($tw) {0 0 0 0}}
                   if {$ts == {n}} {set idx 1} else {set idx 3}
                   set resize($tw) [lreplace $resize($tw) $idx $idx $dy0]
               }
           }
       }
       if {$dy1 != 0} {
           if {[info exists ::ResizeGroup(s\ $w)]} {
               foreach {ts tw} $::ResizeGroup(s\ $w) {
                   if {![info exists resize($tw)]} {set resize($tw) {0 0 0 0}}
                   if {$ts == {n}} {set idx 1} else {set idx 3}
                   set resize($tw) [lreplace $resize($tw) $idx $idx $dy1]
               }
           }
       }
   
       foreach tw [array names resize] {
           setlist {twx0 twy0 twx1 twy1} $resize($tw)
           set conf [bind $w <Configure>]
           bind $w <Configure> {}
           setlist {dx dy x0 y0} [parse_geom [wm geom $tw]]
           set x1 [expr $x0 + $dx + $twx1] ; set y1 [expr $y0 + $dy + $twy1]
           incr x0 $twx0 ; incr y0 $twy0
           wm geom $tw [expr $x1 - $x0]x[expr $y1 - $y0]+$x0+$y0
           bind $w <Configure> $conf
       }
   }
   
   #an example
   proc example {} {
      catch {destroy .a .b .c}
   
      set a [toplevel .a -bg blue]
      set b [toplevel .b -height 75 -bg yellow]
      set c [toplevel .c -width 75 -bg orange]
   
      adjust_geom $b N $a
      adjust_geom $c W $a $b
   
      foreach w {.a .b .c} {
          set ::Config($w) [wm geom $w]
      }
   
   
      bind .a <Configure> "::winconfig .a"
   
      set ::MoveGroup(.a) {.b .c}
   
      set ::ResizeGroup(n\ .a) {n .c}
      set ::ResizeGroup(s\ .a) {n .b  s .b  s .c}
      set ::ResizeGroup(e\ .a) {e .c  w .c  e .b}
      set ::ResizeGroup(w\ .a) {w .b}
   }

It works well under Windows XP, and it works okay under some UNIX window manager's too. The information that is returned from a window manager can be quite flaky, unfortunately.

tje - August 25, 2003


FW: As for applications of this idea, with a little modification it could be applied to windows that "stick" to one another but can also be separated. The most aggressive use of this approach I've seen is the Winamp [L1 ] / xmms [L2 ] interface.

xmav000: I was looking for a solution that goes a bit deeper. The windows "docking" as FW descriped would be one part. I would like to have several chat windows that usually have a buddy list and some other frames. The feature I would like to provide is to minimize the windows down to the frames needed for the chat (e.g. text + entry) and if i have several of those minimized chats I would like them to be able to dock together. just like in winamp as FW mentioned. I think the titlebar should not be displayed or at least in a group of windows only one of them should have a title. I think there is a lot to do to make it possible to create something like winamp, or?