1# 2# Buttonbox 3# ---------------------------------------------------------------------- 4# Manages a framed area with Motif style buttons. The button box can 5# be configured either horizontally or vertically. 6# 7# ---------------------------------------------------------------------- 8# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com 9# Bret A. Schuhmacher EMAIL: bas@wn.com 10# 11# @(#) $Id: buttonbox.itk,v 1.3 2001/08/15 18:30:53 smithc Exp $ 12# ---------------------------------------------------------------------- 13# Copyright (c) 1995 DSC Technologies Corporation 14# ====================================================================== 15# Permission to use, copy, modify, distribute and license this software 16# and its documentation for any purpose, and without fee or written 17# agreement with DSC, is hereby granted, provided that the above copyright 18# notice appears in all copies and that both the copyright notice and 19# warranty disclaimer below appear in supporting documentation, and that 20# the names of DSC Technologies Corporation or DSC Communications 21# Corporation not be used in advertising or publicity pertaining to the 22# software without specific, written prior permission. 23# 24# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 25# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- 26# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE 27# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 28# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 29# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 30# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 31# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, 32# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 33# SOFTWARE. 34# ====================================================================== 35 36# 37# Usual options. 38# 39itk::usual Buttonbox { 40 keep -background -cursor -foreground 41} 42 43# ------------------------------------------------------------------ 44# BUTTONBOX 45# ------------------------------------------------------------------ 46itcl::class iwidgets::Buttonbox { 47 inherit itk::Widget 48 49 constructor {args} {} 50 destructor {} 51 52 itk_option define -pady padY Pad 5 53 itk_option define -padx padX Pad 5 54 itk_option define -orient orient Orient "horizontal" 55 itk_option define -foreground foreground Foreground black 56 57 public method index {args} 58 public method add {args} 59 public method insert {args} 60 public method delete {args} 61 public method default {args} 62 public method hide {args} 63 public method show {args} 64 public method invoke {args} 65 public method buttonconfigure {args} 66 public method buttoncget {index option} 67 68 private method _positionButtons {} 69 private method _setBoxSize {{when later}} 70 private method _getMaxWidth {} 71 private method _getMaxHeight {} 72 73 private variable _resizeFlag {} ;# Flag for resize needed. 74 private variable _buttonList {} ;# List of all buttons in box. 75 private variable _displayList {} ;# List of displayed buttons. 76 private variable _unique 0 ;# Counter for button widget ids. 77} 78 79namespace eval iwidgets::Buttonbox { 80 # 81 # Set up some class level bindings for map and configure events. 82 # 83 bind bbox-map <Map> [itcl::code %W _setBoxSize] 84 bind bbox-config <Configure> [itcl::code %W _positionButtons] 85} 86 87# 88# Provide a lowercased access method for the Buttonbox class. 89# 90proc ::iwidgets::buttonbox {pathName args} { 91 uplevel ::iwidgets::Buttonbox $pathName $args 92} 93 94# ------------------------------------------------------------------ 95# CONSTRUCTOR 96# ------------------------------------------------------------------ 97itcl::body iwidgets::Buttonbox::constructor {args} { 98 # 99 # Add Configure bindings for geometry management. 100 # 101 bindtags $itk_component(hull) \ 102 [linsert [bindtags $itk_component(hull)] 0 bbox-map] 103 bindtags $itk_component(hull) \ 104 [linsert [bindtags $itk_component(hull)] 1 bbox-config] 105 106 pack propagate $itk_component(hull) no 107 108 # 109 # Initialize the widget based on the command line options. 110 # 111 eval itk_initialize $args 112} 113 114# ------------------------------------------------------------------ 115# DESTRUCTOR 116# ------------------------------------------------------------------ 117itcl::body iwidgets::Buttonbox::destructor {} { 118 if {$_resizeFlag != ""} {after cancel $_resizeFlag} 119} 120 121# ------------------------------------------------------------------ 122# OPTIONS 123# ------------------------------------------------------------------ 124 125# ------------------------------------------------------------------ 126# OPTION: -pady 127# 128# Pad the y space between the button box frame and the hull. 129# ------------------------------------------------------------------ 130itcl::configbody iwidgets::Buttonbox::pady { 131 _setBoxSize 132} 133 134# ------------------------------------------------------------------ 135# OPTION: -padx 136# 137# Pad the x space between the button box frame and the hull. 138# ------------------------------------------------------------------ 139itcl::configbody iwidgets::Buttonbox::padx { 140 _setBoxSize 141} 142 143# ------------------------------------------------------------------ 144# OPTION: -orient 145# 146# Position buttons either horizontally or vertically. 147# ------------------------------------------------------------------ 148itcl::configbody iwidgets::Buttonbox::orient { 149 switch $itk_option(-orient) { 150 "horizontal" - 151 "vertical" { 152 _setBoxSize 153 } 154 155 default { 156 error "bad orientation option \"$itk_option(-orient)\",\ 157 should be either horizontal or vertical" 158 } 159 } 160} 161 162# ------------------------------------------------------------------ 163# METHODS 164# ------------------------------------------------------------------ 165 166# ------------------------------------------------------------------ 167# METHOD: index index 168# 169# Searches the buttons in the box for the one with the requested tag, 170# numerical index, keyword "end" or "default". Returns the button's 171# tag if found, otherwise error. 172# ------------------------------------------------------------------ 173itcl::body iwidgets::Buttonbox::index {index} { 174 if {[llength $_buttonList] > 0} { 175 if {[regexp {(^[0-9]+$)} $index]} { 176 if {$index < [llength $_buttonList]} { 177 return $index 178 } else { 179 error "Buttonbox index \"$index\" is out of range" 180 } 181 182 } elseif {$index == "end"} { 183 return [expr {[llength $_buttonList] - 1}] 184 185 } elseif {$index == "default"} { 186 foreach knownButton $_buttonList { 187 if {[$itk_component($knownButton) cget -defaultring]} { 188 return [lsearch -exact $_buttonList $knownButton] 189 } 190 } 191 192 error "Buttonbox \"$itk_component(hull)\" has no default" 193 194 } else { 195 if {[set idx [lsearch $_buttonList $index]] != -1} { 196 return $idx 197 } 198 199 error "bad Buttonbox index \"$index\": must be number, end,\ 200 default, or pattern" 201 } 202 203 } else { 204 error "Buttonbox \"$itk_component(hull)\" has no buttons" 205 } 206} 207 208# ------------------------------------------------------------------ 209# METHOD: add tag ?option value option value ...? 210# 211# Add the specified button to the button box. All PushButton options 212# are allowed. New buttons are added to the list of buttons and the 213# list of displayed buttons. The PushButton path name is returned. 214# ------------------------------------------------------------------ 215itcl::body iwidgets::Buttonbox::add {tag args} { 216 itk_component add $tag { 217 iwidgets::Pushbutton $itk_component(hull).[incr _unique] 218 } { 219 usual 220 rename -highlightbackground -background background Background 221 } 222 223 if {$args != ""} { 224 uplevel $itk_component($tag) configure $args 225 } 226 227 lappend _buttonList $tag 228 lappend _displayList $tag 229 230 _setBoxSize 231} 232 233# ------------------------------------------------------------------ 234# METHOD: insert index tag ?option value option value ...? 235# 236# Insert the specified button in the button box just before the one 237# given by index. All PushButton options are allowed. New buttons 238# are added to the list of buttons and the list of displayed buttons. 239# The PushButton path name is returned. 240# ------------------------------------------------------------------ 241itcl::body iwidgets::Buttonbox::insert {index tag args} { 242 itk_component add $tag { 243 iwidgets::Pushbutton $itk_component(hull).[incr _unique] 244 } { 245 usual 246 rename -highlightbackground -background background Background 247 } 248 249 if {$args != ""} { 250 uplevel $itk_component($tag) configure $args 251 } 252 253 set index [index $index] 254 set _buttonList [linsert $_buttonList $index $tag] 255 set _displayList [linsert $_displayList $index $tag] 256 257 _setBoxSize 258} 259 260# ------------------------------------------------------------------ 261# METHOD: delete index 262# 263# Delete the specified button from the button box. 264# ------------------------------------------------------------------ 265itcl::body iwidgets::Buttonbox::delete {index} { 266 set index [index $index] 267 set tag [lindex $_buttonList $index] 268 269 destroy $itk_component($tag) 270 271 set _buttonList [lreplace $_buttonList $index $index] 272 273 if {[set dind [lsearch $_displayList $tag]] != -1} { 274 set _displayList [lreplace $_displayList $dind $dind] 275 } 276 277 _setBoxSize 278 update idletasks 279} 280 281# ------------------------------------------------------------------ 282# METHOD: default index 283# 284# Sets the default to the push button given by index. 285# ------------------------------------------------------------------ 286itcl::body iwidgets::Buttonbox::default {index} { 287 set index [index $index] 288 289 set defbtn [lindex $_buttonList $index] 290 291 foreach knownButton $_displayList { 292 if {$knownButton == $defbtn} { 293 $itk_component($knownButton) configure -defaultring yes 294 } else { 295 $itk_component($knownButton) configure -defaultring no 296 } 297 } 298} 299 300# ------------------------------------------------------------------ 301# METHOD: hide index 302# 303# Hide the push button given by index. This doesn't remove the button 304# permanently from the display list, just inhibits its display. 305# ------------------------------------------------------------------ 306itcl::body iwidgets::Buttonbox::hide {index} { 307 set index [index $index] 308 set tag [lindex $_buttonList $index] 309 310 if {[set dind [lsearch $_displayList $tag]] != -1} { 311 place forget $itk_component($tag) 312 set _displayList [lreplace $_displayList $dind $dind] 313 314 _setBoxSize 315 } 316} 317 318# ------------------------------------------------------------------ 319# METHOD: show index 320# 321# Displays a previously hidden push button given by index. Check if 322# the button is already in the display list. If not then add it back 323# at it's original location and redisplay. 324# ------------------------------------------------------------------ 325itcl::body iwidgets::Buttonbox::show {index} { 326 set index [index $index] 327 set tag [lindex $_buttonList $index] 328 329 if {[lsearch $_displayList $tag] == -1} { 330 set _displayList [linsert $_displayList $index $tag] 331 332 _setBoxSize 333 } 334} 335 336# ------------------------------------------------------------------ 337# METHOD: invoke ?index? 338# 339# Invoke the command associated with a push button. If no arguments 340# are given then the default button is invoked, otherwise the argument 341# is expected to be a button index. 342# ------------------------------------------------------------------ 343itcl::body iwidgets::Buttonbox::invoke {args} { 344 if {[llength $args] == 0} { 345 $itk_component([lindex $_buttonList [index default]]) invoke 346 347 } else { 348 $itk_component([lindex $_buttonList [index [lindex $args 0]]]) \ 349 invoke 350 } 351} 352 353# ------------------------------------------------------------------ 354# METHOD: buttonconfigure index ?option? ?value option value ...? 355# 356# Configure a push button given by index. This method allows 357# configuration of pushbuttons from the Buttonbox level. The options 358# may have any of the values accepted by the add method. 359# ------------------------------------------------------------------ 360itcl::body iwidgets::Buttonbox::buttonconfigure {index args} { 361 set tag [lindex $_buttonList [index $index]] 362 363 set retstr [uplevel $itk_component($tag) configure $args] 364 365 _setBoxSize 366 367 return $retstr 368} 369 370# ------------------------------------------------------------------ 371# METHOD: buttonccget index option 372# 373# Return value of option for push button given by index. Option may 374# have any of the values accepted by the add method. 375# ------------------------------------------------------------------ 376itcl::body iwidgets::Buttonbox::buttoncget {index option} { 377 set tag [lindex $_buttonList [index $index]] 378 379 set retstr [uplevel $itk_component($tag) cget [list $option]] 380 381 return $retstr 382} 383 384# ----------------------------------------------------------------- 385# PRIVATE METHOD: _getMaxWidth 386# 387# Returns the required width of the largest button. 388# ----------------------------------------------------------------- 389itcl::body iwidgets::Buttonbox::_getMaxWidth {} { 390 set max 0 391 392 foreach tag $_displayList { 393 set w [winfo reqwidth $itk_component($tag)] 394 395 if {$w > $max} { 396 set max $w 397 } 398 } 399 400 return $max 401} 402 403# ----------------------------------------------------------------- 404# PRIVATE METHOD: _getMaxHeight 405# 406# Returns the required height of the largest button. 407# ----------------------------------------------------------------- 408itcl::body iwidgets::Buttonbox::_getMaxHeight {} { 409 set max 0 410 411 foreach tag $_displayList { 412 set h [winfo reqheight $itk_component($tag)] 413 414 if {$h > $max} { 415 set max $h 416 } 417 } 418 419 return $max 420} 421 422# ------------------------------------------------------------------ 423# METHOD: _setBoxSize ?when? 424# 425# Sets the proper size of the frame surrounding all the buttons. 426# If "when" is "now", the change is applied immediately. If it is 427# "later" or it is not specified, then the change is applied later, 428# when the application is idle. 429# ------------------------------------------------------------------ 430itcl::body iwidgets::Buttonbox::_setBoxSize {{when later}} { 431 if {[winfo ismapped $itk_component(hull)]} { 432 if {$when == "later"} { 433 if {$_resizeFlag == ""} { 434 set _resizeFlag [after idle [itcl::code $this _setBoxSize now]] 435 } 436 return 437 } elseif {$when != "now"} { 438 error "bad option \"$when\": should be now or later" 439 } 440 441 set _resizeFlag "" 442 443 set numBtns [llength $_displayList] 444 445 if {$itk_option(-orient) == "horizontal"} { 446 set minw [expr {$numBtns * [_getMaxWidth] \ 447 + ($numBtns+1) * $itk_option(-padx)}] 448 set minh [expr {[_getMaxHeight] + 2 * $itk_option(-pady)}] 449 450 } else { 451 set minw [expr {[_getMaxWidth] + 2 * $itk_option(-padx)}] 452 set minh [expr {$numBtns * [_getMaxHeight] \ 453 + ($numBtns+1) * $itk_option(-pady)}] 454 } 455 456 # 457 # Remove the configure event bindings on the hull while we adjust the 458 # width/height and re-position the buttons. Once we're through, we'll 459 # update and reinstall them. This prevents double calls to position 460 # the buttons. 461 # 462 set tags [bindtags $itk_component(hull)] 463 if {[set i [lsearch $tags bbox-config]] != -1} { 464 set tags [lreplace $tags $i $i] 465 bindtags $itk_component(hull) $tags 466 } 467 468 component hull configure -width $minw -height $minh 469 470 update idletasks 471 472 _positionButtons 473 474 bindtags $itk_component(hull) [linsert $tags 0 bbox-config] 475 } 476} 477 478# ------------------------------------------------------------------ 479# METHOD: _positionButtons 480# 481# This method is responsible setting the width/height of all the 482# displayed buttons to the same value and for placing all the buttons 483# in equidistant locations. 484# ------------------------------------------------------------------ 485itcl::body iwidgets::Buttonbox::_positionButtons {} { 486 set bf $itk_component(hull) 487 set numBtns [llength $_displayList] 488 489 # 490 # First, determine the common width and height for all the 491 # displayed buttons. 492 # 493 if {$numBtns > 0} { 494 set bfWidth [winfo width $itk_component(hull)] 495 set bfHeight [winfo height $itk_component(hull)] 496 497 if {$bfWidth >= [winfo reqwidth $itk_component(hull)]} { 498 set _btnWidth [_getMaxWidth] 499 500 } else { 501 if {$itk_option(-orient) == "horizontal"} { 502 set _btnWidth [expr {$bfWidth / $numBtns}] 503 } else { 504 set _btnWidth $bfWidth 505 } 506 } 507 508 if {$bfHeight >= [winfo reqheight $itk_component(hull)]} { 509 set _btnHeight [_getMaxHeight] 510 511 } else { 512 if {$itk_option(-orient) == "vertical"} { 513 set _btnHeight [expr {$bfHeight / $numBtns}] 514 } else { 515 set _btnHeight $bfHeight 516 } 517 } 518 } 519 520 # 521 # Place the buttons at the proper locations. 522 # 523 if {$numBtns > 0} { 524 if {$itk_option(-orient) == "horizontal"} { 525 set leftover [expr {[winfo width $bf] \ 526 - 2 * $itk_option(-padx) - $_btnWidth * $numBtns}] 527 528 if {$numBtns > 0} { 529 set offset [expr {$leftover / ($numBtns + 1)}] 530 } else { 531 set offset 0 532 } 533 if {$offset < 0} {set offset 0} 534 535 set xDist [expr {$itk_option(-padx) + $offset}] 536 set incrAmount [expr {$_btnWidth + $offset}] 537 538 foreach button $_displayList { 539 place $itk_component($button) -anchor w \ 540 -x $xDist -rely .5 -y 0 -relx 0 \ 541 -width $_btnWidth -height $_btnHeight 542 543 set xDist [expr {$xDist + $incrAmount}] 544 } 545 546 } else { 547 set leftover [expr {[winfo height $bf] \ 548 - 2 * $itk_option(-pady) - $_btnHeight * $numBtns}] 549 550 if {$numBtns > 0} { 551 set offset [expr {$leftover / ($numBtns + 1)}] 552 } else { 553 set offset 0 554 } 555 if {$offset < 0} {set offset 0} 556 557 set yDist [expr {$itk_option(-pady) + $offset}] 558 set incrAmount [expr {$_btnHeight + $offset}] 559 560 foreach button $_displayList { 561 place $itk_component($button) -anchor n \ 562 -y $yDist -relx .5 -x 0 -rely 0 \ 563 -width $_btnWidth -height $_btnHeight 564 565 set yDist [expr {$yDist + $incrAmount}] 566 } 567 } 568 } 569} 570 571 572