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