PWQ 11 Jun 2004
I see a lot of programmers creating higher level widgets and I often wonder what their motivation is. I suspect a lot of it stems from learning programming from a OO point of view.
There seems to be an interest in multicolum list boxes. I would use tktable myself, but I do understand the desire to use TCL only code.
So I have started this page (and am unlikely to finish it) to see just how minimal we can go to get higher level widgets. I have used the multicolumn list box as an example since there seems to be at least 6 variants on the net.
First of all let's decide our requirements for this widget:
We will have to have some differences due to the expectations of the user. We try to minimise these to keep compatibility with the standard listbox.
We conceed to have column headings only because there is no way of aligning widgets to the columns (in a practical way!).
In the following example, issues such as namespaces are covered but not fully specified. If this code is eval'd in a namespace, it should still work but is not tested. Note that the successful use of namespaces requires careful use of uplevel and namespace inscope to be totaly transparent to user's code.
Let's do the basics:
proc multilistbox {path args} {
frame $path -class Multilistbox
rename $path $path/top
uplevel 1 [list interp alias {} $path {} [namespace current]::handle $path]
array set options { -width {} -title {}}
array set options $args
set i -1
foreach width $options(-width) title $options(-title) {
incr i
pack [frame $path.$i] -expand 1 -fill both -anc nw -side left
if {$title != {} } {
pack [label $path.$i.t -text $title] -side top -fill x -anc nw
}
pack [listbox $path.$i.lb -width $width -exportselection 0 ] -side top -anc nw -expand 1 -fill both
bind $path.$i.lb <<ListboxSelect>> [namespace code "sel $path $i"]
}
bind $path <Destroy> "[namespace current]::cleanup $path"
variable $path/cols
set $path/cols $i
configurelist $path $args
set path
}
proc handle {path cmd args} {uplevel 1 $cmd $path $args}We have satisfied the first three requirements; using the minimal of subwidgets as our containers, we have standard listboxes that arrange themselves to the same height, accept standard options, and have their own set of options.
For example:
option add *Multilistbox*Label.relief sunken
Will specify the way the headings are displayed. Options for the listboxes likewise can be specified.
Configuration:
proc configurelist {path arglist} {
variable $path/cols
array set options $arglist
if {[info exists options(-listvariable)]} {
variable $path/lv
set $path/lv $options(-listvariable)
for {set i 0} {$i <= [set $path/cols]} {incr i} {
variable $path/$i/lv
set $path/$i/lv {}
$path.$i.lb configure -listvariable [namespace current]::$path/$i/lv
}
listvariable $path
set cmd "[namespace current]::listvariable $path ;#"
trace remove variable ::[set $path/lv] write $cmd
trace add variable ::[set $path/lv] write $cmd
}
array unset options -width
array unset options -listvariable
array unset options -title
for {set i 0} {$i <= [set $path/cols]} {incr i} {
uplevel 1 $path.$i.lb configure [array get options]
}
}
proc configure {path args} {uplevel 1 [list configurelist $path $args]}
proc listvariable {path} {
variable $path/cols
variable $path/lv
upvar #0 [set $path/lv] listvar
for {set i 0} {$i <= [set $path/cols]} {incr i} {
variable $path/$i/lv
set $path/$i/lv [list]
}
foreach item $listvar {
for {set i 0} {$i <= [set $path/cols]} {incr i} {
lappend $path/$i/lv [lindex $item $i]
}
}
}
# Basic cleanup
proc cleanup {path} {
variable $path/cols
for {set i 0} {$i <= [set $path/cols]} {incr i} {
variable $path/$i/lv
unset -nocomplain $path/$i/lv
}
unset $path/cols
variable $path/lv
if {[info exists $path/lv]} {
set cmd "[namespace current]::listvariable $path ;#"
trace remove variable ::[set $path/lv] write $cmd
} ariable ::[set $path/lv] write $cmd
unset -nocomplain $path/lv
destroy $path/top ;# and all will follow
}We need to use special handling for -listvariable but we can let the scrollbar be updated by all and any listbox. While this is inefficient there is no harm in having the scroll bar set multiple times.
Scrolling:
proc yview {path args} {
variable $path/cols
for {set i 0} {$i <= [set $path/cols]} {incr i} {
eval $path.$i.lb yview $args
}
return {}
}When the command $path yview is called we will scroll all widgets, in this we don't support retrieving the current yview settings, but would be a simple addition.
Selecting:
proc sel {path who} {
variable $path/cols
for {set i 0} {$i <= [set $path/cols]} {incr i} {
if {$who == $i} {continue}
$path.$i.lb selection clear 0 end
foreach item [$path.$who.lb cursel] { $path.$i.lb selection set $item}
}
return {}
}This is enough to force all in the set to follow the selection of any one of the others.
What this doesn't cover is:
Some of these are simple bindings, others are more complicated as the listbox supports multiple select modes and a plethora of non public bindings.
A Simple Test:
destroy .mlb .mlb2 .sc
set fred { {1 2 3} {4 5 6} {7 8 9}}
set fred2 [string repeat "{aaaa bbbbb cccc} " 1000]
pack [multilistbox .mlb2 -selectmode multiple -width {30 20 10} \
-listvariable fred2 -title {One Two Three} \
-yscrollcommand ".sc set"] -expand 1 -fill both -side left
pack [scrollbar .sc -orient v -command ".mlb2 yview"] -side right \
-anc nw -fill yMissing Functions:
While procs for insert, and other listbox functions are missing, they are easy to implement as we can query one of the set of listboxes as they all have the same settings. Settings options likewise is simply a case of iterating for each listbox.
Conclusion:
Ramblings:
While the above takes longer to document than it does to write, a complete widget would take several days to construct to be as fully conformant as the original listbox widget.
The triviality of the code above makes the use of megawidget frameworks such as widget and Snit redundant and inefficient.
Using bindings it would be easy to virtualise the data in the listboxes without having to create another type of widget (such as Hugelist) et al.
E.g., (use -listvar and bind to PageUp, PageDn et al).
See also
ulis I don't understand why this link was not added by the author of this page (which was able to add a link in the referred page). Is this a Tcl attitude?
LV Tcl is a programming language - it doesn't have attitudes. It isn't an attitude by most who write wiki pages - most of us love to add links. I suggest continuing to add links when you find them missing.