You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
351 lines
12 KiB
Plaintext
351 lines
12 KiB
Plaintext
# 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]
|
|
}
|