neingeist
/
arduinisten
Archived
1
0
Fork 0
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.
This repo is archived. You can view files and clone it, but cannot push or open issues/pull-requests.

357 lines
12 KiB
Plaintext

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