1# ---------------------------------------------------------------------------- 2# listbox.tcl 3# This file is part of Unifix BWidget Toolkit 4# $Id: listbox.tcl,v 1.33 2010/05/12 08:28:56 oehhar Exp $ 5# ---------------------------------------------------------------------------- 6# Index of commands: 7# - ListBox::create 8# - ListBox::configure 9# - ListBox::cget 10# - ListBox::insert 11# - ListBox::itemconfigure 12# - ListBox::itemcget 13# - ListBox::bindText 14# - ListBox::bindImage 15# - ListBox::delete 16# - ListBox::move 17# - ListBox::reorder 18# - ListBox::selection 19# - ListBox::exists 20# - ListBox::index 21# - ListBox::item - deprecated 22# - ListBox::items 23# - ListBox::see 24# - ListBox::edit 25# - ListBox::xview 26# - ListBox::yview 27# - ListBox::_update_edit_size 28# - ListBox::_destroy 29# - ListBox::_see 30# - ListBox::_update_scrollregion 31# - ListBox::_draw_item 32# - ListBox::_redraw_items 33# - ListBox::_redraw_selection 34# - ListBox::_redraw_listbox 35# - ListBox::_redraw_idle 36# - ListBox::_resize 37# - ListBox::_init_drag_cmd 38# - ListBox::_drop_cmd 39# - ListBox::_over_cmd 40# - ListBox::_auto_scroll 41# - ListBox::_scroll 42# - ListBox::_themechanged 43# ---------------------------------------------------------------------------- 44 45namespace eval ListBox { 46 Widget::define ListBox listbox DragSite DropSite DynamicHelp 47 48 namespace eval Item { 49 Widget::declare ListBox::Item { 50 {-indent Int 0 0 "%d >= 0"} 51 {-text String "" 0} 52 {-font String "" 0} 53 {-foreground Color "SystemWindowText" 0} 54 {-image TkResource "" 0 label} 55 {-window String "" 0} 56 {-data String "" 0} 57 58 {-fill Synonym -foreground} 59 {-fg Synonym -foreground} 60 } 61 } 62 63 DynamicHelp::include ListBox::Item balloon 64 65 Widget::tkinclude ListBox canvas .c \ 66 remove { 67 -insertwidth -insertbackground -insertborderwidth -insertofftime 68 -insertontime -selectborderwidth -closeenough -confine -scrollregion 69 -xscrollincrement -yscrollincrement -width -height 70 } \ 71 initialize { 72 -relief sunken -borderwidth 2 -takefocus 1 73 -highlightthickness 1 -width 200 74 } 75 76 DragSite::include ListBox "LISTBOX_ITEM" 1 77 DropSite::include ListBox { 78 LISTBOX_ITEM {copy {} move {}} 79 } 80 81 Widget::declare ListBox { 82 {-deltax Int 10 0 "%d >= 0"} 83 {-deltay Int 15 0 "%d >= 0"} 84 {-padx Int 20 0 "%d >= 0"} 85 {-foreground Color "SystemWindowText" 0} 86 {-background Color "SystemWindow" 0} 87 {-selectbackground Color "SystemHighlight" 0} 88 {-selectforeground Color "SystemHighlightText" 0} 89 {-font String "TkTextFont" 0} 90 {-width TkResource "" 0 listbox} 91 {-height TkResource "" 0 listbox} 92 {-redraw Boolean 1 0} 93 {-multicolumn Boolean 0 0} 94 {-dropovermode Flag "wpi" 0 "wpi"} 95 {-selectmode Enum none 0 {none single multiple}} 96 {-fg Synonym -foreground} 97 {-bg Synonym -background} 98 {-dropcmd String "ListBox::_drag_and_drop" 0} 99 {-autofocus Boolean 1 1} 100 {-selectfill Boolean 0 1} 101 } 102 103 Widget::addmap ListBox "" .c {-deltay -yscrollincrement} 104 105 bind ListBox <FocusIn> [list after idle {BWidget::refocus %W %W.c}] 106 bind ListBox <Destroy> [list ListBox::_destroy %W] 107 bind ListBox <Configure> [list ListBox::_resize %W] 108 bind ListBoxFocus <1> [list focus %W] 109 bind ListBox <Key-Up> [list ListBox::_keyboard_navigation %W -1] 110 bind ListBox <Key-Down> [list ListBox::_keyboard_navigation %W 1] 111 112 if {[lsearch [bindtags .] ListBoxThemeChanged] < 0} { 113 bindtags . [linsert [bindtags .] 1 ListBoxThemeChanged] 114 } 115 116 variable _edit 117} 118 119 120# ---------------------------------------------------------------------------- 121# Command ListBox::create 122# ---------------------------------------------------------------------------- 123proc ListBox::create { path args } { 124 Widget::init ListBox $path $args 125 126 variable $path 127 upvar 0 $path data 128 129 frame $path -class ListBox -bd 0 -highlightthickness 0 -relief flat \ 130 -takefocus 0 131 # For 8.4+ we don't want to inherit the padding 132 catch {$path configure -padx 0 -pady 0} 133 # widget informations 134 set data(nrows) -1 135 136 # items informations 137 set data(items) {} 138 set data(selitems) {} 139 140 # update informations 141 set data(upd,level) 0 142 set data(upd,afterid) "" 143 set data(upd,level) 0 144 set data(upd,delete) {} 145 146 # drag and drop informations 147 set data(dnd,scroll) "" 148 set data(dnd,afterid) "" 149 set data(dnd,item) "" 150 151 eval [list canvas $path.c] [Widget::subcget $path .c] \ 152 [list -xscrollincrement 8] 153 pack $path.c -expand yes -fill both 154 155 DragSite::setdrag $path $path.c ListBox::_init_drag_cmd \ 156 [Widget::cget $path -dragendcmd] 1 157 DropSite::setdrop $path $path.c ListBox::_over_cmd ListBox::_drop_cmd 1 158 159 Widget::create ListBox $path 160 161 set w [Widget::cget $path -width] 162 set h [Widget::cget $path -height] 163 set dy [Widget::cget $path -deltay] 164 $path.c configure -width [expr {$w*8}] -height [expr {$h*$dy}] 165 166 # Insert $path into the canvas bindings, so that anyone binding 167 # directly onto the widget will see their bindings activated when 168 # the canvas has focus. 169 set bindtags [bindtags $path.c] 170 set bindtags [linsert $bindtags 1 $path] 171 # Let any click within the canvas focus on the canvas so that 172 # MouseWheel scroll events will be properly handled by the canvas. 173 if {[Widget::cget $path -autofocus]} { 174 lappend bindtags ListBoxFocus 175 BWidget::bindMouseWheel $path.c 176 BWidget::bindMiddleMouseMovement $path.c 177 } 178 179 bindtags $path.c $bindtags 180 181 # Add slightly modified up/down bindings to the canvas, in case 182 # it gets the focus (like with -autofocus). 183 bind $path.c <Key-Up> {ListBox::_keyboard_navigation [winfo parent %W] -1} 184 bind $path.c <Key-Down> {ListBox::_keyboard_navigation [winfo parent %W] 1} 185 186 bind ListBoxThemeChanged <<ThemeChanged>> \ 187 "+ [namespace current]::_themechanged $path" 188 189 _configureSelectmode $path [Widget::getoption $path -selectmode] 190 191 return $path 192} 193 194 195# ---------------------------------------------------------------------------- 196# Command ListBox::_configureSelectmode 197# ---------------------------------------------------------------------------- 198# Configure the selectmode 199proc ListBox::_configureSelectmode { path selectmode {previous none} } { 200 # clear current binding 201 switch -exact -- $previous { 202 single { 203 $path _bindText <Button-1> "" 204 $path _bindImage <Button-1> "" 205 } 206 multiple { 207 $path _bindText <ButtonRelease-1> "" 208 $path _bindText <Shift-ButtonRelease-1> "" 209 $path _bindText <Control-ButtonRelease-1> "" 210 211 $path _bindImage <ButtonRelease-1> "" 212 $path _bindImage <Shift-ButtonRelease-1> "" 213 $path _bindImage <Control-ButtonRelease-1> "" 214 } 215 } 216 # set new bindings 217 switch -exact -- $selectmode { 218 single { 219 $path _bindText <Button-1> [list ListBox::_mouse_select $path set] 220 $path _bindImage <Button-1> [list ListBox::_mouse_select $path set] 221 if {1 < [llength [ListBox::selection $path get]]} { 222 ListBox::selection $path clear 223 } 224 } 225 multiple { 226 set cmd ListBox::_multiple_select 227 $path _bindText <ButtonRelease-1> [list $cmd $path n %x %y] 228 $path _bindText <Shift-ButtonRelease-1> [list $cmd $path s %x %y] 229 $path _bindText <Control-ButtonRelease-1> [list $cmd $path c %x %y] 230 231 $path _bindImage <ButtonRelease-1> [list $cmd $path n %x %y] 232 $path _bindImage <Shift-ButtonRelease-1> [list $cmd $path s %x %y] 233 $path _bindImage <Control-ButtonRelease-1> [list $cmd $path c %x %y] 234 } 235 default { 236 if {0 < [llength [ListBox::selection $path get]]} { 237 ListBox::selection $path clear 238 } 239 } 240 } 241} 242 243 244# ---------------------------------------------------------------------------- 245# Command ListBox::configure 246# ---------------------------------------------------------------------------- 247proc ListBox::configure { path args } { 248 set selectmodePrevious [Widget::getoption $path -selectmode] 249 set res [Widget::configure $path $args] 250 251 if { [Widget::hasChanged $path -selectmode selectmode] } { 252 _configureSelectmode $path $selectmode $selectmodePrevious 253 } 254 255 set ch1 [expr {[Widget::hasChanged $path -deltay dy] | 256 [Widget::hasChanged $path -padx val] | 257 [Widget::hasChanged $path -multicolumn val]}] 258 259 set ch2 [expr {[Widget::hasChanged $path -selectbackground val] | 260 [Widget::hasChanged $path -selectforeground val]}] 261 262 set redraw 0 263 if { [Widget::hasChanged $path -height h] } { 264 $path.c configure -height [expr {$h*$dy}] 265 set redraw 1 266 } 267 if { [Widget::hasChanged $path -width w] } { 268 $path.c configure -width [expr {$w*8}] 269 set redraw 1 270 } 271 272 if { [Widget::hasChanged $path -background bg] } { 273 $path.c itemconfigure box -fill $bg 274 } 275 276 if { !$redraw } { 277 if { $ch1 } { 278 _redraw_idle $path 2 279 } elseif { $ch2 } { 280 _redraw_idle $path 1 281 } 282 } 283 284 if { [Widget::hasChanged $path -redraw bool] && $bool } { 285 variable $path 286 upvar 0 $path data 287 set lvl $data(upd,level) 288 set data(upd,level) 0 289 _redraw_idle $path $lvl 290 } 291 set force [Widget::hasChanged $path -dragendcmd dragend] 292 DragSite::setdrag $path $path.c ListBox::_init_drag_cmd $dragend $force 293 DropSite::setdrop $path $path.c ListBox::_over_cmd ListBox::_drop_cmd 294 295 return $res 296} 297 298 299# ---------------------------------------------------------------------------- 300# Command ListBox::cget 301# ---------------------------------------------------------------------------- 302proc ListBox::cget { path option } { 303 return [Widget::cget $path $option] 304} 305 306 307# ---------------------------------------------------------------------------- 308# Command ListBox::insert 309# ---------------------------------------------------------------------------- 310proc ListBox::insert { path index item args } { 311 variable $path 312 upvar 0 $path data 313 314 set item [Widget::nextIndex $path $item] 315 316 if {[info exists data(exists,$item)]} { 317 return -code error "item \"$item\" already exists" 318 } 319 320 Widget::init ListBox::Item $path.$item $args 321 322 set data(items) [linsert $data(items) $index $item] 323 set data(exists,$item) 1 324 set data(upd,create,$item) $item 325 326 _redraw_idle $path 2 327 return $item 328} 329 330# Bastien Chevreux (bach@mwgdna.com) 331# The multipleinsert command performs inserts several items at once into 332# the list. It is faster than calling insert multiple times as it uses the 333# Widget::copyinit command for initializing all items after the 1st. The 334# speedup factor is between 2 and 3 for typical usage, but could be higher 335# for inserts with many options. 336# 337# Syntax: path and index are as in the insert command 338# args is a list of even numbered elements where the 1st of each pair 339# corresponds to the item of 'insert' and the second to args of 'insert'. 340# ---------------------------------------------------------------------------- 341# Command ListBox::multipleinsert 342# ---------------------------------------------------------------------------- 343proc ListBox::multipleinsert { path index args } { 344 variable $path 345 upvar 0 $path data 346 347 # If we got only one list as arg, take the first element as args 348 # This enables callers to use 349 # $list multipleinsert index $thelist 350 # instead of 351 # eval $list multipleinsert index $thelist 352 353 if {[llength $args] == 1} { 354 set args [lindex $args 0] 355 } 356 357 set count 0 358 foreach {item iargs} $args { 359 if {[info exists data(exists,$item)]} { 360 return -code error "item \"$item\" already exists" 361 } 362 363 if {$count==0} { 364 Widget::init ListBox::Item $path.$item $iargs 365 set firstpath $path.$item 366 } else { 367 Widget::copyinit ListBox::Item $firstpath $path.$item $iargs 368 } 369 370 set data(items) [linsert $data(items) $index $item] 371 set data(exists,$item) 1 372 set data(upd,create,$item) $item 373 374 incr count 375 } 376 377 _redraw_idle $path 2 378 return $item 379} 380 381# ---------------------------------------------------------------------------- 382# Command ListBox::itemconfigure 383# ---------------------------------------------------------------------------- 384proc ListBox::itemconfigure { path item args } { 385 variable $path 386 upvar 0 $path data 387 388 if { [lsearch -exact $data(items) $item] == -1 } { 389 return -code error "item \"$item\" does not exist" 390 } 391 392 set oldind [Widget::getoption $path.$item -indent] 393 394 set res [Widget::configure $path.$item $args] 395 set chind [Widget::hasChanged $path.$item -indent indent] 396 set chw [Widget::hasChanged $path.$item -window win] 397 set chi [Widget::hasChanged $path.$item -image img] 398 set cht [Widget::hasChanged $path.$item -text txt] 399 set chf [Widget::hasChanged $path.$item -font fnt] 400 set chfg [Widget::hasChanged $path.$item -foreground fg] 401 set idn [$path.c find withtag n:$item] 402 403 _set_help $path $item 404 405 if { $idn == "" } { 406 # item is not drawn yet 407 _redraw_idle $path 2 408 return $res 409 } 410 411 set oldb [$path.c bbox $idn] 412 set coords [$path.c coords $idn] 413 set padx [Widget::getoption $path -padx] 414 set x0 [expr {[lindex $coords 0]-$padx-$oldind+$indent}] 415 set y0 [lindex $coords 1] 416 if { $chw || $chi } { 417 # -window or -image modified 418 set idi [$path.c find withtag i:$item] 419 set type [lindex [$path.c gettags $idi] 0] 420 if { [string length $win] } { 421 if { [string equal $type "win"] } { 422 $path.c itemconfigure $idi -window $win 423 } else { 424 $path.c delete $idi 425 $path.c create window $x0 $y0 -window $win -anchor w \ 426 -tags [list win i:$item] 427 } 428 } elseif { [string length $img] } { 429 if { [string equal $type "img"] } { 430 $path.c itemconfigure $idi -image $img 431 } else { 432 $path.c delete $idi 433 $path.c create image $x0 $y0 -image $img -anchor w \ 434 -tags [list img imgbind i:$item] 435 } 436 } else { 437 $path.c delete $idi 438 } 439 } 440 441 if { $cht || $chf || $chfg } { 442 # -text or -font modified, or -foreground modified 443 set fnt [_getoption $path $item -font] 444 set fg [_getoption $path $item -foreground] 445 $path.c itemconfigure $idn -text $txt -font $fnt -fill $fg 446 _redraw_idle $path 1 447 } 448 449 if { $chind } { 450 # -indent modified 451 $path.c coords $idn [expr {$x0+$padx}] $y0 452 $path.c coords i:$item $x0 $y0 453 _redraw_idle $path 1 454 } 455 456 if { [Widget::getoption $path -multicolumn] && ($cht || $chf || $chind) } { 457 set bbox [$path.c bbox $idn] 458 if { [lindex $bbox 2] > [lindex $oldb 2] } { 459 _redraw_idle $path 2 460 } 461 } 462 463 return $res 464} 465 466 467# ---------------------------------------------------------------------------- 468# Command ListBox::itemcget 469# ---------------------------------------------------------------------------- 470proc ListBox::itemcget { path item option } { 471 return [Widget::cget $path.$item $option] 472} 473 474 475# ---------------------------------------------------------------------------- 476# Command ListBox::_bindText 477# ---------------------------------------------------------------------------- 478proc ListBox::_bindText { path event script {tag click} } { 479 if { $script != "" } { 480 set map [list %W $path] 481 set script [string map $map $script] 482 append script " \[ListBox::_get_current [list $path]\]" 483 } 484 $path.c bind $tag $event $script 485} 486 487# ---------------------------------------------------------------------------- 488# Command ListBox::bindText 489# ---------------------------------------------------------------------------- 490proc ListBox::bindText { path event script } { 491 _bindText $path $event $script clickbind 492} 493 494# ---------------------------------------------------------------------------- 495# Command ListBox::_bindImage 496# ---------------------------------------------------------------------------- 497proc ListBox::_bindImage { path event script {tag img} } { 498 if { $script != "" } { 499 set map [list %W $path] 500 set script [string map $map $script] 501 append script " \[ListBox::_get_current [list $path]\]" 502 } 503 $path.c bind $tag $event $script 504} 505 506# ---------------------------------------------------------------------------- 507# Command ListBox::bindImage 508# ---------------------------------------------------------------------------- 509proc ListBox::bindImage { path event script } { 510 _bindImage $path $event $script imgbind 511} 512 513# ---------------------------------------------------------------------------- 514# Command ListBox::delete 515# ---------------------------------------------------------------------------- 516proc ListBox::delete { path args } { 517 variable $path 518 upvar 0 $path data 519 Widget::getVariable $path help 520 521 foreach litems $args { 522 foreach item $litems { 523 set idx [lsearch -exact $data(items) $item] 524 if { $idx != -1 } { 525 set data(items) [lreplace $data(items) $idx $idx] 526 array unset help $item 527 Widget::destroy $path.$item 528 if { [info exists data(exists,$item)] } { 529 unset data(exists,$item) 530 } 531 if { [info exists data(upd,create,$item)] } { 532 unset data(upd,create,$item) 533 } else { 534 lappend data(upd,delete) $item 535 } 536 } 537 } 538 } 539 540 set sel $data(selitems) 541 set data(selitems) {} 542 eval [list selection $path set] $sel 543 _redraw_idle $path 2 544} 545 546 547# ---------------------------------------------------------------------------- 548# Command ListBox::move 549# ---------------------------------------------------------------------------- 550proc ListBox::move { path item index } { 551 variable $path 552 upvar 0 $path data 553 554 if { [set idx [lsearch -exact $data(items) $item]] == -1 } { 555 return -code error "item \"$item\" does not exist" 556 } 557 558 set data(items) [linsert [lreplace $data(items) $idx $idx] $index $item] 559 560 _redraw_idle $path 2 561} 562 563 564# ---------------------------------------------------------------------------- 565# Command ListBox::reorder 566# ---------------------------------------------------------------------------- 567proc ListBox::reorder { path neworder } { 568 variable $path 569 upvar 0 $path data 570 571 set data(items) [BWidget::lreorder $data(items) $neworder] 572 _redraw_idle $path 2 573} 574 575 576# ---------------------------------------------------------------------------- 577# Command ListBox::selection 578# ---------------------------------------------------------------------------- 579proc ListBox::selection { path cmd args } { 580 variable $path 581 upvar 0 $path data 582 583 switch -- $cmd { 584 set { 585 set data(selitems) {} 586 foreach item $args { 587 if { [lsearch -exact $data(selitems) $item] == -1 } { 588 if { [lsearch -exact $data(items) $item] != -1 } { 589 lappend data(selitems) $item 590 } 591 } 592 } 593 } 594 add { 595 foreach item $args { 596 if { [lsearch -exact $data(selitems) $item] == -1 } { 597 if { [lsearch -exact $data(items) $item] != -1 } { 598 lappend data(selitems) $item 599 } 600 } 601 } 602 } 603 remove { 604 foreach item $args { 605 if { [set idx [lsearch -exact $data(selitems) $item]] != -1 } { 606 set data(selitems) [lreplace $data(selitems) $idx $idx] 607 } 608 } 609 } 610 clear { 611 set data(selitems) {} 612 } 613 get { 614 return $data(selitems) 615 } 616 includes { 617 return [expr {[lsearch -exact $data(selitems) $args] != -1}] 618 } 619 default { 620 return 621 } 622 } 623 624 _redraw_idle $path 1 625} 626 627 628# ---------------------------------------------------------------------------- 629# Command ListBox::exists 630# ---------------------------------------------------------------------------- 631proc ListBox::exists { path item } { 632 variable $path 633 upvar 0 $path data 634 635 return [expr {[lsearch -exact $data(items) $item] != -1}] 636} 637 638 639# ---------------------------------------------------------------------------- 640# Command ListBox::index 641# ---------------------------------------------------------------------------- 642proc ListBox::index { path item } { 643 variable $path 644 upvar 0 $path data 645 if {[string equal $item "active"]} { return [$path selection get] } 646 return [lsearch -exact $data(items) $item] 647} 648 649 650# ---------------------------------------------------------------------------- 651# ListBox::find 652# Returns the item given a position. 653# findInfo @x,y ?confine? 654# lineNumber 655# ---------------------------------------------------------------------------- 656proc ListBox::find {path findInfo {confine ""}} { 657 variable $path 658 upvar 0 $path widgetData 659 660 if {[regexp -- {^@([0-9]+),([0-9]+)$} $findInfo match x y]} { 661 set x [$path.c canvasx $x] 662 set y [$path.c canvasy $y] 663 } elseif {[regexp -- {^[0-9]+$} $findInfo lineNumber]} { 664 set dy [Widget::getoption $path -deltay] 665 set y [expr {$dy*($lineNumber+0.5)}] 666 set confine "" 667 } else { 668 return -code error "invalid find spec \"$findInfo\"" 669 } 670 671 set found 0 672 set xi 0 673 foreach xs $widgetData(xlist) { 674 if {$x <= $xs} { 675 foreach id [$path.c find overlapping $xi $y $xs $y] { 676 set ltags [$path.c gettags $id] 677 set item [lindex $ltags 0] 678 if { [string equal $item "item"] || 679 [string equal $item "img"] || 680 [string equal $item "win"] } { 681 # item is the label or image/window of the node 682 set item [string range [lindex $ltags 1] 2 end] 683 set found 1 684 break 685 } 686 } 687 break 688 } 689 set xi $xs 690 } 691 692 if {$found} { 693 if {[string equal $confine "confine"]} { 694 # test if x stand inside node bbox 695 set xi [expr {[lindex [$path.c coords n:$item] 0]-[Widget::getoption $path -padx]}] 696 set xs [lindex [$path.c bbox n:$item] 2] 697 if {$x >= $xi && $x <= $xs} { 698 return $item 699 } 700 } else { 701 return $item 702 } 703 } 704 return "" 705} 706 707 708# ---------------------------------------------------------------------------- 709# Command ListBox::item - deprecated 710# ---------------------------------------------------------------------------- 711proc ListBox::item { path first {last ""} } { 712 variable $path 713 upvar 0 $path data 714 715 if { ![string length $last] } { 716 return [lindex $data(items) $first] 717 } else { 718 return [lrange $data(items) $first $last] 719 } 720} 721 722 723# ---------------------------------------------------------------------------- 724# Command ListBox::items 725# ---------------------------------------------------------------------------- 726proc ListBox::items { path {first ""} {last ""}} { 727 variable $path 728 upvar 0 $path data 729 730 if { ![string length $first] } { 731 return $data(items) 732 } 733 734 if { ![string length $last] } { 735 return [lindex $data(items) $first] 736 } else { 737 return [lrange $data(items) $first $last] 738 } 739} 740 741 742# ---------------------------------------------------------------------------- 743# Command ListBox::see 744# ---------------------------------------------------------------------------- 745proc ListBox::see { path item } { 746 variable $path 747 upvar 0 $path data 748 749 if { [Widget::getoption $path -redraw] && $data(upd,afterid) != "" } { 750 after cancel $data(upd,afterid) 751 _redraw_listbox $path 752 } 753 set idn [$path.c find withtag n:$item] 754 if { $idn != "" } { 755 set idi [$path.c find withtag i:$item] 756 if { $idi == "" } { set idi $idn } 757 ListBox::_see $path $idn right 758 ListBox::_see $path $idi left 759 } 760} 761 762 763# ---------------------------------------------------------------------------- 764# Command ListBox::edit 765# ---------------------------------------------------------------------------- 766proc ListBox::edit { path item text {verifycmd ""} {clickres 0} {select 1}} { 767 variable _edit 768 variable $path 769 upvar 0 $path data 770 771 if { [Widget::getoption $path -redraw] && $data(upd,afterid) != "" } { 772 after cancel $data(upd,afterid) 773 _redraw_listbox $path 774 } 775 set idn [$path.c find withtag n:$item] 776 if { $idn != "" } { 777 ListBox::_see $path $idn right 778 ListBox::_see $path $idn left 779 780 set oldfg [$path.c itemcget $idn -fill] 781 set sbg [Widget::getoption $path -selectbackground] 782 set coords [$path.c coords $idn] 783 set x [lindex $coords 0] 784 set y [lindex $coords 1] 785 set bd [expr {[$path.c cget -borderwidth]+[$path.c cget -highlightthickness]}] 786 set w [expr {[winfo width $path] - 2*$bd}] 787 set wmax [expr {[$path.c canvasx $w]-$x}] 788 789 $path.c itemconfigure $idn -fill [Widget::getoption $path -background] 790 $path.c itemconfigure s:$item -fill {} -outline {} 791 792 set _edit(text) $text 793 set _edit(wait) 0 794 795 set frame [frame $path.edit \ 796 -relief flat -borderwidth 0 -highlightthickness 0 \ 797 -background [Widget::getoption $path -background]] 798 set ent [entry $frame.edit \ 799 -width 0 \ 800 -relief solid \ 801 -borderwidth 1 \ 802 -highlightthickness 0 \ 803 -foreground [_getoption $path $item -foreground] \ 804 -background [Widget::getoption $path -background] \ 805 -selectforeground [Widget::getoption $path -selectforeground] \ 806 -selectbackground $sbg \ 807 -font [_getoption $path $item -font] \ 808 -textvariable ListBox::_edit(text)] 809 pack $ent -ipadx 8 -anchor w 810 811 set idw [$path.c create window $x $y -window $frame -anchor w] 812 trace variable ListBox::_edit(text) w [list ListBox::_update_edit_size $path $ent $idw $wmax] 813 tkwait visibility $ent 814 grab $frame 815 BWidget::focus set $ent 816 _update_edit_size $path $ent $idw $wmax 817 update 818 if { $select } { 819 $ent selection range 0 end 820 $ent icursor end 821 $ent xview end 822 } 823 824 bindtags $ent [list $ent Entry] 825 bind $ent <Escape> {set ListBox::_edit(wait) 0} 826 bind $ent <Return> {set ListBox::_edit(wait) 1} 827 if { $clickres == 0 || $clickres == 1 } { 828 bind $frame <Button> [list set ListBox::_edit(wait) $clickres] 829 } 830 831 set ok 0 832 while { !$ok } { 833 tkwait variable ListBox::_edit(wait) 834 if { !$_edit(wait) || [llength $verifycmd]==0 || 835 [uplevel \#0 $verifycmd [list $_edit(text)]] } { 836 set ok 1 837 } 838 } 839 trace vdelete ListBox::_edit(text) w [list ListBox::_update_edit_size $path $ent $idw $wmax] 840 grab release $frame 841 BWidget::focus release $ent 842 destroy $frame 843 $path.c delete $idw 844 $path.c itemconfigure $idn -fill $oldfg 845 $path.c itemconfigure s:$item -fill $sbg -outline $sbg 846 847 if { $_edit(wait) } { 848 return $_edit(text) 849 } 850 } 851 return "" 852} 853 854 855# ---------------------------------------------------------------------------- 856# Command ListBox::xview 857# ---------------------------------------------------------------------------- 858proc ListBox::xview { path args } { 859 return [eval [linsert $args 0 $path.c xview]] 860} 861 862 863# ---------------------------------------------------------------------------- 864# Command ListBox::yview 865# ---------------------------------------------------------------------------- 866proc ListBox::yview { path args } { 867 return [eval [linsert $args 0 $path.c yview]] 868} 869 870 871proc ListBox::getcanvas { path } { 872 return $path.c 873} 874 875 876proc ListBox::curselection { path } { 877 return [$path selection get] 878} 879 880 881# ---------------------------------------------------------------------------- 882# Command ListBox::_update_edit_size 883# ---------------------------------------------------------------------------- 884proc ListBox::_update_edit_size { path entry idw wmax args } { 885 set entw [winfo reqwidth $entry] 886 if { $entw >= $wmax } { 887 $path.c itemconfigure $idw -width $wmax 888 } else { 889 $path.c itemconfigure $idw -width 0 890 } 891} 892 893 894# ---------------------------------------------------------------------------- 895# Command ListBox::_getoption 896# Returns the value of option for node. If empty, returned value is those 897# of the ListBox. 898# ---------------------------------------------------------------------------- 899proc ListBox::_getoption { path item option } { 900 set value [Widget::getoption $path.$item $option] 901 if {![string length $value]} { 902 set value [Widget::getoption $path $option] 903 } 904 return $value 905} 906 907 908# ---------------------------------------------------------------------------- 909# Command ListBox::_destroy 910# ---------------------------------------------------------------------------- 911proc ListBox::_destroy { path } { 912 variable $path 913 upvar 0 $path data 914 915 if { $data(upd,afterid) != "" } { 916 after cancel $data(upd,afterid) 917 } 918 if { $data(dnd,afterid) != "" } { 919 after cancel $data(dnd,afterid) 920 } 921 foreach item $data(items) { 922 Widget::destroy $path.$item 923 } 924 925 Widget::destroy $path 926 unset data 927} 928 929 930# ---------------------------------------------------------------------------- 931# Command ListBox::_see 932# ---------------------------------------------------------------------------- 933proc ListBox::_see { path idn side } { 934 set bbox [$path.c bbox $idn] 935 set scrl [$path.c cget -scrollregion] 936 937 set ymax [lindex $scrl 3] 938 set dy [$path.c cget -yscrollincrement] 939 set yv [$path.c yview] 940 set yv0 [expr {round([lindex $yv 0]*$ymax/$dy)}] 941 set yv1 [expr {round([lindex $yv 1]*$ymax/$dy)}] 942 set y [expr {int([lindex [$path.c coords $idn] 1]/$dy)}] 943 if { $y < $yv0 } { 944 $path.c yview scroll [expr {$y-$yv0}] units 945 } elseif { $y >= $yv1 } { 946 $path.c yview scroll [expr {$y-$yv1+1}] units 947 } 948 949 set xmax [lindex $scrl 2] 950 set dx [$path.c cget -xscrollincrement] 951 set xv [$path.c xview] 952 if { [string equal $side "right"] } { 953 set xv1 [expr {round([lindex $xv 1]*$xmax/$dx)}] 954 set x1 [expr {int([lindex $bbox 2]/$dx)}] 955 if { $x1 >= $xv1 } { 956 $path.c xview scroll [expr {$x1-$xv1+1}] units 957 } 958 } else { 959 set xv0 [expr {round([lindex $xv 0]*$xmax/$dx)}] 960 set x0 [expr {int([lindex $bbox 0]/$dx)}] 961 if { $x0 < $xv0 } { 962 $path.c xview scroll [expr {$x0-$xv0}] units 963 } 964 } 965} 966 967 968# ---------------------------------------------------------------------------- 969# Command ListBox::_update_scrollregion 970# ---------------------------------------------------------------------------- 971proc ListBox::_update_scrollregion { path } { 972 set bd [$path.c cget -borderwidth] 973 set ht [$path.c cget -highlightthickness] 974 set bd [expr {2*($bd + $ht)}] 975 set w [expr {[winfo width $path] - $bd}] 976 set h [expr {[winfo height $path] - $bd}] 977 set xinc [$path.c cget -xscrollincrement] 978 set yinc [$path.c cget -yscrollincrement] 979 set bbox [$path.c bbox item win img] 980 if { [llength $bbox] } { 981 set xs [lindex $bbox 2] 982 set ys [lindex $bbox 3] 983 984 if { $w < $xs } { 985 set w [expr {int($xs)}] 986 if { [set r [expr {$w % $xinc}]] } { 987 set w [expr {$w+$xinc-$r}] 988 } 989 } 990 if { $h < $ys } { 991 set h [expr {int($ys)}] 992 if { [set r [expr {$h % $yinc}]] } { 993 set h [expr {$h+$yinc-$r}] 994 } 995 } 996 } 997 998 $path.c configure -scrollregion [list 0 0 $w $h] 999} 1000 1001 1002proc ListBox::_update_select_fill { path } { 1003 variable $path 1004 upvar 0 $path data 1005 1006 set width [winfo width $path] 1007 1008 foreach item $data(items) { 1009 set bbox [$path.c bbox n:$item] 1010 set bbox [list 0 [lindex $bbox 1] $width [lindex $bbox 3]] 1011 $path.c coords b:$item $bbox 1012 } 1013 1014 _redraw_selection $path 1015} 1016 1017 1018# ---------------------------------------------------------------------------- 1019# Command ListBox::_draw_item 1020# ---------------------------------------------------------------------------- 1021proc ListBox::_draw_item {path item x0 x1 y bg selfill multi ww} { 1022 set indent [Widget::getoption $path.$item -indent] 1023 set i [$path.c create text [expr {$x1+$indent}] $y \ 1024 -text [Widget::getoption $path.$item -text] \ 1025 -fill [_getoption $path $item -foreground] \ 1026 -font [_getoption $path $item -font] \ 1027 -anchor w \ 1028 -tags [list item n:$item click clickbind]] 1029 1030 if { $selfill && !$multi } { 1031 set bbox [$path.c bbox n:$item] 1032 set bbox [list 0 [lindex $bbox 1] $ww [lindex $bbox 3]] 1033 set tags [list box b:$item click clickbind] 1034 $path.c create rect $bbox -fill $bg -width 0 -tags $tags 1035 $path.c raise $i 1036 } 1037 1038 if { [set win [Widget::getoption $path.$item -window]] != "" } { 1039 $path.c create window [expr {$x0+$indent}] $y \ 1040 -window $win -anchor w -tags [list win i:$item] 1041 } elseif { [set img [Widget::getoption $path.$item -image]] != "" } { 1042 $path.c create image [expr {$x0+$indent}] $y \ 1043 -image $img -anchor w -tags [list img imgbind i:$item] 1044 } 1045 1046 _set_help $path $item 1047} 1048 1049 1050# ---------------------------------------------------------------------------- 1051# Command ListBox::_redraw_items 1052# ---------------------------------------------------------------------------- 1053proc ListBox::_redraw_items { path } { 1054 variable $path 1055 upvar 0 $path data 1056 1057 set cursor [$path.c cget -cursor] 1058 $path.c configure -cursor watch 1059 update idletasks ; # make sure watch cursor is reflected 1060 set dx [Widget::getoption $path -deltax] 1061 set dy [Widget::getoption $path -deltay] 1062 set padx [Widget::getoption $path -padx] 1063 set y0 [expr {$dy/2}] 1064 set x0 4 1065 set x1 [expr {$x0+$padx}] 1066 set nitem 0 1067 set width 0 1068 set drawn {} 1069 set data(xlist) {} 1070 if { [Widget::cget $path -multicolumn] } { 1071 set nrows $data(nrows) 1072 } else { 1073 set nrows [llength $data(items)] 1074 } 1075 foreach item $data(upd,delete) { 1076 $path.c delete i:$item n:$item s:$item b:$item 1077 } 1078 # Pass these to _draw_item so it doesn't have to request them 1079 # for each item. 1080 set bg [Widget::cget $path -background] 1081 set selfill [Widget::cget $path -selectfill] 1082 set multi [Widget::cget $path -multicolumn] 1083 set ww [winfo width $path] 1084 foreach item $data(items) { 1085 if { [info exists data(upd,create,$item)] } { 1086 _draw_item $path $item $x0 $x1 $y0 $bg $selfill $multi $ww 1087 unset data(upd,create,$item) 1088 } else { 1089 set indent [Widget::getoption $path.$item -indent] 1090 $path.c coords n:$item [expr {$x1+$indent}] $y0 1091 $path.c coords i:$item [expr {$x0+$indent}] $y0 1092 } 1093 set font [_getoption $path $item -font] 1094 set text [Widget::getoption $path.$item -text] 1095 set tw [font measure $font $text] 1096 if {$tw > $width} { set width $tw } 1097 incr y0 $dy 1098 incr nitem 1099 lappend drawn n:$item 1100 if { $nitem == $nrows } { 1101 set x2 [expr {$x1 + $width}] 1102 set y0 [expr {$dy/2}] 1103 set drawn {} 1104 set x0 [expr {$x2+$dx}] 1105 set x1 [expr {$x0+$padx}] 1106 set nitem 0 1107 lappend data(xlist) $x2 1108 set width 0 1109 } 1110 } 1111 if { $nitem && $nitem < $nrows } { 1112 lappend data(xlist) [expr {$x1 + $width}] 1113 } 1114 set data(upd,delete) {} 1115 $path.c configure -cursor $cursor 1116} 1117 1118 1119# ---------------------------------------------------------------------------- 1120# Command ListBox::_redraw_selection 1121# ---------------------------------------------------------------------------- 1122proc ListBox::_redraw_selection { path } { 1123 variable $path 1124 upvar 0 $path data 1125 1126 set selbg [Widget::getoption $path -selectbackground] 1127 set selfg [Widget::getoption $path -selectforeground] 1128 set selfill [Widget::getoption $path -selectfill] 1129 set multi [Widget::getoption $path -multicolumn] 1130 foreach id [$path.c find withtag sel] { 1131 set item [string range [lindex [$path.c gettags $id] 1] 2 end] 1132 if {-1 == [lsearch -exact $data(upd,delete) $item]} { 1133 $path.c itemconfigure "n:$item" \ 1134 -fill [_getoption $path $item -foreground] 1135 } 1136 } 1137 $path.c delete sel 1138 if {$selfill && !$multi} { 1139 # cache window width for use below 1140 set width [winfo width $path] 1141 } 1142 foreach item $data(selitems) { 1143 set bbox [$path.c bbox "n:$item"] 1144 if { [llength $bbox] } { 1145 if { $selfill && !$multi } { 1146 # With -selectfill, make box occupy full width of widget 1147 set bbox [list 0 [lindex $bbox 1] $width [lindex $bbox 3]] 1148 } 1149 set tags [list sel s:$item click clickbind] 1150 set id [$path.c create rectangle $bbox \ 1151 -fill $selbg -outline $selbg -tags $tags] 1152 if {$selfg != ""} { 1153 # Don't allow an empty fill - that would be transparent 1154 $path.c itemconfigure "n:$item" -fill $selfg 1155 } 1156 $path.c lower $id 1157 $path.c lower b:$item 1158 } 1159 } 1160} 1161 1162 1163# ---------------------------------------------------------------------------- 1164# Command ListBox::_redraw_listbox 1165# ---------------------------------------------------------------------------- 1166proc ListBox::_redraw_listbox { path } { 1167 variable $path 1168 upvar 0 $path data 1169 1170 if { [Widget::getoption $path -redraw] } { 1171 if { $data(upd,level) == 2 } { 1172 _redraw_items $path 1173 } 1174 _redraw_selection $path 1175 _update_scrollregion $path 1176 if {[Widget::cget $path -selectfill]} { 1177 _update_select_fill $path 1178 } 1179 set data(upd,level) 0 1180 set data(upd,afterid) "" 1181 } 1182} 1183 1184 1185# ---------------------------------------------------------------------------- 1186# Command ListBox::_redraw_idle 1187# ---------------------------------------------------------------------------- 1188proc ListBox::_redraw_idle { path level } { 1189 variable $path 1190 upvar 0 $path data 1191 1192 if { $data(nrows) != -1 } { 1193 # widget is realized 1194 if { [Widget::getoption $path -redraw] && $data(upd,afterid) == "" } { 1195 set data(upd,afterid) \ 1196 [after idle [list ListBox::_redraw_listbox $path]] 1197 } 1198 } 1199 if { $level > $data(upd,level) } { 1200 set data(upd,level) $level 1201 } 1202 return "" 1203} 1204 1205 1206# ---------------------------------------------------------------------------- 1207# Command ListBox::_resize 1208# ---------------------------------------------------------------------------- 1209proc ListBox::_resize { path } { 1210 variable $path 1211 upvar 0 $path data 1212 1213 if { [Widget::getoption $path -multicolumn] } { 1214 set bd [expr {[$path.c cget -borderwidth]+[$path.c cget -highlightthickness]}] 1215 set h [expr {[winfo height $path] - 2*$bd}] 1216 set nrows [expr {$h/[$path.c cget -yscrollincrement]}] 1217 if { $nrows == 0 } { 1218 set nrows 1 1219 } 1220 if { $nrows != $data(nrows) } { 1221 set data(nrows) $nrows 1222 _redraw_idle $path 2 1223 } else { 1224 _update_scrollregion $path 1225 } 1226 } elseif { $data(nrows) == -1 } { 1227 # first Configure event 1228 set data(nrows) 0 1229 ListBox::_redraw_listbox $path 1230 if {[Widget::cget $path -selectfill]} { 1231 _update_select_fill $path 1232 } 1233 } else { 1234 if {[Widget::cget $path -selectfill]} { 1235 _update_select_fill $path 1236 } 1237 1238 _update_scrollregion $path 1239 } 1240} 1241 1242 1243# ---------------------------------------------------------------------------- 1244# Command ListBox::_init_drag_cmd 1245# ---------------------------------------------------------------------------- 1246proc ListBox::_init_drag_cmd { path X Y top } { 1247 set path [winfo parent $path] 1248 set ltags [$path.c gettags current] 1249 set item [lindex $ltags 0] 1250 if { [string equal $item "item"] || 1251 [string equal $item "img"] || 1252 [string equal $item "win"] } { 1253 set item [string range [lindex $ltags 1] 2 end] 1254 if {[llength [set cmd [Widget::getoption $path -draginitcmd]]]} { 1255 return [uplevel \#0 $cmd [list $path $item $top]] 1256 } 1257 if { [set type [Widget::getoption $path -dragtype]] == "" } { 1258 set type "LISTBOX_ITEM" 1259 } 1260 if { [set img [Widget::getoption $path.$item -image]] != "" } { 1261 pack [label $top.l -image $img -padx 0 -pady 0] 1262 } 1263 return [list $type {copy move link} $item] 1264 } 1265 return {} 1266} 1267 1268 1269# ---------------------------------------------------------------------------- 1270# Command ListBox::_drop_cmd 1271# ---------------------------------------------------------------------------- 1272proc ListBox::_drop_cmd { path source X Y op type dnddata } { 1273 set path [winfo parent $path] 1274 variable $path 1275 upvar 0 $path data 1276 1277 if { [string length $data(dnd,afterid)] } { 1278 after cancel $data(dnd,afterid) 1279 set data(dnd,afterid) "" 1280 } 1281 $path.c delete drop 1282 set data(dnd,scroll) "" 1283 if { [llength $data(dnd,item)] || ![llength $data(items)] } { 1284 if {[llength [set cmd [Widget::getoption $path -dropcmd]]]} { 1285 return [uplevel \#0 $cmd [list $path $source $data(dnd,item) $op $type $dnddata]] 1286 } 1287 } 1288 return 0 1289} 1290 1291 1292# ---------------------------------------------------------------------------- 1293# Command ListBox::_over_cmd 1294# ---------------------------------------------------------------------------- 1295proc ListBox::_over_cmd { path source event X Y op type dnddata } { 1296 set path [winfo parent $path] 1297 variable $path 1298 upvar 0 $path data 1299 1300 if { [string equal $event "leave"] } { 1301 # we leave the window listbox 1302 $path.c delete drop 1303 if { [string length $data(dnd,afterid)] } { 1304 after cancel $data(dnd,afterid) 1305 set data(dnd,afterid) "" 1306 } 1307 set data(dnd,scroll) "" 1308 return 0 1309 } 1310 1311 if { [string equal $event "enter"] } { 1312 # we enter the window listbox - dnd data initialization 1313 set mode [Widget::getoption $path -dropovermode] 1314 set data(dnd,mode) 0 1315 foreach c {w p i} { 1316 set data(dnd,mode) [expr {($data(dnd,mode) << 1) | ([string first $c $mode] != -1)}] 1317 } 1318 } 1319 1320 set x [expr {$X-[winfo rootx $path]}] 1321 set y [expr {$Y-[winfo rooty $path]}] 1322 $path.c delete drop 1323 set data(dnd,item) "" 1324 1325 # test for auto-scroll unless mode is widget only 1326 if { $data(dnd,mode) != 4 && [_auto_scroll $path $x $y] != "" } { 1327 return 2 1328 } 1329 1330 if { $data(dnd,mode) & 4 } { 1331 # dropovermode includes widget 1332 set target [list widget] 1333 set vmode 4 1334 } else { 1335 set target [list ""] 1336 set vmode 0 1337 } 1338 if { ($data(dnd,mode) & 2) && ![llength $data(items)] } { 1339 # dropovermode includes position and listbox is empty 1340 lappend target "" 0 1341 set vmode [expr {$vmode | 2}] 1342 } 1343 1344 if { ($data(dnd,mode) & 3) && [llength $data(items)]} { 1345 # dropovermode includes item or position 1346 # we extract the box (xi,yi,xs,ys) where we can find item around x,y 1347 set len [llength $data(items)] 1348 set xc [$path.c canvasx $x] 1349 set yc [$path.c canvasy $y] 1350 set dy [$path.c cget -yscrollincrement] 1351 set line [expr {int($yc/$dy)}] 1352 set yi [expr {$line*$dy}] 1353 set ys [expr {$yi+$dy}] 1354 set xi 0 1355 set pos $line 1356 if { [Widget::getoption $path -multicolumn] } { 1357 set nrows $data(nrows) 1358 } else { 1359 set nrows $len 1360 } 1361 if { $line < $nrows } { 1362 foreach xs $data(xlist) { 1363 if { $xc <= $xs } { 1364 break 1365 } 1366 set xi $xs 1367 incr pos $nrows 1368 } 1369 if { $pos < $len } { 1370 set item [lindex $data(items) $pos] 1371 set xi [expr {[lindex [$path.c coords n:$item] 0]-[Widget::getoption $path -padx]-1}] 1372 if { $data(dnd,mode) & 1 } { 1373 # dropovermode includes item 1374 lappend target $item 1375 set vmode [expr {$vmode | 1}] 1376 } else { 1377 lappend target "" 1378 } 1379 1380 if { $data(dnd,mode) & 2 } { 1381 # dropovermode includes position 1382 if { $yc >= $yi+$dy/2 } { 1383 # position is after $item 1384 incr pos 1385 set yl $ys 1386 } else { 1387 # position is before $item 1388 set yl $yi 1389 } 1390 lappend target $pos 1391 set vmode [expr {$vmode | 2}] 1392 } else { 1393 lappend target "" 1394 } 1395 } else { 1396 lappend target "" "" 1397 } 1398 } else { 1399 lappend target "" "" 1400 } 1401 1402 if { ($vmode & 3) == 3 } { 1403 # result have both item and position 1404 # we compute what is the preferred method 1405 if { $yc-$yi <= 3 || $ys-$yc <= 3 } { 1406 lappend target "position" 1407 } else { 1408 lappend target "item" 1409 } 1410 } 1411 } 1412 1413 if {$vmode && [llength [set cmd [Widget::getoption $path -dropovercmd]]]} { 1414 # user-defined dropover command 1415 set res [uplevel \#0 $cmd [list $source $target $op $type $dnddata]] 1416 set code [lindex $res 0] 1417 set vmode 0 1418 if {$code & 1} { 1419 # update vmode 1420 switch -exact -- [lindex $res 1] { 1421 item {set vmode 1} 1422 position {set vmode 2} 1423 widget {set vmode 4} 1424 } 1425 } 1426 } else { 1427 if { ($vmode & 3) == 3 } { 1428 # result have both item and position 1429 # we choose the preferred method 1430 if { [string equal [lindex $target 3] "position"] } { 1431 set vmode [expr {$vmode & ~1}] 1432 } else { 1433 set vmode [expr {$vmode & ~2}] 1434 } 1435 } 1436 1437 if { $data(dnd,mode) == 4 || $data(dnd,mode) == 0 } { 1438 # dropovermode is widget or empty - recall is not necessary 1439 set code 1 1440 } else { 1441 set code 3 1442 } 1443 } 1444 1445 # draw dnd visual following vmode 1446 if {[llength $data(items)]} { 1447 if { $vmode & 1 } { 1448 set data(dnd,item) [list "item" [lindex $target 1]] 1449 $path.c create rectangle $xi $yi $xs $ys -tags drop 1450 } elseif { $vmode & 2 } { 1451 set data(dnd,item) [concat "position" [lindex $target 2]] 1452 $path.c create line $xi $yl $xs $yl -tags drop 1453 } elseif { $vmode & 4 } { 1454 set data(dnd,item) [list "widget"] 1455 } else { 1456 set code [expr {$code & 2}] 1457 } 1458 } 1459 1460 if { $code & 1 } { 1461 DropSite::setcursor based_arrow_down 1462 } else { 1463 DropSite::setcursor dot 1464 } 1465 return $code 1466} 1467 1468 1469# ---------------------------------------------------------------------------- 1470# Command ListBox::_auto_scroll 1471# ---------------------------------------------------------------------------- 1472proc ListBox::_auto_scroll { path x y } { 1473 variable $path 1474 upvar 0 $path data 1475 1476 set xmax [winfo width $path] 1477 set ymax [winfo height $path] 1478 set scroll {} 1479 if { $y <= 6 } { 1480 if { [lindex [$path.c yview] 0] > 0 } { 1481 set scroll [list yview -1] 1482 DropSite::setcursor sb_up_arrow 1483 } 1484 } elseif { $y >= $ymax-6 } { 1485 if { [lindex [$path.c yview] 1] < 1 } { 1486 set scroll [list yview 1] 1487 DropSite::setcursor sb_down_arrow 1488 } 1489 } elseif { $x <= 6 } { 1490 if { [lindex [$path.c xview] 0] > 0 } { 1491 set scroll [list xview -1] 1492 DropSite::setcursor sb_left_arrow 1493 } 1494 } elseif { $x >= $xmax-6 } { 1495 if { [lindex [$path.c xview] 1] < 1 } { 1496 set scroll [list xview 1] 1497 DropSite::setcursor sb_right_arrow 1498 } 1499 } 1500 1501 if { [string length $data(dnd,afterid)] && ![string equal $data(dnd,scroll) $scroll] } { 1502 after cancel $data(dnd,afterid) 1503 set data(dnd,afterid) "" 1504 } 1505 1506 set data(dnd,scroll) $scroll 1507 if { [llength $scroll] && ![string length $data(dnd,afterid)] } { 1508 set data(dnd,afterid) [after 200 [list ListBox::_scroll $path $scroll]] 1509 } 1510 return $data(dnd,afterid) 1511 1512} 1513 1514# ----------------------------------------------------------------------------- 1515# Command ListBox::_multiple_select 1516# ----------------------------------------------------------------------------- 1517proc ListBox::_multiple_select { path mode x y idx } { 1518 1519 variable $path 1520 upvar 0 $path data 1521 1522 1523 if { ![info exists data(anchor)] || ![info exists data(sel_anchor)] } { 1524 set data(anchor) $idx 1525 set data(sel_anchor) {} 1526 } 1527 1528 switch -exact -- $mode { 1529 n { 1530 _mouse_select $path set $idx 1531 set data(anchor) $idx 1532 set data(sel_anchor) {} 1533 } 1534 c { 1535 set l [$path selection get] 1536 if { [lsearch -exact $l $idx] >= 0 } { 1537 _mouse_select $path remove $idx 1538 } else { 1539 _mouse_select $path add $idx 1540 } 1541 set data(anchor) $idx 1542 set data(sel_anchor) {} 1543 } 1544 s { 1545 eval [list $path _mouse_select remove] $data(sel_anchor) 1546 1547 set ix [$path index $idx] 1548 set ia [$path index $data(anchor)] 1549 if { $ix > $ia } { 1550 set istart $ia 1551 set iend $ix 1552 } else { 1553 set istart $ix 1554 set iend $ia 1555 } 1556 1557 for { set i $istart } { $i <= $iend } { incr i } { 1558 set l [$path selection get] 1559 set t [$path items $i] 1560 set li [lsearch -exact $l $t] 1561 if { $li < 0 } { 1562 _mouse_select $path add $t 1563 lappend data(sel_anchor) $t 1564 } 1565 } 1566 } 1567 } 1568} 1569 1570 1571# ---------------------------------------------------------------------------- 1572# Command ListBox::_scroll 1573# ---------------------------------------------------------------------------- 1574proc ListBox::_scroll { path scroll} { 1575 variable $path 1576 upvar 0 $path data 1577 set cmd [lindex $scroll 0] 1578 set dir [lindex $scroll 1] 1579 if { ($dir == -1 && [lindex [$path.c $cmd] 0] > 0) || 1580 ($dir == 1 && [lindex [$path.c $cmd] 1] < 1) } { 1581 $path $cmd scroll $dir units 1582 set data(dnd,afterid) \ 1583 [after 50 [list ListBox::_scroll $path $scroll]] 1584 } else { 1585 set data(dnd,afterid) "" 1586 DropSite::setcursor dot 1587 } 1588} 1589 1590# ListBox::_set_help -- 1591# 1592# Register dynamic help for an item in the listbox. 1593# 1594# Arguments: 1595# path ListBox to query 1596# item Item in the listbox 1597# force Optional argument to force a reset of the help 1598# 1599# Results: 1600# none 1601proc ListBox::_set_help { path node } { 1602 Widget::getVariable $path help 1603 1604 set item $path.$node 1605 set opts [list -helptype -helptext -helpvar] 1606 foreach {cty ctx cv} [eval [linsert $opts 0 Widget::hasChangedX $item]] break 1607 set text [Widget::getoption $item -helptext] 1608 1609 ## If we've never set help for this item before, and text is not blank, 1610 ## we need to setup help. We also need to reset help if any of the 1611 ## options have changed. 1612 if { (![info exists help($node)] && $text != "") || $cty || $ctx || $cv } { 1613 set help($node) 1 1614 set type [Widget::getoption $item -helptype] 1615 switch $type { 1616 balloon { 1617 DynamicHelp::register $path.c balloon n:$node $text 1618 DynamicHelp::register $path.c balloon i:$node $text 1619 DynamicHelp::register $path.c balloon b:$node $text 1620 } 1621 variable { 1622 set var [Widget::getoption $item -helpvar] 1623 DynamicHelp::register $path.c variable n:$node $var $text 1624 DynamicHelp::register $path.c variable i:$node $var $text 1625 DynamicHelp::register $path.c variable b:$node $var $text 1626 } 1627 } 1628 } 1629} 1630 1631# ListBox::_mouse_select -- 1632# 1633# Handle selection commands that are done by the mouse. If the 1634# selection command returns true, we generate a <<ListboxSelect>> 1635# event for the listbox. 1636# 1637# Arguments: 1638# Standard arguments passed to a selection command. 1639# 1640# Results: 1641# none 1642proc ListBox::_mouse_select { path cmd args } { 1643 eval [linsert $args 0 selection $path $cmd] 1644 switch -- $cmd { 1645 "add" - "clear" - "remove" - "set" { 1646 event generate $path <<ListboxSelect>> 1647 } 1648 } 1649} 1650 1651 1652proc ListBox::_get_current { path } { 1653 set t [$path.c gettags current] 1654 return [string range [lindex $t 1] 2 end] 1655} 1656 1657 1658# ListBox::_drag_and_drop -- 1659# 1660# A default command to handle drag-and-drop functions local to this 1661# listbox. With this as the default -dropcmd, the user can simply 1662# enable drag-and-drop and be able to move items within this list 1663# with no further code. 1664# 1665# Arguments: 1666# Standard arguments passed to a dropcmd. 1667# 1668# Results: 1669# none 1670proc ListBox::_drag_and_drop { path from endItem operation type startItem } { 1671 set items [$path items] 1672 1673 ## This proc only handles drag-and-drop commands within itself. 1674 ## If the widget this came from is not our widget (minus the canvas), 1675 ## we don't want to do anything. They need to handle this themselves. 1676 if {[winfo parent $from] != $path} { return } 1677 1678 set place [lindex $endItem 0] 1679 set i [lindex $endItem 1] 1680 1681 switch -- $place { 1682 "position" { 1683 set idx $i 1684 } 1685 "item" { 1686 set idx [$path index $i] 1687 } 1688 "widget" { 1689 set idx [llength $items] 1690 } 1691 } 1692 1693 # Check if startItem is part of the current selection and process the 1694 # whole selection if so 1695 set selItems [selection $path get] 1696 if {-1 != [lsearch -exact $selItems $startItem]} { 1697 set dragItems $selItems 1698 } else { 1699 set dragItems [list $startItem] 1700 } 1701 1702 # get drag indexes (to sort them) 1703 foreach dragItem $dragItems { 1704 lappend dragIdx [$path index $dragItem] 1705 } 1706 foreach pos [lsort -integer -indices $dragIdx] { 1707 set dragItem [lindex $dragItems $pos] 1708 set dragIdx [$path index $dragItem] 1709 if {$idx > $dragIdx} { incr idx -1 } 1710 if {[string equal $operation "copy"]} { 1711 set options [Widget::options $path.$dragItem] 1712 eval [linsert $options 0 $path insert $idx $dragItem\#auto] 1713 incr idx 1714 } else { 1715 $path move $dragItem $idx 1716 set idx [$path index $dragItem] 1717 incr idx 1718 } 1719 } 1720} 1721 1722 1723proc ListBox::_keyboard_navigation { path dir } { 1724 variable $path 1725 upvar 0 $path data 1726 1727 set sel [$path index [lindex [$path selection get] end]] 1728 if {$dir > 0} { 1729 incr sel 1730 if {$sel >= [llength $data(items)]} { return } 1731 } else { 1732 incr sel -1 1733 if {$sel < 0} { return } 1734 } 1735 set item [lindex $data(items) $sel] 1736 $path see $item 1737 _mouse_select $path set $item 1738} 1739 1740 1741# ---------------------------------------------------------------------------- 1742# Command ListBox::_themechanged 1743# ---------------------------------------------------------------------------- 1744proc ListBox::_themechanged { path } { 1745 1746 if { ![winfo exists $path] } { return } 1747 BWidget::set_themedefaults 1748 1749 $path configure \ 1750 -background $BWidget::colors(SystemWindow) \ 1751 -foreground $BWidget::colors(SystemWindowText) \ 1752 -selectbackground $BWidget::colors(SystemHighlight) \ 1753 -selectforeground $BWidget::colors(SystemHighlightText) 1754 1755 # make sure, existing items appear in the same color as well: 1756 foreach item [$path items] { 1757 $path itemconfigure $item \ 1758 -foreground $BWidget::colors(SystemWindowText) 1759 } 1760 _redraw_idle $path 2 1761} 1762 1763