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