1# 2# Optionmenu 3# ---------------------------------------------------------------------- 4# Implements an option menu widget with options to manage it. 5# An option menu displays a frame containing a label and a button. 6# A pop-up menu will allow for the value of the button to change. 7# 8# ---------------------------------------------------------------------- 9# AUTHOR: Alfredo Jahn Phone: (214) 519-3545 10# Email: ajahn@spd.dsccc.com 11# alfredo@wn.com 12# 13# @(#) $Id: optionmenu.itk,v 1.9 2001/10/26 15:28:22 smithc Exp $ 14# ---------------------------------------------------------------------- 15# Copyright (c) 1995 DSC Technologies Corporation 16# ====================================================================== 17# Permission to use, copy, modify, distribute and license this software 18# and its documentation for any purpose, and without fee or written 19# agreement with DSC, is hereby granted, provided that the above copyright 20# notice appears in all copies and that both the copyright notice and 21# warranty disclaimer below appear in supporting documentation, and that 22# the names of DSC Technologies Corporation or DSC Communications 23# Corporation not be used in advertising or publicity pertaining to the 24# software without specific, written prior permission. 25# 26# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 27# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- 28# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE 29# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 30# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 31# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 32# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 33# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, 34# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 35# SOFTWARE. 36# ====================================================================== 37 38# 39# Default resources. 40# 41 42option add *Optionmenu.highlightThickness 1 widgetDefault 43option add *Optionmenu.borderWidth 2 widgetDefault 44option add *Optionmenu.labelPos w widgetDefault 45option add *Optionmenu.labelMargin 2 widgetDefault 46option add *Optionmenu.popupCursor arrow widgetDefault 47 48# 49# Usual options. 50# 51itk::usual Optionmenu { 52 keep -activebackground -activeborderwidth -activeforeground \ 53 -background -borderwidth -cursor -disabledforeground -font \ 54 -foreground -highlightcolor -highlightthickness -labelfont \ 55 -popupcursor 56} 57 58# ------------------------------------------------------------------ 59# OPTONMENU 60# ------------------------------------------------------------------ 61itcl::class iwidgets::Optionmenu { 62 inherit iwidgets::Labeledwidget 63 64 constructor {args} {} 65 destructor {} 66 67 itk_option define -clicktime clickTime ClickTime 150 68 itk_option define -command command Command {} 69 itk_option define -cyclicon cyclicOn CyclicOn true 70 itk_option define -width width Width 0 71 itk_option define -font font Font -Adobe-Helvetica-Bold-R-Normal--*-120-* 72 itk_option define -borderwidth borderWidth BorderWidth 2 73 itk_option define -highlightthickness highlightThickness HighlightThickness 1 74 itk_option define -state state State normal 75 76 public { 77 method index {index} 78 method delete {first {last {}}} 79 method disable {index} 80 method enable {args} 81 method get {{first "current"} {last ""}} 82 method insert {index string args} 83 method popupMenu {args} 84 method select {index} 85 method sort {{mode "increasing"}} 86 } 87 88 protected { 89 variable _calcSize "" ;# non-null => _calcSize pending 90 } 91 92 private { 93 method _buttonRelease {time} 94 method _getNextItem {index} 95 method _next {} 96 method _postMenu {time} 97 method _previous {} 98 method _setItem {item} 99 method _setSize {{when later}} 100 method _setitems {items} ;# Set the list of menu entries 101 102 variable _postTime 0 103 variable _items {} ;# List of popup menu entries 104 variable _numitems 0 ;# List of popup menu entries 105 106 variable _currentItem "" ;# Active menu selection 107 } 108} 109 110# 111# Provide a lowercased access method for the Optionmenu class. 112# 113proc ::iwidgets::optionmenu {pathName args} { 114 uplevel ::iwidgets::Optionmenu $pathName $args 115} 116 117# ------------------------------------------------------------------ 118# CONSTRUCTOR 119# ------------------------------------------------------------------ 120itcl::body iwidgets::Optionmenu::constructor {args} { 121 global tcl_platform 122 123 component hull configure -highlightthickness 0 124 125 itk_component add menuBtn { 126 menubutton $itk_interior.menuBtn -relief raised -indicatoron on \ 127 -textvariable [itcl::scope _currentItem] -takefocus 1 \ 128 -menu $itk_interior.menuBtn.menu 129 } { 130 usual 131 keep -borderwidth 132 if {$tcl_platform(platform) != "unix"} { 133 ignore -activebackground -activeforeground 134 } 135 } 136 pack $itk_interior.menuBtn -fill x 137 pack propagate $itk_interior no 138 139 itk_component add popupMenu { 140 menu $itk_interior.menuBtn.menu -tearoff no 141 } { 142 usual 143 ignore -tearoff 144 keep -activeborderwidth -borderwidth 145 rename -cursor -popupcursor popupCursor Cursor 146 } 147 148 # 149 # Bind to button release for all components. 150 # 151 bind $itk_component(menuBtn) <ButtonPress-1> \ 152 "[itcl::code $this _postMenu %t]; break" 153 bind $itk_component(menuBtn) <KeyPress-space> \ 154 "[itcl::code $this _postMenu %t]; break" 155 bind $itk_component(popupMenu) <ButtonRelease-1> \ 156 [itcl::code $this _buttonRelease %t] 157 158 # 159 # Initialize the widget based on the command line options. 160 # 161 eval itk_initialize $args 162} 163 164# ------------------------------------------------------------------ 165# DESTRUCTOR 166# ------------------------------------------------------------------ 167itcl::body iwidgets::Optionmenu::destructor {} { 168 if {$_calcSize != ""} {after cancel $_calcSize} 169} 170 171# ------------------------------------------------------------------ 172# OPTIONS 173# ------------------------------------------------------------------ 174 175# ------------------------------------------------------------------ 176# OPTION -clicktime 177# 178# Interval time (in msec) used to determine that a single mouse 179# click has occurred. Used to post menu on a quick mouse click. 180# **WARNING** changing this value may cause the sigle-click 181# functionality to not work properly! 182# ------------------------------------------------------------------ 183itcl::configbody iwidgets::Optionmenu::clicktime {} 184 185# ------------------------------------------------------------------ 186# OPTION -command 187# 188# Specifies a command to be evaluated upon change in option menu. 189# ------------------------------------------------------------------ 190itcl::configbody iwidgets::Optionmenu::command {} 191 192# ------------------------------------------------------------------ 193# OPTION -cyclicon 194# 195# Turns on/off the 3rd mouse button capability. This feature 196# allows the right mouse button to cycle through the popup 197# menu list without poping it up. <shift>M3 cycles through 198# the menu in reverse order. 199# ------------------------------------------------------------------ 200itcl::configbody iwidgets::Optionmenu::cyclicon { 201 if {$itk_option(-cyclicon)} { 202 bind $itk_component(menuBtn) <3> [itcl::code $this _next] 203 bind $itk_component(menuBtn) <Shift-3> [itcl::code $this _previous] 204 bind $itk_component(menuBtn) <KeyPress-Down> [itcl::code $this _next] 205 bind $itk_component(menuBtn) <KeyPress-Up> [itcl::code $this _previous] 206 } else { 207 bind $itk_component(menuBtn) <3> break 208 bind $itk_component(menuBtn) <Shift-3> break 209 bind $itk_component(menuBtn) <KeyPress-Down> break 210 bind $itk_component(menuBtn) <KeyPress-Up> break 211 } 212} 213 214# ------------------------------------------------------------------ 215# OPTION -width 216# 217# Allows the menu label width to be set to a fixed size 218# ------------------------------------------------------------------ 219itcl::configbody iwidgets::Optionmenu::width { 220 _setSize 221} 222 223# ------------------------------------------------------------------ 224# OPTION -font 225# 226# Change all fonts for this widget. Also re-calculate height based 227# on font size (used to line up menu items over menu button label). 228# ------------------------------------------------------------------ 229itcl::configbody iwidgets::Optionmenu::font { 230 _setSize 231} 232 233# ------------------------------------------------------------------ 234# OPTION -borderwidth 235# 236# Change borderwidth for this widget. Also re-calculate height based 237# on font size (used to line up menu items over menu button label). 238# ------------------------------------------------------------------ 239itcl::configbody iwidgets::Optionmenu::borderwidth { 240 _setSize 241} 242 243# ------------------------------------------------------------------ 244# OPTION -highlightthickness 245# 246# Change highlightthickness for this widget. Also re-calculate 247# height based on font size (used to line up menu items over 248# menu button label). 249# ------------------------------------------------------------------ 250itcl::configbody iwidgets::Optionmenu::highlightthickness { 251 _setSize 252} 253 254# ------------------------------------------------------------------ 255# OPTION -state 256# 257# Specified one of two states for the Optionmenu: normal, or 258# disabled. If the Optionmenu is disabled, then option menu 259# selection is ignored. 260# ------------------------------------------------------------------ 261itcl::configbody iwidgets::Optionmenu::state { 262 switch $itk_option(-state) { 263 normal { 264 $itk_component(menuBtn) config -state normal 265 $itk_component(label) config -fg $itk_option(-foreground) 266 } 267 disabled { 268 $itk_component(menuBtn) config -state disabled 269 $itk_component(label) config -fg $itk_option(-disabledforeground) 270 } 271 default { 272 error "bad state option \"$itk_option(-state)\":\ 273 should be disabled or normal" 274 } 275 } 276} 277 278# ------------------------------------------------------------------ 279# METHODS 280# ------------------------------------------------------------------ 281 282# ------------------------------------------------------------------ 283# METHOD: index index 284# 285# Return the numerical index corresponding to index. 286# ------------------------------------------------------------------ 287itcl::body iwidgets::Optionmenu::index {index} { 288 289 if {[regexp {(^[0-9]+$)} $index]} { 290 set idx [$itk_component(popupMenu) index $index] 291 292 if {$idx == "none"} { 293 return 0 294 } 295 return [expr {$index > $idx ? $_numitems : $idx}] 296 297 } elseif {$index == "end"} { 298 return [expr {$_numitems - 1}] 299 300 } elseif {$index == "select"} { 301 return [lsearch $_items $_currentItem] 302 303 } 304 305 set numValue [lsearch -glob $_items $index] 306 307 if {$numValue == -1} { 308 error "bad Optionmenu index \"$index\"" 309 } 310 return $numValue 311} 312 313# ------------------------------------------------------------------ 314# METHOD: delete first ?last? 315# 316# Remove an item (or range of items) from the popup menu. 317# ------------------------------------------------------------------ 318itcl::body iwidgets::Optionmenu::delete {first {last {}}} { 319 320 set first [index $first] 321 set last [expr {$last != {} ? [index $last] : $first}] 322 set nextAvail $_currentItem 323 324 # 325 # If current item is in delete range point to next available. 326 # 327 if {$_numitems > 1 && 328 ([lsearch -exact [lrange $_items $first $last] [get]] != -1)} { 329 set nextAvail [_getNextItem $last] 330 } 331 332 _setitems [lreplace $_items $first $last] 333 334 # 335 # Make sure "nextAvail" is still in the list. 336 # 337 set index [lsearch -exact $_items $nextAvail] 338 _setItem [expr {$index != -1 ? $nextAvail : ""}] 339} 340 341# ------------------------------------------------------------------ 342# METHOD: disable index 343# 344# Disable a menu item in the option menu. This will prevent the user 345# from being able to select this item from the menu. This only effects 346# the state of the item in the menu, in other words, should the item 347# be the currently selected item, the user is responsible for 348# determining this condition and taking appropriate action. 349# ------------------------------------------------------------------ 350itcl::body iwidgets::Optionmenu::disable {index} { 351 set index [index $index] 352 $itk_component(popupMenu) entryconfigure $index -state disabled 353} 354 355# ------------------------------------------------------------------ 356# METHOD: enable index 357# 358# Enable a menu item in the option menu. This will allow the user 359# to select this item from the menu. 360# ------------------------------------------------------------------ 361itcl::body iwidgets::Optionmenu::enable {index} { 362 set index [index $index] 363 $itk_component(popupMenu) entryconfigure $index -state normal 364} 365 366# ------------------------------------------------------------------ 367# METHOD: get 368# 369# Returns the current menu item. 370# ------------------------------------------------------------------ 371itcl::body iwidgets::Optionmenu::get {{first "current"} {last ""}} { 372 if {"current" == $first} { 373 return $_currentItem 374 } 375 376 set first [index $first] 377 if {"" == $last} { 378 return [$itk_component(popupMenu) entrycget $first -label] 379 } 380 381 if {"end" == $last} { 382 set last [$itk_component(popupMenu) index end] 383 } else { 384 set last [index $last] 385 } 386 set rval "" 387 while {$first <= $last} { 388 lappend rval [$itk_component(popupMenu) entrycget $first -label] 389 incr first 390 } 391 return $rval 392} 393 394# ------------------------------------------------------------------ 395# METHOD: insert index string ?string? 396# 397# Insert an item in the popup menu. 398# ------------------------------------------------------------------ 399itcl::body iwidgets::Optionmenu::insert {index string args} { 400 if {$index == "end"} { 401 set index $_numitems 402 } else { 403 set index [index $index] 404 } 405 set args [linsert $args 0 $string] 406 _setitems [eval linsert {$_items} $index $args] 407 return "" 408} 409 410# ------------------------------------------------------------------ 411# METHOD: select index 412# 413# Select an item from the popup menu to display on the menu label 414# button. 415# ------------------------------------------------------------------ 416itcl::body iwidgets::Optionmenu::select {index} { 417 set index [index $index] 418 if {$index > ($_numitems - 1)} { 419 incr index -1 420 } 421 _setItem [lindex $_items $index] 422} 423 424# ------------------------------------------------------------------ 425# METHOD: popupMenu 426# 427# Evaluates the specified args against the popup menu component 428# and returns the result. 429# ------------------------------------------------------------------ 430itcl::body iwidgets::Optionmenu::popupMenu {args} { 431 return [eval $itk_component(popupMenu) $args] 432} 433 434# ------------------------------------------------------------------ 435# METHOD: sort mode 436# 437# Sort the current menu in either "ascending" or "descending" order. 438# ------------------------------------------------------------------ 439itcl::body iwidgets::Optionmenu::sort {{mode "increasing"}} { 440 switch $mode { 441 ascending - 442 increasing { 443 _setitems [lsort -increasing $_items] 444 } 445 descending - 446 decreasing { 447 _setitems [lsort -decreasing $_items] 448 } 449 default { 450 error "bad sort argument \"$mode\": should be ascending,\ 451 descending, increasing, or decreasing" 452 } 453 } 454} 455 456# ------------------------------------------------------------------ 457# PRIVATE METHOD: _buttonRelease 458# 459# Display the popup menu. Menu position is calculated. 460# ------------------------------------------------------------------ 461itcl::body iwidgets::Optionmenu::_buttonRelease {time} { 462 if {(abs([expr $_postTime - $time])) <= $itk_option(-clicktime)} { 463 return -code break 464 } 465} 466 467# ------------------------------------------------------------------ 468# PRIVATE METHOD: _getNextItem index 469# 470# Allows either a string or index number to be passed in, and returns 471# the next item in the list in string format. Wrap around is automatic. 472# ------------------------------------------------------------------ 473itcl::body iwidgets::Optionmenu::_getNextItem {index} { 474 475 if {[incr index] >= $_numitems} { 476 set index 0 ;# wrap around 477 } 478 return [lindex $_items $index] 479} 480 481# ------------------------------------------------------------------ 482# PRIVATE METHOD: _next 483# 484# Sets the current option label to next item in list if that item is 485# not disbaled. 486# ------------------------------------------------------------------ 487itcl::body iwidgets::Optionmenu::_next {} { 488 if {$itk_option(-state) != "normal"} { 489 return 490 } 491 set i [lsearch -exact $_items $_currentItem] 492 493 for {set cnt 0} {$cnt < $_numitems} {incr cnt} { 494 495 if {[incr i] >= $_numitems} { 496 set i 0 497 } 498 499 if {[$itk_component(popupMenu) entrycget $i -state] != "disabled"} { 500 _setItem [lindex $_items $i] 501 break 502 } 503 } 504} 505 506# ------------------------------------------------------------------ 507# PRIVATE METHOD: _previous 508# 509# Sets the current option label to previous item in list if that 510# item is not disbaled. 511# ------------------------------------------------------------------ 512itcl::body iwidgets::Optionmenu::_previous {} { 513 if {$itk_option(-state) != "normal"} { 514 return 515 } 516 517 set i [lsearch -exact $_items $_currentItem] 518 519 for {set cnt 0} {$cnt < $_numitems} {incr cnt} { 520 set i [expr {$i - 1}] 521 522 if {$i < 0} { 523 set i [expr {$_numitems - 1}] 524 } 525 526 if {[$itk_component(popupMenu) entrycget $i -state] != "disabled"} { 527 _setItem [lindex $_items $i] 528 break 529 } 530 } 531} 532 533# ------------------------------------------------------------------ 534# PRIVATE METHOD: _postMenu time 535# 536# Display the popup menu. Menu position is calculated. 537# ------------------------------------------------------------------ 538itcl::body iwidgets::Optionmenu::_postMenu {time} { 539 # 540 # Don't bother to post if menu is empty. 541 # 542 if {[llength $_items] > 0 && $itk_option(-state) == "normal"} { 543 set _postTime $time 544 set itemIndex [lsearch -exact $_items $_currentItem] 545 546 set margin [expr {$itk_option(-borderwidth) \ 547 + $itk_option(-highlightthickness)}] 548 549 set x [expr {[winfo rootx $itk_component(menuBtn)] + $margin}] 550 set y [expr {[winfo rooty $itk_component(menuBtn)] \ 551 - [$itk_component(popupMenu) yposition $itemIndex] + $margin}] 552 553 tk_popup $itk_component(popupMenu) $x $y 554 } 555} 556 557# ------------------------------------------------------------------ 558# PRIVATE METHOD: _setItem 559# 560# Set the menu button label to item, then dismiss the popup menu. 561# Also check if item has been changed. If so, also call user-supplied 562# command. 563# ------------------------------------------------------------------ 564itcl::body iwidgets::Optionmenu::_setItem {item} { 565 if {$_currentItem != $item} { 566 set _currentItem $item 567 if {[winfo ismapped $itk_component(hull)]} { 568 uplevel #0 $itk_option(-command) 569 } 570 } 571} 572 573# ------------------------------------------------------------------ 574# PRIVATE METHOD: _setitems items 575# 576# Create a list of items available on the menu. Used to create the 577# popup menu. 578# ------------------------------------------------------------------ 579itcl::body iwidgets::Optionmenu::_setitems {items_} { 580 581 # 582 # Delete the old menu entries, and set the new list of 583 # menu entries to those specified in "items_". 584 # 585 $itk_component(popupMenu) delete 0 last 586 set _items "" 587 set _numitems [llength $items_] 588 589 # 590 # Clear the menu button label. 591 # 592 if {$_numitems == 0} { 593 _setItem "" 594 return 595 } 596 597 set savedCurrentItem $_currentItem 598 599 foreach opt $items_ { 600 lappend _items $opt 601 $itk_component(popupMenu) add command -label $opt \ 602 -command [itcl::code $this _setItem $opt] 603 } 604 set first [lindex $_items 0] 605 606 # 607 # Make sure "savedCurrentItem" is still in the list. 608 # 609 if {$first != ""} { 610 set i [lsearch -exact $_items $savedCurrentItem] 611 #------------------------------------------------------------- 612 # BEGIN BUG FIX: csmith (Chad Smith: csmith@adc.com), 11/18/99 613 #------------------------------------------------------------- 614 # The previous code fragment: 615 # <select [expr {$i != -1 ? $savedCurrentItem : $first}]> 616 # is faulty because of exponential numbers. For example, 617 # 2e-4 is numerically equal to 2e-04, but the string representation 618 # is of course different. As a result, the select invocation 619 # fails, and an error message is printed. 620 #------------------------------------------------------------- 621 if {$i != -1} { 622 select $savedCurrentItem 623 } else { 624 select $first 625 } 626 #------------------------------------------------------------- 627 # END BUG FIX 628 #------------------------------------------------------------- 629 } else { 630 _setItem "" 631 } 632 633 _setSize 634} 635 636# ------------------------------------------------------------------ 637# PRIVATE METHOD: _setSize ?when? 638# 639# Set the size of the option menu. If "when" is "now", the change 640# is applied immediately. If it is "later" or it is not specified, 641# then the change is applied later, when the application is idle. 642# ------------------------------------------------------------------ 643itcl::body iwidgets::Optionmenu::_setSize {{when later}} { 644 645 if {$when == "later"} { 646 if {$_calcSize == ""} { 647 set _calcSize [after idle [itcl::code $this _setSize now]] 648 } 649 return 650 } 651 652 set margin [expr {2*($itk_option(-borderwidth) \ 653 + $itk_option(-highlightthickness))}] 654 655 if {"0" != $itk_option(-width)} { 656 set width $itk_option(-width) 657 } else { 658 set width [expr {[winfo reqwidth $itk_component(popupMenu)]+$margin+20}] 659 } 660 set height [winfo reqheight $itk_component(menuBtn)] 661 $itk_component(lwchildsite) configure -width $width -height $height 662 663 set _calcSize "" 664} 665