Updated 2012-04-21 21:14:53 by RLE ▲

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:

  1. Arrange to the same height.
  2. Be standard with the original listbox.
  3. Support Options.
  4. Scroll together.
  5. Select together.

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.

  1. -listvariable list (Each row is provided as a list).
  2. -width list of widths (The number of elements in the list determines the number of columns)
  3. insert command
  4. get
  5. -title

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:

  1. Click and drag scrolling of a listbox.
  2. PageUp / PageDn events on a listbox.

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 y

Missing 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:

  1. Using options can remove the need to create new and incompatible options for our widgets.
  2. Bindings are the biggest headache in creating new widgets or higher level widgets.

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.

Category ExampleCategory GUICategory Widget