Changeset 772

Timestamp:

Dec 4, 2009 5:11:46 PM (13 years ago)

Author:

toby

Message:

# on 2004/01/30 00:41:47, toby did:
update putontop to match new version of CIF routines

File:

• trunk/gsascmds.tcl (modified) (2 diffs, 3 props)

trunk/gsascmds.tcl

@@ -341 +341 @@
 }
 
-proc putontop {w} {
+proc putontop {w "center 0"} {
     # center window $w above its parent and make it stay on top
     set wp [winfo parent $w]
@@ -347 +347 @@
     wm withdraw $w
     update idletasks
-    # center the new window in the middle of the parent
-    set x [expr [winfo x $wp] + [winfo width $wp]/2 - \
-            [winfo reqwidth $w]/2 - [winfo vrootx $wp]]
-    if {$x < 0} {set x 0}
-    set xborder 10
-    if {$x+[winfo reqwidth $w] +$xborder > [winfo screenwidth $w]} {
-        incr x [expr \
-                [winfo screenwidth $w] - ($x+[winfo reqwidth $w] + $xborder)]
-    }
-    set y [expr [winfo y $wp] + [winfo height $wp]/2 - \
-            [winfo reqheight $w]/2 - [winfo vrooty $wp]]
-    if {$y < 0} {set y 0}
-    set yborder 25
-    if {$y+[winfo reqheight $w] +$yborder > [winfo screenheight $w]} {
-        incr y [expr \
-                [winfo screenheight $w] - ($y+[winfo reqheight $w] + $yborder)]
-    }
-    wm geom $w +$x+$y
+    if {$center} {
+        set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
+                - [winfo vrootx [winfo parent $w]]}]
+        set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
+                - [winfo vrooty [winfo parent $w]]}]
+    } else {
+        # center the new window in the middle of the parent
+        set x [expr [winfo x $wp] + [winfo width $wp]/2 - \
+                [winfo reqwidth $w]/2 - [winfo vrootx $wp]]
+        if {$x < 0} {set x 0}
+        set xborder 10
+        if {$x+[winfo reqwidth $w] +$xborder > [winfo screenwidth $w]} {
+            incr x [expr [winfo screenwidth $w] - \
+                    ($x+[winfo reqwidth $w] + $xborder)]
+        }
+        set y [expr [winfo y $wp] + [winfo height $wp]/2 - \
+                [winfo reqheight $w]/2 - [winfo vrooty $wp]]
+        if {$y < 0} {set y 0}
+        set yborder 25
+        if {$y+[winfo reqheight $w] +$yborder > [winfo screenheight $w]} {
+            incr y [expr [winfo screenheight $w] - \
+                    ($y+[winfo reqheight $w] + $yborder)]
+        }
+    }
+    wm geometry $w +$x+$y
     wm deiconify $w