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.
357 lines
12 KiB
Plaintext
357 lines
12 KiB
Plaintext
15 years ago
|
#
|
||
|
|
# Pushbutton
|
||
|
|
# ----------------------------------------------------------------------
|
||
|
|
# Implements a Motif-like Pushbutton with an optional default ring.
|
||
|
|
#
|
||
|
|
# WISH LIST:
|
||
|
|
# 1) Allow bitmaps and text on the same button face (Tk limitation).
|
||
|
|
# 2) provide arm and disarm bitmaps.
|
||
|
|
#
|
||
|
|
# ----------------------------------------------------------------------
|
||
|
|
# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com
|
||
|
|
# Bret A. Schuhmacher EMAIL: bas@wn.com
|
||
|
|
#
|
||
|
|
# @(#) $Id: pushbutton.itk,v 1.3 2001/08/17 19:03:44 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 Pushbutton {
|
||
|
|
keep -activebackground -activeforeground -background -borderwidth \
|
||
|
|
-cursor -disabledforeground -font -foreground -highlightbackground \
|
||
|
|
-highlightcolor -highlightthickness
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# PUSHBUTTON
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::class iwidgets::Pushbutton {
|
||
|
|
inherit itk::Widget
|
||
|
|
|
||
|
|
constructor {args} {}
|
||
|
|
destructor {}
|
||
|
|
|
||
|
|
itk_option define -padx padX Pad 11
|
||
|
|
itk_option define -pady padY Pad 4
|
||
|
|
itk_option define -font font Font \
|
||
|
|
-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*
|
||
|
|
itk_option define -text text Text {}
|
||
|
|
itk_option define -bitmap bitmap Bitmap {}
|
||
|
|
itk_option define -image image Image {}
|
||
|
|
itk_option define -highlightthickness highlightThickness \
|
||
|
|
HighlightThickness 2
|
||
|
|
itk_option define -borderwidth borderWidth BorderWidth 2
|
||
|
|
itk_option define -defaultring defaultRing DefaultRing 0
|
||
|
|
itk_option define -defaultringpad defaultRingPad Pad 4
|
||
|
|
itk_option define -height height Height 0
|
||
|
|
itk_option define -width width Width 0
|
||
|
|
itk_option define -takefocus takeFocus TakeFocus 0
|
||
|
|
|
||
|
|
public method flash {}
|
||
|
|
public method invoke {}
|
||
|
|
|
||
|
|
protected method _relayout {{when later}}
|
||
|
|
protected variable _reposition "" ;# non-null => _relayout pending
|
||
|
|
}
|
||
|
|
|
||
|
|
#
|
||
|
|
# Provide a lowercased access method for the Pushbutton class.
|
||
|
|
#
|
||
|
|
proc ::iwidgets::pushbutton {pathName args} {
|
||
|
|
uplevel ::iwidgets::Pushbutton $pathName $args
|
||
|
|
}
|
||
|
|
|
||
|
|
#
|
||
|
|
# Use option database to override default resources of base classes.
|
||
|
|
#
|
||
|
|
option add *Pushbutton.borderWidth 2 widgetDefault
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# CONSTRUCTOR
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body iwidgets::Pushbutton::constructor {args} {
|
||
|
|
#
|
||
|
|
# Reconfigure the hull to act as the outer sunken ring of
|
||
|
|
# the pushbutton, complete with focus ring.
|
||
|
|
#
|
||
|
|
itk_option add hull.borderwidth hull.relief
|
||
|
|
itk_option add hull.highlightcolor
|
||
|
|
itk_option add hull.highlightbackground
|
||
|
|
|
||
|
|
component hull configure \
|
||
|
|
-borderwidth [$this cget -borderwidth]
|
||
|
|
|
||
|
|
pack propagate $itk_component(hull) no
|
||
|
|
|
||
|
|
itk_component add pushbutton {
|
||
|
|
button $itk_component(hull).pushbutton \
|
||
|
|
} {
|
||
|
|
usual
|
||
|
|
keep -underline -wraplength -state -command
|
||
|
|
}
|
||
|
|
pack $itk_component(pushbutton) -expand 1 -fill both
|
||
|
|
|
||
|
|
#
|
||
|
|
# Initialize the widget based on the command line options.
|
||
|
|
#
|
||
|
|
eval itk_initialize $args
|
||
|
|
|
||
|
|
#
|
||
|
|
# Layout the pushbutton.
|
||
|
|
#
|
||
|
|
_relayout
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# DESTRUCTOR
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body iwidgets::Pushbutton::destructor {} {
|
||
|
|
if {$_reposition != ""} {after cancel $_reposition}
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# OPTIONS
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# OPTION: -padx
|
||
|
|
#
|
||
|
|
# Specifies the extra space surrounding the label in the x direction.
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::configbody iwidgets::Pushbutton::padx {
|
||
|
|
$itk_component(pushbutton) configure -padx $itk_option(-padx)
|
||
|
|
|
||
|
|
_relayout
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# OPTION: -pady
|
||
|
|
#
|
||
|
|
# Specifies the extra space surrounding the label in the y direction.
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::configbody iwidgets::Pushbutton::pady {
|
||
|
|
$itk_component(pushbutton) configure -pady $itk_option(-pady)
|
||
|
|
|
||
|
|
_relayout
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# OPTION: -font
|
||
|
|
#
|
||
|
|
# Specifies the label font.
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::configbody iwidgets::Pushbutton::font {
|
||
|
|
$itk_component(pushbutton) configure -font $itk_option(-font)
|
||
|
|
|
||
|
|
_relayout
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# OPTION: -text
|
||
|
|
#
|
||
|
|
# Specifies the label text.
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::configbody iwidgets::Pushbutton::text {
|
||
|
|
$itk_component(pushbutton) configure -text $itk_option(-text)
|
||
|
|
|
||
|
|
_relayout
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# OPTION: -bitmap
|
||
|
|
#
|
||
|
|
# Specifies the label bitmap.
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::configbody iwidgets::Pushbutton::bitmap {
|
||
|
|
$itk_component(pushbutton) configure -bitmap $itk_option(-bitmap)
|
||
|
|
|
||
|
|
_relayout
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# OPTION: -image
|
||
|
|
#
|
||
|
|
# Specifies the label image.
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::configbody iwidgets::Pushbutton::image {
|
||
|
|
$itk_component(pushbutton) configure -image $itk_option(-image)
|
||
|
|
|
||
|
|
_relayout
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# OPTION: -highlightthickness
|
||
|
|
#
|
||
|
|
# Specifies the thickness of the highlight ring.
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::configbody iwidgets::Pushbutton::highlightthickness {
|
||
|
|
$itk_component(pushbutton) configure \
|
||
|
|
-highlightthickness $itk_option(-highlightthickness)
|
||
|
|
|
||
|
|
_relayout
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# OPTION: -borderwidth
|
||
|
|
#
|
||
|
|
# Specifies the width of the relief border.
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::configbody iwidgets::Pushbutton::borderwidth {
|
||
|
|
$itk_component(pushbutton) configure -borderwidth $itk_option(-borderwidth)
|
||
|
|
|
||
|
|
_relayout
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# OPTION: -defaultring
|
||
|
|
#
|
||
|
|
# Boolean describing whether the button displays its default ring.
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::configbody iwidgets::Pushbutton::defaultring {
|
||
|
|
_relayout
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# OPTION: -defaultringpad
|
||
|
|
#
|
||
|
|
# The size of the padded default ring around the button.
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::configbody iwidgets::Pushbutton::defaultringpad {
|
||
|
|
pack $itk_component(pushbutton) \
|
||
|
|
-padx $itk_option(-defaultringpad) \
|
||
|
|
-pady $itk_option(-defaultringpad)
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# OPTION: -height
|
||
|
|
#
|
||
|
|
# Specifies the height of the button inclusive of any default ring.
|
||
|
|
# A value of zero lets the push button determine the height based
|
||
|
|
# on the requested height plus highlightring and defaultringpad.
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::configbody iwidgets::Pushbutton::height {
|
||
|
|
_relayout
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# OPTION: -width
|
||
|
|
#
|
||
|
|
# Specifies the width of the button inclusive of any default ring.
|
||
|
|
# A value of zero lets the push button determine the width based
|
||
|
|
# on the requested width plus highlightring and defaultringpad.
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::configbody iwidgets::Pushbutton::width {
|
||
|
|
_relayout
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHODS
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: flash
|
||
|
|
#
|
||
|
|
# Thin wrap of standard button widget flash method.
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body iwidgets::Pushbutton::flash {} {
|
||
|
|
$itk_component(pushbutton) flash
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: invoke
|
||
|
|
#
|
||
|
|
# Thin wrap of standard button widget invoke method.
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body iwidgets::Pushbutton::invoke {} {
|
||
|
|
$itk_component(pushbutton) invoke
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# PROTECTED METHOD: _relayout ?when?
|
||
|
|
#
|
||
|
|
# Adjust the width and height of the Pushbutton to accomadate all the
|
||
|
|
# current options settings. Add back in the highlightthickness to
|
||
|
|
# the button such that the correct reqwidth and reqheight are computed.
|
||
|
|
# Set the width and height based on the reqwidth/reqheight,
|
||
|
|
# highlightthickness, and ringpad. Finally, configure the defaultring
|
||
|
|
# properly. If "when" is "now", the change is applied immediately. If
|
||
|
|
# it is "later" or it is not specified, then the change is applied later,
|
||
|
|
# when the application is idle.
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body iwidgets::Pushbutton::_relayout {{when later}} {
|
||
|
|
if {$when == "later"} {
|
||
|
|
if {$_reposition == ""} {
|
||
|
|
set _reposition [after idle [itcl::code $this _relayout now]]
|
||
|
|
}
|
||
|
|
return
|
||
|
|
} elseif {$when != "now"} {
|
||
|
|
error "bad option \"$when\": should be now or later"
|
||
|
|
}
|
||
|
|
|
||
|
|
set _reposition ""
|
||
|
|
|
||
|
|
if {$itk_option(-width) == 0} {
|
||
|
|
set w [expr {[winfo reqwidth $itk_component(pushbutton)] \
|
||
|
|
+ 2 * $itk_option(-highlightthickness) \
|
||
|
|
+ 2 * $itk_option(-borderwidth) \
|
||
|
|
+ 2 * $itk_option(-defaultringpad)}]
|
||
|
|
} else {
|
||
|
|
set w $itk_option(-width)
|
||
|
|
}
|
||
|
|
|
||
|
|
if {$itk_option(-height) == 0} {
|
||
|
|
set h [expr {[winfo reqheight $itk_component(pushbutton)] \
|
||
|
|
+ 2 * $itk_option(-highlightthickness) \
|
||
|
|
+ 2 * $itk_option(-borderwidth) \
|
||
|
|
+ 2 * $itk_option(-defaultringpad)}]
|
||
|
|
} else {
|
||
|
|
set h $itk_option(-height)
|
||
|
|
}
|
||
|
|
|
||
|
|
component hull configure -width $w -height $h
|
||
|
|
|
||
|
|
if {$itk_option(-defaultring)} {
|
||
|
|
component hull configure -relief sunken \
|
||
|
|
-highlightthickness [$this cget -highlightthickness] \
|
||
|
|
-takefocus 1
|
||
|
|
|
||
|
|
configure -takefocus 1
|
||
|
|
|
||
|
|
component pushbutton configure \
|
||
|
|
-highlightthickness 0 -takefocus 0
|
||
|
|
|
||
|
|
} else {
|
||
|
|
component hull configure -relief flat \
|
||
|
|
-highlightthickness 0 -takefocus 0
|
||
|
|
|
||
|
|
component pushbutton configure \
|
||
|
|
-highlightthickness [$this cget -highlightthickness] \
|
||
|
|
-takefocus 1
|
||
|
|
|
||
|
|
configure -takefocus 0
|
||
|
|
}
|
||
|
|
}
|