diff options
Diffstat (limited to 'iwidgets/generic/shell.itk')
| -rw-r--r-- | iwidgets/generic/shell.itk | 375 |
1 files changed, 375 insertions, 0 deletions
diff --git a/iwidgets/generic/shell.itk b/iwidgets/generic/shell.itk new file mode 100644 index 00000000000..85ebfbc7cb9 --- /dev/null +++ b/iwidgets/generic/shell.itk @@ -0,0 +1,375 @@ +# Shell +# ---------------------------------------------------------------------- +# This class is implements a shell which is a top level widget +# giving a childsite and providing activate, deactivate, and center +# methods. +# +# ---------------------------------------------------------------------- +# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com +# Kris Raney EMAIL: kraney@spd.dsccc.com +# +# @(#) $Id$ +# ---------------------------------------------------------------------- +# Copyright (c) 1996 DSC Technologies Corporation +# ====================================================================== +# Permission to use, copy, modify, distribute and license this software +# and its documentation for any purpose, and without fee or written +# agreement with DSC, is hereby granted, provided that the above copyright +# notice appears in all copies and that both the copyright notice and +# warranty disclaimer below appear in supporting documentation, and that +# the names of DSC Technologies Corporation or DSC Communications +# Corporation not be used in advertising or publicity pertaining to the +# software without specific, written prior permission. +# +# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING +# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- +# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE +# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, +# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL +# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR +# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, +# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, +# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS +# SOFTWARE. +# ====================================================================== + +# +# Usual options. +# +itk::usual Shell { + keep -background -cursor -modality +} + +# ------------------------------------------------------------------ +# SHELL +# ------------------------------------------------------------------ +itcl::class iwidgets::Shell { + inherit itk::Toplevel + + constructor {args} {} + + itk_option define -master master Window "" + itk_option define -modality modality Modality none + itk_option define -padx padX Pad 0 + itk_option define -pady padY Pad 0 + itk_option define -width width Width 0 + itk_option define -height height Height 0 + + public method childsite {} + public method activate {} + public method deactivate {args} + public method center {{widget {}}} + + private variable _result {} ;# Resultant value for modal activation. + private variable _busied {} ;# List of busied top level widgets. + + common grabstack {} + common _wait +} + +# +# Provide a lowercased access method for the Shell class. +# +proc ::iwidgets::shell {pathName args} { + uplevel ::iwidgets::Shell $pathName $args +} + +# ------------------------------------------------------------------ +# CONSTRUCTOR +# ------------------------------------------------------------------ +itcl::body iwidgets::Shell::constructor {args} { + itk_option add hull.width hull.height + + # + # Maintain a withdrawn state until activated. + # + wm withdraw $itk_component(hull) + + # + # Create the user child site + # + itk_component add -protected shellchildsite { + frame $itk_interior.shellchildsite + } + pack $itk_component(shellchildsite) -fill both -expand yes + + # + # Set the itk_interior variable to be the childsite for derived + # classes. + # + set itk_interior $itk_component(shellchildsite) + + # + # Bind the window manager delete protocol to deactivation of the + # widget. This can be overridden by the user via the execution + # of a similar command outside the class. + # + wm protocol $itk_component(hull) WM_DELETE_WINDOW [itcl::code $this deactivate] + + # + # Initialize the widget based on the command line options. + # + eval itk_initialize $args +} + +# ------------------------------------------------------------------ +# OPTIONS +# ------------------------------------------------------------------ + +# ------------------------------------------------------------------ +# OPTION: -master +# +# Specifies the master window for the shell. The window manager is +# informed that the shell is a transient window whose master is +# -masterwindow. +# ------------------------------------------------------------------ +itcl::configbody iwidgets::Shell::master {} + +# ------------------------------------------------------------------ +# OPTION: -modality +# +# Specify the modality of the dialog. +# ------------------------------------------------------------------ +itcl::configbody iwidgets::Shell::modality { + switch $itk_option(-modality) { + none - + application - + global { + } + + default { + error "bad modality option \"$itk_option(-modality)\":\ + should be none, application, or global" + } + } +} + +# ------------------------------------------------------------------ +# OPTION: -padx +# +# Specifies a padding distance for the childsite in the X-direction. +# ------------------------------------------------------------------ +itcl::configbody iwidgets::Shell::padx { + pack config $itk_component(shellchildsite) -padx $itk_option(-padx) +} + +# ------------------------------------------------------------------ +# OPTION: -pady +# +# Specifies a padding distance for the childsite in the Y-direction. +# ------------------------------------------------------------------ +itcl::configbody iwidgets::Shell::pady { + pack config $itk_component(shellchildsite) -pady $itk_option(-pady) +} + +# ------------------------------------------------------------------ +# OPTION: -width +# +# Specifies the width of the shell. The value may be specified in +# any of the forms acceptable to Tk_GetPixels. A value of zero +# causes the width to be adjusted to the required value based on +# the size requests of the components placed in the childsite. +# Otherwise, the width is fixed. +# ------------------------------------------------------------------ +itcl::configbody iwidgets::Shell::width { + # + # The width option was added to the hull in the constructor. + # So, any width value given is passed automatically to the + # hull. All we have to do is play with the propagation. + # + if {$itk_option(-width) != 0} { + pack propagate $itk_component(hull) no + } else { + pack propagate $itk_component(hull) yes + } +} + +# ------------------------------------------------------------------ +# OPTION: -height +# +# Specifies the height of the shell. The value may be specified in +# any of the forms acceptable to Tk_GetPixels. A value of zero +# causes the height to be adjusted to the required value based on +# the size requests of the components placed in the childsite. +# Otherwise, the height is fixed. +# ------------------------------------------------------------------ +itcl::configbody iwidgets::Shell::height { + # + # The height option was added to the hull in the constructor. + # So, any height value given is passed automatically to the + # hull. All we have to do is play with the propagation. + # + if {$itk_option(-height) != 0} { + pack propagate $itk_component(hull) no + } else { + pack propagate $itk_component(hull) yes + } +} + +# ------------------------------------------------------------------ +# METHODS +# ------------------------------------------------------------------ + +# ------------------------------------------------------------------ +# METHOD: childsite +# +# Return the pathname of the user accessible area. +# ------------------------------------------------------------------ +itcl::body iwidgets::Shell::childsite {} { + return $itk_component(shellchildsite) +} + +# ------------------------------------------------------------------ +# METHOD: activate +# +# Display the dialog and wait based on the modality. For application +# and global modal activations, perform a grab operation, and wait +# for the result. The result may be returned via an argument to the +# "deactivate" method. +# ------------------------------------------------------------------ +itcl::body iwidgets::Shell::activate {} { + + if {[winfo ismapped $itk_component(hull)]} { + raise $itk_component(hull) + return + } + + if {($itk_option(-master) != {}) && \ + [winfo exists $itk_option(-master)]} { + wm transient $itk_component(hull) $itk_option(-master) + } + + set _wait($this) 0 + raise $itk_component(hull) + wm deiconify $itk_component(hull) + tkwait visibility $itk_component(hull) + + # Need to flush the event loop. This line added as a result of + # SF ticket #227885. + update idletasks + + if {$itk_option(-modality) == "application"} { + if {$grabstack != {}} { + grab release [lindex $grabstack end] + } + + set err 1 + while {$err == 1} { + set err [catch [list grab $itk_component(hull)]] + if {$err == 1} { + after 1000 + } + } + + lappend grabstack [list grab $itk_component(hull)] + + tkwait variable [itcl::scope _wait($this)] + return $_result + + } elseif {$itk_option(-modality) == "global" } { + if {$grabstack != {}} { + grab release [lindex $grabstack end] + } + + set err 1 + while {$err == 1} { + set err [catch [list grab -global $itk_component(hull)]] + if {$err == 1} { + after 1000 + } + } + + lappend grabstack [list grab -global $itk_component(hull)] + + tkwait variable [itcl::scope _wait($this)] + return $_result + } +} + +# ------------------------------------------------------------------ +# METHOD: deactivate +# +# Deactivate the display of the dialog. The method takes an optional +# argument to passed to the "activate" method which returns the value. +# This is only effective for application and global modal dialogs. +# ------------------------------------------------------------------ +itcl::body iwidgets::Shell::deactivate {args} { + + if {! [winfo ismapped $itk_component(hull)]} { + return + } + + if {$itk_option(-modality) == "none"} { + wm withdraw $itk_component(hull) + } elseif {$itk_option(-modality) == "application"} { + grab release $itk_component(hull) + if {$grabstack != {}} { + if {[set grabstack [lreplace $grabstack end end]] != {}} { + eval [lindex $grabstack end] + } + } + + wm withdraw $itk_component(hull) + + } elseif {$itk_option(-modality) == "global"} { + grab release $itk_component(hull) + if {$grabstack != {}} { + if {[set grabstack [lreplace $grabstack end end]] != {}} { + eval [lindex $grabstack end] + } + } + + wm withdraw $itk_component(hull) + } + + if {[llength $args]} { + set _result $args + } else { + set _result {} + } + + set _wait($this) 1 + return +} + +# ------------------------------------------------------------------ +# METHOD: center +# +# Centers the dialog with respect to another widget or the screen +# as a whole. +# ------------------------------------------------------------------ +itcl::body iwidgets::Shell::center {{widget {}}} { + update idletasks + + set hull $itk_component(hull) + set w [winfo width $hull] + set h [winfo height $hull] + set sh [winfo screenheight $hull] ;# display screen's height/width + set sw [winfo screenwidth $hull] + + # + # User can request it centered with respect to root by passing in '{}' + # + if { $widget == "" } { + set reqX [expr {($sw-$w)/2}] + set reqY [expr {($sh-$h)/2}] + } else { + set wfudge 5 ;# wm width fudge factor + set hfudge 20 ;# wm height fudge factor + set widgetW [winfo width $widget] + set widgetH [winfo height $widget] + set reqX [expr {[winfo rootx $widget]+($widgetW-($widgetW/2))-($w/2)}] + set reqY [expr {[winfo rooty $widget]+($widgetH-($widgetH/2))-($h/2)}] + + # + # Adjust for errors - if too long or too tall + # + if { ($reqX+$w+$wfudge) > $sw } { set reqX [expr {$sw-$w-$wfudge}] } + if { $reqX < $wfudge } { set reqX $wfudge } + if { ($reqY+$h+$hfudge) > $sh } { set reqY [expr {$sh-$h-$hfudge}] } + if { $reqY < $hfudge } { set reqY $hfudge } + } + + wm geometry $hull +$reqX+$reqY +} + |