iwidgets4 4.1.0-1 / usr / share / tcltk / iwidgets4.1.0 / scripts / pushbutton.itk

#
# 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.4 2007/06/10 19:28:30 hobbs 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

    if {$::tk_version > 8.3} {
	# Tk 8.4+ frame -padx -pady options creates inadvertant margin box
	component hull configure -padx 0 -pady 0 \
	    -borderwidth [$this cget -borderwidth]
    } else {
	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
    }
}