home *** CD-ROM | disk | FTP | other *** search
/ PC World 2005 June / PCWorld_2005-06_cd.bin / software / vyzkuste / firewally / firewally.exe / framework-2.3.exe / shell.itk < prev    next >
Text File  |  2003-09-01  |  13KB  |  376 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.7 2002/02/25 06:43:26 mgbacke 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. itcl::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. itcl::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 [itcl::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. itcl::configbody iwidgets::Shell::master {}
  127.  
  128. # ------------------------------------------------------------------
  129. # OPTION: -modality
  130. #
  131. # Specify the modality of the dialog.
  132. # ------------------------------------------------------------------
  133. itcl::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. itcl::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. itcl::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. itcl::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. itcl::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. itcl::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. itcl::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.     raise $itk_component(hull)
  244.     wm deiconify $itk_component(hull)
  245.     tkwait visibility $itk_component(hull)
  246.  
  247.     # Need to flush the event loop.  This line added as a result of
  248.     # SF ticket #227885.
  249.     update idletasks
  250.     
  251.     if {$itk_option(-modality) == "application"} {
  252.         if {$grabstack != {}} {
  253.             grab release [lindex $grabstack end]
  254.         }
  255.  
  256.     set err 1
  257.     while {$err == 1} {
  258.         set err [catch [list grab $itk_component(hull)]]
  259.         if {$err == 1} {
  260.         after 1000
  261.         }
  262.     }
  263.  
  264.         lappend grabstack [list grab $itk_component(hull)]
  265.         
  266.         tkwait variable [itcl::scope _wait($this)]
  267.         return $_result
  268.         
  269.     } elseif {$itk_option(-modality) == "global" }  {
  270.         if {$grabstack != {}} {
  271.             grab release [lindex $grabstack end]
  272.         }
  273.  
  274.     set err 1
  275.     while {$err == 1} {
  276.         set err [catch [list grab -global $itk_component(hull)]]
  277.         if {$err == 1} {
  278.         after 1000
  279.         }
  280.     }
  281.  
  282.         lappend grabstack [list grab -global $itk_component(hull)]
  283.  
  284.         tkwait variable [itcl::scope _wait($this)]
  285.         return $_result
  286.     }
  287. }
  288.  
  289. # ------------------------------------------------------------------
  290. # METHOD: deactivate
  291. #
  292. # Deactivate the display of the dialog.  The method takes an optional
  293. # argument to passed to the "activate" method which returns the value.
  294. # This is only effective for application and global modal dialogs.
  295. # ------------------------------------------------------------------
  296. itcl::body iwidgets::Shell::deactivate {args} {
  297.  
  298.     if {! [winfo ismapped $itk_component(hull)]} {
  299.         return
  300.     }
  301.     
  302.     if {$itk_option(-modality) == "none"} {
  303.         wm withdraw $itk_component(hull)
  304.     } elseif {$itk_option(-modality) == "application"} {
  305.         grab release $itk_component(hull)
  306.         if {$grabstack != {}} {
  307.             if {[set grabstack [lreplace $grabstack end end]] != {}} {
  308.                 eval [lindex $grabstack end]
  309.             }
  310.         }
  311.  
  312.         wm withdraw $itk_component(hull)
  313.         
  314.     } elseif {$itk_option(-modality) == "global"} {
  315.         grab release $itk_component(hull)
  316.         if {$grabstack != {}} {
  317.             if {[set grabstack [lreplace $grabstack end end]] != {}} {
  318.                 eval [lindex $grabstack end]
  319.             }
  320.         }
  321.  
  322.         wm withdraw $itk_component(hull)
  323.     }
  324.     
  325.     if {[llength $args]} {
  326.         set _result $args
  327.     } else {
  328.         set _result {}
  329.     }
  330.     
  331.     set _wait($this) 1
  332.     return
  333. }
  334.  
  335. # ------------------------------------------------------------------
  336. # METHOD: center
  337. #
  338. # Centers the dialog with respect to another widget or the screen
  339. # as a whole.
  340. # ------------------------------------------------------------------
  341. itcl::body iwidgets::Shell::center {{widget {}}} {
  342.     update idletasks
  343.  
  344.     set hull $itk_component(hull)
  345.     set w [winfo width $hull]
  346.     set h [winfo height $hull]
  347.     set sh [winfo screenheight $hull]     ;# display screen's height/width
  348.     set sw [winfo screenwidth $hull]
  349.  
  350.     #
  351.     # User can request it centered with respect to root by passing in '{}'
  352.     #
  353.     if { $widget == "" } {
  354.         set reqX [expr {($sw-$w)/2}]
  355.         set reqY [expr {($sh-$h)/2}]
  356.     } else {
  357.         set wfudge 5      ;# wm width fudge factor
  358.         set hfudge 20     ;# wm height fudge factor
  359.         set widgetW [winfo width $widget]
  360.         set widgetH [winfo height $widget]
  361.         set reqX [expr {[winfo rootx $widget]+($widgetW-($widgetW/2))-($w/2)}]
  362.         set reqY [expr {[winfo rooty $widget]+($widgetH-($widgetH/2))-($h/2)}]
  363.  
  364.         #
  365.         # Adjust for errors - if too long or too tall
  366.         #
  367.         if { ($reqX+$w+$wfudge) > $sw } { set reqX [expr {$sw-$w-$wfudge}] }
  368.         if { $reqX < $wfudge } { set reqX $wfudge }
  369.         if { ($reqY+$h+$hfudge) > $sh } { set reqY [expr {$sh-$h-$hfudge}] }
  370.         if { $reqY < $hfudge } { set reqY $hfudge }
  371.     } 
  372.  
  373.     wm geometry $hull +$reqX+$reqY
  374. }
  375.  
  376.