diff options
Diffstat (limited to 'iwidgets/generic/dialogshell.itk')
| -rw-r--r-- | iwidgets/generic/dialogshell.itk | 350 |
1 files changed, 350 insertions, 0 deletions
diff --git a/iwidgets/generic/dialogshell.itk b/iwidgets/generic/dialogshell.itk new file mode 100644 index 00000000000..7284b354db3 --- /dev/null +++ b/iwidgets/generic/dialogshell.itk @@ -0,0 +1,350 @@ +# Dialogshell +# ---------------------------------------------------------------------- +# This class is implements a dialog shell which is a top level widget +# composed of a button box, separator, and child site area. The class +# also has methods to control button construction. +# +# ---------------------------------------------------------------------- +# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com +# +# @(#) $Id$ +# ---------------------------------------------------------------------- +# Copyright (c) 1995 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 Dialogshell { + keep -background -cursor -foreground -modality +} + +# ------------------------------------------------------------------ +# DIALOGSHELL +# ------------------------------------------------------------------ +itcl::class iwidgets::Dialogshell { + inherit iwidgets::Shell + + constructor {args} {} + + itk_option define -thickness thickness Thickness 3 + itk_option define -buttonboxpos buttonBoxPos Position s + itk_option define -separator separator Separator on + itk_option define -padx padX Pad 10 + itk_option define -pady padY Pad 10 + + public method childsite {} + public method index {args} + public method add {args} + public method insert {args} + public method delete {args} + public method hide {args} + public method show {args} + public method default {args} + public method invoke {args} + public method buttonconfigure {args} + public method buttoncget {index option} +} + +# +# Provide a lowercased access method for the Dialogshell class. +# +proc ::iwidgets::dialogshell {pathName args} { + uplevel ::iwidgets::Dialogshell $pathName $args +} + +# +# Use option database to override default resources of base classes. +# +option add *Dialogshell.master "." widgetDefault + +# ------------------------------------------------------------------ +# CONSTRUCTOR +# ------------------------------------------------------------------ +itcl::body iwidgets::Dialogshell::constructor {args} { + itk_option remove iwidgets::Shell::padx iwidgets::Shell::pady + + # + # Create the user child site, separator, and button box, + # + itk_component add -protected dschildsite { + frame $itk_interior.dschildsite + } + + itk_component add separator { + frame $itk_interior.separator -relief sunken + } + + itk_component add bbox { + iwidgets::Buttonbox $itk_interior.bbox + } { + usual + + rename -padx -buttonboxpadx buttonBoxPadX Pad + rename -pady -buttonboxpady buttonBoxPadY Pad + } + + # + # Set the itk_interior variable to be the childsite for derived + # classes. + # + set itk_interior $itk_component(dschildsite) + + # + # Set up the default button so that if <Return> is pressed in + # any widget, it will invoke the default button. + # + bind $itk_component(hull) <Return> [itcl::code $this invoke] + + # + # Initialize the widget based on the command line options. + # + eval itk_initialize $args +} + +# ------------------------------------------------------------------ +# OPTIONS +# ------------------------------------------------------------------ + +# ------------------------------------------------------------------ +# OPTION: -thickness +# +# Specifies the thickness of the separator. It sets the width and +# height of the separator to the thickness value and the borderwidth +# to half the thickness. +# ------------------------------------------------------------------ +itcl::configbody iwidgets::Dialogshell::thickness { + $itk_component(separator) config -height $itk_option(-thickness) + $itk_component(separator) config -width $itk_option(-thickness) + $itk_component(separator) config \ + -borderwidth [expr {$itk_option(-thickness) / 2}] +} + +# ------------------------------------------------------------------ +# OPTION: -buttonboxpos +# +# Specifies the position of the button box relative to the child site. +# The separator appears between the child site and button box. +# ------------------------------------------------------------------ +itcl::configbody iwidgets::Dialogshell::buttonboxpos { + set parent [winfo parent $itk_component(bbox)] + + switch $itk_option(-buttonboxpos) { + n { + $itk_component(bbox) configure -orient horizontal + + grid $itk_component(bbox) -row 0 -column 0 -sticky ew + grid $itk_component(separator) -row 1 -column 0 -sticky ew + grid $itk_component(dschildsite) -row 2 -column 0 -sticky nsew + + grid rowconfigure $parent 0 -weight 0 + grid rowconfigure $parent 1 -weight 0 + grid rowconfigure $parent 2 -weight 1 + grid columnconfigure $parent 0 -weight 1 + grid columnconfigure $parent 1 -weight 0 + grid columnconfigure $parent 2 -weight 0 + } + s { + $itk_component(bbox) configure -orient horizontal + + grid $itk_component(dschildsite) -row 0 -column 0 -sticky nsew + grid $itk_component(separator) -row 1 -column 0 -sticky ew + grid $itk_component(bbox) -row 2 -column 0 -sticky ew + + grid rowconfigure $parent 0 -weight 1 + grid rowconfigure $parent 1 -weight 0 + grid rowconfigure $parent 2 -weight 0 + grid columnconfigure $parent 0 -weight 1 + grid columnconfigure $parent 1 -weight 0 + grid columnconfigure $parent 2 -weight 0 + } + w { + $itk_component(bbox) configure -orient vertical + + grid $itk_component(bbox) -row 0 -column 0 -sticky ns + grid $itk_component(separator) -row 0 -column 1 -sticky ns + grid $itk_component(dschildsite) -row 0 -column 2 -sticky nsew + + grid rowconfigure $parent 0 -weight 1 + grid rowconfigure $parent 1 -weight 0 + grid rowconfigure $parent 2 -weight 0 + grid columnconfigure $parent 0 -weight 0 + grid columnconfigure $parent 1 -weight 0 + grid columnconfigure $parent 2 -weight 1 + } + e { + $itk_component(bbox) configure -orient vertical + + grid $itk_component(dschildsite) -row 0 -column 0 -sticky nsew + grid $itk_component(separator) -row 0 -column 1 -sticky ns + grid $itk_component(bbox) -row 0 -column 2 -sticky ns + + grid rowconfigure $parent 0 -weight 1 + grid rowconfigure $parent 1 -weight 0 + grid rowconfigure $parent 2 -weight 0 + grid columnconfigure $parent 0 -weight 1 + grid columnconfigure $parent 1 -weight 0 + grid columnconfigure $parent 2 -weight 0 + } + default { + error "bad buttonboxpos option\ + \"$itk_option(-buttonboxpos)\": should be n,\ + s, e, or w" + } + } +} + +# ------------------------------------------------------------------ +# OPTION: -separator +# +# Boolean option indicating wheather to display the separator. +# ------------------------------------------------------------------ +itcl::configbody iwidgets::Dialogshell::separator { + if {$itk_option(-separator)} { + $itk_component(separator) configure -relief sunken + } else { + $itk_component(separator) configure -relief flat + } +} + +# ------------------------------------------------------------------ +# OPTION: -padx +# +# Specifies a padding distance for the childsite in the X-direction. +# ------------------------------------------------------------------ +itcl::configbody iwidgets::Dialogshell::padx { + grid configure $itk_component(dschildsite) -padx $itk_option(-padx) +} + +# ------------------------------------------------------------------ +# OPTION: -pady +# +# Specifies a padding distance for the childsite in the Y-direction. +# ------------------------------------------------------------------ +itcl::configbody iwidgets::Dialogshell::pady { + grid configure $itk_component(dschildsite) -pady $itk_option(-pady) +} + +# ------------------------------------------------------------------ +# METHODS +# ------------------------------------------------------------------ + +# ------------------------------------------------------------------ +# METHOD: childsite +# +# Return the pathname of the user accessible area. +# ------------------------------------------------------------------ +itcl::body iwidgets::Dialogshell::childsite {} { + return $itk_component(dschildsite) +} + +# ------------------------------------------------------------------ +# METHOD: index index +# +# Thin wrapper of Buttonbox's index method. +# ------------------------------------------------------------------ +itcl::body iwidgets::Dialogshell::index {args} { + uplevel $itk_component(bbox) index $args +} + +# ------------------------------------------------------------------ +# METHOD: add tag ?option value ...? +# +# Thin wrapper of Buttonbox's add method. +# ------------------------------------------------------------------ +itcl::body iwidgets::Dialogshell::add {args} { + uplevel $itk_component(bbox) add $args +} + +# ------------------------------------------------------------------ +# METHOD: insert index tag ?option value ...? +# +# Thin wrapper of Buttonbox's insert method. +# ------------------------------------------------------------------ +itcl::body iwidgets::Dialogshell::insert {args} { + uplevel $itk_component(bbox) insert $args +} + +# ------------------------------------------------------------------ +# METHOD: delete tag +# +# Thin wrapper of Buttonbox's delete method. +# ------------------------------------------------------------------ +itcl::body iwidgets::Dialogshell::delete {args} { + uplevel $itk_component(bbox) delete $args +} + +# ------------------------------------------------------------------ +# METHOD: hide index +# +# Thin wrapper of Buttonbox's hide method. +# ------------------------------------------------------------------ +itcl::body iwidgets::Dialogshell::hide {args} { + uplevel $itk_component(bbox) hide $args +} + +# ------------------------------------------------------------------ +# METHOD: show index +# +# Thin wrapper of Buttonbox's show method. +# ------------------------------------------------------------------ +itcl::body iwidgets::Dialogshell::show {args} { + uplevel $itk_component(bbox) show $args +} + +# ------------------------------------------------------------------ +# METHOD: default index +# +# Thin wrapper of Buttonbox's default method. +# ------------------------------------------------------------------ +itcl::body iwidgets::Dialogshell::default {args} { + uplevel $itk_component(bbox) default $args +} + +# ------------------------------------------------------------------ +# METHOD: invoke ?index? +# +# Thin wrapper of Buttonbox's invoke method. +# ------------------------------------------------------------------ +itcl::body iwidgets::Dialogshell::invoke {args} { + uplevel $itk_component(bbox) invoke $args +} + +# ------------------------------------------------------------------ +# METHOD: buttonconfigure index ?option? ?value option value ...? +# +# Thin wrapper of Buttonbox's buttonconfigure method. +# ------------------------------------------------------------------ +itcl::body iwidgets::Dialogshell::buttonconfigure {args} { + uplevel $itk_component(bbox) buttonconfigure $args +} + +# ------------------------------------------------------------------ +# METHOD: buttoncget index option +# +# Thin wrapper of Buttonbox's buttoncget method. +# ------------------------------------------------------------------ +itcl::body iwidgets::Dialogshell::buttoncget {index option} { + uplevel $itk_component(bbox) buttoncget [list $index] \ + [list $option] +} |