share/iwidgets4.0.1/scripts/dialogshell.itk - toolchains/skids - Git at Google

 # 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]
 }
	# 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]
	}