1# 2# Selectionbox 3# ---------------------------------------------------------------------- 4# Implements a selection box composed of a scrolled list of items and 5# a selection entry field. The user may choose any of the items displayed 6# in the scrolled list of alternatives and the selection field will be 7# filled with the choice. The user is also free to enter a new value in 8# the selection entry field. Both the list and entry areas have labels. 9# A child site is also provided in which the user may create other widgets 10# to be used in conjunction with the selection box. 11# 12# ---------------------------------------------------------------------- 13# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com 14# 15# @(#) $Id: selectionbox.itk,v 1.2 2001/08/07 19:56:48 smithc Exp $ 16# ---------------------------------------------------------------------- 17# Copyright (c) 1995 DSC Technologies Corporation 18# ====================================================================== 19# Permission to use, copy, modify, distribute and license this software 20# and its documentation for any purpose, and without fee or written 21# agreement with DSC, is hereby granted, provided that the above copyright 22# notice appears in all copies and that both the copyright notice and 23# warranty disclaimer below appear in supporting documentation, and that 24# the names of DSC Technologies Corporation or DSC Communications 25# Corporation not be used in advertising or publicity pertaining to the 26# software without specific, written prior permission. 27# 28# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 29# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- 30# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE 31# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 32# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 33# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 34# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 35# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, 36# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 37# SOFTWARE. 38# ====================================================================== 39 40# 41# Usual options. 42# 43itk::usual Selectionbox { 44 keep -activebackground -activerelief -background -borderwidth -cursor \ 45 -elementborderwidth -foreground -highlightcolor -highlightthickness \ 46 -insertbackground -insertborderwidth -insertofftime -insertontime \ 47 -insertwidth -jump -labelfont -selectbackground -selectborderwidth \ 48 -selectforeground -textbackground -textfont -troughcolor 49} 50 51# ------------------------------------------------------------------ 52# SELECTIONBOX 53# ------------------------------------------------------------------ 54itcl::class iwidgets::Selectionbox { 55 inherit itk::Widget 56 57 constructor {args} {} 58 destructor {} 59 60 itk_option define -childsitepos childSitePos Position center 61 itk_option define -margin margin Margin 7 62 itk_option define -itemson itemsOn ItemsOn true 63 itk_option define -selectionon selectionOn SelectionOn true 64 itk_option define -width width Width 260 65 itk_option define -height height Height 320 66 67 public method childsite {} 68 public method get {} 69 public method curselection {} 70 public method clear {component} 71 public method insert {component index args} 72 public method delete {first {last {}}} 73 public method size {} 74 public method scan {option args} 75 public method nearest {y} 76 public method index {index} 77 public method selection {option args} 78 public method selectitem {} 79 80 private method _packComponents {{when later}} 81 82 private variable _repacking {} ;# non-null => _packComponents pending 83} 84 85# 86# Provide a lowercased access method for the Selectionbox class. 87# 88proc ::iwidgets::selectionbox {pathName args} { 89 uplevel ::iwidgets::Selectionbox $pathName $args 90} 91 92# 93# Use option database to override default resources of base classes. 94# 95option add *Selectionbox.itemsLabel Items widgetDefault 96option add *Selectionbox.selectionLabel Selection widgetDefault 97option add *Selectionbox.width 260 widgetDefault 98option add *Selectionbox.height 320 widgetDefault 99 100# ------------------------------------------------------------------ 101# CONSTRUCTOR 102# ------------------------------------------------------------------ 103itcl::body iwidgets::Selectionbox::constructor {args} { 104 # 105 # Set the borderwidth to zero and add width and height options 106 # back to the hull. 107 # 108 component hull configure -borderwidth 0 109 itk_option add hull.width hull.height 110 111 # 112 # Create the child site widget. 113 # 114 itk_component add -protected sbchildsite { 115 frame $itk_interior.sbchildsite 116 } 117 118 # 119 # Create the items list. 120 # 121 itk_component add items { 122 iwidgets::Scrolledlistbox $itk_interior.items -selectmode single \ 123 -visibleitems 20x10 -labelpos nw -vscrollmode static \ 124 -hscrollmode none 125 } { 126 usual 127 keep -dblclickcommand -exportselection 128 129 rename -labeltext -itemslabel itemsLabel Text 130 rename -selectioncommand -itemscommand itemsCommand Command 131 } 132 configure -itemscommand [itcl::code $this selectitem] 133 134 # 135 # Create the selection entry. 136 # 137 itk_component add selection { 138 iwidgets::Entryfield $itk_interior.selection -labelpos nw 139 } { 140 usual 141 142 keep -exportselection 143 144 rename -labeltext -selectionlabel selectionLabel Text 145 rename -command -selectioncommand selectionCommand Command 146 } 147 148 # 149 # Set the interior to the childsite for derived classes. 150 # 151 set itk_interior $itk_component(sbchildsite) 152 153 # 154 # Initialize the widget based on the command line options. 155 # 156 eval itk_initialize $args 157 158 # 159 # When idle, pack the components. 160 # 161 _packComponents 162} 163 164# ------------------------------------------------------------------ 165# DESTRUCTOR 166# ------------------------------------------------------------------ 167itcl::body iwidgets::Selectionbox::destructor {} { 168 if {$_repacking != ""} {after cancel $_repacking} 169} 170 171# ------------------------------------------------------------------ 172# OPTIONS 173# ------------------------------------------------------------------ 174 175# ------------------------------------------------------------------ 176# OPTION: -childsitepos 177# 178# Specifies the position of the child site in the selection box. 179# ------------------------------------------------------------------ 180itcl::configbody iwidgets::Selectionbox::childsitepos { 181 _packComponents 182} 183 184# ------------------------------------------------------------------ 185# OPTION: -margin 186# 187# Specifies distance between the items list and selection entry. 188# ------------------------------------------------------------------ 189itcl::configbody iwidgets::Selectionbox::margin { 190 _packComponents 191} 192 193# ------------------------------------------------------------------ 194# OPTION: -itemson 195# 196# Specifies whether or not to display the items list. 197# ------------------------------------------------------------------ 198itcl::configbody iwidgets::Selectionbox::itemson { 199 _packComponents 200} 201 202# ------------------------------------------------------------------ 203# OPTION: -selectionon 204# 205# Specifies whether or not to display the selection entry widget. 206# ------------------------------------------------------------------ 207itcl::configbody iwidgets::Selectionbox::selectionon { 208 _packComponents 209} 210 211# ------------------------------------------------------------------ 212# OPTION: -width 213# 214# Specifies the width of the hull. The value may be specified in 215# any of the forms acceptable to Tk_GetPixels. A value of zero 216# causes the width to be adjusted to the required value based on 217# the size requests of the components. Otherwise, the width is 218# fixed. 219# ------------------------------------------------------------------ 220itcl::configbody iwidgets::Selectionbox::width { 221 # 222 # The width option was added to the hull in the constructor. 223 # So, any width value given is passed automatically to the 224 # hull. All we have to do is play with the propagation. 225 # 226 if {$itk_option(-width) != 0} { 227 set propagate 0 228 } else { 229 set propagate 1 230 } 231 232 # 233 # Due to a bug in the tk4.2 grid, we have to check the 234 # propagation before setting it. Setting it to the same 235 # value it already is will cause it to toggle. 236 # 237 if {[grid propagate $itk_component(hull)] != $propagate} { 238 grid propagate $itk_component(hull) $propagate 239 } 240} 241 242# ------------------------------------------------------------------ 243# OPTION: -height 244# 245# Specifies the height of the hull. The value may be specified in 246# any of the forms acceptable to Tk_GetPixels. A value of zero 247# causes the height to be adjusted to the required value based on 248# the size requests of the components. Otherwise, the height is 249# fixed. 250# ------------------------------------------------------------------ 251itcl::configbody iwidgets::Selectionbox::height { 252 # 253 # The height option was added to the hull in the constructor. 254 # So, any height value given is passed automatically to the 255 # hull. All we have to do is play with the propagation. 256 # 257 if {$itk_option(-height) != 0} { 258 set propagate 0 259 } else { 260 set propagate 1 261 } 262 263 # 264 # Due to a bug in the tk4.2 grid, we have to check the 265 # propagation before setting it. Setting it to the same 266 # value it already is will cause it to toggle. 267 # 268 if {[grid propagate $itk_component(hull)] != $propagate} { 269 grid propagate $itk_component(hull) $propagate 270 } 271} 272 273# ------------------------------------------------------------------ 274# METHODS 275# ------------------------------------------------------------------ 276 277# ------------------------------------------------------------------ 278# METHOD: childsite 279# 280# Returns the path name of the child site widget. 281# ------------------------------------------------------------------ 282itcl::body iwidgets::Selectionbox::childsite {} { 283 return $itk_component(sbchildsite) 284} 285 286# ------------------------------------------------------------------ 287# METHOD: get 288# 289# Returns the current selection. 290# ------------------------------------------------------------------ 291itcl::body iwidgets::Selectionbox::get {} { 292 return [$itk_component(selection) get] 293} 294 295# ------------------------------------------------------------------ 296# METHOD: curselection 297# 298# Returns the current selection index. 299# ------------------------------------------------------------------ 300itcl::body iwidgets::Selectionbox::curselection {} { 301 return [$itk_component(items) curselection] 302} 303 304# ------------------------------------------------------------------ 305# METHOD: clear component 306# 307# Delete the contents of either the selection entry widget or items 308# list. 309# ------------------------------------------------------------------ 310itcl::body iwidgets::Selectionbox::clear {component} { 311 switch $component { 312 selection { 313 $itk_component(selection) clear 314 } 315 316 items { 317 delete 0 end 318 } 319 320 default { 321 error "bad clear argument \"$component\": should be\ 322 selection or items" 323 } 324 } 325} 326 327# ------------------------------------------------------------------ 328# METHOD: insert component index args 329# 330# Insert element(s) into either the selection or items list widget. 331# ------------------------------------------------------------------ 332itcl::body iwidgets::Selectionbox::insert {component index args} { 333 switch $component { 334 selection { 335 eval $itk_component(selection) insert $index $args 336 } 337 338 items { 339 eval $itk_component(items) insert $index $args 340 } 341 342 default { 343 error "bad insert argument \"$component\": should be\ 344 selection or items" 345 } 346 } 347} 348 349# ------------------------------------------------------------------ 350# METHOD: delete first ?last? 351# 352# Delete one or more elements from the items list box. The default 353# is to delete by indexed range. If an item is to be removed by name, 354# it must be preceeded by the keyword "item". Only index numbers can 355# be used to delete a range of items. 356# ------------------------------------------------------------------ 357itcl::body iwidgets::Selectionbox::delete {first {last {}}} { 358 set first [index $first] 359 360 if {$last != {}} { 361 set last [index $last] 362 } else { 363 set last $first 364 } 365 366 if {$first <= $last} { 367 eval $itk_component(items) delete $first $last 368 } else { 369 error "first index must not be greater than second" 370 } 371} 372 373# ------------------------------------------------------------------ 374# METHOD: size 375# 376# Returns a decimal string indicating the total number of elements 377# in the items list. 378# ------------------------------------------------------------------ 379itcl::body iwidgets::Selectionbox::size {} { 380 return [$itk_component(items) size] 381} 382 383# ------------------------------------------------------------------ 384# METHOD: scan option args 385# 386# Implements scanning on items list. 387# ------------------------------------------------------------------ 388itcl::body iwidgets::Selectionbox::scan {option args} { 389 eval $itk_component(items) scan $option $args 390} 391 392# ------------------------------------------------------------------ 393# METHOD: nearest y 394# 395# Returns the index to the nearest listbox item given a y coordinate. 396# ------------------------------------------------------------------ 397itcl::body iwidgets::Selectionbox::nearest {y} { 398 return [$itk_component(items) nearest $y] 399} 400 401# ------------------------------------------------------------------ 402# METHOD: index index 403# 404# Returns the decimal string giving the integer index corresponding 405# to index. 406# ------------------------------------------------------------------ 407itcl::body iwidgets::Selectionbox::index {index} { 408 return [$itk_component(items) index $index] 409} 410 411# ------------------------------------------------------------------ 412# METHOD: selection option args 413# 414# Adjusts the selection within the items list. 415# ------------------------------------------------------------------ 416itcl::body iwidgets::Selectionbox::selection {option args} { 417 eval $itk_component(items) selection $option $args 418 419 selectitem 420} 421 422# ------------------------------------------------------------------ 423# METHOD: selectitem 424# 425# Replace the selection entry field contents with the currently 426# selected items value. 427# ------------------------------------------------------------------ 428itcl::body iwidgets::Selectionbox::selectitem {} { 429 $itk_component(selection) clear 430 set numSelected [$itk_component(items) selecteditemcount] 431 432 if {$numSelected == 1} { 433 $itk_component(selection) insert end \ 434 [$itk_component(items) getcurselection] 435 } elseif {$numSelected > 1} { 436 $itk_component(selection) insert end \ 437 [lindex [$itk_component(items) getcurselection] 0] 438 } 439 440 $itk_component(selection) icursor end 441} 442 443# ------------------------------------------------------------------ 444# PRIVATE METHOD: _packComponents ?when? 445# 446# Pack the selection, items, and child site widgets based on options. 447# If "when" is "now", the change is applied immediately. If it is 448# "later" or it is not specified, then the change is applied later, 449# when the application is idle. 450# ------------------------------------------------------------------ 451itcl::body iwidgets::Selectionbox::_packComponents {{when later}} { 452 if {$when == "later"} { 453 if {$_repacking == ""} { 454 set _repacking [after idle [itcl::code $this _packComponents now]] 455 } 456 return 457 } elseif {$when != "now"} { 458 error "bad option \"$when\": should be now or later" 459 } 460 461 set _repacking "" 462 463 set parent [winfo parent $itk_component(sbchildsite)] 464 set margin [winfo pixels $itk_component(hull) $itk_option(-margin)] 465 466 switch $itk_option(-childsitepos) { 467 n { 468 grid $itk_component(sbchildsite) -row 0 -column 0 \ 469 -sticky nsew -rowspan 1 470 grid $itk_component(items) -row 1 -column 0 -sticky nsew 471 grid $itk_component(selection) -row 3 -column 0 -sticky ew 472 473 grid rowconfigure $parent 0 -weight 0 -minsize 0 474 grid rowconfigure $parent 1 -weight 1 -minsize 0 475 grid rowconfigure $parent 2 -weight 0 -minsize $margin 476 grid rowconfigure $parent 3 -weight 0 -minsize 0 477 478 grid columnconfigure $parent 0 -weight 1 -minsize 0 479 grid columnconfigure $parent 1 -weight 0 -minsize 0 480 } 481 482 w { 483 grid $itk_component(sbchildsite) -row 0 -column 0 \ 484 -sticky nsew -rowspan 3 485 grid $itk_component(items) -row 0 -column 1 -sticky nsew 486 grid $itk_component(selection) -row 2 -column 1 -sticky ew 487 488 grid rowconfigure $parent 0 -weight 1 -minsize 0 489 grid rowconfigure $parent 1 -weight 0 -minsize $margin 490 grid rowconfigure $parent 2 -weight 0 -minsize 0 491 grid rowconfigure $parent 3 -weight 0 -minsize 0 492 493 grid columnconfigure $parent 0 -weight 0 -minsize 0 494 grid columnconfigure $parent 1 -weight 1 -minsize 0 495 } 496 497 s { 498 grid $itk_component(items) -row 0 -column 0 -sticky nsew 499 grid $itk_component(selection) -row 2 -column 0 -sticky ew 500 grid $itk_component(sbchildsite) -row 3 -column 0 \ 501 -sticky nsew -rowspan 1 502 503 grid rowconfigure $parent 0 -weight 1 -minsize 0 504 grid rowconfigure $parent 1 -weight 0 -minsize $margin 505 grid rowconfigure $parent 2 -weight 0 -minsize 0 506 grid rowconfigure $parent 3 -weight 0 -minsize 0 507 508 grid columnconfigure $parent 0 -weight 1 -minsize 0 509 grid columnconfigure $parent 1 -weight 0 -minsize 0 510 } 511 512 e { 513 grid $itk_component(items) -row 0 -column 0 -sticky nsew 514 grid $itk_component(selection) -row 2 -column 0 -sticky ew 515 grid $itk_component(sbchildsite) -row 0 -column 1 \ 516 -sticky nsew -rowspan 3 517 518 grid rowconfigure $parent 0 -weight 1 -minsize 0 519 grid rowconfigure $parent 1 -weight 0 -minsize $margin 520 grid rowconfigure $parent 2 -weight 0 -minsize 0 521 grid rowconfigure $parent 3 -weight 0 -minsize 0 522 523 grid columnconfigure $parent 0 -weight 1 -minsize 0 524 grid columnconfigure $parent 1 -weight 0 -minsize 0 525 } 526 527 center { 528 grid $itk_component(items) -row 0 -column 0 -sticky nsew 529 grid $itk_component(sbchildsite) -row 1 -column 0 \ 530 -sticky nsew -rowspan 1 531 grid $itk_component(selection) -row 3 -column 0 -sticky ew 532 533 grid rowconfigure $parent 0 -weight 1 -minsize 0 534 grid rowconfigure $parent 1 -weight 0 -minsize 0 535 grid rowconfigure $parent 2 -weight 0 -minsize $margin 536 grid rowconfigure $parent 3 -weight 0 -minsize 0 537 538 grid columnconfigure $parent 0 -weight 1 -minsize 0 539 grid columnconfigure $parent 1 -weight 0 -minsize 0 540 } 541 542 default { 543 error "bad childsitepos option \"$itk_option(-childsitepos)\":\ 544 should be n, e, s, w, or center" 545 } 546 } 547 548 if {$itk_option(-itemson)} { 549 } else { 550 grid forget $itk_component(items) 551 } 552 553 if {$itk_option(-selectionon)} { 554 } else { 555 grid forget $itk_component(selection) 556 } 557 558 raise $itk_component(sbchildsite) 559} 560 561