home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / comanche.exe / lib / iwidgets3.0.0 / scripts / shell.itk < prev    next >
Text File  |  1999-02-24  |  13KB  |  372 lines
  1. # Shell
  2. # ----------------------------------------------------------------------
  3. # This class is implements a shell which is a top level widget
  4. # giving a childsite and providing activate, deactivate, and center 
  5. # methods.
  6. #    
  7. # ----------------------------------------------------------------------
  8. #  AUTHOR: Mark L. Ulferts              EMAIL: mulferts@austin.dsccc.com
  9. #          Kris Raney                   EMAIL: kraney@spd.dsccc.com
  10. #
  11. #  @(#) $Id: shell.itk,v 1.2 1998/08/11 14:42:15 welch Exp $
  12. # ----------------------------------------------------------------------
  13. #            Copyright (c) 1996 DSC Technologies Corporation
  14. # ======================================================================
  15. # Permission to use, copy, modify, distribute and license this software 
  16. # and its documentation for any purpose, and without fee or written 
  17. # agreement with DSC, is hereby granted, provided that the above copyright 
  18. # notice appears in all copies and that both the copyright notice and 
  19. # warranty disclaimer below appear in supporting documentation, and that 
  20. # the names of DSC Technologies Corporation or DSC Communications 
  21. # Corporation not be used in advertising or publicity pertaining to the 
  22. # software without specific, written prior permission.
  23. # 
  24. # DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 
  25. # ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
  26. # INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
  27. # AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 
  28. # SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 
  29. # DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 
  30. # ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 
  31. # WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
  32. # ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 
  33. # SOFTWARE.
  34. # ======================================================================
  35.  
  36. #
  37. # Usual options.
  38. #
  39. itk::usual Shell {
  40.     keep -background -cursor -modality 
  41. }
  42.  
  43. # ------------------------------------------------------------------
  44. #                            SHELL
  45. # ------------------------------------------------------------------
  46. class iwidgets::Shell {
  47.     inherit itk::Toplevel
  48.  
  49.     constructor {args} {}
  50.  
  51.     itk_option define -master master Window "" 
  52.     itk_option define -modality modality Modality none
  53.     itk_option define -padx padX Pad 0
  54.     itk_option define -pady padY Pad 0
  55.     itk_option define -width width Width 0
  56.     itk_option define -height height Height 0
  57.  
  58.     public method childsite {}
  59.     public method activate {}
  60.     public method deactivate {args}
  61.     public method center {{widget {}}}
  62.  
  63.     private variable _result {}     ;# Resultant value for modal activation.
  64.     private variable _busied {}     ;# List of busied top level widgets.
  65.  
  66.     common grabstack {}
  67.     common _wait
  68. }
  69.  
  70. #
  71. # Provide a lowercased access method for the Shell class.
  72. # 
  73. proc ::iwidgets::shell {pathName args} {
  74.     uplevel ::iwidgets::Shell $pathName $args
  75. }
  76.  
  77. # ------------------------------------------------------------------
  78. #                        CONSTRUCTOR
  79. # ------------------------------------------------------------------
  80. body iwidgets::Shell::constructor {args} {
  81.     itk_option add hull.width hull.height
  82.  
  83.     #
  84.     # Maintain a withdrawn state until activated.  
  85.     #
  86.     wm withdraw $itk_component(hull)
  87.     
  88.     #
  89.     # Create the user child site
  90.     #
  91.     itk_component add -protected shellchildsite {
  92.         frame $itk_interior.shellchildsite
  93.     } 
  94.     pack $itk_component(shellchildsite) -fill both -expand yes
  95.  
  96.     #
  97.     # Set the itk_interior variable to be the childsite for derived 
  98.     # classes.
  99.     #
  100.     set itk_interior $itk_component(shellchildsite)
  101.  
  102.     #
  103.     # Bind the window manager delete protocol to deactivation of the 
  104.     # widget.  This can be overridden by the user via the execution 
  105.     # of a similar command outside the class.
  106.     #
  107.     wm protocol $itk_component(hull) WM_DELETE_WINDOW [code $this deactivate]
  108.     
  109.     #
  110.     # Initialize the widget based on the command line options.
  111.     #
  112.     eval itk_initialize $args
  113. }
  114.  
  115. # ------------------------------------------------------------------
  116. #                             OPTIONS
  117. # ------------------------------------------------------------------
  118.  
  119. # ------------------------------------------------------------------
  120. # OPTION: -master
  121. #
  122. # Specifies the master window for the shell.  The window manager is
  123. # informed that the shell is a transient window whose master is
  124. # -masterwindow.
  125. # ------------------------------------------------------------------
  126. configbody iwidgets::Shell::master {}
  127.  
  128. # ------------------------------------------------------------------
  129. # OPTION: -modality
  130. #
  131. # Specify the modality of the dialog.
  132. # ------------------------------------------------------------------
  133. configbody iwidgets::Shell::modality {
  134.     switch $itk_option(-modality) {
  135.         none -
  136.         application -
  137.         global {
  138.         }
  139.         
  140.         default {
  141.             error "bad modality option \"$itk_option(-modality)\":\
  142.                     should be none, application, or global"
  143.         }
  144.     }
  145. }
  146.  
  147. # ------------------------------------------------------------------
  148. # OPTION: -padx
  149. #
  150. # Specifies a padding distance for the childsite in the X-direction.
  151. # ------------------------------------------------------------------
  152. configbody iwidgets::Shell::padx {
  153.     pack config $itk_component(shellchildsite) -padx $itk_option(-padx)
  154. }
  155.  
  156. # ------------------------------------------------------------------
  157. # OPTION: -pady
  158. #
  159. # Specifies a padding distance for the childsite in the Y-direction.
  160. # ------------------------------------------------------------------
  161. configbody iwidgets::Shell::pady {
  162.     pack config $itk_component(shellchildsite) -pady $itk_option(-pady)
  163. }
  164.  
  165. # ------------------------------------------------------------------
  166. # OPTION: -width
  167. #
  168. # Specifies the width of the shell.  The value may be specified in 
  169. # any of the forms acceptable to Tk_GetPixels.  A value of zero 
  170. # causes the width to be adjusted to the required value based on 
  171. # the size requests of the components placed in the childsite.  
  172. # Otherwise, the width is fixed.
  173. # ------------------------------------------------------------------
  174. configbody iwidgets::Shell::width {
  175.     #
  176.     # The width option was added to the hull in the constructor.
  177.     # So, any width value given is passed automatically to the
  178.     # hull.  All we have to do is play with the propagation.
  179.     #
  180.     if {$itk_option(-width) != 0} {
  181.     pack propagate $itk_component(hull) no
  182.     } else {
  183.     pack propagate $itk_component(hull) yes
  184.     }
  185. }
  186.  
  187. # ------------------------------------------------------------------
  188. # OPTION: -height
  189. #
  190. # Specifies the height of the shell.  The value may be specified in 
  191. # any of the forms acceptable to Tk_GetPixels.  A value of zero 
  192. # causes the height to be adjusted to the required value based on 
  193. # the size requests of the components placed in the childsite.
  194. # Otherwise, the height is fixed.
  195. # ------------------------------------------------------------------
  196. configbody iwidgets::Shell::height {
  197.     #
  198.     # The height option was added to the hull in the constructor.
  199.     # So, any height value given is passed automatically to the
  200.     # hull.  All we have to do is play with the propagation.
  201.     #
  202.     if {$itk_option(-height) != 0} {
  203.     pack propagate $itk_component(hull) no
  204.     } else {
  205.     pack propagate $itk_component(hull) yes
  206.     }
  207. }
  208.  
  209. # ------------------------------------------------------------------
  210. #                            METHODS
  211. # ------------------------------------------------------------------
  212.  
  213. # ------------------------------------------------------------------
  214. # METHOD: childsite
  215. #
  216. # Return the pathname of the user accessible area.
  217. # ------------------------------------------------------------------
  218. body iwidgets::Shell::childsite {} {
  219.     return $itk_component(shellchildsite)
  220. }
  221.  
  222. # ------------------------------------------------------------------
  223. # METHOD: activate
  224. #
  225. # Display the dialog and wait based on the modality.  For application
  226. # and global modal activations, perform a grab operation, and wait
  227. # for the result.  The result may be returned via an argument to the
  228. # "deactivate" method.
  229. # ------------------------------------------------------------------
  230. body iwidgets::Shell::activate {} {
  231.  
  232.     if {[winfo ismapped $itk_component(hull)]} {
  233.         raise $itk_component(hull)
  234.     return
  235.     }
  236.     
  237.     if {($itk_option(-master) != {}) && \
  238.         [winfo exists $itk_option(-master)]} {
  239.     wm transient $itk_component(hull) $itk_option(-master)
  240.     } 
  241.  
  242.     set _wait($this) 0
  243.     wm deiconify $itk_component(hull)
  244.     raise $itk_component(hull)
  245.     tkwait visibility $itk_component(hull)
  246.     
  247.     if {$itk_option(-modality) == "application"} {
  248.         if {$grabstack != {}} {
  249.             grab release [lindex $grabstack end]
  250.         }
  251.  
  252.     set err 1
  253.     while {$err == 1} {
  254.         set err [catch [list grab $itk_component(hull)]]
  255.         if {$err == 1} {
  256.         after 1000
  257.         }
  258.     }
  259.  
  260.         lappend grabstack [list grab $itk_component(hull)]
  261.         
  262.         tkwait variable [scope _wait($this)]
  263.         return $_result
  264.         
  265.     } elseif {$itk_option(-modality) == "global" }  {
  266.         if {$grabstack != {}} {
  267.             grab release [lindex $grabstack end]
  268.         }
  269.  
  270.     set err 1
  271.     while {$err == 1} {
  272.         set err [catch [list grab -global $itk_component(hull)]]
  273.         if {$err == 1} {
  274.         after 1000
  275.         }
  276.     }
  277.  
  278.         lappend grabstack [list grab -global $itk_component(hull)]
  279.  
  280.         tkwait variable [scope _wait($this)]
  281.         return $_result
  282.     }
  283. }
  284.  
  285. # ------------------------------------------------------------------
  286. # METHOD: deactivate
  287. #
  288. # Deactivate the display of the dialog.  The method takes an optional
  289. # argument to passed to the "activate" method which returns the value.
  290. # This is only effective for application and global modal dialogs.
  291. # ------------------------------------------------------------------
  292. body iwidgets::Shell::deactivate {args} {
  293.  
  294.     if {! [winfo ismapped $itk_component(hull)]} {
  295.         return
  296.     }
  297.     
  298.     if {$itk_option(-modality) == "none"} {
  299.         wm withdraw $itk_component(hull)
  300.     } elseif {$itk_option(-modality) == "application"} {
  301.         grab release $itk_component(hull)
  302.         if {$grabstack != {}} {
  303.             if {[set grabstack [lreplace $grabstack end end]] != {}} {
  304.                 eval [lindex $grabstack end]
  305.             }
  306.         }
  307.  
  308.         wm withdraw $itk_component(hull)
  309.         
  310.     } elseif {$itk_option(-modality) == "global"} {
  311.         grab release $itk_component(hull)
  312.         if {$grabstack != {}} {
  313.             if {[set grabstack [lreplace $grabstack end end]] != {}} {
  314.                 eval [lindex $grabstack end]
  315.             }
  316.         }
  317.  
  318.         wm withdraw $itk_component(hull)
  319.     }
  320.     
  321.     if {[llength $args]} {
  322.         set _result $args
  323.     } else {
  324.         set _result {}
  325.     }
  326.     
  327.     set _wait($this) 1
  328.     return
  329. }
  330.  
  331. # ------------------------------------------------------------------
  332. # METHOD: center
  333. #
  334. # Centers the dialog with respect to another widget or the screen
  335. # as a whole.
  336. # ------------------------------------------------------------------
  337. body iwidgets::Shell::center {{widget {}}} {
  338.     update idletasks
  339.  
  340.     set hull $itk_component(hull)
  341.     set w [winfo reqwidth $hull]
  342.     set h [winfo reqheight $hull]
  343.     set sh [winfo screenheight $hull]     ;# display screen's height/width
  344.     set sw [winfo screenwidth $hull]
  345.  
  346.     #
  347.     # User can request it centered with respect to root by passing in '{}'
  348.     #
  349.     if { $widget == "" } {
  350.         set reqX [expr {($sw-$w)/2}]
  351.         set reqY [expr {($sh-$h)/2}]
  352.     } else {
  353.         set wfudge 5      ;# wm width fudge factor
  354.         set hfudge 20     ;# wm height fudge factor
  355.         set widgetW [winfo width $widget]
  356.         set widgetH [winfo height $widget]
  357.         set reqX [expr [winfo rootx $widget]+($widgetW-($widgetW/2))-($w/2)]
  358.         set reqY [expr [winfo rooty $widget]+($widgetH-($widgetH/2))-($h/2)]
  359.  
  360.         #
  361.         # Adjust for errors - if too long or too tall
  362.         #
  363.         if { [expr $reqX+$w+$wfudge] > $sw } { set reqX [expr $sw-$w-$wfudge] }
  364.         if { $reqX < $wfudge } { set reqX $wfudge }
  365.         if { [expr $reqY+$h+$hfudge] > $sh } { set reqY [expr $sh-$h-$hfudge] }
  366.         if { $reqY < $hfudge } { set reqY $hfudge }
  367.     } 
  368.  
  369.     wm geometry $hull +$reqX+$reqY
  370. }
  371.  
  372.