Version 0 of clistbox
Updated 2001-09-13 16:28:55George Peter Staplin: 2001 Thu Sep 13 - I looked at the other multi-column listboxes and became curious about how they worked. So, I wrote my own very concise megawidget multi-column listbox. See the test code at the end for usage and a screenshot.
#By George Peter Staplin
#Thu Sep 13 10:07:37 MDT 2001
#You may use/modify/redistribute this under the same
#terms as the Tcl license.
namespace eval clistbox {
variable firstX
}
proc clistbox::clearSelection listboxWinList {
foreach win $listboxWinList {
$win selection clear 0 end
}
}
proc clistbox::drawSlider:setInitialPosition x {
variable firstX
set firstX $x
}
proc clistbox::dragSlider {sep frame1 x} {
variable firstX
set win [winfo parent $sep]
set diff [expr {$x - $firstX}]
set xUnits [expr {1.0 / [winfo width $win]}]
set haveSecondFrame 0
set frame2 [expr {$frame1 + 1}]
array set arF0 [place info $win.f$frame1]
array set arS0 [place info $win.sep$frame1]
if {[winfo exists $win.f$frame2] == 1} {
array set arF1 [place info $win.f$frame2]
set haveSecondFrame 1
}
set xdiff [expr {$diff * $xUnits}]
place $win.f$frame1 -relwidth [expr {$arF0(-relwidth) + $xdiff}]
place $win.sep$frame1 -relx [expr {$arS0(-relx) + $xdiff}]
if {$haveSecondFrame == 1} {
place $win.f$frame2 -relx [expr {$arF1(-relx) + $xdiff}]
place $win.f$frame2 -relwidth [expr {$arF1(-relwidth) - $xdiff}]
}
set firstX $x
return
}
proc clistbox::scrollListboxes {listboxWinList args} {
foreach win $listboxWinList {
eval $win yview $args
}
}
proc clistbox {win args} {
if {[expr {[llength $args] & 1}] != 0} {
return -code error "Invalid number of arguments given to clistbox\
(uneven number): $args"
}
frame $win -bd 2 -relief raised
upvar #0 _listbox$win ar
set cmdArgs(-columns) 5
set cmdArgs(-titleEditable) 1
set cmdArgs(-autosee) 1
set ar(rowSelected) {}
array set cmdArgs $args
array set ar [array get cmdArgs]
set relxPortion [expr {1.0 / $cmdArgs(-columns)}]
set relx 0
for {set wi 0} {$wi < $cmdArgs(-columns)} {incr wi} {
lappend listboxWinList $win.f$wi.sf.listbox
}
set ar(listboxWinList) $listboxWinList
for {set wi 0} {$wi < $cmdArgs(-columns)} {incr wi} {
lappend frameWinList $win.f$wi
}
set ar(frameWinList) $frameWinList
#i is the column index
for {set i 0} {$i < $cmdArgs(-columns)} {incr i} {
place [frame $win.f$i] -relx $relx -relwidth $relxPortion
pack [entry $win.f$i.title -bg gray75 -relief raised -takefocus 0] \
-side top -fill x -padx 2 -ipadx 2
if {$cmdArgs(-titleEditable) == 0} {
bindtags $win.f$i.title "$win.f$i.title [winfo toplevel $win]"
}
#scrolled area frame
pack [frame $win.f$i.sf] -fill both -expand 1
if {$i == 0} {
scrollbar $win.f0.sf.y -command "clistbox::scrollListboxes {$listboxWinList}"
pack $win.f0.sf.y -fill y -side left
}
pack [listbox $win.f$i.sf.listbox \
-relief flat -exportselection 0] \
-fill both -expand 1 -side right
bindtags $win.f$i.sf.listbox $win.f$i.sf.listbox
bind $win.f$i.sf.listbox <ButtonPress-1> "
upvar #0 _listbox$win ar
clistbox::clearSelection {$listboxWinList}
set selectedIndex \[%W index @%x,%y\]
foreach lwin {$listboxWinList} {
\$lwin selection set \$selectedIndex
}
set ar(rowSelected) \$selectedIndex
"
set relx [expr {$relx + $relxPortion}]
}
$win.f0.sf.listbox config -yscrollcommand "$win.f0.sf.y set"
set relx $relxPortion
#This builds the separators between columns.
for {set sepIndex 0} {$sepIndex < ($cmdArgs(-columns) - 1)} {incr sepIndex} {
place [frame $win.sep$sepIndex -width 6 -bg gray75 \
-cursor sb_h_double_arrow -relief raised -bd 1] -relx $relx \
-x -3 -height [winfo reqheight $win.f$sepIndex.title]
set relx [expr {$relx + $relxPortion}]
bind $win.sep$sepIndex <Button-1> "clistbox::drawSlider:setInitialPosition %X"
bind $win.sep$sepIndex <B1-Motion> "clistbox::dragSlider %W $sepIndex %X"
}
set mapCmd {}
if {[info exists cmdArgs(-height)] == 1} {
append mapCmd "%W configure -height $cmdArgs(-height); "
} else {
append mapCmd "%W configure -height \[winfo height %W.f0\]; "
}
if {[info exists cmdArgs(-width)] == 1} {
append mapCmd "%W configure -width $cmdArgs(-width); "
} else {
append mapCmd "%W configure -width \[expr {$cmdArgs(-columns) * 100}\]; "
}
update idletasks
append mapCmd "; bind Clistbox$win <Map> {}"
bind Clistbox$win <Map> $mapCmd
#This makes the listboxes grow, as if they had -fill y
bind Clistbox$win <Configure> "
foreach win {$ar(frameWinList)} {
place \$win -relheight 1.0
}
"
set bindClasses [linsert [bindtags $win] end Clistbox$win]
bindtags $win $bindClasses
rename $win _clistbox$win
proc $win {cmd args} {
set self [lindex [info level 0] 0]
upvar #0 _listbox$self ar
set actWin _clistbox$self
if {$cmd == "config"} {
set cmd configure
}
switch -- $cmd {
configure {
eval $actWin config $args
}
delete {
if {[llength $args] != 2} {
return -code error "wrong number of arguments: use $self delete column row"
}
set column [lindex $args 0]
set row [lindex $args 1]
set res [$self.f$column.sf.listbox delete $row]
$self.f$column.sf.listbox insert $row {}
return $res
}
get {
set lengthArgs [llength $args]
if {$lengthArgs > 2 || $lengthArgs < 1} {
return -code error "wrong number of arguments: use $self get row || $self get column row"
}
if {$lengthArgs == 1} {
set row [lindex $args 0]
foreach win $ar(listboxWinList) {
lappend getResult [$win get $row]
}
return $getResult
}
if {$lengthArgs == 2} {
set column [lindex $args 0]
set row [lindex $args 1]
return [$self.f$column.sf.listbox get $row]
}
}
insert {
if {[llength $args] != 3} {
return -code error "wrong number of arguments: use $self insert column row data"
}
set column [lindex $args 0]
set row [lindex $args 1]
set data [lindex $args 2]
set oldSelection [$self.f$column.sf.listbox curselection]
foreach win $ar(listboxWinList) {
set lastIndex [$win index end]
if {[string compare $self.f$column.sf.listbox $win] != 0} {
for {set i $lastIndex} {$i <= $row} {incr i} {
$win insert $i {}
}
} else {
for {set i $lastIndex} {$i < $row} {incr i} {
$win insert $i {}
}
}
}
$self.f$column.sf.listbox delete $row
set res [$self.f$column.sf.listbox insert $row $data]
if {$ar(-autosee) == 1} {
foreach swin $ar(listboxWinList) {
$swin see $row
}
}
if {$oldSelection != ""} {
$self.f$column.sf.listbox selection set $oldSelection
}
return $res
}
title {
if {[llength $args] != 2} {
return -code error "wrong number of arguments: use $self title column data"
}
set column [lindex $args 0]
set data [lindex $args 1]
$self.f$column.title delete 0 end
return [$self.f$column.title insert 0 $data]
}
see {
if {[llength $args] != 1} {
return -code error "wrong number of arguments: use $self see row"
}
set row [lindex $args 0]
foreach swin $ar(listboxWinList) {
$swin see $row
}
}
selected {
return [$self.f0.sf.listbox curselection]
}
default {
return -code error "unknown argument sent to $self"
}
}
}
return $win
}
#!/usr/local/bin/wish8.3
proc main {} {
source ./clistbox.tcl
pack [clistbox .cl -columns 4 -titleEditable 0] -expand 1 \
-fill both -side top
#$win.f$i.sf.listbox
.cl title 0 Class
.cl title 1 {Uses Subclass}
.cl title 2 {Uses Method}
.cl title 3 {Uses Variables}
set i 0
foreach val {Button Checkbutton Entry Label Listbox Text \
Struct BigNum} {
.cl insert 0 $i $val
incr i
}
#random test data
for {set i 0} {$i < 8} {incr i} {
.cl insert 1 $i [expr {int(rand() * 9)}]
}
for {set i 0} {$i < 8} {incr i} {
.cl insert 2 $i [expr {int(rand() * 9)}]
}
set str abcdefgh
for {set i 0} {$i < 8} {incr i} {
.cl insert 3 $i [string index $str $i]
}
#.cl.f0.sf.listbox selection set 0
#.cl.f1.sf.listbox selection set 0
pack [frame .f] -side top
pack [button .f.b -text Test -command {puts [.cl get 0]}] -side left
pack [button .f.b2 -text Test -command {puts [.cl get 1]}] -side left
pack [button .f.b3 -text Test2 \
-command {.cl insert [expr {int(rand() * 4)}] 22 [expr rand()]}] \
-side left
pack [button .f.b4 -text Test3 -command {.cl delete 0 1}] -side left
pack [button .f.b5 -text Test4 -command {.cl see 1}] -side left
pack [button .f.b6 -text Test5 -command {puts [.cl selected]}] -side left
.cl see 0
}
mainThe test code above running: 