Changeset 783

Timestamp:

Dec 4, 2009 5:11:57 PM (14 years ago)

Author:

toby

Message:

# on 2004/04/27 14:12:04, toby did:
update non-modal dialogs to match newer versions of Tk
add window resize for OS X

File:

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

trunk/gsascmds.tcl

@@ -133 +133 @@
     wm iconname $w Dialog
     wm protocol $w WM_DELETE_WINDOW { }
-    wm transient $w $data(-parent)
-    if {![string compare $tcl_platform(platform) "macintosh"]} {
-        unsupported1 style $w dBoxProc
+    # Make the message box transient if the parent is viewable.
+    if {[winfo viewable [winfo toplevel $data(-parent)]] } {
+        wm transient $w $data(-parent)
+    } 
+   
+    catch {
+        if {[string equal [tk windowingsystem] "classic"]
+        || [string equal [tk windowingsystem] "aqua"]} {
+            unsupported::MacWindowStyle style $w dBoxProc
+        }
     }
 
@@ -343 +350 @@
 proc putontop {w "center 0"} {
     # center window $w above its parent and make it stay on top
-    set wp [winfo parent $w]
-    wm transient $w [winfo toplevel $wp]
+    set wpt [winfo toplevel [set wp [winfo parent $w]]]
+    if {[winfo viewable $wpt]} {
+        wm transient $w $wpt
+    }
     wm withdraw $w
     update idletasks
     if {$center} {
         set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
-                - [winfo vrootx [winfo parent $w]]}]
+                - [winfo vrootx $wpt]}]
         set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
-                - [winfo vrooty [winfo parent $w]]}]
+                - [winfo vrooty $wpt]}]
     } 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]]
+        set x [expr [winfo x $wpt] + [winfo width $wpt]/2 - \
+                [winfo reqwidth $w]/2 - [winfo vrootx $wpt]]
         if {$x < 0} {set x 0}
         set xborder 10
@@ -362 +371 @@
                     ($x+[winfo reqwidth $w] + $xborder)]
         }
-        set y [expr [winfo y $wp] + [winfo height $wp]/2 - \
-                [winfo reqheight $w]/2 - [winfo vrooty $wp]]
+        set y [expr [winfo y $wpt] + [winfo height $wpt]/2 - \
+                [winfo reqheight $w]/2 - [winfo vrooty $wpt]]
         if {$y < 0} {set y 0}
         set yborder 25
@@ -375 +384 @@
 
     global makenew
-    set makenew(OldGrab) ""
-    set makenew(OldFocus) ""
-    catch {set makenew(OldFocus) [focus]}
-    catch {set makenew(OldGrab) [grab current $w]}
-    catch {grab $w}
-}
-
+    # set grab & focus; use new approach for 8.3 & later
+    if {[info proc ::tk::SetFocusGrab] == ""} {
+        set makenew(OldGrab) ""
+        set makenew(OldFocus) ""
+        catch {set makenew(OldFocus) [focus]}
+        catch {set makenew(OldGrab) [grab current $w]}
+        catch {grab $w}
+    } else {
+        set makenew(OldGrab) $w
+        set makenew(OldFocus) $w
+        ::tk::SetFocusGrab $w $w
+    }
+}
+
+# restore focus after putontop has completed
 proc afterputontop {} {
-    # restore focus
     global makenew
-    # reset focus & grab
-    catch {
+    # reset focus & grab; use new approach for 8.3 & later
+    if {[info proc ::tk::SetFocusGrab] == ""} {
         if {$makenew(OldFocus) != ""} {
-            focus $makenew(OldFocus)
-        }
-    }
-    catch {
+            catch {focus $makenew(OldFocus)}
+        }
         if {$makenew(OldGrab) != ""} {
-            grab $makenew(OldGrab)
-        }
+            catch {grab $makenew(OldGrab)}
+        }
+    } else {
+        catch {::tk::RestoreFocusGrab $makenew(OldGrab) $makenew(OldFocus)}
     }
 }
@@ -852 +868 @@
             incr colstr 5
         }
+    }
+    if {$::tcl_platform(os) == "Darwin"} {
+        # on OS X force a window resize
+        wm geometry [winfo toplevel $w] {}
     }
 }