1# 2# Pushbutton 3# ---------------------------------------------------------------------- 4# Implements a Motif-like Pushbutton with an optional default ring. 5# 6# WISH LIST: 7# 1) Allow bitmaps and text on the same button face (Tk limitation). 8# 2) provide arm and disarm bitmaps. 9# 10# ---------------------------------------------------------------------- 11# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com 12# Bret A. Schuhmacher EMAIL: bas@wn.com 13# 14# @(#) $Id: pushbutton.itk,v 1.4 2007/06/10 19:28:30 hobbs Exp $ 15# ---------------------------------------------------------------------- 16# Copyright (c) 1995 DSC Technologies Corporation 17# ====================================================================== 18# Permission to use, copy, modify, distribute and license this software 19# and its documentation for any purpose, and without fee or written 20# agreement with DSC, is hereby granted, provided that the above copyright 21# notice appears in all copies and that both the copyright notice and 22# warranty disclaimer below appear in supporting documentation, and that 23# the names of DSC Technologies Corporation or DSC Communications 24# Corporation not be used in advertising or publicity pertaining to the 25# software without specific, written prior permission. 26# 27# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 28# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- 29# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE 30# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 31# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 32# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 33# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 34# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, 35# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 36# SOFTWARE. 37# ====================================================================== 38 39# 40# Usual options. 41# 42itk::usual Pushbutton { 43 keep -activebackground -activeforeground -background -borderwidth \ 44 -cursor -disabledforeground -font -foreground -highlightbackground \ 45 -highlightcolor -highlightthickness 46} 47 48# ------------------------------------------------------------------ 49# PUSHBUTTON 50# ------------------------------------------------------------------ 51itcl::class iwidgets::Pushbutton { 52 inherit itk::Widget 53 54 constructor {args} {} 55 destructor {} 56 57 itk_option define -padx padX Pad 11 58 itk_option define -pady padY Pad 4 59 itk_option define -font font Font \ 60 -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* 61 itk_option define -text text Text {} 62 itk_option define -bitmap bitmap Bitmap {} 63 itk_option define -image image Image {} 64 itk_option define -highlightthickness highlightThickness \ 65 HighlightThickness 2 66 itk_option define -borderwidth borderWidth BorderWidth 2 67 itk_option define -defaultring defaultRing DefaultRing 0 68 itk_option define -defaultringpad defaultRingPad Pad 4 69 itk_option define -height height Height 0 70 itk_option define -width width Width 0 71 itk_option define -takefocus takeFocus TakeFocus 0 72 73 public method flash {} 74 public method invoke {} 75 76 protected method _relayout {{when later}} 77 protected variable _reposition "" ;# non-null => _relayout pending 78} 79 80# 81# Provide a lowercased access method for the Pushbutton class. 82# 83proc ::iwidgets::pushbutton {pathName args} { 84 uplevel ::iwidgets::Pushbutton $pathName $args 85} 86 87# 88# Use option database to override default resources of base classes. 89# 90option add *Pushbutton.borderWidth 2 widgetDefault 91 92# ------------------------------------------------------------------ 93# CONSTRUCTOR 94# ------------------------------------------------------------------ 95itcl::body iwidgets::Pushbutton::constructor {args} { 96 # 97 # Reconfigure the hull to act as the outer sunken ring of 98 # the pushbutton, complete with focus ring. 99 # 100 itk_option add hull.borderwidth hull.relief 101 itk_option add hull.highlightcolor 102 itk_option add hull.highlightbackground 103 104 if {$::tk_version > 8.3} { 105 # Tk 8.4+ frame -padx -pady options creates inadvertant margin box 106 component hull configure -padx 0 -pady 0 \ 107 -borderwidth [$this cget -borderwidth] 108 } else { 109 component hull configure -borderwidth [$this cget -borderwidth] 110 } 111 112 pack propagate $itk_component(hull) no 113 114 itk_component add pushbutton { 115 button $itk_component(hull).pushbutton \ 116 } { 117 usual 118 keep -underline -wraplength -state -command 119 } 120 pack $itk_component(pushbutton) -expand 1 -fill both 121 122 # 123 # Initialize the widget based on the command line options. 124 # 125 eval itk_initialize $args 126 127 # 128 # Layout the pushbutton. 129 # 130 _relayout 131} 132 133# ------------------------------------------------------------------ 134# DESTRUCTOR 135# ------------------------------------------------------------------ 136itcl::body iwidgets::Pushbutton::destructor {} { 137 if {$_reposition != ""} {after cancel $_reposition} 138} 139 140# ------------------------------------------------------------------ 141# OPTIONS 142# ------------------------------------------------------------------ 143 144# ------------------------------------------------------------------ 145# OPTION: -padx 146# 147# Specifies the extra space surrounding the label in the x direction. 148# ------------------------------------------------------------------ 149itcl::configbody iwidgets::Pushbutton::padx { 150 $itk_component(pushbutton) configure -padx $itk_option(-padx) 151 152 _relayout 153} 154 155# ------------------------------------------------------------------ 156# OPTION: -pady 157# 158# Specifies the extra space surrounding the label in the y direction. 159# ------------------------------------------------------------------ 160itcl::configbody iwidgets::Pushbutton::pady { 161 $itk_component(pushbutton) configure -pady $itk_option(-pady) 162 163 _relayout 164} 165 166# ------------------------------------------------------------------ 167# OPTION: -font 168# 169# Specifies the label font. 170# ------------------------------------------------------------------ 171itcl::configbody iwidgets::Pushbutton::font { 172 $itk_component(pushbutton) configure -font $itk_option(-font) 173 174 _relayout 175} 176 177# ------------------------------------------------------------------ 178# OPTION: -text 179# 180# Specifies the label text. 181# ------------------------------------------------------------------ 182itcl::configbody iwidgets::Pushbutton::text { 183 $itk_component(pushbutton) configure -text $itk_option(-text) 184 185 _relayout 186} 187 188# ------------------------------------------------------------------ 189# OPTION: -bitmap 190# 191# Specifies the label bitmap. 192# ------------------------------------------------------------------ 193itcl::configbody iwidgets::Pushbutton::bitmap { 194 $itk_component(pushbutton) configure -bitmap $itk_option(-bitmap) 195 196 _relayout 197} 198 199# ------------------------------------------------------------------ 200# OPTION: -image 201# 202# Specifies the label image. 203# ------------------------------------------------------------------ 204itcl::configbody iwidgets::Pushbutton::image { 205 $itk_component(pushbutton) configure -image $itk_option(-image) 206 207 _relayout 208} 209 210# ------------------------------------------------------------------ 211# OPTION: -highlightthickness 212# 213# Specifies the thickness of the highlight ring. 214# ------------------------------------------------------------------ 215itcl::configbody iwidgets::Pushbutton::highlightthickness { 216 $itk_component(pushbutton) configure \ 217 -highlightthickness $itk_option(-highlightthickness) 218 219 _relayout 220} 221 222# ------------------------------------------------------------------ 223# OPTION: -borderwidth 224# 225# Specifies the width of the relief border. 226# ------------------------------------------------------------------ 227itcl::configbody iwidgets::Pushbutton::borderwidth { 228 $itk_component(pushbutton) configure -borderwidth $itk_option(-borderwidth) 229 230 _relayout 231} 232 233# ------------------------------------------------------------------ 234# OPTION: -defaultring 235# 236# Boolean describing whether the button displays its default ring. 237# ------------------------------------------------------------------ 238itcl::configbody iwidgets::Pushbutton::defaultring { 239 _relayout 240} 241 242# ------------------------------------------------------------------ 243# OPTION: -defaultringpad 244# 245# The size of the padded default ring around the button. 246# ------------------------------------------------------------------ 247itcl::configbody iwidgets::Pushbutton::defaultringpad { 248 pack $itk_component(pushbutton) \ 249 -padx $itk_option(-defaultringpad) \ 250 -pady $itk_option(-defaultringpad) 251} 252 253# ------------------------------------------------------------------ 254# OPTION: -height 255# 256# Specifies the height of the button inclusive of any default ring. 257# A value of zero lets the push button determine the height based 258# on the requested height plus highlightring and defaultringpad. 259# ------------------------------------------------------------------ 260itcl::configbody iwidgets::Pushbutton::height { 261 _relayout 262} 263 264# ------------------------------------------------------------------ 265# OPTION: -width 266# 267# Specifies the width of the button inclusive of any default ring. 268# A value of zero lets the push button determine the width based 269# on the requested width plus highlightring and defaultringpad. 270# ------------------------------------------------------------------ 271itcl::configbody iwidgets::Pushbutton::width { 272 _relayout 273} 274 275# ------------------------------------------------------------------ 276# METHODS 277# ------------------------------------------------------------------ 278 279# ------------------------------------------------------------------ 280# METHOD: flash 281# 282# Thin wrap of standard button widget flash method. 283# ------------------------------------------------------------------ 284itcl::body iwidgets::Pushbutton::flash {} { 285 $itk_component(pushbutton) flash 286} 287 288# ------------------------------------------------------------------ 289# METHOD: invoke 290# 291# Thin wrap of standard button widget invoke method. 292# ------------------------------------------------------------------ 293itcl::body iwidgets::Pushbutton::invoke {} { 294 $itk_component(pushbutton) invoke 295} 296 297# ------------------------------------------------------------------ 298# PROTECTED METHOD: _relayout ?when? 299# 300# Adjust the width and height of the Pushbutton to accomadate all the 301# current options settings. Add back in the highlightthickness to 302# the button such that the correct reqwidth and reqheight are computed. 303# Set the width and height based on the reqwidth/reqheight, 304# highlightthickness, and ringpad. Finally, configure the defaultring 305# properly. If "when" is "now", the change is applied immediately. If 306# it is "later" or it is not specified, then the change is applied later, 307# when the application is idle. 308# ------------------------------------------------------------------ 309itcl::body iwidgets::Pushbutton::_relayout {{when later}} { 310 if {$when == "later"} { 311 if {$_reposition == ""} { 312 set _reposition [after idle [itcl::code $this _relayout now]] 313 } 314 return 315 } elseif {$when != "now"} { 316 error "bad option \"$when\": should be now or later" 317 } 318 319 set _reposition "" 320 321 if {$itk_option(-width) == 0} { 322 set w [expr {[winfo reqwidth $itk_component(pushbutton)] \ 323 + 2 * $itk_option(-highlightthickness) \ 324 + 2 * $itk_option(-borderwidth) \ 325 + 2 * $itk_option(-defaultringpad)}] 326 } else { 327 set w $itk_option(-width) 328 } 329 330 if {$itk_option(-height) == 0} { 331 set h [expr {[winfo reqheight $itk_component(pushbutton)] \ 332 + 2 * $itk_option(-highlightthickness) \ 333 + 2 * $itk_option(-borderwidth) \ 334 + 2 * $itk_option(-defaultringpad)}] 335 } else { 336 set h $itk_option(-height) 337 } 338 339 component hull configure -width $w -height $h 340 341 if {$itk_option(-defaultring)} { 342 component hull configure -relief sunken \ 343 -highlightthickness [$this cget -highlightthickness] \ 344 -takefocus 1 345 346 configure -takefocus 1 347 348 component pushbutton configure \ 349 -highlightthickness 0 -takefocus 0 350 351 } else { 352 component hull configure -relief flat \ 353 -highlightthickness 0 -takefocus 0 354 355 component pushbutton configure \ 356 -highlightthickness [$this cget -highlightthickness] \ 357 -takefocus 1 358 359 configure -takefocus 0 360 } 361} 362