--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/python-2.5.2/win32/tcl/tix8.4/DialogS.tcl Fri Apr 03 17:19:34 2009 +0100
@@ -0,0 +1,175 @@
+# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
+#
+# $Id: DialogS.tcl,v 1.5 2004/03/28 02:44:57 hobbs Exp $
+#
+# DialogS.tcl --
+#
+#
+# Implements the DialogShell widget. It tells the window
+# manager that it is a dialog window and should be treated specially.
+# The exact treatment depends on the treatment of the window
+# manager
+#
+# Copyright (c) 1994-1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+tixWidgetClass tixDialogShell {
+ -superclass tixShell
+ -classname TixDialogShell
+ -method {
+ popdown popup center
+ }
+ -flag {
+ -mapped -minheight -minwidth -parent -transient
+ }
+ -static {}
+ -configspec {
+ {-mapped mapped Mapped 0}
+ {-minwidth minWidth MinWidth 0}
+ {-minheight minHeight MinHeight 0}
+ {-transient transient Transient true}
+ {-parent parent Parent ""}
+ }
+}
+
+#----------------------------------------------------------------------
+# Construct widget
+#----------------------------------------------------------------------
+
+proc tixDialogShell:ConstructWidget {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructWidget
+
+ # Set the title of this shell appropriately
+ #
+ if {$data(-title) == ""} {
+ # dynamically sets the title
+ #
+ set data(-title) [winfo name $w]
+ }
+ wm title $w $data(-title)
+
+ # Set the parent of this dialog shell
+ #
+ if {$data(-parent) == ""} {
+ set data(-parent) [winfo parent $w]
+ }
+
+ # Set the minsize and maxsize of the thing
+ #
+ wm minsize $w $data(-minwidth) $data(-minheight)
+ wm transient $w ""
+}
+
+# The next procedures manage the dialog boxes
+#
+proc tixDialogShell:popup {w {parent ""}} {
+ upvar #0 $w data
+
+ # First update to make sure the boxes are the right size
+ #
+ update idletask
+
+ # Then we set the position and update
+ #
+ # tixDialogShell:center $w $parent
+
+ # and now make it visible. Viola! Centered over parent.
+ #
+ wm deiconify $w
+ after idle raise $w
+}
+
+# This procedure centers a dialog box over a window making sure that the
+# dialog box doesn't appear off the screen
+#
+# However, if the parent is smaller than this dialog, make this dialog
+# appear at parent(x,y) + (20,20)
+#
+proc tixDialogShell:center {w {parent ""}} {
+ upvar #0 $w data
+
+ # Tell the WM that we'll do this ourselves.
+ wm sizefrom $w user
+ wm positionfrom $w user
+
+ if {$parent == ""} {
+ set parent $data(-parent)
+ }
+ if {$parent == "" || [catch {set parent [winfo toplevel $parent]}]} {
+ set parent "."
+ }
+
+ # Where is my parent and what are it's dimensions
+ #
+ if {$parent != ""} {
+ set pargeo [split [wm geometry $parent] "+x"]
+ set parentW [lindex $pargeo 0]
+ set parentH [lindex $pargeo 1]
+ set parx [lindex $pargeo 2]
+ set pary [lindex $pargeo 3]
+
+ if {[string is true -strict $data(-transient)]} {
+ wm transient $w $parent
+ }
+ } else {
+ set parentW [winfo screenwidth $w]
+ set parentH [winfo screenheight $w]
+ set parx 0
+ set pary 0
+ set parent [winfo parent $w]
+ }
+
+ # What are is the offset of the virtual window
+ set vrootx [winfo vrootx $parent]
+ set vrooty [winfo vrooty $parent]
+
+ # What are my dimensions ?
+ set dialogW [winfo reqwidth $w]
+ set dialogH [winfo reqheight $w]
+
+ if {$dialogW < $parentW-30 || $dialogW < $parentH-30} {
+ set dialogx [expr {$parx+($parentW-$dialogW)/2+$vrootx}]
+ set dialogy [expr {$pary+($parentH-$dialogH)/2+$vrooty}]
+ } else {
+ # This dialog is too big. Place it at (parentx, parenty) + (20,20)
+ #
+ set dialogx [expr {$parx+20+$vrootx}]
+ set dialogy [expr {$pary+20+$vrooty}]
+ }
+
+ set maxx [expr {[winfo screenwidth $parent] - $dialogW}]
+ set maxy [expr {[winfo screenheight $parent] - $dialogH}]
+
+ # Make sure it doesn't go off screen
+ #
+ if {$dialogx < 0} {
+ set dialogx 0
+ } else {
+ if {$dialogx > $maxx} {
+ set dialogx $maxx
+ }
+ }
+ if {$dialogy < 0} {
+ set dialogy 0
+ } else {
+ if {$dialogy > $maxy} {
+ set dialogy $maxy
+ }
+ }
+
+ # set my new position (and dimensions)
+ #
+ if {[wm geometry $w] == "1x1+0+0"} {
+ wm geometry $w ${dialogW}x${dialogH}+${dialogx}+${dialogy}
+ }
+}
+
+proc tixDialogShell:popdown {w args} {
+ wm withdraw $w
+}
+