Subversion Repositories or1k

# 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: shell.itk,v 1.1.1.1 2002-01-16 10:24:50 markom Exp $

# ----------------------------------------------------------------------

#            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

# ------------------------------------------------------------------

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

# ------------------------------------------------------------------

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 [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.

# ------------------------------------------------------------------

configbody iwidgets::Shell::master {}

# ------------------------------------------------------------------

# OPTION: -modality

#

# Specify the modality of the dialog.

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

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

    wm deiconify $itk_component(hull)

    raise $itk_component(hull)

    tkwait visibility $itk_component(hull)

    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 [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 [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.

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

body iwidgets::Shell::center {{widget {}}} {

    update idletasks

    set hull $itk_component(hull)

    set w [winfo reqwidth $hull]

    set h [winfo reqheight $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 { [expr $reqX+$w+$wfudge] > $sw } { set reqX [expr $sw-$w-$wfudge] }

        if { $reqX < $wfudge } { set reqX $wfudge }

        if { [expr $reqY+$h+$hfudge] > $sh } { set reqY [expr $sh-$h-$hfudge] }

        if { $reqY < $hfudge } { set reqY $hfudge }

    }

    wm geometry $hull +$reqX+$reqY

}