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