home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / BWidget-1.2 / listbox.tcl < prev    next >
Text File  |  2000-11-02  |  39KB  |  1,161 lines
  1. # ------------------------------------------------------------------------------
  2. #  listbox.tcl
  3. #  This file is part of Unifix BWidget Toolkit
  4. #  $Id: listbox.tcl,v 1.1.1.1 1996/02/22 06:05:56 daniel 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::items
  22. #     - ListBox::see
  23. #     - ListBox::edit
  24. #     - ListBox::xview
  25. #     - ListBox::yview
  26. #     - ListBox::_update_edit_size
  27. #     - ListBox::_destroy
  28. #     - ListBox::_see
  29. #     - ListBox::_update_scrollregion
  30. #     - ListBox::_draw_item
  31. #     - ListBox::_redraw_items
  32. #     - ListBox::_redraw_selection
  33. #     - ListBox::_redraw_listbox
  34. #     - ListBox::_redraw_idle
  35. #     - ListBox::_resize
  36. #     - ListBox::_init_drag_cmd
  37. #     - ListBox::_drop_cmd
  38. #     - ListBox::_over_cmd
  39. #     - ListBox::_auto_scroll
  40. #     - ListBox::_scroll
  41. # ------------------------------------------------------------------------------
  42.  
  43.  
  44. namespace eval ListBox {
  45.     namespace eval Item {
  46.         Widget::declare ListBox::Item {
  47.             {-indent     Int        0       0 {=0}}
  48.             {-text       String     ""      0}
  49.             {-font       TkResource ""      0 listbox}
  50.             {-image      TkResource ""      0 label}
  51.             {-window     String     ""      0}
  52.             {-fill       TkResource black   0 {listbox -foreground}}
  53.             {-data       String     ""      0}
  54.         }
  55.     }
  56.  
  57.     Widget::tkinclude ListBox canvas :cmd \
  58.         remove     {-insertwidth -insertbackground -insertborderwidth -insertofftime \
  59.                         -insertontime -selectborderwidth -closeenough -confine -scrollregion \
  60.                         -xscrollincrement -yscrollincrement -width -height} \
  61.         initialize {-relief sunken -borderwidth 2 -takefocus 1 \
  62.                         -highlightthickness 1 -width 200}
  63.  
  64.     Widget::declare ListBox {
  65.         {-deltax           Int 10 0 {=0 ""}}
  66.         {-deltay           Int 15 0 {=0 ""}}
  67.         {-padx             Int 20 0 {=0 ""}}
  68.         {-background       TkResource "" 0 listbox}
  69.         {-selectbackground TkResource "" 0 listbox}
  70.         {-selectforeground TkResource "" 0 listbox}
  71.         {-width            TkResource "" 0 listbox}
  72.         {-height           TkResource "" 0 listbox}
  73.         {-redraw           Boolean 1  0}
  74.         {-multicolumn      Boolean 0  0}
  75.         {-dropovermode     Flag    "wpi" 0 "wpi"}
  76.         {-bg               Synonym -background}
  77.     }
  78.     DragSite::include ListBox "LISTBOX_ITEM" 1
  79.     DropSite::include ListBox {
  80.         LISTBOX_ITEM {copy {} move {}}
  81.     }
  82.  
  83.     Widget::addmap ListBox "" :cmd {-deltay -yscrollincrement}
  84.  
  85.     proc ::ListBox { path args } { return [eval ListBox::create $path $args] }
  86.     proc use {} {}
  87.  
  88.     variable _edit
  89. }
  90.  
  91.  
  92. # ------------------------------------------------------------------------------
  93. #  Command ListBox::create
  94. # ------------------------------------------------------------------------------
  95. proc ListBox::create { path args } {
  96.     Widget::init ListBox $path $args
  97.  
  98.     variable $path
  99.     upvar 0  $path data
  100.  
  101.     # widget informations
  102.     set data(nrows) -1
  103.  
  104.     # items informations
  105.     set data(items)    {}
  106.     set data(selitems) {}
  107.  
  108.     # update informations
  109.     set data(upd,level)   0
  110.     set data(upd,afterid) ""
  111.     set data(upd,level)   0
  112.     set data(upd,delete)  {}
  113.  
  114.     # drag and drop informations
  115.     set data(dnd,scroll)   ""
  116.     set data(dnd,afterid)  ""
  117.     set data(dnd,item)     ""
  118.  
  119.     eval canvas $path [Widget::subcget $path :cmd] \
  120.         -width  [expr {[Widget::getoption $path -width]*8}] \
  121.         -height [expr {[Widget::getoption $path -height]*[Widget::getoption $path -deltay]}] \
  122.         -xscrollincrement 8
  123.  
  124.     bind $path <Configure> "ListBox::_resize  $path"
  125.     bind $path <Destroy>   "ListBox::_destroy $path"
  126.  
  127.     DragSite::setdrag $path $path ListBox::_init_drag_cmd [Widget::getoption $path -dragendcmd] 1
  128.     DropSite::setdrop $path $path ListBox::_over_cmd ListBox::_drop_cmd 1
  129.  
  130.     rename $path ::$path:cmd
  131.     proc ::$path { cmd args } "return \[eval ListBox::\$cmd $path \$args\]"
  132.  
  133.     return $path
  134. }
  135.  
  136.  
  137. # ------------------------------------------------------------------------------
  138. #  Command ListBox::configure
  139. # ------------------------------------------------------------------------------
  140. proc ListBox::configure { path args } {
  141.     set res [Widget::configure $path $args]
  142.  
  143.     set ch1 [expr {[Widget::hasChanged $path -deltay dy]  |
  144.                    [Widget::hasChanged $path -padx val]   |
  145.                    [Widget::hasChanged $path -multicolumn val]}]
  146.  
  147.     set ch2 [expr {[Widget::hasChanged $path -selectbackground val] |
  148.                    [Widget::hasChanged $path -selectforeground val]}]
  149.  
  150.     set redraw 0
  151.     if { [Widget::hasChanged $path -height h] } {
  152.         $path:cmd configure -height [expr {$h*$dy}]
  153.         set redraw 1
  154.     }
  155.     if { [Widget::hasChanged $path -width w] } {
  156.         $path:cmd configure -width [expr {$w*8}]
  157.         set redraw 1
  158.     }
  159.  
  160.     if { !$redraw } {
  161.         if { $ch1 } {
  162.             _redraw_idle $path 2
  163.         } elseif { $ch2 } {
  164.             _redraw_idle $path 1
  165.         }
  166.     }
  167.  
  168.     if { [Widget::hasChanged $path -redraw bool] && $bool } {
  169.         variable $path
  170.         upvar 0  $path data
  171.         set lvl $data(upd,level)
  172.         set data(upd,level) 0
  173.         _redraw_idle $path $lvl
  174.     }
  175.     set force [Widget::hasChanged $path -dragendcmd dragend]
  176.     DragSite::setdrag $path $path ListBox::_init_drag_cmd $dragend $force
  177.     DropSite::setdrop $path $path ListBox::_over_cmd ListBox::_drop_cmd
  178.  
  179.     return $res
  180. }
  181.  
  182.  
  183. # ------------------------------------------------------------------------------
  184. #  Command ListBox::cget
  185. # ------------------------------------------------------------------------------
  186. proc ListBox::cget { path option } {
  187.     return [Widget::cget $path $option]
  188. }
  189.  
  190.  
  191. # ------------------------------------------------------------------------------
  192. #  Command ListBox::insert
  193. # ------------------------------------------------------------------------------
  194. proc ListBox::insert { path index item args } {
  195.     variable $path
  196.     upvar 0  $path data
  197.  
  198.     if { [lsearch $data(items) $item] != -1 } {
  199.         return -code error "item \"$item\" already exists"
  200.     }
  201.  
  202.     Widget::init ListBox::Item $path.$item $args
  203.  
  204.     if { ![string compare $index "end"] } {
  205.         lappend data(items) $item
  206.     } else {
  207.         set data(items) [linsert $data(items) $index $item]
  208.     }
  209.     set data(upd,create,$item) $item
  210.  
  211.     _redraw_idle $path 2
  212.     return $item
  213. }
  214.  
  215.  
  216. # ------------------------------------------------------------------------------
  217. #  Command ListBox::itemconfigure
  218. # ------------------------------------------------------------------------------
  219. proc ListBox::itemconfigure { path item args } {
  220.     variable $path
  221.     upvar 0  $path data
  222.  
  223.     if { [lsearch $data(items) $item] == -1 } {
  224.         return -code error "item \"$item\" does not exist"
  225.     }
  226.  
  227.     set oldind [Widget::getoption $path.$item -indent]
  228.  
  229.     set res   [Widget::configure $path.$item $args]
  230.     set chind [Widget::hasChanged $path.$item -indent indent]
  231.     set chw   [Widget::hasChanged $path.$item -window win]
  232.     set chi   [Widget::hasChanged $path.$item -image  img]
  233.     set cht   [Widget::hasChanged $path.$item -text txt]
  234.     set chf   [Widget::hasChanged $path.$item -font fnt]
  235.     set chfg  [Widget::hasChanged $path.$item -fill fg]
  236.     set idn   [$path:cmd find withtag n:$item]
  237.  
  238.     if { $idn == "" } {
  239.         # item is not drawn yet
  240.         _redraw_idle $path 2
  241.         return $res
  242.     }
  243.  
  244.     set oldb   [$path:cmd bbox $idn]
  245.     set coords [$path:cmd coords $idn]
  246.     set padx   [Widget::getoption $path -padx]
  247.     set x0     [expr {[lindex $coords 0]-$padx-$oldind+$indent}]
  248.     set y0     [lindex $coords 1]
  249.     if { $chw || $chi } {
  250.         # -window or -image modified
  251.         set idi  [$path:cmd find withtag i:$item]
  252.         set type [lindex [$path:cmd gettags $idi] 0]
  253.         if { [string length $win] } {
  254.             if { ![string compare $type "win"] } {
  255.                 $path:cmd itemconfigure $idi -window $win
  256.             } else {
  257.                 $path:cmd delete $idi
  258.                 $path:cmd create window $x0 $y0 -window $win -anchor w -tags "win i:$item"
  259.             }
  260.         } elseif { [string length $img] } {
  261.             if { ![string compare $type "img"] } {
  262.                 $path:cmd itemconfigure $idi -image $img
  263.             } else {
  264.                 $path:cmd delete $idi
  265.                 $path:cmd create image $x0 $y0 -image $img -anchor w -tags "img i:$item"
  266.             }
  267.         } else {
  268.             $path:cmd delete $idi
  269.         }
  270.     }
  271.  
  272.     if { $cht || $chf || $chfg } {
  273.         # -text or -font modified, or -fill modified
  274.         $path:cmd itemconfigure $idn -text $txt -font $fnt -fill $fg
  275.         _redraw_idle $path 1
  276.     }
  277.  
  278.     if { $chind } {
  279.         # -indent modified
  280.         $path:cmd coords $idn [expr {$x0+$padx}] $y0
  281.         $path:cmd coords i:$item $x0 $y0
  282.         _redraw_idle $path 1
  283.     }
  284.  
  285.     if { [Widget::getoption $path -multicolumn] && ($cht || $chf || $chind) } {
  286.         set bbox [$path:cmd bbox $idn]
  287.         if { [lindex $bbox 2] > [lindex $oldb 2] } {
  288.             _redraw_idle $path 2
  289.         }
  290.     }
  291.  
  292.     return $res
  293. }
  294.  
  295.  
  296. # ------------------------------------------------------------------------------
  297. #  Command ListBox::itemcget
  298. # ------------------------------------------------------------------------------
  299. proc ListBox::itemcget { path item option } {
  300.     return [Widget::cget $path.$item $option]
  301. }
  302.  
  303.  
  304. # ------------------------------------------------------------------------------
  305. #  Command ListBox::bindText
  306. # ------------------------------------------------------------------------------
  307. proc ListBox::bindText { path event script } {
  308.     if { $script != "" } {
  309.         $path:cmd bind "item" $event \
  310.             "$script \[string range \[lindex \[$path:cmd gettags current\] 1\] 2 end\]"
  311.     } else {
  312.         $path:cmd bind "item" $event {}
  313.     }
  314. }
  315.  
  316.  
  317. # ------------------------------------------------------------------------------
  318. #  Command ListBox::bindImage
  319. # ------------------------------------------------------------------------------
  320. proc ListBox::bindImage { path event script } {
  321.     if { $script != "" } {
  322.         $path:cmd bind "img" $event \
  323.             "$script \[string range \[lindex \[$path:cmd gettags current\] 1\] 2 end\]"
  324.     } else {
  325.         $path:cmd bind "img" $event {}
  326.     }
  327. }
  328.  
  329.  
  330. # ------------------------------------------------------------------------------
  331. #  Command ListBox::delete
  332. # ------------------------------------------------------------------------------
  333. proc ListBox::delete { path args } {
  334.     variable $path
  335.     upvar 0  $path data
  336.  
  337.     foreach litems $args {
  338.         foreach item $litems {
  339.             set idx [lsearch $data(items) $item]
  340.             if { $idx != -1 } {
  341.                 set data(items) [lreplace $data(items) $idx $idx]
  342.                 Widget::destroy $path.$item
  343.                 if { [info exists data(upd,create,$item)] } {
  344.                     unset data(upd,create,$item)
  345.                 } else {
  346.                     lappend data(upd,delete) $item
  347.                 }
  348.             }
  349.         }
  350.     }
  351.  
  352.     set sel $data(selitems)
  353.     set data(selitems) {}
  354.     eval selection $path set $sel
  355.     _redraw_idle $path 2
  356. }
  357.  
  358.  
  359. # ------------------------------------------------------------------------------
  360. #  Command ListBox::move
  361. # ------------------------------------------------------------------------------
  362. proc ListBox::move { path item index } {
  363.     variable $path
  364.     upvar 0  $path data
  365.  
  366.     if { [set idx [lsearch $data(items) $item]] == -1 } {
  367.         return -code error "item \"$item\" does not exist"
  368.     }
  369.  
  370.     set data(items) [lreplace $data(items) $idx $idx]
  371.     if { ![string compare $index "end"] } {
  372.         lappend data($path,item) $item
  373.     } else {
  374.         set data(items) [linsert $data(items) $index $item]
  375.     }
  376.  
  377.     _redraw_idle $path 2
  378. }
  379.  
  380.  
  381. # ------------------------------------------------------------------------------
  382. #  Command ListBox::reorder
  383. # ------------------------------------------------------------------------------
  384. proc ListBox::reorder { path neworder } {
  385.     variable $path
  386.     upvar 0  $path data
  387.  
  388.     set data(items) [BWidget::lreorder $data(items) $neworder]
  389.     _redraw_idle $path 2
  390. }
  391.  
  392.  
  393. # ------------------------------------------------------------------------------
  394. #  Command ListBox::selection
  395. # ------------------------------------------------------------------------------
  396. proc ListBox::selection { path cmd args } {
  397.     variable $path
  398.     upvar 0  $path data
  399.  
  400.     switch -- $cmd {
  401.         set {
  402.             set data(selitems) {}
  403.             foreach item $args {
  404.                 if { [lsearch $data(selitems) $item] == -1 } {
  405.                     if { [lsearch $data(items) $item] != -1 } {
  406.                         lappend data(selitems) $item
  407.                     }
  408.                 }
  409.             }
  410.         }
  411.         add {
  412.             foreach item $args {
  413.                 if { [lsearch $data(selitems) $item] == -1 } {
  414.                     if { [lsearch $data(items) $item] != -1 } {
  415.                         lappend data(selitems) $item
  416.                     }
  417.                 }
  418.             }
  419.         }
  420.         remove {
  421.             foreach item $args {
  422.                 if { [set idx [lsearch $data(selitems) $item]] != -1 } {
  423.                     set data(selitems) [lreplace $data(selitems) $idx $idx]
  424.                 }
  425.             }
  426.         }
  427.         clear {
  428.             set data(selitems) {}
  429.         }
  430.         get {
  431.             return $data(selitems)
  432.         }
  433.         default {
  434.             return
  435.         }
  436.     }
  437.     _redraw_idle $path 1
  438. }
  439.  
  440.  
  441. # ------------------------------------------------------------------------------
  442. #  Command ListBox::exists
  443. # ------------------------------------------------------------------------------
  444. proc ListBox::exists { path item } {
  445.     variable $path
  446.     upvar 0  $path data
  447.  
  448.     return [expr {[lsearch $data(items) $item] != -1}]
  449. }
  450.  
  451.  
  452. # ------------------------------------------------------------------------------
  453. #  Command ListBox::index
  454. # ------------------------------------------------------------------------------
  455. proc ListBox::index { path item } {
  456.     variable $path
  457.     upvar 0  $path data
  458.  
  459.     return [lsearch $data(items) $item]
  460. }
  461.  
  462.  
  463. proc ListBox::item { path first {last ""} } {
  464.     variable $path
  465.     upvar 0  $path data
  466.  
  467.     if { ![string length $last] } {
  468.         return [lindex $data(items) $first]
  469.     } else {
  470.         return [lrange $data(items) $first $last]
  471.     }
  472. }
  473.  
  474.  
  475. # ------------------------------------------------------------------------------
  476. #  Command ListBox::items
  477. # ------------------------------------------------------------------------------
  478. proc ListBox::items { path } {
  479.     variable $path
  480.     upvar 0  $path data
  481.  
  482.     return $data(items)
  483. }
  484.  
  485.  
  486. # ------------------------------------------------------------------------------
  487. #  Command ListBox::see
  488. # ------------------------------------------------------------------------------
  489. proc ListBox::see { path item } {
  490.     set idn [$path:cmd find withtag n:$item]
  491.     if { $idn != "" } {
  492.         ListBox::_see $path $idn left
  493.     }
  494. }
  495.  
  496.  
  497. # ------------------------------------------------------------------------------
  498. #  Command ListBox::edit
  499. # ------------------------------------------------------------------------------
  500. proc ListBox::edit { path item text {verifycmd ""} {clickres 0} {select 1}} {
  501.     variable _edit
  502.  
  503.     set idn [$path:cmd find withtag n:$item]
  504.     if { $idn != "" } {
  505.         ListBox::_see $path $idn right
  506.         ListBox::_see $path $idn left
  507.  
  508.         set oldfg  [$path:cmd itemcget $idn -fill]
  509.         set sbg    [Widget::getoption $path -selectbackground]
  510.         set coords [$path:cmd coords $idn]
  511.         set x      [lindex $coords 0]
  512.         set y      [lindex $coords 1]
  513.         set bd     [expr {[$path:cmd cget -borderwidth]+[$path:cmd cget -highlightthickness]}]
  514.         set w      [expr {[winfo width $path] - 2*$bd}]
  515.         set wmax   [expr {[$path:cmd canvasx $w]-$x}]
  516.  
  517.     $path:cmd itemconfigure $idn    -fill [Widget::getoption $path -background]
  518.         $path:cmd itemconfigure s:$item -fill {} -outline {}
  519.  
  520.         set _edit(text) $text
  521.         set _edit(wait) 0
  522.  
  523.         set frame  [frame $path.edit \
  524.                         -relief flat -borderwidth 0 -highlightthickness 0 \
  525.                         -background [Widget::getoption $path -background]]
  526.         set ent    [entry $frame.edit \
  527.                         -width              0     \
  528.                         -relief             solid \
  529.                         -borderwidth        1     \
  530.                         -highlightthickness 0     \
  531.                         -foreground         [Widget::getoption $path.$item -fill] \
  532.                         -background         [Widget::getoption $path -background] \
  533.                         -selectforeground   [Widget::getoption $path -selectforeground] \
  534.                         -selectbackground   $sbg  \
  535.                         -font               [Widget::getoption $path.$item -font] \
  536.                         -textvariable       ListBox::_edit(text)]
  537.         pack $ent -ipadx 8 -anchor w
  538.  
  539.         set idw [$path:cmd create window $x $y -window $frame -anchor w]
  540.         trace variable ListBox::_edit(text) w "ListBox::_update_edit_size $path $ent $idw $wmax"
  541.         tkwait visibility $ent
  542.         grab  $frame
  543.         BWidget::focus set $ent
  544.         _update_edit_size $path $ent $idw $wmax
  545.         update
  546.         if { $select } {
  547.             $ent selection from 0
  548.             $ent selection to   end
  549.             $ent icursor end
  550.             $ent xview end
  551.         }
  552.  
  553.         bind $ent <Escape> {set ListBox::_edit(wait) 0}
  554.         bind $ent <Return> {set ListBox::_edit(wait) 1}
  555.     if { $clickres == 0 || $clickres == 1 } {
  556.         bind $frame <Button>  "set ListBox::_edit(wait) $clickres"
  557.     }
  558.  
  559.         set ok 0
  560.         while { !$ok } {
  561.             tkwait variable ListBox::_edit(wait)
  562.             if { !$_edit(wait) || $verifycmd == "" ||
  563.                  [uplevel \#0 $verifycmd [list $_edit(text)]] } {
  564.                 set ok 1
  565.             }
  566.         }
  567.         trace vdelete ListBox::_edit(text) w "ListBox::_update_edit_size $path $ent $idw $wmax"
  568.         grab release $frame
  569.         BWidget::focus release $ent
  570.         destroy $frame
  571.         $path:cmd delete $idw
  572.         $path:cmd itemconfigure $idn    -fill $oldfg
  573.         $path:cmd itemconfigure s:$item -fill $sbg -outline $sbg
  574.  
  575.         if { $_edit(wait) } {
  576.             return $_edit(text)
  577.         }
  578.     }
  579.     return ""
  580. }
  581.  
  582.  
  583. # ------------------------------------------------------------------------------
  584. #  Command ListBox::xview
  585. # ------------------------------------------------------------------------------
  586. proc ListBox::xview { path args } {
  587.     return [eval $path:cmd xview $args]
  588. }
  589.  
  590.  
  591. # ------------------------------------------------------------------------------
  592. #  Command ListBox::yview
  593. # ------------------------------------------------------------------------------
  594. proc ListBox::yview { path args } {
  595.     return [eval $path:cmd yview $args]
  596. }
  597.  
  598.  
  599. # ------------------------------------------------------------------------------
  600. #  Command ListBox::_update_edit_size
  601. # ------------------------------------------------------------------------------
  602. proc ListBox::_update_edit_size { path entry idw wmax args } {
  603.     set entw [winfo reqwidth $entry]
  604.     if { $entw >= $wmax } {
  605.         $path:cmd itemconfigure $idw -width $wmax
  606.     } else {
  607.         $path:cmd itemconfigure $idw -width 0
  608.     }
  609. }
  610.  
  611.  
  612. # ------------------------------------------------------------------------------
  613. #  Command ListBox::_destroy
  614. # ------------------------------------------------------------------------------
  615. proc ListBox::_destroy { path } {
  616.     variable $path
  617.     upvar 0  $path data
  618.  
  619.     if { $data(upd,afterid) != "" } {
  620.         after cancel $data(upd,afterid)
  621.     }
  622.     if { $data(dnd,afterid) != "" } {
  623.         after cancel $data(dnd,afterid)
  624.     }
  625.     foreach item $data(items) {
  626.         Widget::destroy $path.$item
  627.     }
  628.  
  629.     Widget::destroy $path
  630.     unset data
  631.     rename $path {}
  632. }
  633.  
  634.  
  635. # ------------------------------------------------------------------------------
  636. #  Command ListBox::_see
  637. # ------------------------------------------------------------------------------
  638. proc ListBox::_see { path idn side } {
  639.     set bbox [$path:cmd bbox $idn]
  640.     set scrl [$path:cmd cget -scrollregion]
  641.  
  642.     set ymax [lindex $scrl 3]
  643.     set dy   [$path:cmd cget -yscrollincrement]
  644.     set yv   [$path:cmd yview]
  645.     set yv0  [expr {round([lindex $yv 0]*$ymax/$dy)}]
  646.     set yv1  [expr {round([lindex $yv 1]*$ymax/$dy)}]
  647.     set y    [expr {int([lindex [$path:cmd coords $idn] 1]/$dy)}]
  648.     if { $y < $yv0 } {
  649.         $path:cmd yview scroll [expr {$y-$yv0}] units
  650.     } elseif { $y >= $yv1 } {
  651.         $path:cmd yview scroll [expr {$y-$yv1+1}] units
  652.     }
  653.  
  654.     set xmax [lindex $scrl 2]
  655.     set dx   [$path:cmd cget -xscrollincrement]
  656.     set xv   [$path:cmd xview]
  657.     if { ![string compare $side "right"] } {
  658.         set xv1 [expr {round([lindex $xv 1]*$xmax/$dx)}]
  659.         set x1  [expr {int([lindex $bbox 2]/$dx)}]
  660.         if { $x1 >= $xv1 } {
  661.             $path:cmd xview scroll [expr {$x1-$xv1+1}] units
  662.         }
  663.     } else {
  664.         set xv0 [expr {round([lindex $xv 0]*$xmax/$dx)}]
  665.         set x0  [expr {int([lindex $bbox 0]/$dx)}]
  666.         if { $x0 < $xv0 } {
  667.             $path:cmd xview scroll [expr {$x0-$xv0}] units
  668.         }
  669.     }
  670. }
  671.  
  672.  
  673. # ------------------------------------------------------------------------------
  674. #  Command ListBox::_update_scrollregion
  675. # ------------------------------------------------------------------------------
  676. proc ListBox::_update_scrollregion { path } {
  677.     set bd   [expr {2*([$path:cmd cget -borderwidth]+[$path:cmd cget -highlightthickness])}]
  678.     set w    [expr {[winfo width  $path] - $bd}]
  679.     set h    [expr {[winfo height $path] - $bd}]
  680.     set xinc [$path:cmd cget -xscrollincrement]
  681.     set yinc [$path:cmd cget -yscrollincrement]
  682.     set bbox [$path:cmd bbox all]
  683.     if { [llength $bbox] } {
  684.         set xs [lindex $bbox 2]
  685.         set ys [lindex $bbox 3]
  686.  
  687.         if { $w < $xs } {
  688.             set w [expr {int($xs)}]
  689.             if { [set r [expr {$w % $xinc}]] } {
  690.                 set w [expr {$w+$xinc-$r}]
  691.             }
  692.         }
  693.         if { $h < $ys } {
  694.             set h [expr {int($ys)}]
  695.             if { [set r [expr {$h % $yinc}]] } {
  696.                 set h [expr {$h+$yinc-$r}]
  697.             }
  698.         }
  699.     }
  700.  
  701.     $path:cmd configure -scrollregion [list 0 0 $w $h]
  702. }
  703.  
  704.  
  705. # ------------------------------------------------------------------------------
  706. #  Command ListBox::_draw_item
  707. # ------------------------------------------------------------------------------
  708. proc ListBox::_draw_item { path item x0 x1 y } {
  709.     set indent [Widget::getoption $path.$item -indent]
  710.     $path:cmd create text [expr {$x1+$indent}] $y \
  711.         -text   [Widget::getoption $path.$item -text] \
  712.         -fill   [Widget::getoption $path.$item -fill] \
  713.         -font   [Widget::getoption $path.$item -font] \
  714.         -anchor w \
  715.         -tags   "item n:$item"
  716.     if { [set win [Widget::getoption $path.$item -window]] != "" } {
  717.         $path:cmd create window [expr {$x0+$indent}] $y \
  718.             -window $win -anchor w -tags "win i:$item"
  719.     } elseif { [set img [Widget::getoption $path.$item -image]] != "" } {
  720.         $path:cmd create image [expr {$x0+$indent}] $y \
  721.             -image $img -anchor w -tags "img i:$item"
  722.     }
  723. }
  724.  
  725.  
  726. # ------------------------------------------------------------------------------
  727. #  Command ListBox::_redraw_items
  728. # ------------------------------------------------------------------------------
  729. proc ListBox::_redraw_items { path } {
  730.     variable $path
  731.     upvar 0  $path data
  732.  
  733.     $path:cmd configure -cursor watch
  734.     set dx   [Widget::getoption $path -deltax]
  735.     set dy   [Widget::getoption $path -deltay]
  736.     set padx [Widget::getoption $path -padx]
  737.     set y0   [expr {$dy/2}]
  738.     set x0   4
  739.     set x1   [expr {$x0+$padx}]
  740.     set nitem 0
  741.     set drawn {}
  742.     set data(xlist) {}
  743.     if { [Widget::getoption $path -multicolumn] } {
  744.         set nrows $data(nrows)
  745.     } else {
  746.         set nrows [llength $data(items)]
  747.     }
  748.     foreach item $data(upd,delete) {
  749.         $path:cmd delete i:$item n:$item s:$item
  750.     }
  751.     foreach item $data(items) {
  752.         if { [info exists data(upd,create,$item)] } {
  753.             _draw_item $path $item $x0 $x1 $y0
  754.             unset data(upd,create,$item)
  755.         } else {
  756.             set indent [Widget::getoption $path.$item -indent]
  757.             $path:cmd coords n:$item [expr {$x1+$indent}] $y0
  758.             $path:cmd coords i:$item [expr {$x0+$indent}] $y0
  759.         }
  760.         incr y0 $dy
  761.         incr nitem
  762.         lappend drawn n:$item
  763.         if { $nitem == $nrows } {
  764.             set y0    [expr {$dy/2}]
  765.             set bbox  [eval $path:cmd bbox $drawn]
  766.             set drawn {}
  767.             set x0    [expr {[lindex $bbox 2]+$dx}]
  768.             set x1    [expr {$x0+$padx}]
  769.             set nitem 0
  770.             lappend data(xlist) [lindex $bbox 2]
  771.         }
  772.     }
  773.     if { $nitem && $nitem < $nrows } {
  774.         set bbox  [eval $path:cmd bbox $drawn]
  775.         lappend data(xlist) [lindex $bbox 2]
  776.     }
  777.     set data(upd,delete) {}
  778.     $path:cmd configure -cursor [Widget::getoption $path -cursor]
  779. }
  780.  
  781.  
  782. # ------------------------------------------------------------------------------
  783. #  Command ListBox::_redraw_selection
  784. # ------------------------------------------------------------------------------
  785. proc ListBox::_redraw_selection { path } {
  786.     variable $path
  787.     upvar 0  $path data
  788.  
  789.     set selbg [Widget::getoption $path -selectbackground]
  790.     set selfg [Widget::getoption $path -selectforeground]
  791.     foreach id [$path:cmd find withtag sel] {
  792.         set item [string range [lindex [$path:cmd gettags $id] 1] 2 end]
  793.         $path:cmd itemconfigure "n:$item" -fill [Widget::getoption $path.$item -fill]
  794.     }
  795.     $path:cmd delete sel
  796.     foreach item $data(selitems) {
  797.         set bbox [$path:cmd bbox "n:$item"]
  798.         set w  [expr [winfo width $path] - 4  ]
  799.     set bbox [list [$path:cmd canvasx 4] [lindex $bbox 1] \
  800.     [$path:cmd canvasx $w] [lindex $bbox 3]]
  801.     
  802.     # Change bbox to fill 
  803.     
  804.         if { [llength $bbox] } {
  805.             set id [eval $path:cmd create rectangle $bbox -fill $selbg -outline $selbg -tags [list "sel s:$item"]]
  806.             $path:cmd itemconfigure "n:$item" -fill $selfg
  807.             $path:cmd lower $id
  808.         }
  809.     }
  810. }
  811.  
  812.  
  813. # ------------------------------------------------------------------------------
  814. #  Command ListBox::_redraw_listbox
  815. # ------------------------------------------------------------------------------
  816. proc ListBox::_redraw_listbox { path } {
  817.     variable $path
  818.     upvar 0  $path data
  819.  
  820.     if { [Widget::getoption $path -redraw] } {
  821.         if { $data(upd,level) == 2 } {
  822.             _redraw_items $path
  823.         }
  824.         _redraw_selection $path
  825.         _update_scrollregion $path
  826.         set data(upd,level)   0
  827.         set data(upd,afterid) ""
  828.     }
  829. }
  830.  
  831.  
  832. # ------------------------------------------------------------------------------
  833. #  Command ListBox::_redraw_idle
  834. # ------------------------------------------------------------------------------
  835. proc ListBox::_redraw_idle { path level } {
  836.     variable $path
  837.     upvar 0  $path data
  838.  
  839.     if { $data(nrows) != -1 } {
  840.         # widget is realized
  841.         if { [Widget::getoption $path -redraw] && $data(upd,afterid) == "" } {
  842.             set data(upd,afterid) [after idle ListBox::_redraw_listbox $path]
  843.         }
  844.     }
  845.     if { $level > $data(upd,level) } {
  846.         set data(upd,level) $level
  847.     }
  848.     return ""
  849. }
  850.  
  851.  
  852. # ------------------------------------------------------------------------------
  853. #  Command ListBox::_resize
  854. # ------------------------------------------------------------------------------
  855. proc ListBox::_resize { path } {
  856.     variable $path
  857.     upvar 0  $path data
  858.  
  859.     if { [Widget::getoption $path -multicolumn] } {
  860.         set bd    [expr {[$path:cmd cget -borderwidth]+[$path:cmd cget -highlightthickness]}]
  861.         set h     [expr {[winfo height $path] - 2*$bd}]
  862.         set nrows [expr {$h/[$path:cmd cget -yscrollincrement]}]
  863.         if { $nrows == 0 } {
  864.             set nrows 1
  865.         }
  866.         if { $nrows != $data(nrows) } {
  867.             set data(nrows) $nrows
  868.             _redraw_idle $path 2
  869.         } else {
  870.             _update_scrollregion $path
  871.         }
  872.     } elseif { $data(nrows) == -1 } {
  873.         # first Configure event
  874.         set data(nrows) 0
  875.         ListBox::_redraw_listbox $path
  876.     } else {
  877.         _update_scrollregion $path
  878.     }
  879. }
  880.  
  881.  
  882. # ------------------------------------------------------------------------------
  883. #  Command ListBox::_init_drag_cmd
  884. # ------------------------------------------------------------------------------
  885. proc ListBox::_init_drag_cmd { path X Y top } {
  886.     set ltags [$path:cmd gettags current]
  887.     set item  [lindex $ltags 0]
  888.     if { ![string compare $item "item"] ||
  889.          ![string compare $item "img"]  ||
  890.          ![string compare $item "win"] } {
  891.         set item [string range [lindex $ltags 1] 2 end]
  892.         if { [set cmd [Widget::getoption $path -draginitcmd]] != "" } {
  893.             return [uplevel \#0 $cmd [list $path $item $top]]
  894.         }
  895.         if { [set type [Widget::getoption $path -dragtype]] == "" } {
  896.             set type "LISTBOX_ITEM"
  897.         }
  898.         if { [set img [Widget::getoption $path.$item -image]] != "" } {
  899.             pack [label $top.l -image $img -padx 0 -pady 0]
  900.         }
  901.         return [list $type {copy move link} $item]
  902.     }
  903.     return {}
  904. }
  905.  
  906.  
  907. # ------------------------------------------------------------------------------
  908. #  Command ListBox::_drop_cmd
  909. # ------------------------------------------------------------------------------
  910. proc ListBox::_drop_cmd { path source X Y op type dnddata } {
  911.     variable $path
  912.     upvar 0  $path data
  913.  
  914.     if { [string length $data(dnd,afterid)] } {
  915.         after cancel $data(dnd,afterid)
  916.         set data(dnd,afterid) ""
  917.     }
  918.     $path:cmd delete drop
  919.     set data(dnd,scroll) ""
  920.     if { [llength $data(dnd,item)] } {
  921.         if { [set cmd [Widget::getoption $path -dropcmd]] != "" } {
  922.             return [uplevel \#0 $cmd [list $path $source $data(dnd,item) $op $type $dnddata]]
  923.         }
  924.     }
  925.     return 0
  926. }
  927.  
  928.  
  929. # ------------------------------------------------------------------------------
  930. #  Command ListBox::_over_cmd
  931. # ------------------------------------------------------------------------------
  932. proc ListBox::_over_cmd { path source event X Y op type dnddata } {
  933.     variable $path
  934.     upvar 0  $path data
  935.  
  936.     if { ![string compare $event "leave"] } {
  937.         # we leave the window listbox
  938.         $path:cmd delete drop
  939.         if { [string length $data(dnd,afterid)] } {
  940.             after cancel $data(dnd,afterid)
  941.             set data(dnd,afterid) ""
  942.         }
  943.         set data(dnd,scroll) ""
  944.         return 0
  945.     }
  946.  
  947.     if { ![string compare $event "enter"] } {
  948.         # we enter the window listbox - dnd data initialization
  949.         set mode [Widget::getoption $path -dropovermode]
  950.         set data(dnd,mode) 0
  951.         foreach c {w p i} {
  952.             set data(dnd,mode) [expr {($data(dnd,mode) << 1) | ([string first $c $mode] != -1)}]
  953.         }
  954.     }
  955.  
  956.     set x [expr {$X-[winfo rootx $path]}]
  957.     set y [expr {$Y-[winfo rooty $path]}]
  958.     $path:cmd delete drop
  959.     set data(dnd,item) ""
  960.  
  961.     # test for auto-scroll unless mode is widget only
  962.     if { $data(dnd,mode) != 4 && [_auto_scroll $path $x $y] != "" } {
  963.         return 2
  964.     }
  965.  
  966.     if { $data(dnd,mode) & 4 } {
  967.         # dropovermode includes widget
  968.         set target [list widget]
  969.         set vmode  4
  970.     } else {
  971.         set target [list ""]
  972.         set vmode  0
  973.     }
  974.  
  975.     if { $data(dnd,mode) & 3 } {
  976.         # dropovermode includes item or position
  977.         # we extract the box (xi,yi,xs,ys) where we can find item around x,y
  978.         set len  [llength $data(items)]
  979.         set xc   [$path:cmd canvasx $x]
  980.         set yc   [$path:cmd canvasy $y]
  981.         set dy   [$path:cmd cget -yscrollincrement]
  982.         set line [expr {int($yc/$dy)}]
  983.         set yi   [expr {$line*$dy}]
  984.         set ys   [expr {$yi+$dy}]
  985.         set xi   0
  986.         set pos  $line
  987.         if { [Widget::getoption $path -multicolumn] } {
  988.             set nrows $data(nrows)
  989.         } else {
  990.             set nrows $len
  991.         }
  992.         if { $line < $nrows } {
  993.             foreach xs $data(xlist) {
  994.                 if { $xc <= $xs } {
  995.                     break
  996.                 }
  997.                 set  xi  $xs
  998.                 incr pos $nrows
  999.             }
  1000.             if { $pos < $len } {
  1001.                 set item [lindex $data(items) $pos]
  1002.                 if { $data(dnd,mode) & 1 } {
  1003.                     # dropovermode includes item
  1004.                     lappend target $item
  1005.                     set vmode [expr {$vmode | 1}]
  1006.                 } else {
  1007.                     lappend target ""
  1008.                 }
  1009.  
  1010.                 if { $data(dnd,mode) & 2 } {
  1011.                     # dropovermode includes position
  1012.                     if { $yc >= $yi+$dy/2 } {
  1013.                         # position is after $item
  1014.                         incr pos
  1015.                         set yl $ys
  1016.                     } else {
  1017.                         # position is before $item
  1018.                         set yl $yi
  1019.                     }
  1020.                     lappend target $pos
  1021.                     set vmode [expr {$vmode | 2}]
  1022.                 } else {
  1023.                     lappend target ""
  1024.                 }
  1025.             } else {
  1026.                 lappend target "" ""
  1027.             }
  1028.         } else {
  1029.             lappend target "" ""
  1030.         }
  1031.  
  1032.         if { ($vmode & 3) == 3 } {
  1033.             # result have both item and position
  1034.             # we compute what is the preferred method
  1035.             if { $yc-$yi <= 3 || $ys-$yc <= 3 } {
  1036.                 lappend target "position"
  1037.             } else {
  1038.                 lappend target "item"
  1039.             }
  1040.         }
  1041.     }
  1042.  
  1043.     if { $vmode && [set cmd [Widget::getoption $path -dropovercmd]] != "" } {
  1044.         # user-defined dropover command
  1045.         set res   [uplevel \#0 $cmd [list $source $target $op $type $dnddata]]
  1046.         set code  [lindex $res 0]
  1047.         set vmode 0
  1048.         if { $code & 1 } {
  1049.             # update vmode
  1050.             set mode [lindex $res 1]
  1051.             if { ![string compare $mode "item"] } {
  1052.                 set vmode 1
  1053.             } elseif { ![string compare $mode "position"] } {
  1054.                 set vmode 2
  1055.             } elseif { ![string compare $mode "widget"] } {
  1056.                 set vmode 4
  1057.             }
  1058.         }
  1059.     } else {
  1060.         if { ($vmode & 3) == 3 } {
  1061.             # result have both item and position
  1062.             # we choose the preferred method
  1063.             if { ![string compare [lindex $target 3] "position"] } {
  1064.                 set vmode [expr {$vmode & ~1}]
  1065.             } else {
  1066.                 set vmode [expr {$vmode & ~2}]
  1067.             }
  1068.         }
  1069.  
  1070.         if { $data(dnd,mode) == 4 || $data(dnd,mode) == 0 } {
  1071.             # dropovermode is widget or empty - recall is not necessary
  1072.             set code 1
  1073.         } else {
  1074.             set code 3
  1075.         }
  1076.     }
  1077.  
  1078.     # draw dnd visual following vmode
  1079.     if { $vmode & 1 } {
  1080.         set data(dnd,item) [list "item" [lindex $target 1]]
  1081.         $path:cmd create rectangle $xi $yi $xs $ys -tags drop
  1082.     } elseif { $vmode & 2 } {
  1083.         set data(dnd,item) [concat "position" [lindex $target 2]]
  1084.         $path:cmd create line $xi $yl $xs $yl -tags drop
  1085.     } elseif { $vmode & 4 } {
  1086.         set data(dnd,item) [list "widget"]
  1087.     } else {
  1088.         set code [expr {$code & 2}]
  1089.     }
  1090.  
  1091.     if { $code & 1 } {
  1092.         DropSite::setcursor based_arrow_down
  1093.     } else {
  1094.         DropSite::setcursor dot
  1095.     }
  1096.     return $code
  1097. }
  1098.  
  1099.  
  1100. # ------------------------------------------------------------------------------
  1101. #  Command ListBox::_auto_scroll
  1102. # ------------------------------------------------------------------------------
  1103. proc ListBox::_auto_scroll { path x y } {
  1104.     variable $path
  1105.     upvar 0  $path data
  1106.  
  1107.     set xmax   [winfo width  $path]
  1108.     set ymax   [winfo height $path]
  1109.     set scroll {}
  1110.     if { $y <= 6 } {
  1111.         if { [lindex [$path:cmd yview] 0] > 0 } {
  1112.             set scroll [list yview -1]
  1113.             DropSite::setcursor sb_up_arrow
  1114.         }
  1115.     } elseif { $y >= $ymax-6 } {
  1116.         if { [lindex [$path:cmd yview] 1] < 1 } {
  1117.             set scroll [list yview 1]
  1118.             DropSite::setcursor sb_down_arrow
  1119.         }
  1120.     } elseif { $x <= 6 } {
  1121.         if { [lindex [$path:cmd xview] 0] > 0 } {
  1122.             set scroll [list xview -1]
  1123.             DropSite::setcursor sb_left_arrow
  1124.         }
  1125.     } elseif { $x >= $xmax-6 } {
  1126.         if { [lindex [$path:cmd xview] 1] < 1 } {
  1127.             set scroll [list xview 1]
  1128.             DropSite::setcursor sb_right_arrow
  1129.         }
  1130.     }
  1131.  
  1132.     if { [string length $data(dnd,afterid)] && [string compare $data(dnd,scroll) $scroll] } {
  1133.         after cancel $data(dnd,afterid)
  1134.         set data(dnd,afterid) ""
  1135.     }
  1136.  
  1137.     set data(dnd,scroll) $scroll
  1138.     if { [llength $scroll] && ![string length $data(dnd,afterid)] } {
  1139.         set data(dnd,afterid) [after 200 ListBox::_scroll $path $scroll]
  1140.     }
  1141.     return $data(dnd,afterid)
  1142. }
  1143.  
  1144.  
  1145. # ------------------------------------------------------------------------------
  1146. #  Command ListBox::_scroll
  1147. # ------------------------------------------------------------------------------
  1148. proc ListBox::_scroll { path cmd dir } {
  1149.     variable $path
  1150.     upvar 0  $path data
  1151.  
  1152.     if { ($dir == -1 && [lindex [$path:cmd $cmd] 0] > 0) ||
  1153.          ($dir == 1  && [lindex [$path:cmd $cmd] 1] < 1) } {
  1154.         $path $cmd scroll $dir units
  1155.         set data(dnd,afterid) [after 100 ListBox::_scroll $path $cmd $dir]
  1156.     } else {
  1157.         set data(dnd,afterid) ""
  1158.         DropSite::setcursor dot
  1159.     }
  1160. }
  1161.