source: trunk/BWidget-1.2.1/listbox.tcl @ 931

Last change on this file since 931 was 931, checked in by toby, 11 years ago

include rest of files

File size: 38.0 KB
RevLine 
[931]1# ------------------------------------------------------------------------------
2#  listbox.tcl
3#  This file is part of Unifix BWidget Toolkit
4#  $Id: listbox.tcl,v 1.11 1999/07/09 08:10:32 eric 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# ------------------------------------------------------------------------------
43
44
45namespace eval ListBox {
46    namespace eval Item {
47        Widget::declare ListBox::Item {
48            {-indent     Int        0       0 {=0}}
49            {-text       String     ""      0}
50            {-font       TkResource ""      0 listbox}
51            {-image      TkResource ""      0 label}
52            {-window     String     ""      0}
53            {-fill       TkResource black   0 {listbox -foreground}}
54            {-data       String     ""      0}
55        }
56    }
57
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}
64
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}
74        {-redraw           Boolean 1  0}
75        {-multicolumn      Boolean 0  0}
76        {-dropovermode     Flag    "wpi" 0 "wpi"}
77        {-bg               Synonym -background}
78    }
79    DragSite::include ListBox "LISTBOX_ITEM" 1
80    DropSite::include ListBox {
81        LISTBOX_ITEM {copy {} move {}}
82    }
83
84    Widget::addmap ListBox "" :cmd {-deltay -yscrollincrement}
85
86    proc ::ListBox { path args } { return [eval ListBox::create $path $args] }
87    proc use {} {}
88
89    variable _edit
90}
91
92
93# ------------------------------------------------------------------------------
94#  Command ListBox::create
95# ------------------------------------------------------------------------------
96proc ListBox::create { path args } {
97    Widget::init ListBox $path $args
98
99    variable $path
100    upvar 0  $path data
101
102    # widget informations
103    set data(nrows) -1
104
105    # items informations
106    set data(items)    {}
107    set data(selitems) {}
108
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)  {}
114
115    # drag and drop informations
116    set data(dnd,scroll)   ""
117    set data(dnd,afterid)  ""
118    set data(dnd,item)     ""
119
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]}] \
123        -xscrollincrement 8
124
125    bind $path <Configure> "ListBox::_resize  $path"
126    bind $path <Destroy>   "ListBox::_destroy $path"
127
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
130
131    rename $path ::$path:cmd
132    proc ::$path { cmd args } "return \[eval ListBox::\$cmd $path \$args\]"
133
134    return $path
135}
136
137
138# ------------------------------------------------------------------------------
139#  Command ListBox::configure
140# ------------------------------------------------------------------------------
141proc ListBox::configure { path args } {
142    set res [Widget::configure $path $args]
143
144    set ch1 [expr {[Widget::hasChanged $path -deltay dy]  |
145                   [Widget::hasChanged $path -padx val]   |
146                   [Widget::hasChanged $path -multicolumn val]}]
147
148    set ch2 [expr {[Widget::hasChanged $path -selectbackground val] |
149                   [Widget::hasChanged $path -selectforeground val]}]
150
151    set redraw 0
152    if { [Widget::hasChanged $path -height h] } {
153        $path:cmd configure -height [expr {$h*$dy}]
154        set redraw 1
155    }
156    if { [Widget::hasChanged $path -width w] } {
157        $path:cmd configure -width [expr {$w*8}]
158        set redraw 1
159    }
160
161    if { !$redraw } {
162        if { $ch1 } {
163            _redraw_idle $path 2
164        } elseif { $ch2 } {
165            _redraw_idle $path 1
166        }
167    }
168
169    if { [Widget::hasChanged $path -redraw bool] && $bool } {
170        variable $path
171        upvar 0  $path data
172        set lvl $data(upd,level)
173        set data(upd,level) 0
174        _redraw_idle $path $lvl
175    }
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
179
180    return $res
181}
182
183
184# ------------------------------------------------------------------------------
185#  Command ListBox::cget
186# ------------------------------------------------------------------------------
187proc ListBox::cget { path option } {
188    return [Widget::cget $path $option]
189}
190
191
192# ------------------------------------------------------------------------------
193#  Command ListBox::insert
194# ------------------------------------------------------------------------------
195proc ListBox::insert { path index item args } {
196    variable $path
197    upvar 0  $path data
198
199    if { [lsearch $data(items) $item] != -1 } {
200        return -code error "item \"$item\" already exists"
201    }
202
203    Widget::init ListBox::Item $path.$item $args
204
205    if { ![string compare $index "end"] } {
206        lappend data(items) $item
207    } else {
208        set data(items) [linsert $data(items) $index $item]
209    }
210    set data(upd,create,$item) $item
211
212    _redraw_idle $path 2
213    return $item
214}
215
216
217# ------------------------------------------------------------------------------
218#  Command ListBox::itemconfigure
219# ------------------------------------------------------------------------------
220proc ListBox::itemconfigure { path item args } {
221    variable $path
222    upvar 0  $path data
223
224    if { [lsearch $data(items) $item] == -1 } {
225        return -code error "item \"$item\" does not exist"
226    }
227
228    set oldind [Widget::getoption $path.$item -indent]
229
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]
238
239    if { $idn == "" } {
240        # item is not drawn yet
241        _redraw_idle $path 2
242        return $res
243    }
244
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
257            } else {
258                $path:cmd delete $idi
259                $path:cmd create window $x0 $y0 -window $win -anchor w -tags "win i:$item"
260            }
261        } elseif { [string length $img] } {
262            if { ![string compare $type "img"] } {
263                $path:cmd itemconfigure $idi -image $img
264            } else {
265                $path:cmd delete $idi
266                $path:cmd create image $x0 $y0 -image $img -anchor w -tags "img i:$item"
267            }
268        } else {
269            $path:cmd delete $idi
270        }
271    }
272
273    if { $cht || $chf || $chfg } {
274        # -text or -font modified, or -fill modified
275        $path:cmd itemconfigure $idn -text $txt -font $fnt -fill $fg
276        _redraw_idle $path 1
277    }
278
279    if { $chind } {
280        # -indent modified
281        $path:cmd coords $idn [expr {$x0+$padx}] $y0
282        $path:cmd coords i:$item $x0 $y0
283        _redraw_idle $path 1
284    }
285
286    if { [Widget::getoption $path -multicolumn] && ($cht || $chf || $chind) } {
287        set bbox [$path:cmd bbox $idn]
288        if { [lindex $bbox 2] > [lindex $oldb 2] } {
289            _redraw_idle $path 2
290        }
291    }
292
293    return $res
294}
295
296
297# ------------------------------------------------------------------------------
298#  Command ListBox::itemcget
299# ------------------------------------------------------------------------------
300proc ListBox::itemcget { path item option } {
301    return [Widget::cget $path.$item $option]
302}
303
304
305# ------------------------------------------------------------------------------
306#  Command ListBox::bindText
307# ------------------------------------------------------------------------------
308proc 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\]"
312    } else {
313        $path:cmd bind "item" $event {}
314    }
315}
316
317
318# ------------------------------------------------------------------------------
319#  Command ListBox::bindImage
320# ------------------------------------------------------------------------------
321proc 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\]"
325    } else {
326        $path:cmd bind "img" $event {}
327    }
328}
329
330
331# ------------------------------------------------------------------------------
332#  Command ListBox::delete
333# ------------------------------------------------------------------------------
334proc ListBox::delete { path args } {
335    variable $path
336    upvar 0  $path data
337
338    foreach litems $args {
339        foreach item $litems {
340            set idx [lsearch $data(items) $item]
341            if { $idx != -1 } {
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)
346                } else {
347                    lappend data(upd,delete) $item
348                }
349            }
350        }
351    }
352
353    set sel $data(selitems)
354    set data(selitems) {}
355    eval selection $path set $sel
356    _redraw_idle $path 2
357}
358
359
360# ------------------------------------------------------------------------------
361#  Command ListBox::move
362# ------------------------------------------------------------------------------
363proc ListBox::move { path item index } {
364    variable $path
365    upvar 0  $path data
366
367    if { [set idx [lsearch $data(items) $item]] == -1 } {
368        return -code error "item \"$item\" does not exist"
369    }
370
371    set data(items) [lreplace $data(items) $idx $idx]
372    if { ![string compare $index "end"] } {
373        lappend data($path,item) $item
374    } else {
375        set data(items) [linsert $data(items) $index $item]
376    }
377
378    _redraw_idle $path 2
379}
380
381
382# ------------------------------------------------------------------------------
383#  Command ListBox::reorder
384# ------------------------------------------------------------------------------
385proc ListBox::reorder { path neworder } {
386    variable $path
387    upvar 0  $path data
388
389    set data(items) [BWidget::lreorder $data(items) $neworder]
390    _redraw_idle $path 2
391}
392
393
394# ------------------------------------------------------------------------------
395#  Command ListBox::selection
396# ------------------------------------------------------------------------------
397proc ListBox::selection { path cmd args } {
398    variable $path
399    upvar 0  $path data
400
401    switch -- $cmd {
402        set {
403            set data(selitems) {}
404            foreach item $args {
405                if { [lsearch $data(selitems) $item] == -1 } {
406                    if { [lsearch $data(items) $item] != -1 } {
407                        lappend data(selitems) $item
408                    }
409                }
410            }
411        }
412        add {
413            foreach item $args {
414                if { [lsearch $data(selitems) $item] == -1 } {
415                    if { [lsearch $data(items) $item] != -1 } {
416                        lappend data(selitems) $item
417                    }
418                }
419            }
420        }
421        remove {
422            foreach item $args {
423                if { [set idx [lsearch $data(selitems) $item]] != -1 } {
424                    set data(selitems) [lreplace $data(selitems) $idx $idx]
425                }
426            }
427        }
428        clear {
429            set data(selitems) {}
430        }
431        get {
432            return $data(selitems)
433        }
434        default {
435            return
436        }
437    }
438    _redraw_idle $path 1
439}
440
441
442# ------------------------------------------------------------------------------
443#  Command ListBox::exists
444# ------------------------------------------------------------------------------
445proc ListBox::exists { path item } {
446    variable $path
447    upvar 0  $path data
448
449    return [expr {[lsearch $data(items) $item] != -1}]
450}
451
452
453# ------------------------------------------------------------------------------
454#  Command ListBox::index
455# ------------------------------------------------------------------------------
456proc ListBox::index { path item } {
457    variable $path
458    upvar 0  $path data
459
460    return [lsearch $data(items) $item]
461}
462
463
464# ------------------------------------------------------------------------------
465#  Command ListBox::item - deprecated
466# ------------------------------------------------------------------------------
467proc ListBox::item { path first {last ""} } {
468    variable $path
469    upvar 0  $path data
470
471    if { ![string length $last] } {
472        return [lindex $data(items) $first]
473    } else {
474        return [lrange $data(items) $first $last]
475    }
476}
477
478
479# ------------------------------------------------------------------------------
480#  Command ListBox::items
481# ------------------------------------------------------------------------------
482proc ListBox::items { path {first ""} {last ""}} {
483    variable $path
484    upvar 0  $path data
485
486    if { ![string length $first] } {
487        return $data(items)
488    }
489
490    if { ![string length $last] } {
491        return [lindex $data(items) $first]
492    } else {
493        return [lrange $data(items) $first $last]
494    }
495}
496
497
498# ------------------------------------------------------------------------------
499#  Command ListBox::see
500# ------------------------------------------------------------------------------
501proc ListBox::see { path item } {
502    variable $path
503    upvar 0  $path data
504
505    if { [Widget::getoption $path -redraw] && $data(upd,afterid) != "" } {
506        after cancel $data(upd,afterid)
507        _redraw_listbox $path
508    }
509    set idn [$path:cmd find withtag n:$item]
510    if { $idn != "" } {
511        ListBox::_see $path $idn right
512        ListBox::_see $path $idn left
513    }
514}
515
516
517# ------------------------------------------------------------------------------
518#  Command ListBox::edit
519# ------------------------------------------------------------------------------
520proc ListBox::edit { path item text {verifycmd ""} {clickres 0} {select 1}} {
521    variable _edit
522    variable $path
523    upvar 0  $path data
524
525    if { [Widget::getoption $path -redraw] && $data(upd,afterid) != "" } {
526        after cancel $data(upd,afterid)
527        _redraw_listbox $path
528    }
529    set idn [$path:cmd find withtag n:$item]
530    if { $idn != "" } {
531        ListBox::_see $path $idn right
532        ListBox::_see $path $idn left
533
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}]
542
543        $path:cmd itemconfigure $idn    -fill [Widget::getoption $path -background]
544        $path:cmd itemconfigure s:$item -fill {} -outline {}
545
546        set _edit(text) $text
547        set _edit(wait) 0
548
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 \
553                        -width              0     \
554                        -relief             solid \
555                        -borderwidth        1     \
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
564
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
568        grab  $frame
569        BWidget::focus set $ent
570        _update_edit_size $path $ent $idw $wmax
571        update
572        if { $select } {
573            $ent selection range 0 end
574            $ent icursor end
575            $ent xview end
576        }
577
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"
582        }
583
584        set ok 0
585        while { !$ok } {
586            tkwait variable ListBox::_edit(wait)
587            if { !$_edit(wait) || $verifycmd == "" ||
588                 [uplevel \#0 $verifycmd [list $_edit(text)]] } {
589                set ok 1
590            }
591        }
592        trace vdelete ListBox::_edit(text) w "ListBox::_update_edit_size $path $ent $idw $wmax"
593        grab release $frame
594        BWidget::focus release $ent
595        destroy $frame
596        $path:cmd delete $idw
597        $path:cmd itemconfigure $idn    -fill $oldfg
598        $path:cmd itemconfigure s:$item -fill $sbg -outline $sbg
599
600        if { $_edit(wait) } {
601            return $_edit(text)
602        }
603    }
604    return ""
605}
606
607
608# ------------------------------------------------------------------------------
609#  Command ListBox::xview
610# ------------------------------------------------------------------------------
611proc ListBox::xview { path args } {
612    return [eval $path:cmd xview $args]
613}
614
615
616# ------------------------------------------------------------------------------
617#  Command ListBox::yview
618# ------------------------------------------------------------------------------
619proc ListBox::yview { path args } {
620    return [eval $path:cmd yview $args]
621}
622
623
624# ------------------------------------------------------------------------------
625#  Command ListBox::_update_edit_size
626# ------------------------------------------------------------------------------
627proc 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
631    } else {
632        $path:cmd itemconfigure $idw -width 0
633    }
634}
635
636
637# ------------------------------------------------------------------------------
638#  Command ListBox::_destroy
639# ------------------------------------------------------------------------------
640proc ListBox::_destroy { path } {
641    variable $path
642    upvar 0  $path data
643
644    if { $data(upd,afterid) != "" } {
645        after cancel $data(upd,afterid)
646    }
647    if { $data(dnd,afterid) != "" } {
648        after cancel $data(dnd,afterid)
649    }
650    foreach item $data(items) {
651        Widget::destroy $path.$item
652    }
653
654    Widget::destroy $path
655    unset data
656    rename $path {}
657}
658
659
660# ------------------------------------------------------------------------------
661#  Command ListBox::_see
662# ------------------------------------------------------------------------------
663proc ListBox::_see { path idn side } {
664    set bbox [$path:cmd bbox $idn]
665    set scrl [$path:cmd cget -scrollregion]
666
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)}]
673    if { $y < $yv0 } {
674        $path:cmd yview scroll [expr {$y-$yv0}] units
675    } elseif { $y >= $yv1 } {
676        $path:cmd yview scroll [expr {$y-$yv1+1}] units
677    }
678
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)}]
685        if { $x1 >= $xv1 } {
686            $path:cmd xview scroll [expr {$x1-$xv1+1}] units
687        }
688    } else {
689        set xv0 [expr {round([lindex $xv 0]*$xmax/$dx)}]
690        set x0  [expr {int([lindex $bbox 0]/$dx)}]
691        if { $x0 < $xv0 } {
692            $path:cmd xview scroll [expr {$x0-$xv0}] units
693        }
694    }
695}
696
697
698# ------------------------------------------------------------------------------
699#  Command ListBox::_update_scrollregion
700# ------------------------------------------------------------------------------
701proc 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]
711
712        if { $w < $xs } {
713            set w [expr {int($xs)}]
714            if { [set r [expr {$w % $xinc}]] } {
715                set w [expr {$w+$xinc-$r}]
716            }
717        }
718        if { $h < $ys } {
719            set h [expr {int($ys)}]
720            if { [set r [expr {$h % $yinc}]] } {
721                set h [expr {$h+$yinc-$r}]
722            }
723        }
724    }
725
726    $path:cmd configure -scrollregion [list 0 0 $w $h]
727}
728
729
730# ------------------------------------------------------------------------------
731#  Command ListBox::_draw_item
732# ------------------------------------------------------------------------------
733proc 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] \
739        -anchor w \
740        -tags   "item n:$item"
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"
747    }
748}
749
750
751# ------------------------------------------------------------------------------
752#  Command ListBox::_redraw_items
753# ------------------------------------------------------------------------------
754proc ListBox::_redraw_items { path } {
755    variable $path
756    upvar 0  $path data
757
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}]
763    set x0   4
764    set x1   [expr {$x0+$padx}]
765    set nitem 0
766    set drawn {}
767    set data(xlist) {}
768    if { [Widget::getoption $path -multicolumn] } {
769        set nrows $data(nrows)
770    } else {
771        set nrows [llength $data(items)]
772    }
773    foreach item $data(upd,delete) {
774        $path:cmd delete i:$item n:$item s:$item
775    }
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)
780        } else {
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
784        }
785        incr y0 $dy
786        incr nitem
787        lappend drawn n:$item
788        if { $nitem == $nrows } {
789            set y0    [expr {$dy/2}]
790            set bbox  [eval $path:cmd bbox $drawn]
791            set drawn {}
792            set x0    [expr {[lindex $bbox 2]+$dx}]
793            set x1    [expr {$x0+$padx}]
794            set nitem 0
795            lappend data(xlist) [lindex $bbox 2]
796        }
797    }
798    if { $nitem && $nitem < $nrows } {
799        set bbox  [eval $path:cmd bbox $drawn]
800        lappend data(xlist) [lindex $bbox 2]
801    }
802    set data(upd,delete) {}
803    $path:cmd configure -cursor [Widget::getoption $path -cursor]
804}
805
806
807# ------------------------------------------------------------------------------
808#  Command ListBox::_redraw_selection
809# ------------------------------------------------------------------------------
810proc ListBox::_redraw_selection { path } {
811    variable $path
812    upvar 0  $path data
813
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]
819    }
820    $path:cmd delete sel
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
826            $path:cmd lower $id
827        }
828    }
829}
830
831
832# ------------------------------------------------------------------------------
833#  Command ListBox::_redraw_listbox
834# ------------------------------------------------------------------------------
835proc ListBox::_redraw_listbox { path } {
836    variable $path
837    upvar 0  $path data
838
839    if { [Widget::getoption $path -redraw] } {
840        if { $data(upd,level) == 2 } {
841            _redraw_items $path
842        }
843        _redraw_selection $path
844        _update_scrollregion $path
845        set data(upd,level)   0
846        set data(upd,afterid) ""
847    }
848}
849
850
851# ------------------------------------------------------------------------------
852#  Command ListBox::_redraw_idle
853# ------------------------------------------------------------------------------
854proc ListBox::_redraw_idle { path level } {
855    variable $path
856    upvar 0  $path data
857
858    if { $data(nrows) != -1 } {
859        # widget is realized
860        if { [Widget::getoption $path -redraw] && $data(upd,afterid) == "" } {
861            set data(upd,afterid) [after idle ListBox::_redraw_listbox $path]
862        }
863    }
864    if { $level > $data(upd,level) } {
865        set data(upd,level) $level
866    }
867    return ""
868}
869
870
871# ------------------------------------------------------------------------------
872#  Command ListBox::_resize
873# ------------------------------------------------------------------------------
874proc ListBox::_resize { path } {
875    variable $path
876    upvar 0  $path data
877
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]}]
882        if { $nrows == 0 } {
883            set nrows 1
884        }
885        if { $nrows != $data(nrows) } {
886            set data(nrows) $nrows
887            _redraw_idle $path 2
888        } else {
889            _update_scrollregion $path
890        }
891    } elseif { $data(nrows) == -1 } {
892        # first Configure event
893        set data(nrows) 0
894        ListBox::_redraw_listbox $path
895    } else {
896        _update_scrollregion $path
897    }
898}
899
900
901# ------------------------------------------------------------------------------
902#  Command ListBox::_init_drag_cmd
903# ------------------------------------------------------------------------------
904proc 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]]
913        }
914        if { [set type [Widget::getoption $path -dragtype]] == "" } {
915            set type "LISTBOX_ITEM"
916        }
917        if { [set img [Widget::getoption $path.$item -image]] != "" } {
918            pack [label $top.l -image $img -padx 0 -pady 0]
919        }
920        return [list $type {copy move link} $item]
921    }
922    return {}
923}
924
925
926# ------------------------------------------------------------------------------
927#  Command ListBox::_drop_cmd
928# ------------------------------------------------------------------------------
929proc ListBox::_drop_cmd { path source X Y op type dnddata } {
930    variable $path
931    upvar 0  $path data
932
933    if { [string length $data(dnd,afterid)] } {
934        after cancel $data(dnd,afterid)
935        set data(dnd,afterid) ""
936    }
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]]
942        }
943    }
944    return 0
945}
946
947
948# ------------------------------------------------------------------------------
949#  Command ListBox::_over_cmd
950# ------------------------------------------------------------------------------
951proc ListBox::_over_cmd { path source event X Y op type dnddata } {
952    variable $path
953    upvar 0  $path data
954
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) ""
961        }
962        set data(dnd,scroll) ""
963        return 0
964    }
965
966    if { ![string compare $event "enter"] } {
967        # we enter the window listbox - dnd data initialization
968        set mode [Widget::getoption $path -dropovermode]
969        set data(dnd,mode) 0
970        foreach c {w p i} {
971            set data(dnd,mode) [expr {($data(dnd,mode) << 1) | ([string first $c $mode] != -1)}]
972        }
973    }
974
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) ""
979
980    # test for auto-scroll unless mode is widget only
981    if { $data(dnd,mode) != 4 && [_auto_scroll $path $x $y] != "" } {
982        return 2
983    }
984
985    if { $data(dnd,mode) & 4 } {
986        # dropovermode includes widget
987        set target [list widget]
988        set vmode  4
989    } else {
990        set target [list ""]
991        set vmode  0
992    }
993
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}]
1004        set xi   0
1005        set pos  $line
1006        if { [Widget::getoption $path -multicolumn] } {
1007            set nrows $data(nrows)
1008        } else {
1009            set nrows $len
1010        }
1011        if { $line < $nrows } {
1012            foreach xs $data(xlist) {
1013                if { $xc <= $xs } {
1014                    break
1015                }
1016                set  xi  $xs
1017                incr pos $nrows
1018            }
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}]
1025                } else {
1026                    lappend target ""
1027                }
1028
1029                if { $data(dnd,mode) & 2 } {
1030                    # dropovermode includes position
1031                    if { $yc >= $yi+$dy/2 } {
1032                        # position is after $item
1033                        incr pos
1034                        set yl $ys
1035                    } else {
1036                        # position is before $item
1037                        set yl $yi
1038                    }
1039                    lappend target $pos
1040                    set vmode [expr {$vmode | 2}]
1041                } else {
1042                    lappend target ""
1043                }
1044            } else {
1045                lappend target "" ""
1046            }
1047        } else {
1048            lappend target "" ""
1049        }
1050
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"
1056            } else {
1057                lappend target "item"
1058            }
1059        }
1060    }
1061
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]
1066        set vmode 0
1067        if { $code & 1 } {
1068            # update vmode
1069            set mode [lindex $res 1]
1070            if { ![string compare $mode "item"] } {
1071                set vmode 1
1072            } elseif { ![string compare $mode "position"] } {
1073                set vmode 2
1074            } elseif { ![string compare $mode "widget"] } {
1075                set vmode 4
1076            }
1077        }
1078    } else {
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}]
1084            } else {
1085                set vmode [expr {$vmode & ~2}]
1086            }
1087        }
1088
1089        if { $data(dnd,mode) == 4 || $data(dnd,mode) == 0 } {
1090            # dropovermode is widget or empty - recall is not necessary
1091            set code 1
1092        } else {
1093            set code 3
1094        }
1095    }
1096
1097    # draw dnd visual following vmode
1098    if { $vmode & 1 } {
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"]
1106    } else {
1107        set code [expr {$code & 2}]
1108    }
1109
1110    if { $code & 1 } {
1111        DropSite::setcursor based_arrow_down
1112    } else {
1113        DropSite::setcursor dot
1114    }
1115    return $code
1116}
1117
1118
1119# ------------------------------------------------------------------------------
1120#  Command ListBox::_auto_scroll
1121# ------------------------------------------------------------------------------
1122proc ListBox::_auto_scroll { path x y } {
1123    variable $path
1124    upvar 0  $path data
1125
1126    set xmax   [winfo width  $path]
1127    set ymax   [winfo height $path]
1128    set scroll {}
1129    if { $y <= 6 } {
1130        if { [lindex [$path:cmd yview] 0] > 0 } {
1131            set scroll [list yview -1]
1132            DropSite::setcursor sb_up_arrow
1133        }
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
1138        }
1139    } elseif { $x <= 6 } {
1140        if { [lindex [$path:cmd xview] 0] > 0 } {
1141            set scroll [list xview -1]
1142            DropSite::setcursor sb_left_arrow
1143        }
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
1148        }
1149    }
1150
1151    if { [string length $data(dnd,afterid)] && [string compare $data(dnd,scroll) $scroll] } {
1152        after cancel $data(dnd,afterid)
1153        set data(dnd,afterid) ""
1154    }
1155
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]
1159    }
1160    return $data(dnd,afterid)
1161}
1162
1163
1164# ------------------------------------------------------------------------------
1165#  Command ListBox::_scroll
1166# ------------------------------------------------------------------------------
1167proc ListBox::_scroll { path cmd dir } {
1168    variable $path
1169    upvar 0  $path data
1170
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]
1175    } else {
1176        set data(dnd,afterid) ""
1177        DropSite::setcursor dot
1178    }
1179}
Note: See TracBrowser for help on using the repository browser.