1
# ------------------------------------------------------------------------------
3
# This file is part of Unifix BWidget Toolkit
4
# $Id: listbox.tcl 10192 2002-01-24 19:25:32Z radim $
5
# ------------------------------------------------------------------------------
11
# - ListBox::itemconfigure
14
# - ListBox::bindImage
18
# - ListBox::selection
21
# - ListBox::item - deprecated
27
# - ListBox::_update_edit_size
30
# - ListBox::_update_scrollregion
31
# - ListBox::_draw_item
32
# - ListBox::_redraw_items
33
# - ListBox::_redraw_selection
34
# - ListBox::_redraw_listbox
35
# - ListBox::_redraw_idle
37
# - ListBox::_init_drag_cmd
38
# - ListBox::_drop_cmd
39
# - ListBox::_over_cmd
40
# - ListBox::_auto_scroll
42
# ------------------------------------------------------------------------------
45
namespace eval ListBox {
47
Widget::declare ListBox::Item {
48
{-indent Int 0 0 {=0}}
50
{-font TkResource "" 0 listbox}
51
{-image TkResource "" 0 label}
53
{-fill TkResource black 0 {listbox -foreground}}
58
Widget::tkinclude ListBox canvas :cmd \
59
remove {-insertwidth -insertbackground -insertborderwidth -insertofftime \
60
-insertontime -selectborderwidth -closeenough -confine -scrollregion \
61
-xscrollincrement -yscrollincrement -width -height} \
62
initialize {-relief sunken -borderwidth 2 -takefocus 1 \
63
-highlightthickness 1 -width 200}
65
Widget::declare ListBox {
66
{-deltax Int 10 0 {=0 ""}}
67
{-deltay Int 15 0 {=0 ""}}
68
{-padx Int 20 0 {=0 ""}}
69
{-background TkResource "" 0 listbox}
70
{-selectbackground TkResource "" 0 listbox}
71
{-selectforeground TkResource "" 0 listbox}
72
{-width TkResource "" 0 listbox}
73
{-height TkResource "" 0 listbox}
75
{-multicolumn Boolean 0 0}
76
{-dropovermode Flag "wpi" 0 "wpi"}
77
{-bg Synonym -background}
79
DragSite::include ListBox "LISTBOX_ITEM" 1
80
DropSite::include ListBox {
81
LISTBOX_ITEM {copy {} move {}}
84
Widget::addmap ListBox "" :cmd {-deltay -yscrollincrement}
86
proc ::ListBox { path args } { return [eval ListBox::create $path $args] }
93
# ------------------------------------------------------------------------------
94
# Command ListBox::create
95
# ------------------------------------------------------------------------------
96
proc ListBox::create { path args } {
97
Widget::init ListBox $path $args
102
# widget informations
107
set data(selitems) {}
109
# update informations
110
set data(upd,level) 0
111
set data(upd,afterid) ""
112
set data(upd,level) 0
113
set data(upd,delete) {}
115
# drag and drop informations
116
set data(dnd,scroll) ""
117
set data(dnd,afterid) ""
118
set data(dnd,item) ""
120
eval canvas $path [Widget::subcget $path :cmd] \
121
-width [expr {[Widget::getoption $path -width]*8}] \
122
-height [expr {[Widget::getoption $path -height]*[Widget::getoption $path -deltay]}] \
125
bind $path <Configure> "ListBox::_resize $path"
126
bind $path <Destroy> "ListBox::_destroy $path"
128
DragSite::setdrag $path $path ListBox::_init_drag_cmd [Widget::getoption $path -dragendcmd] 1
129
DropSite::setdrop $path $path ListBox::_over_cmd ListBox::_drop_cmd 1
131
rename $path ::$path:cmd
132
proc ::$path { cmd args } "return \[eval ListBox::\$cmd $path \$args\]"
138
# ------------------------------------------------------------------------------
139
# Command ListBox::configure
140
# ------------------------------------------------------------------------------
141
proc ListBox::configure { path args } {
142
set res [Widget::configure $path $args]
144
set ch1 [expr {[Widget::hasChanged $path -deltay dy] |
145
[Widget::hasChanged $path -padx val] |
146
[Widget::hasChanged $path -multicolumn val]}]
148
set ch2 [expr {[Widget::hasChanged $path -selectbackground val] |
149
[Widget::hasChanged $path -selectforeground val]}]
152
if { [Widget::hasChanged $path -height h] } {
153
$path:cmd configure -height [expr {$h*$dy}]
156
if { [Widget::hasChanged $path -width w] } {
157
$path:cmd configure -width [expr {$w*8}]
169
if { [Widget::hasChanged $path -redraw bool] && $bool } {
172
set lvl $data(upd,level)
173
set data(upd,level) 0
174
_redraw_idle $path $lvl
176
set force [Widget::hasChanged $path -dragendcmd dragend]
177
DragSite::setdrag $path $path ListBox::_init_drag_cmd $dragend $force
178
DropSite::setdrop $path $path ListBox::_over_cmd ListBox::_drop_cmd
184
# ------------------------------------------------------------------------------
185
# Command ListBox::cget
186
# ------------------------------------------------------------------------------
187
proc ListBox::cget { path option } {
188
return [Widget::cget $path $option]
192
# ------------------------------------------------------------------------------
193
# Command ListBox::insert
194
# ------------------------------------------------------------------------------
195
proc ListBox::insert { path index item args } {
199
if { [lsearch $data(items) $item] != -1 } {
200
return -code error "item \"$item\" already exists"
203
Widget::init ListBox::Item $path.$item $args
205
if { ![string compare $index "end"] } {
206
lappend data(items) $item
208
set data(items) [linsert $data(items) $index $item]
210
set data(upd,create,$item) $item
217
# ------------------------------------------------------------------------------
218
# Command ListBox::itemconfigure
219
# ------------------------------------------------------------------------------
220
proc ListBox::itemconfigure { path item args } {
224
if { [lsearch $data(items) $item] == -1 } {
225
return -code error "item \"$item\" does not exist"
228
set oldind [Widget::getoption $path.$item -indent]
230
set res [Widget::configure $path.$item $args]
231
set chind [Widget::hasChanged $path.$item -indent indent]
232
set chw [Widget::hasChanged $path.$item -window win]
233
set chi [Widget::hasChanged $path.$item -image img]
234
set cht [Widget::hasChanged $path.$item -text txt]
235
set chf [Widget::hasChanged $path.$item -font fnt]
236
set chfg [Widget::hasChanged $path.$item -fill fg]
237
set idn [$path:cmd find withtag n:$item]
240
# item is not drawn yet
245
set oldb [$path:cmd bbox $idn]
246
set coords [$path:cmd coords $idn]
247
set padx [Widget::getoption $path -padx]
248
set x0 [expr {[lindex $coords 0]-$padx-$oldind+$indent}]
249
set y0 [lindex $coords 1]
250
if { $chw || $chi } {
251
# -window or -image modified
252
set idi [$path:cmd find withtag i:$item]
253
set type [lindex [$path:cmd gettags $idi] 0]
254
if { [string length $win] } {
255
if { ![string compare $type "win"] } {
256
$path:cmd itemconfigure $idi -window $win
258
$path:cmd delete $idi
259
$path:cmd create window $x0 $y0 -window $win -anchor w -tags "win i:$item"
261
} elseif { [string length $img] } {
262
if { ![string compare $type "img"] } {
263
$path:cmd itemconfigure $idi -image $img
265
$path:cmd delete $idi
266
$path:cmd create image $x0 $y0 -image $img -anchor w -tags "img i:$item"
269
$path:cmd delete $idi
273
if { $cht || $chf || $chfg } {
274
# -text or -font modified, or -fill modified
275
$path:cmd itemconfigure $idn -text $txt -font $fnt -fill $fg
281
$path:cmd coords $idn [expr {$x0+$padx}] $y0
282
$path:cmd coords i:$item $x0 $y0
286
if { [Widget::getoption $path -multicolumn] && ($cht || $chf || $chind) } {
287
set bbox [$path:cmd bbox $idn]
288
if { [lindex $bbox 2] > [lindex $oldb 2] } {
297
# ------------------------------------------------------------------------------
298
# Command ListBox::itemcget
299
# ------------------------------------------------------------------------------
300
proc ListBox::itemcget { path item option } {
301
return [Widget::cget $path.$item $option]
305
# ------------------------------------------------------------------------------
306
# Command ListBox::bindText
307
# ------------------------------------------------------------------------------
308
proc ListBox::bindText { path event script } {
309
if { $script != "" } {
310
$path:cmd bind "item" $event \
311
"$script \[string range \[lindex \[$path:cmd gettags current\] 1\] 2 end\]"
313
$path:cmd bind "item" $event {}
318
# ------------------------------------------------------------------------------
319
# Command ListBox::bindImage
320
# ------------------------------------------------------------------------------
321
proc ListBox::bindImage { path event script } {
322
if { $script != "" } {
323
$path:cmd bind "img" $event \
324
"$script \[string range \[lindex \[$path:cmd gettags current\] 1\] 2 end\]"
326
$path:cmd bind "img" $event {}
331
# ------------------------------------------------------------------------------
332
# Command ListBox::delete
333
# ------------------------------------------------------------------------------
334
proc ListBox::delete { path args } {
338
foreach litems $args {
339
foreach item $litems {
340
set idx [lsearch $data(items) $item]
342
set data(items) [lreplace $data(items) $idx $idx]
343
Widget::destroy $path.$item
344
if { [info exists data(upd,create,$item)] } {
345
unset data(upd,create,$item)
347
lappend data(upd,delete) $item
353
set sel $data(selitems)
354
set data(selitems) {}
355
eval selection $path set $sel
360
# ------------------------------------------------------------------------------
361
# Command ListBox::move
362
# ------------------------------------------------------------------------------
363
proc ListBox::move { path item index } {
367
if { [set idx [lsearch $data(items) $item]] == -1 } {
368
return -code error "item \"$item\" does not exist"
371
set data(items) [lreplace $data(items) $idx $idx]
372
if { ![string compare $index "end"] } {
373
lappend data($path,item) $item
375
set data(items) [linsert $data(items) $index $item]
382
# ------------------------------------------------------------------------------
383
# Command ListBox::reorder
384
# ------------------------------------------------------------------------------
385
proc ListBox::reorder { path neworder } {
389
set data(items) [BWidget::lreorder $data(items) $neworder]
394
# ------------------------------------------------------------------------------
395
# Command ListBox::selection
396
# ------------------------------------------------------------------------------
397
proc ListBox::selection { path cmd args } {
403
set data(selitems) {}
405
if { [lsearch $data(selitems) $item] == -1 } {
406
if { [lsearch $data(items) $item] != -1 } {
407
lappend data(selitems) $item
414
if { [lsearch $data(selitems) $item] == -1 } {
415
if { [lsearch $data(items) $item] != -1 } {
416
lappend data(selitems) $item
423
if { [set idx [lsearch $data(selitems) $item]] != -1 } {
424
set data(selitems) [lreplace $data(selitems) $idx $idx]
429
set data(selitems) {}
432
return $data(selitems)
442
# ------------------------------------------------------------------------------
443
# Command ListBox::exists
444
# ------------------------------------------------------------------------------
445
proc ListBox::exists { path item } {
449
return [expr {[lsearch $data(items) $item] != -1}]
453
# ------------------------------------------------------------------------------
454
# Command ListBox::index
455
# ------------------------------------------------------------------------------
456
proc ListBox::index { path item } {
460
return [lsearch $data(items) $item]
464
# ------------------------------------------------------------------------------
465
# Command ListBox::item - deprecated
466
# ------------------------------------------------------------------------------
467
proc ListBox::item { path first {last ""} } {
471
if { ![string length $last] } {
472
return [lindex $data(items) $first]
474
return [lrange $data(items) $first $last]
479
# ------------------------------------------------------------------------------
480
# Command ListBox::items
481
# ------------------------------------------------------------------------------
482
proc ListBox::items { path {first ""} {last ""}} {
486
if { ![string length $first] } {
490
if { ![string length $last] } {
491
return [lindex $data(items) $first]
493
return [lrange $data(items) $first $last]
498
# ------------------------------------------------------------------------------
499
# Command ListBox::see
500
# ------------------------------------------------------------------------------
501
proc ListBox::see { path item } {
505
if { [Widget::getoption $path -redraw] && $data(upd,afterid) != "" } {
506
after cancel $data(upd,afterid)
507
_redraw_listbox $path
509
set idn [$path:cmd find withtag n:$item]
511
ListBox::_see $path $idn right
512
ListBox::_see $path $idn left
517
# ------------------------------------------------------------------------------
518
# Command ListBox::edit
519
# ------------------------------------------------------------------------------
520
proc ListBox::edit { path item text {verifycmd ""} {clickres 0} {select 1}} {
525
if { [Widget::getoption $path -redraw] && $data(upd,afterid) != "" } {
526
after cancel $data(upd,afterid)
527
_redraw_listbox $path
529
set idn [$path:cmd find withtag n:$item]
531
ListBox::_see $path $idn right
532
ListBox::_see $path $idn left
534
set oldfg [$path:cmd itemcget $idn -fill]
535
set sbg [Widget::getoption $path -selectbackground]
536
set coords [$path:cmd coords $idn]
537
set x [lindex $coords 0]
538
set y [lindex $coords 1]
539
set bd [expr {[$path:cmd cget -borderwidth]+[$path:cmd cget -highlightthickness]}]
540
set w [expr {[winfo width $path] - 2*$bd}]
541
set wmax [expr {[$path:cmd canvasx $w]-$x}]
543
$path:cmd itemconfigure $idn -fill [Widget::getoption $path -background]
544
$path:cmd itemconfigure s:$item -fill {} -outline {}
546
set _edit(text) $text
549
set frame [frame $path.edit \
550
-relief flat -borderwidth 0 -highlightthickness 0 \
551
-background [Widget::getoption $path -background]]
552
set ent [entry $frame.edit \
556
-highlightthickness 0 \
557
-foreground [Widget::getoption $path.$item -fill] \
558
-background [Widget::getoption $path -background] \
559
-selectforeground [Widget::getoption $path -selectforeground] \
560
-selectbackground $sbg \
561
-font [Widget::getoption $path.$item -font] \
562
-textvariable ListBox::_edit(text)]
563
pack $ent -ipadx 8 -anchor w
565
set idw [$path:cmd create window $x $y -window $frame -anchor w]
566
trace variable ListBox::_edit(text) w "ListBox::_update_edit_size $path $ent $idw $wmax"
567
tkwait visibility $ent
569
BWidget::focus set $ent
570
_update_edit_size $path $ent $idw $wmax
573
$ent selection range 0 end
578
bind $ent <Escape> {set ListBox::_edit(wait) 0}
579
bind $ent <Return> {set ListBox::_edit(wait) 1}
580
if { $clickres == 0 || $clickres == 1 } {
581
bind $frame <Button> "set ListBox::_edit(wait) $clickres"
586
tkwait variable ListBox::_edit(wait)
587
if { !$_edit(wait) || $verifycmd == "" ||
588
[uplevel \#0 $verifycmd [list $_edit(text)]] } {
592
trace vdelete ListBox::_edit(text) w "ListBox::_update_edit_size $path $ent $idw $wmax"
594
BWidget::focus release $ent
596
$path:cmd delete $idw
597
$path:cmd itemconfigure $idn -fill $oldfg
598
$path:cmd itemconfigure s:$item -fill $sbg -outline $sbg
600
if { $_edit(wait) } {
608
# ------------------------------------------------------------------------------
609
# Command ListBox::xview
610
# ------------------------------------------------------------------------------
611
proc ListBox::xview { path args } {
612
return [eval $path:cmd xview $args]
616
# ------------------------------------------------------------------------------
617
# Command ListBox::yview
618
# ------------------------------------------------------------------------------
619
proc ListBox::yview { path args } {
620
return [eval $path:cmd yview $args]
624
# ------------------------------------------------------------------------------
625
# Command ListBox::_update_edit_size
626
# ------------------------------------------------------------------------------
627
proc ListBox::_update_edit_size { path entry idw wmax args } {
628
set entw [winfo reqwidth $entry]
629
if { $entw >= $wmax } {
630
$path:cmd itemconfigure $idw -width $wmax
632
$path:cmd itemconfigure $idw -width 0
637
# ------------------------------------------------------------------------------
638
# Command ListBox::_destroy
639
# ------------------------------------------------------------------------------
640
proc ListBox::_destroy { path } {
644
if { $data(upd,afterid) != "" } {
645
after cancel $data(upd,afterid)
647
if { $data(dnd,afterid) != "" } {
648
after cancel $data(dnd,afterid)
650
foreach item $data(items) {
651
Widget::destroy $path.$item
654
Widget::destroy $path
660
# ------------------------------------------------------------------------------
661
# Command ListBox::_see
662
# ------------------------------------------------------------------------------
663
proc ListBox::_see { path idn side } {
664
set bbox [$path:cmd bbox $idn]
665
set scrl [$path:cmd cget -scrollregion]
667
set ymax [lindex $scrl 3]
668
set dy [$path:cmd cget -yscrollincrement]
669
set yv [$path:cmd yview]
670
set yv0 [expr {round([lindex $yv 0]*$ymax/$dy)}]
671
set yv1 [expr {round([lindex $yv 1]*$ymax/$dy)}]
672
set y [expr {int([lindex [$path:cmd coords $idn] 1]/$dy)}]
674
$path:cmd yview scroll [expr {$y-$yv0}] units
675
} elseif { $y >= $yv1 } {
676
$path:cmd yview scroll [expr {$y-$yv1+1}] units
679
set xmax [lindex $scrl 2]
680
set dx [$path:cmd cget -xscrollincrement]
681
set xv [$path:cmd xview]
682
if { ![string compare $side "right"] } {
683
set xv1 [expr {round([lindex $xv 1]*$xmax/$dx)}]
684
set x1 [expr {int([lindex $bbox 2]/$dx)}]
686
$path:cmd xview scroll [expr {$x1-$xv1+1}] units
689
set xv0 [expr {round([lindex $xv 0]*$xmax/$dx)}]
690
set x0 [expr {int([lindex $bbox 0]/$dx)}]
692
$path:cmd xview scroll [expr {$x0-$xv0}] units
698
# ------------------------------------------------------------------------------
699
# Command ListBox::_update_scrollregion
700
# ------------------------------------------------------------------------------
701
proc ListBox::_update_scrollregion { path } {
702
set bd [expr {2*([$path:cmd cget -borderwidth]+[$path:cmd cget -highlightthickness])}]
703
set w [expr {[winfo width $path] - $bd}]
704
set h [expr {[winfo height $path] - $bd}]
705
set xinc [$path:cmd cget -xscrollincrement]
706
set yinc [$path:cmd cget -yscrollincrement]
707
set bbox [$path:cmd bbox all]
708
if { [llength $bbox] } {
709
set xs [lindex $bbox 2]
710
set ys [lindex $bbox 3]
713
set w [expr {int($xs)}]
714
if { [set r [expr {$w % $xinc}]] } {
715
set w [expr {$w+$xinc-$r}]
719
set h [expr {int($ys)}]
720
if { [set r [expr {$h % $yinc}]] } {
721
set h [expr {$h+$yinc-$r}]
726
$path:cmd configure -scrollregion [list 0 0 $w $h]
730
# ------------------------------------------------------------------------------
731
# Command ListBox::_draw_item
732
# ------------------------------------------------------------------------------
733
proc ListBox::_draw_item { path item x0 x1 y } {
734
set indent [Widget::getoption $path.$item -indent]
735
$path:cmd create text [expr {$x1+$indent}] $y \
736
-text [Widget::getoption $path.$item -text] \
737
-fill [Widget::getoption $path.$item -fill] \
738
-font [Widget::getoption $path.$item -font] \
741
if { [set win [Widget::getoption $path.$item -window]] != "" } {
742
$path:cmd create window [expr {$x0+$indent}] $y \
743
-window $win -anchor w -tags "win i:$item"
744
} elseif { [set img [Widget::getoption $path.$item -image]] != "" } {
745
$path:cmd create image [expr {$x0+$indent}] $y \
746
-image $img -anchor w -tags "img i:$item"
751
# ------------------------------------------------------------------------------
752
# Command ListBox::_redraw_items
753
# ------------------------------------------------------------------------------
754
proc ListBox::_redraw_items { path } {
758
$path:cmd configure -cursor watch
759
set dx [Widget::getoption $path -deltax]
760
set dy [Widget::getoption $path -deltay]
761
set padx [Widget::getoption $path -padx]
762
set y0 [expr {$dy/2}]
764
set x1 [expr {$x0+$padx}]
768
if { [Widget::getoption $path -multicolumn] } {
769
set nrows $data(nrows)
771
set nrows [llength $data(items)]
773
foreach item $data(upd,delete) {
774
$path:cmd delete i:$item n:$item s:$item
776
foreach item $data(items) {
777
if { [info exists data(upd,create,$item)] } {
778
_draw_item $path $item $x0 $x1 $y0
779
unset data(upd,create,$item)
781
set indent [Widget::getoption $path.$item -indent]
782
$path:cmd coords n:$item [expr {$x1+$indent}] $y0
783
$path:cmd coords i:$item [expr {$x0+$indent}] $y0
787
lappend drawn n:$item
788
if { $nitem == $nrows } {
789
set y0 [expr {$dy/2}]
790
set bbox [eval $path:cmd bbox $drawn]
792
set x0 [expr {[lindex $bbox 2]+$dx}]
793
set x1 [expr {$x0+$padx}]
795
lappend data(xlist) [lindex $bbox 2]
798
if { $nitem && $nitem < $nrows } {
799
set bbox [eval $path:cmd bbox $drawn]
800
lappend data(xlist) [lindex $bbox 2]
802
set data(upd,delete) {}
803
$path:cmd configure -cursor [Widget::getoption $path -cursor]
807
# ------------------------------------------------------------------------------
808
# Command ListBox::_redraw_selection
809
# ------------------------------------------------------------------------------
810
proc ListBox::_redraw_selection { path } {
814
set selbg [Widget::getoption $path -selectbackground]
815
set selfg [Widget::getoption $path -selectforeground]
816
foreach id [$path:cmd find withtag sel] {
817
set item [string range [lindex [$path:cmd gettags $id] 1] 2 end]
818
$path:cmd itemconfigure "n:$item" -fill [Widget::getoption $path.$item -fill]
821
foreach item $data(selitems) {
822
set bbox [$path:cmd bbox "n:$item"]
823
if { [llength $bbox] } {
824
set id [eval $path:cmd create rectangle $bbox -fill $selbg -outline $selbg -tags [list "sel s:$item"]]
825
$path:cmd itemconfigure "n:$item" -fill $selfg
832
# ------------------------------------------------------------------------------
833
# Command ListBox::_redraw_listbox
834
# ------------------------------------------------------------------------------
835
proc ListBox::_redraw_listbox { path } {
839
if { [Widget::getoption $path -redraw] } {
840
if { $data(upd,level) == 2 } {
843
_redraw_selection $path
844
_update_scrollregion $path
845
set data(upd,level) 0
846
set data(upd,afterid) ""
851
# ------------------------------------------------------------------------------
852
# Command ListBox::_redraw_idle
853
# ------------------------------------------------------------------------------
854
proc ListBox::_redraw_idle { path level } {
858
if { $data(nrows) != -1 } {
860
if { [Widget::getoption $path -redraw] && $data(upd,afterid) == "" } {
861
set data(upd,afterid) [after idle ListBox::_redraw_listbox $path]
864
if { $level > $data(upd,level) } {
865
set data(upd,level) $level
871
# ------------------------------------------------------------------------------
872
# Command ListBox::_resize
873
# ------------------------------------------------------------------------------
874
proc ListBox::_resize { path } {
878
if { [Widget::getoption $path -multicolumn] } {
879
set bd [expr {[$path:cmd cget -borderwidth]+[$path:cmd cget -highlightthickness]}]
880
set h [expr {[winfo height $path] - 2*$bd}]
881
set nrows [expr {$h/[$path:cmd cget -yscrollincrement]}]
885
if { $nrows != $data(nrows) } {
886
set data(nrows) $nrows
889
_update_scrollregion $path
891
} elseif { $data(nrows) == -1 } {
892
# first Configure event
894
ListBox::_redraw_listbox $path
896
_update_scrollregion $path
901
# ------------------------------------------------------------------------------
902
# Command ListBox::_init_drag_cmd
903
# ------------------------------------------------------------------------------
904
proc ListBox::_init_drag_cmd { path X Y top } {
905
set ltags [$path:cmd gettags current]
906
set item [lindex $ltags 0]
907
if { ![string compare $item "item"] ||
908
![string compare $item "img"] ||
909
![string compare $item "win"] } {
910
set item [string range [lindex $ltags 1] 2 end]
911
if { [set cmd [Widget::getoption $path -draginitcmd]] != "" } {
912
return [uplevel \#0 $cmd [list $path $item $top]]
914
if { [set type [Widget::getoption $path -dragtype]] == "" } {
915
set type "LISTBOX_ITEM"
917
if { [set img [Widget::getoption $path.$item -image]] != "" } {
918
pack [label $top.l -image $img -padx 0 -pady 0]
920
return [list $type {copy move link} $item]
926
# ------------------------------------------------------------------------------
927
# Command ListBox::_drop_cmd
928
# ------------------------------------------------------------------------------
929
proc ListBox::_drop_cmd { path source X Y op type dnddata } {
933
if { [string length $data(dnd,afterid)] } {
934
after cancel $data(dnd,afterid)
935
set data(dnd,afterid) ""
937
$path:cmd delete drop
938
set data(dnd,scroll) ""
939
if { [llength $data(dnd,item)] } {
940
if { [set cmd [Widget::getoption $path -dropcmd]] != "" } {
941
return [uplevel \#0 $cmd [list $path $source $data(dnd,item) $op $type $dnddata]]
948
# ------------------------------------------------------------------------------
949
# Command ListBox::_over_cmd
950
# ------------------------------------------------------------------------------
951
proc ListBox::_over_cmd { path source event X Y op type dnddata } {
955
if { ![string compare $event "leave"] } {
956
# we leave the window listbox
957
$path:cmd delete drop
958
if { [string length $data(dnd,afterid)] } {
959
after cancel $data(dnd,afterid)
960
set data(dnd,afterid) ""
962
set data(dnd,scroll) ""
966
if { ![string compare $event "enter"] } {
967
# we enter the window listbox - dnd data initialization
968
set mode [Widget::getoption $path -dropovermode]
971
set data(dnd,mode) [expr {($data(dnd,mode) << 1) | ([string first $c $mode] != -1)}]
975
set x [expr {$X-[winfo rootx $path]}]
976
set y [expr {$Y-[winfo rooty $path]}]
977
$path:cmd delete drop
978
set data(dnd,item) ""
980
# test for auto-scroll unless mode is widget only
981
if { $data(dnd,mode) != 4 && [_auto_scroll $path $x $y] != "" } {
985
if { $data(dnd,mode) & 4 } {
986
# dropovermode includes widget
987
set target [list widget]
994
if { $data(dnd,mode) & 3 } {
995
# dropovermode includes item or position
996
# we extract the box (xi,yi,xs,ys) where we can find item around x,y
997
set len [llength $data(items)]
998
set xc [$path:cmd canvasx $x]
999
set yc [$path:cmd canvasy $y]
1000
set dy [$path:cmd cget -yscrollincrement]
1001
set line [expr {int($yc/$dy)}]
1002
set yi [expr {$line*$dy}]
1003
set ys [expr {$yi+$dy}]
1006
if { [Widget::getoption $path -multicolumn] } {
1007
set nrows $data(nrows)
1011
if { $line < $nrows } {
1012
foreach xs $data(xlist) {
1019
if { $pos < $len } {
1020
set item [lindex $data(items) $pos]
1021
if { $data(dnd,mode) & 1 } {
1022
# dropovermode includes item
1023
lappend target $item
1024
set vmode [expr {$vmode | 1}]
1029
if { $data(dnd,mode) & 2 } {
1030
# dropovermode includes position
1031
if { $yc >= $yi+$dy/2 } {
1032
# position is after $item
1036
# position is before $item
1040
set vmode [expr {$vmode | 2}]
1045
lappend target "" ""
1048
lappend target "" ""
1051
if { ($vmode & 3) == 3 } {
1052
# result have both item and position
1053
# we compute what is the preferred method
1054
if { $yc-$yi <= 3 || $ys-$yc <= 3 } {
1055
lappend target "position"
1057
lappend target "item"
1062
if { $vmode && [set cmd [Widget::getoption $path -dropovercmd]] != "" } {
1063
# user-defined dropover command
1064
set res [uplevel \#0 $cmd [list $source $target $op $type $dnddata]]
1065
set code [lindex $res 0]
1069
set mode [lindex $res 1]
1070
if { ![string compare $mode "item"] } {
1072
} elseif { ![string compare $mode "position"] } {
1074
} elseif { ![string compare $mode "widget"] } {
1079
if { ($vmode & 3) == 3 } {
1080
# result have both item and position
1081
# we choose the preferred method
1082
if { ![string compare [lindex $target 3] "position"] } {
1083
set vmode [expr {$vmode & ~1}]
1085
set vmode [expr {$vmode & ~2}]
1089
if { $data(dnd,mode) == 4 || $data(dnd,mode) == 0 } {
1090
# dropovermode is widget or empty - recall is not necessary
1097
# draw dnd visual following vmode
1099
set data(dnd,item) [list "item" [lindex $target 1]]
1100
$path:cmd create rectangle $xi $yi $xs $ys -tags drop
1101
} elseif { $vmode & 2 } {
1102
set data(dnd,item) [concat "position" [lindex $target 2]]
1103
$path:cmd create line $xi $yl $xs $yl -tags drop
1104
} elseif { $vmode & 4 } {
1105
set data(dnd,item) [list "widget"]
1107
set code [expr {$code & 2}]
1111
DropSite::setcursor based_arrow_down
1113
DropSite::setcursor dot
1119
# ------------------------------------------------------------------------------
1120
# Command ListBox::_auto_scroll
1121
# ------------------------------------------------------------------------------
1122
proc ListBox::_auto_scroll { path x y } {
1126
set xmax [winfo width $path]
1127
set ymax [winfo height $path]
1130
if { [lindex [$path:cmd yview] 0] > 0 } {
1131
set scroll [list yview -1]
1132
DropSite::setcursor sb_up_arrow
1134
} elseif { $y >= $ymax-6 } {
1135
if { [lindex [$path:cmd yview] 1] < 1 } {
1136
set scroll [list yview 1]
1137
DropSite::setcursor sb_down_arrow
1139
} elseif { $x <= 6 } {
1140
if { [lindex [$path:cmd xview] 0] > 0 } {
1141
set scroll [list xview -1]
1142
DropSite::setcursor sb_left_arrow
1144
} elseif { $x >= $xmax-6 } {
1145
if { [lindex [$path:cmd xview] 1] < 1 } {
1146
set scroll [list xview 1]
1147
DropSite::setcursor sb_right_arrow
1151
if { [string length $data(dnd,afterid)] && [string compare $data(dnd,scroll) $scroll] } {
1152
after cancel $data(dnd,afterid)
1153
set data(dnd,afterid) ""
1156
set data(dnd,scroll) $scroll
1157
if { [llength $scroll] && ![string length $data(dnd,afterid)] } {
1158
set data(dnd,afterid) [after 200 ListBox::_scroll $path $scroll]
1160
return $data(dnd,afterid)
1164
# ------------------------------------------------------------------------------
1165
# Command ListBox::_scroll
1166
# ------------------------------------------------------------------------------
1167
proc ListBox::_scroll { path cmd dir } {
1171
if { ($dir == -1 && [lindex [$path:cmd $cmd] 0] > 0) ||
1172
($dir == 1 && [lindex [$path:cmd $cmd] 1] < 1) } {
1173
$path $cmd scroll $dir units
1174
set data(dnd,afterid) [after 100 ListBox::_scroll $path $cmd $dir]
1176
set data(dnd,afterid) ""
1177
DropSite::setcursor dot