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