home *** CD-ROM | disk | FTP | other *** search
- #
- # 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
- }
- }
-