home *** CD-ROM | disk | FTP | other *** search
/ Freelog Special Freeware 31 / FreelogHS31.iso / Texte / scribus / scribus-1.3.3.9-win32-install.exe / tcl / tix8.1 / DialogS.tcl < prev    next >
Text File  |  2001-11-03  |  4KB  |  176 lines
  1. # -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
  2. #
  3. #    $Id: DialogS.tcl,v 1.3.2.1 2001/11/03 07:51:42 idiscovery Exp $
  4. #
  5. # DialogS.tcl --
  6. #
  7. #
  8. #    Implements the DialogShell widget. It tells the window
  9. #    manager that it is a dialog window and should be treated specially.
  10. #    The exact treatment depends on the treatment of the window
  11. #    manager
  12. #
  13. # Copyright (c) 1994-1996, Expert Interface Technologies
  14. #
  15. # See the file "license.terms" for information on usage and redistribution
  16. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  17. #
  18.  
  19. tixWidgetClass tixDialogShell {
  20.     -superclass tixShell
  21.     -classname  TixDialogShell
  22.     -method {
  23.     popdown popup center
  24.     }
  25.     -flag   {
  26.     -mapped -minheight -minwidth -parent -transient
  27.     }
  28.     -static {}
  29.     -configspec {
  30.     {-mapped mapped Mapped 0}
  31.     {-minwidth minWidth MinWidth 0}
  32.     {-minheight minHeight MinHeight 0}
  33.     {-transient transient Transient true}
  34.     {-parent parent Parent ""}
  35.     }
  36. }
  37.  
  38. #----------------------------------------------------------------------
  39. #        Construct widget
  40. #----------------------------------------------------------------------
  41.  
  42. proc tixDialogShell:ConstructWidget {w} {
  43.     upvar #0 $w data
  44.  
  45.     tixChainMethod $w ConstructWidget
  46.  
  47.     # Set the title of this shell appropriately
  48.     #
  49.     if {$data(-title) == ""} {
  50.     # dynamically sets the title
  51.     #
  52.     set data(-title) [winfo name $w]
  53.     }
  54.     wm title $w $data(-title)
  55.  
  56.     # Set the parent of this dialog shell
  57.     #
  58.     if {$data(-parent) == ""} {
  59.     set data(-parent) [winfo parent $w]
  60.     }
  61.  
  62.     # Set the minsize and maxsize of the thing
  63.     #
  64.     wm minsize $w $data(-minwidth) $data(-minheight)
  65.     wm transient $w ""
  66. }
  67.  
  68. # The next procedures manage the dialog boxes
  69. #
  70. proc tixDialogShell:popup {w {parent ""}} {
  71.     upvar #0 $w data
  72.  
  73.     # First update to make sure the boxes are the right size
  74.     #
  75.     update idletask
  76.  
  77.     # Then we set the position and update
  78.     #
  79.     # tixDialogShell:center $w $parent
  80.  
  81.     # and now make it visible. Viola!  Centered over parent.
  82.     #
  83.     wm deiconify $w
  84.     after idle raise $w
  85. }
  86.  
  87. # This procedure centers a dialog box over a window making sure that the 
  88. # dialog box doesn't appear off the screen
  89. #
  90. # However, if the parent is smaller than this dialog, make this dialog
  91. # appear at parent(x,y) + (20,20)
  92. #
  93. proc tixDialogShell:center {w {parent ""}} {
  94.     upvar #0 $w data
  95.  
  96.     # Tell the WM that we'll do this ourselves.
  97.     wm sizefrom $w user
  98.     wm positionfrom $w user
  99.  
  100.     if {$parent == ""} {
  101.     set parent $data(-parent)
  102.     }
  103.     if {$parent == "" || [catch {set parent [winfo toplevel $parent]}]} {
  104.     set parent "."
  105.     }
  106.  
  107.     # Where is my parent and what are it's dimensions
  108.     #
  109.     if {$parent != ""} {
  110.     set pargeo [split [wm geometry $parent] "+x"]
  111.     set parentW [lindex $pargeo 0]
  112.     set parentH [lindex $pargeo 1]
  113.     set parx [lindex $pargeo 2]
  114.     set pary [lindex $pargeo 3]
  115.  
  116.     if {[tixGetBoolean -nocomplain $data(-transient)]} {
  117.         wm transient $w $parent
  118.     }
  119.     } else {
  120.     set parentW [winfo screenwidth $w]
  121.     set parentH [winfo screenheight $w]
  122.     set parx 0
  123.     set pary 0
  124.     set parent [winfo parent $w]
  125.     }
  126.  
  127.     # What are is the offset of the virtual window
  128.     set vrootx [winfo vrootx $parent]
  129.     set vrooty [winfo vrooty $parent]
  130.  
  131.     # What are my dimensions ?
  132.     set dialogW [winfo reqwidth $w]
  133.     set dialogH [winfo reqheight $w]
  134.  
  135.     if {$dialogW < [expr $parentW-30] || $dialogW < [expr $parentH-30]} {
  136.     set dialogx [expr $parx+($parentW-$dialogW)/2+$vrootx]
  137.     set dialogy [expr $pary+($parentH-$dialogH)/2+$vrooty]
  138.     } else {
  139.     # This dialog is too big. Place it at (parentx, parenty) + (20,20)
  140.     #
  141.     set dialogx [expr {$parx+20+$vrootx}]
  142.     set dialogy [expr {$pary+20+$vrooty}]
  143.     }
  144.  
  145.     set maxx [expr "[winfo screenwidth  $parent] - $dialogW"]
  146.     set maxy [expr "[winfo screenheight $parent] - $dialogH"]
  147.  
  148.     # Make sure it doesn't go off screen
  149.     #
  150.     if {$dialogx < 0} {
  151.     set dialogx 0
  152.     } else {
  153.     if {$dialogx > $maxx} {
  154.         set dialogx $maxx
  155.     }
  156.     }
  157.     if {$dialogy < 0} {
  158.     set dialogy 0
  159.     } else {
  160.     if {$dialogy > $maxy} {
  161.         set dialogy $maxy
  162.     }
  163.     }
  164.  
  165.     # set my new position (and dimensions)
  166.     #
  167.     if {[wm geometry $w] == "1x1+0+0"} {
  168.     wm geometry $w $dialogW\x$dialogH\+$dialogx\+$dialogy
  169.     }
  170. }
  171.  
  172. proc tixDialogShell:popdown {w args} {
  173.     wm withdraw $w
  174. }
  175.  
  176.