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