#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, 2003FW: 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] [1] / [xmms] [2] 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?
