iwidgets4 4.0.1-6 / usr / share / tcltk / iwidgets4.0.1 / scripts / dialogshell.itk

# 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: dialogshell.itk,v 1.3 2001/08/15 18:32:02 smithc Exp $
# ----------------------------------------------------------------------
#            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]
}