Index: tolbase/lib/byswidget/blistboxplus/blistboxplus.tcl =================================================================== --- tolbase/lib/byswidget/blistboxplus/blistboxplus.tcl (revision 1b5b24e974d86af9fe62a4722f3cb84c5cff2d2a) +++ tolbase/lib/byswidget/blistboxplus/blistboxplus.tcl (revision 6d7779d88a35f4606432b88f2eceba8b66c4516b) @@ -6,4 +6,5 @@ package require byscommon +package require BLT package require bfunctions package require bfieldsdialog @@ -52,4 +53,6 @@ # listbox -> el treeview que hace de listbox propiamente # menu -> el menu contextual del listbox +# xbar -> horizontal scrollbar +# ybar -> vertical scrollbar # afterTime -> tiempo desde que se pulso la ultima tecla # listKey -> lista de teclas pulsadas @@ -58,5 +61,4 @@ option -readonly 0 - option -selectmode extended option -keypress true option -colkeypress "" @@ -75,11 +77,8 @@ option -iniconfig "" - #@O! (treeview options) Se introducen para evitar errores - option -exportselection false ;# unused - option -linewidth 1 ;# unused - option -selectbackground "unused" - variable _listbox variable menu + variable xbar + variable ybar variable afterTime 0 @@ -97,18 +96,22 @@ # #/////////////////////////////////////////////////////////////////////////// + debug_init debug_msg "install listbox ..." - if {1} { - install _listbox using ::wtree $win.lb -table 0 -filter no \ - -background white -showroot 0 -selectmode extended -showheader 1 \ - -highlightbackground gray75 -highlightcolor black \ - -highlightthickness 0 -font {Arial 9} + if {0} { + install _listbox using ::blt::treeview $win.lb -hideroot yes \ + -activeicons "" -icons {} -selectmode multiple \ + -selectbackground grey -selectforeground white \ + -highlightthickness 0 -borderwidth 1 -selectborderwidth 1 \ + -nofocusselectbackground grey -font {Arial 9} -flat yes } else { - set _listbox [::wtree $win.lb -table 0 -filter no \ - -background white -showroot 0 -selectmode extended -showheader 1 \ - -highlightbackground gray75 -highlightcolor black \ - -highlightthickness 0 -font {Arial 9}] + set _listbox [::blt::treeview $win.lb -hideroot yes \ + -activeicons "" -icons {} -selectmode multiple \ + -selectbackground grey -selectforeground white \ + -highlightthickness 0 -borderwidth 1 \ + -selectborderwidth 1 \ + -nofocusselectbackground grey -font {Arial 9} -flat yes] } @@ -116,7 +119,15 @@ install menu using menu $win.m -tearoff 0 + install xbar using scrollbar $win.sbh -orient horizontal \ + -command "$win xview" + install ybar using scrollbar $win.sbv -orient vertical \ + -command "$win yview" #bindtags is modified to make possible to associate binds to self - $_listbox configure -bindtags [list $self Blistboxplus] + bindtags $_listbox [linsert [bindtags $_listbox] 2 $win] + + $_listbox style configure text -bg white + + $_listbox column configure treeView -bg white $self configure -readonly [from args -readonly] @@ -125,11 +136,13 @@ # Apply all arguments given: $self configurelist $args - + + $_listbox configure -xscrollcommand "$xbar set" + $_listbox configure -yscrollcommand "$ybar set" if { $options(-parent) eq "" } { $self configure -parent [winfo parent $win] } - # bind - bind $_listbox +[list $self _OnKeyPress %A] + # bind + $_listbox bind all +[list $self _OnKeyPress %A] $self configure -nomenu [from args -nomenu] @@ -138,7 +151,11 @@ #pack grid $_listbox -row 0 -column 0 -sticky news + grid $ybar -row 0 -column 1 -sticky ns + grid $xbar -row 1 -column 0 -sticky ew grid columnconfigure $self 0 -weight 1 grid rowconfigure $self 0 -weight 1 + ::autoscroll::autoscroll $ybar + ::autoscroll::autoscroll $xbar debug_msg "voy a pillarte: antes de _ReadIni" $self _ReadIni @@ -159,5 +176,5 @@ catch [list $self _WriteIni ] } - + #/////////////////////////////////////////////////////////////////////////// # @@ -166,25 +183,19 @@ #/////////////////////////////////////////////////////////////////////////// - onconfigure -cols { lst } { - set options(-cols) $lst - - $_listbox column delete all - - set lstx [list [list image -label Icon -tags Icon] ] - foreach col $lst { - #set colx [list text -label [msgcat::mc $col] -tags $col] - set colx [list text -label $col -tags $col] - lappend lstx $colx - } - $_listbox configure -columns $lstx - - if { $options(-icon) == "" } { - $_listbox column configure Icon -visible 0 - } else { - $_listbox column configure Icon -visible 1 - } - - $_listbox column configure first -expand yes -weight 1 - $_listbox column configure all -itembackground "" + onconfigure -cols { lst } { + set options(-cols) $lst + foreach col [$self column names] { + $_listbox column delete $col + } + foreach col $options(-cols) { + $_listbox column insert end $col -justify left + $_listbox column configure $col -command "$self _SortByColumn [list $col]" \ + -titleborderwidth 1 + } + if { $options(-icon) == "" } { + $_listbox column configure "BLT TreeView $_listbox" -hide 1 + } else { + $_lisbox column configure "BLT TreeView $_listbox" -hide 0 + } } @@ -193,7 +204,7 @@ foreach col [$self column names] { if { "-1" eq [lsearch $options(-hiddencols) $col] } { - $_listbox column configure $col -visible 1 + $_listbox column configure $col -hide 0 } else { - $_listbox column configure $col -visible 0 + $_listbox column configure $col -hide 1 } } @@ -202,5 +213,6 @@ onconfigure -showtitles { bool } { set options(-showtitles) $bool - $_listbox configure -showheader $bool + $_listbox configure -showtitles $bool + $_listbox show } @@ -208,8 +220,9 @@ set options(-icon) $icon if { $icon != "" } { - $_listbox column configure Icon -minwidth 16 -maxwidth 16 -visible 1 ;# -titleborderwidth 1 - + $_listbox column configure "BLT TreeView $_listbox" -min 16 -max 16 \ + -hide 0 -titleborderwidth 1 + $_listbox configure -icons [list [Bitmap::get $icon] [Bitmap::get $icon]] } else { - $_listbox column configure Icon -visible 0 + $_listbox column configure "BLT TreeView $_listbox" -hide 1 } } @@ -220,9 +233,9 @@ set cols [$self column names] foreach col $cols { - $_listbox column configure $col -text [mc [lindex $titles $c] ] + $self column configure $col -title [mc [lindex $titles $c] ] incr c 1 } } - + onconfigure -values { lst } { $self clear @@ -240,5 +253,5 @@ } } - + onconfigure -readonly { bool } { if {!($created)} { @@ -250,13 +263,4 @@ } - onconfigure -selectmode { mode } { - if { $mode eq "multiple" } { - set options(-selectmode) "extended" - } else { - set options(-selectmode) $mode - } - $_listbox configure -selectmode $options(-selectmode) - } - onconfigure -filtercols { lst } { set cols [$self cget -cols] @@ -277,39 +281,4 @@ } - onconfigure -exportselection { bool } { - if { $bool } { - error "\[blistboxplus\] option -exportselection should be 'no'" - } - } - - #/////////////////////////////////////////////////////////////////////////// - method show { args } { - #/////////////////////////////////////////////////////////////////////////// - error "\[blistboxplus\] method show unimplemented" - } - - #/////////////////////////////////////////////////////////////////////////// - method hide { args } { - #/////////////////////////////////////////////////////////////////////////// - error "\[blistboxplus\] method hide unimplemented" - } - - #/////////////////////////////////////////////////////////////////////////// - method sort { args } { - #/////////////////////////////////////////////////////////////////////////// - if { [lindex $args 1] eq "configure" } { - if { [lindex $args 2] eq "-column" } { - return [$self _SortByColumn [lindex $args 3]] - } else { - return - } - } elseif { [lindex $args 1] eq "auto" } { - #@O! Llamado desde barima. Hace falta hacer algo? - return - } else { - return - } - } - #/////////////////////////////////////////////////////////////////////////// method _CreateMenu {args} { @@ -364,50 +333,20 @@ -command "$self _LoadFromFile" } - # bindings - bind $_listbox +[list $self _OnControlKey $self %K %k] - bind $_listbox "lbDeleteSelection $self" - bind $_listbox "$self _OpenWR" - bind $_listbox "$self addPrevious" - bind $_listbox "$self addNext" - bind $_listbox "$self previous" - bind $_listbox "$self next" - bind $_listbox "$self first" - bind $_listbox "$self last" - bind $_listbox "$self addAllPrevious" - bind $_listbox "$self addAllNext" - bind $_listbox +[list focus -force %W] - } - - method curselection {} { - set cursel [$_listbox selection get] - if { [expr [llength $cursel] <= 1] } { return $cursel } - set curselx {} - foreach it $cursel { - lappend curselx [list $it [$_listbox item order $it]] - } - set curselxs [lsort -index end $curselx] - set cursels {} - foreach it $curselxs { - lappend cursels [lindex $it 0] - } - return $cursels - - #set firstPos [$_listbox item order [lindex $cursel 0]] - #set lastPos [$_listbox item order [lindex $cursel end]] - #if { [expr $firstPos <= $lastPos] } { - # Tolcon_Trace "right!" - # foreach it $cursel { - # Tolcon_Trace "$it [$_listbox item order $it]" - # } - # return $cursel - #} else { - # Tolcon_Trace "reversed!" - # foreach it $cursel { - # Tolcon_Trace "$it [$_listbox item order $it]" - # } - # return [lreverse $cursel] - #} - } - + # bindings + $self bind all +[list $self _OnControlKey $self %K %k] + $self bind all "lbDeleteSelection $self" + $self bind all "$self _OpenWR" + $self bind all "$self addPrevious" + $self bind all "$self addNext" + $self bind all "$self previous" + $self bind all "$self next" + $self bind all "$self first" + $self bind all "$self last" + $self bind all "$self addAllPrevious" + $self bind all "$self addAllNext" + $self bind all +[list focus -force %W] + } + + #/////////////////////////////////////////////////////////////////////////// method getMenu { } { @@ -421,4 +360,5 @@ return $menu } + #/////////////////////////////////////////////////////////////////////////// @@ -439,4 +379,5 @@ } } + #/////////////////////////////////////////////////////////////////////////// @@ -486,4 +427,5 @@ } + #///////////////////////////////////////////////////////////////////////////// method _ToggleSelection {} { @@ -497,4 +439,5 @@ } + #/////////////////////////////////////////////////////////////////////////// method _SelectAll { } { @@ -507,4 +450,5 @@ } } + #///////////////////////////////////////////////////////////////////////////// @@ -539,4 +483,5 @@ } + #///////////////////////////////////////////////////////////////////////////// method _SaveToFile {se unSe {pref ""} {suf ""} {sep "\n"}} { @@ -561,20 +506,20 @@ if { ![ catch { set fd [open $filNam w] } msgerr] } { # text to save - set lst {} - if { $se } { - foreach i [$self selection get selected] { - lappend lst [$self get $i] - } - } - if { $unSe } { - foreach i [$self selection get unselected] { - lappend lst [$self get $i] - } - } - set str [ListToStr $lst $sep $pref $suf] - # write - puts -nonewline $fd $str - close $fd - return 1 + set lst {} + if { $se } { + foreach i [$self selection get selected] { + lappend lst [$self get $i] + } + } + if { $unSe } { + foreach i [$self selection get unselected] { + lappend lst [$self get $i] + } + } + set str [ListToStr $lst $sep $pref $suf] + # write + puts -nonewline $fd $str + close $fd + return 1 } error $msgerr @@ -596,5 +541,5 @@ # open file to read if { ![ catch { set fd [open $filNam r] } msgerr] } { - while { [gets $fd line ] >= 0} { + while { [gets $fd line ] >= 0} { $self add $line } @@ -606,4 +551,5 @@ } + #/////////////////////////////////////////////////////////////////////////// method _SortByColumn { col } { @@ -614,6 +560,78 @@ # #/////////////////////////////////////////////////////////////////////////// - return [$_listbox SortbyColumn $_listbox $col] - } + $self _QuickSort $col 0 [expr [$self size]-1] + } + + + #/////////////////////////////////////////////////////////////////////////// + method _QuickSort { col left right } { + # + # PURPOSE: + # function quicksort(a, left, right) + # if right > left + # select a pivot value a[pivotIndex] + # pivotNewIndex := partition(a, left, right, pivotIndex) + # quicksort(a, left, pivotNewIndex-1) + # quicksort(a, pivotNewIndex+1, right) + # + #/////////////////////////////////////////////////////////////////////////// + if {$right > $left} { + set pivotIndex [expr (($left + $right) / 2)] + set pivotNewIndex [$self _Partition $col $left $right $pivotIndex] + $self _QuickSort $col $left [expr $pivotNewIndex-1] + $self _QuickSort $col [expr $pivotNewIndex+1] $right + } + } + + + #/////////////////////////////////////////////////////////////////////////// + method _Partition { col left right pivotIndex } { + # + # PURPOSE: + # function partition(a, left, right, pivotIndex) + # pivotValue := a[pivotIndex] + # swap(a[pivotIndex], a[right]) // Move pivot to end + # storeIndex := left + # for i from left to right + # if a[i] <= pivotValue + # swap(a[storeIndex], a[i]) + # storeIndex := storeIndex + 1 + # swap(a[right], a[storeIndex]) // Move pivot to its final place + # return storeIndex + # + #/////////////////////////////////////////////////////////////////////////// + set pivotValue [$self get [lindex [$self get] $pivotIndex] $col] + $self _Swap $pivotIndex $right + set storeIndex $left + for { set i $left } { $i < $right } { incr i } { + if { [$self get [lindex [$self get] $i] $col] <= $pivotValue } { + $self _Swap $storeIndex $i + incr storeIndex + } + } + $self _Swap $right $storeIndex + return $storeIndex + } + + + #/////////////////////////////////////////////////////////////////////////// + method _Swap { index1 index2 } { + # + # PURPOSE: + # + #/////////////////////////////////////////////////////////////////////////// + if { $index1 < $index2 } { + set lst [$self get] + $self move [lindex $lst $index1] after [lindex $lst $index2] + set lst [$self get] + $self move [lindex $lst [expr $index2-1]] before [lindex $lst $index1] + } elseif { $index1 > $index2 } { + set lst [$self get] + $self move [lindex $lst $index1] before [lindex $lst $index2] + set lst [$self get] + $self move [lindex $lst [expr $index2+1]] after [lindex $lst $index1] + } + } + #/////////////////////////////////////////////////////////////////////////// @@ -631,4 +649,5 @@ } } + #////////////////////////////////////////////////////////////////////////// @@ -661,5 +680,6 @@ $dialog draw } - + + #/////////////////////////////////////////////////////////////////////////// proc _Filter { elem father } { @@ -674,4 +694,5 @@ eval $father filter $elem } + #////////////////////////////////////////////////////////////////////////// @@ -686,5 +707,5 @@ -parent $self -orientation $options(-orientation) \ -fields $options(-filtercols) -procedure [codename _Filter] \ - -buttons { info apply accept cancel } \ + -buttons { info apply accept cancel } \ -titles $options(-titles)] $dialog configure -info \ @@ -729,5 +750,5 @@ $dialog draw } - + #/////////////////////////////////////////////////////////////////////////// method _WriteIni { } { @@ -774,4 +795,5 @@ } + #/////////////////////////////////////////////////////////////////////////// method selection { args } { @@ -784,19 +806,21 @@ #/////////////////////////////////////////////////////////////////////////// if { [lindex $args 0] eq "get" } { - if { [lindex $args 1] eq "unselected" } { - set result {} - set selected [$self curselection] - foreach i [$self get] { - if { "-1" eq [lsearch $selected $i] } { - lappend result $i - } - } - return $result - } else { - return [$self curselection] - } - } + if { [lindex $args 1] eq "unselected" } { + set result {} + set selected [$self curselection] + foreach i [$self get] { + if { "-1" eq [lsearch $selected $i] } { + lappend result $i + } + } + return $result + } else { + return [eval $_listbox curselection] + } + } + eval $_listbox selection $args } + #/////////////////////////////////////////////////////////////////////////// @@ -819,13 +843,8 @@ switch [llength $cols] { 1 { - # una sola columna + # mas de una columna foreach dats $args { set datos [list [lindex $cols 0] $dats] - #@ Crea y completa los datos de un nodo - set node [$_listbox item create -parent root -button 0 -open 0] - eval $_listbox item text $node $datos - if { $options(-icon) != "" } { - $_listbox item image $node [Bitmap::get $options(-icon)] - } + $_listbox insert $pos $currentId -data $datos incr currentId } @@ -838,12 +857,7 @@ foreach col $cols { lappend datos $col [lindex $dats $i] - incr i - } - #@ Crea y completa los datos de un nodo - set node [$_listbox item create -parent root -button 0 -open 0] - eval $_listbox item text $node $datos - if { $options(-icon) != "" } { - $_listbox item image $node [Bitmap::get $options(-icon)] + incr i } + $_listbox insert $pos $currentId -data $datos incr currentId } @@ -852,4 +866,5 @@ } + #/////////////////////////////////////////////////////////////////////////// method add { args } { @@ -864,4 +879,5 @@ eval $self insert end $args } + #/////////////////////////////////////////////////////////////////////////// @@ -876,10 +892,11 @@ #/////////////////////////////////////////////////////////////////////////// if { "-1" eq [lsearch $args 0] } { - eval $_listbox item delete $args + eval $_listbox delete $args } else { puts "Root node can't be deleted" } } - + + #/////////////////////////////////////////////////////////////////////////// method getlb {} { @@ -891,4 +908,5 @@ } + #/////////////////////////////////////////////////////////////////////////// method get { {ids ""} {cols ""}} { @@ -901,29 +919,31 @@ # #/////////////////////////////////////////////////////////////////////////// - if { $ids eq "" } { - set items [$_listbox item children root] - return $items - } + if { $ids eq "" } { return [lrange [$self find] 1 end] } set result {} - - if { "$cols" eq "" } { - set cols [$self column names] - } - + foreach id $ids { - set elem {} + + set elem {} + + set data [$_listbox entry cget $id -data] + if { "$cols" eq "" } { + set cols [$self column names] + } + foreach col $cols { - lappend elem [$_listbox item text $id $col] - } + set inx [lsearch $data $col] + if { "-1" ne $inx } { + incr inx + lappend elem [lindex $data $inx] + } + } + lappend result $elem } - - if { [llength $ids] eq 1 } { - return [lindex $result 0] - } - + if { [llength $ids] eq 1 } { return [lindex $result 0] } return $result } + #/////////////////////////////////////////////////////////////////////////// @@ -948,6 +968,7 @@ incr i } - return [eval $_listbox item text $id $datos] - } + return [$_listbox entry configure $id -data $datos] + } + #/////////////////////////////////////////////////////////////////////////// @@ -971,5 +992,6 @@ return [lindex $all 0] } - + + #/////////////////////////////////////////////////////////////////////////// method last {} { @@ -992,4 +1014,5 @@ return [lindex $all [expr [llength $all] - 1]] } + #/////////////////////////////////////////////////////////////////////////// @@ -1019,4 +1042,5 @@ } } + #/////////////////////////////////////////////////////////////////////////// @@ -1046,4 +1070,5 @@ } + #/////////////////////////////////////////////////////////////////////////// method previous {} { @@ -1075,4 +1100,5 @@ } } + #/////////////////////////////////////////////////////////////////////////// @@ -1105,4 +1131,5 @@ } } + #/////////////////////////////////////////////////////////////////////////// @@ -1134,4 +1161,5 @@ } } + #/////////////////////////////////////////////////////////////////////////// @@ -1160,4 +1188,5 @@ } } + #/////////////////////////////////////////////////////////////////////////// @@ -1173,4 +1202,5 @@ } + #/////////////////////////////////////////////////////////////////////////// method size {} { @@ -1182,4 +1212,5 @@ } + #/////////////////////////////////////////////////////////////////////////// method column { args } { @@ -1189,15 +1220,9 @@ #/////////////////////////////////////////////////////////////////////////// if { [lindex $args 0] eq "names" } { - set names {} - foreach col [lrange [$_listbox column list] 1 end] { - lappend names [$_listbox column tag names $col] - } - return $names - } elseif { [lindex $args 0] eq "configure" } { - return [eval $_listbox column $args] - } else { - return [eval $_listbox column id $args] - } - } + return [lrange [$_listbox column names] 1 end] + } + return [eval $_listbox column $args] + } + #/////////////////////////////////////////////////////////////////////////// @@ -1342,14 +1367,13 @@ .top.f1.f.blb clear .top.f1.f.blb insert end {1 2 3 4} {one two three four} \ - {uno dos tres cuatro} {k kk kkk kkkk} {0 0 0 0} {@ # $ %} + {uno dos tres cuatro} {k kk kkk kkkk} {0 0 0 0} {@ # $ %} } proc toggleSelectModeCmd {} { if { [.top.f1.f.blb cget -selectmode] eq "multiple" } { - .top.f1.f.blb configure -selectmode single + .top.f1.f.blb configure -selectmode single } else { - .top.f1.f.blb configure -selectmode multiple + .top.f1.f.blb configure -selectmode multiple } } } -