# --------------------------------
  #
  # a minimal multi listboxes megawidget
  #
  # --------------------------------

  namespace eval multilist \
  {
    namespace export multilist

    # -----------------
    # the constructor
    # -----------------
    proc multilist {w args} \
    {
      variable {}
      # variables
      set ($w:yview) 0
      set ($w:started) 0
      set ($w:resizing) 0
      # options
      set lheight 20
      set theight 20
      set width1 20
      set width2 20
      set width3 20
      set font {Courier -12}
      set lcolor white
      set tcolor gray90
      array set titles {1 1 2 2 3 3}
      foreach {key value} $args \
      {
        switch -glob -- $key \
        {
          -font     { set font $value }
          -lcolor   { set lcolor $value }
          -tcolor   { set tcolor $value }
          -lheight  { set lheight $value }
          -theight  { set theight $value }
          -titles   { array set titles $value }
          -width1   { set width1 $value }
          -width2   { set width2 $value }
          -width3   { set width3 $value }
        }
      }
      set ($w:chwidth) [font measure $font 0]
      set ($w:theight) $theight
      # widgets
      pack [frame $w] -fill both -expand 1
      frame $w.t -cursor sb_h_double_arrow
      frame $w.f -bg beige
      set ty [expr {$theight / 2}]
      foreach i {1 2 3} \
      {
        set width [set width$i]
        set pwidth [expr {$width * $($w:chwidth)}]
        canvas $w.t.l$i -width $pwidth -height $theight -bg $tcolor -bd 1 -relief ridge \
          -highlightthickness 0 -cursor arrow
        $w.t.l$i create text [expr {$pwidth / 2}] $ty -text $titles($i) -font $font
        listbox $w.f.l$i -yscrollc [namespace code [list yscroll $w]] \
          -font $font -width $width -height $lheight \
          -bd 2 -relief groove -highlightthickness 0 \
          -exportselection 0
      }
      scrollbar $w.vs -command [namespace code [list yview $w]]
      grid $w.t  -column 0 -row 0 -sticky nsew
      grid $w.f  -column 0 -row 1 -sticky nsew
      grid $w.vs -column 1 -row 0 -rowspan 2 -sticky ns
      grid $w.t.l1 -column 0 -row 0 -padx 1
      grid $w.t.l2 -column 1 -row 0 -padx 1
      grid $w.t.l3 -column 2 -row 0 -padx 1 -sticky ew
      grid $w.f.l1 -column 0 -row 1 -sticky ns
      grid $w.f.l2 -column 1 -row 1 -sticky ns
      grid $w.f.l3 -column 2 -row 1 -sticky ewns
      grid rowconfigure    $w 1 -weight 1
      grid columnconfigure $w 0 -weight 1
      grid rowconfigure    $w.t 1 -weight 1
      grid columnconfigure $w.t 2 -weight 1
      grid rowconfigure    $w.f 1 -weight 1
      grid columnconfigure $w.f 2 -weight 1
      # bind the Motion event
      bind $w.t <ButtonPress-1>   [namespace code [list start  $w %x]]
      bind $w.t <ButtonRelease-1> [namespace code [list stop   $w %x]]
      bind $w.t <Motion>          [namespace code [list resize $w %x]]
      # bind the select events
      bind $w.f.l1 <<ListboxSelect>> [namespace code [list synchro $w 1 2 3]]
      bind $w.f.l2 <<ListboxSelect>> [namespace code [list synchro $w 2 3 1]]
      bind $w.f.l3 <<ListboxSelect>> [namespace code [list synchro $w 3 1 2]]
      # return ref
      return $w
    }

    # -----------------
    # the scroll procs
    # -----------------
      # called by a listbox
    proc yscroll {w args} \
    { 
      if {![winfo exists $w.vs]} { return }
      eval [linsert $args 0 $w.vs set]
      yview $w moveto [lindex [$w.vs get] 0]
    }
      # called by the scroll bar
    proc yview {w args} \
    { 
      variable {}
      if {$($w:yview)} { return }
      set ($w:yview) 1
      foreach i {1 2 3} { eval $w.f.l$i yview $args } 
      set ($w:yview) 0
    }
      # called by a select event
    proc synchro {w i1 i2 i3} \
    {
      set sel [$w.f.l$i1 cursel]
      $w.f.l$i2 selection clear 0 end
      $w.f.l$i3 selection clear 0 end
      foreach item $sel { $w.f.l$i2 selection set $item }
      foreach item $sel { $w.f.l$i3 selection set $item }
    }

    # -----------------
    # the resize procs
    # -----------------
      # start resizing
    proc start {w x} \
    { 
      variable {}
      set ($w:started) 1 
      set i 0
      set ww 0
      while {$ww < $x} \
      {
        incr i
        incr ww [winfo width $w.f.l$i]
      }
      set ($w:i) $i
    }
      # stop resizing
    proc stop {w x} { variable {}; set ($w:started) 0 }
      # resize
    proc resize {w x} \
    {
      variable {}
      if {!$($w:started) || $($w:resizing) || $($w:i) == 0} { return }
      set ($w:resizing) 1
      set ww 0
      set i 1
      while {$i < $($w:i)} \
      {
        incr ww [winfo width $w.f.l$i]
        incr i
      }
      set i $($w:i)
      set lwidth [expr {($x - $ww) / $($w:chwidth)}]
      set twidth [expr {$lwidth * $($w:chwidth)}]
      $w.t.l$i config -width $twidth
      $w.t.l$i coord all [expr {$twidth / 2}] [expr {$($w:theight) / 2}]
      $w.f.l$i config -width $lwidth
      update
      set ($w:resizing) 0
    }
  }

  # =============
  #  demo
  # =============

  wm title . "multi listboxes"

  # create the multilistbox
  namespace import ::multilist::multilist
  multilist .ml -width1 10 -width2 20 -width3 30 \
    -titles {1 command 2 category 3 description} -tcolor beige
  pack .ml -fill both -expand 1
  # fill the multilistbox
  # (data from ActiveState ActiveTcl 8.4.2.0 Help)
  set data \
  {
    {{after} {Control Constructs} {Execute a command after a time delay}}
    {{append} {Variables and Procedures} {Append to variable}}
    {{array} {Variables and Procedures} {Manipulate array variables}}
    {{bgerror} {Interpreter Routines} {Command invoked to process background errors}}
    {{binary} {String Handling} {Insert and extract fields from binary strings}}
    {{break} {Control Constructs} {Abort looping command}}
    {{catch} {Control Constructs} {Evaluate script and trap exceptional returns}}
    {{cd} {System Related} {Change working directory}}
    {{clock} {System Related} {Obtain and manipulate time}}
    {{close} {Output} {Close an open channel.}}
    {{concat} {List Handling} {Join lists together}}
    {{continue} {Control Constructs} {Skip to the next iteration of a loop}}
    {{dde} {Platform-specific} {Execute a Dynamic Data Exchange command}}
    {{encoding} {Library Procedures} {Manipulate encodings}}
    {{eof} {Output} {Check for end of file condition on channel}}
    {{error} {Control Constructs} {Generate an error}}
    {{eval} {Control Constructs} {Evaluate a Tcl script}}
    {{exec} {System Related} {Invoke subprocess(es)}}
    {{exit} {System Related} {End the application}}
    {{expr} {Expr} {Evaluate an expression}}
    {{fblocked} {Output} {Test whether the last input operation exhausted all available input}}
    {{fconfigure} {Output} {Set and get options on a channel}}
    {{fcopy} {Output} {Copy data from one channel to another.}}
    {{file} {Output} {Manipulate file names and attributes}}
    {{fileevent} {Output} {Execute a script when a channel becomes readable or writable}}
    {{flush} {Output} {Flush buffered output for a channel}}
    {{for} {Control Constructs} {``For'' loop}}
    {{foreach} {Control Constructs} {Iterate over all elements in one or more lists}}
    {{format} {String Handling} {Format a string in the style of sprintf}}
    {{gets} {Output} {Read a line from a channel}}
    {{glob} {System Related} {Return names of files that match patterns}}
    {{global} {Variables and Procedures} {Access global variables}}
    {{history} {Interpreter Routines} {Manipulate the history list}}
    {{http} {Library Procedures} {Client-side implementation of the HTTP/1.0 protocol.}}
    {{if} {Control Constructs} {Execute scripts conditionally}}
    {{incr} {Variables and Procedures} {Increment the value of a variable}}
    {{info} {Interpreter Routines} {Return information about the state of the Tcl interpreter}}
    {{interp} {Interpreter Routines} {Create and manipulate Tcl interpreters}}
    {{join} {List Handling} {Create a string by joining together list elements}}
    {{lappend} {Variables and Procedures} {Append list elements onto a variable}}
    {{lindex} {List Handling} {Retrieve an element from a list}}
    {{linsert} {List Handling} {Insert elements into a list}}
    {{list} {List Handling} {Create a list}}
    {{llength} {List Handling} {Count the number of elements in a list}}
    {{load} {Packages and Source files} {Load machine code and initialize new commands.}}
    {{loadTk} {Packages and Source files} {Load Tk into a safe interpreter.}}
    {{lrange} {List Handling} {Return one or more adjacent elements from a list}}
    {{lreplace} {List Handling} {Replace elements in a list with new elements}}
    {{lsearch} {List Handling} {See if a list contains a particular element}}
    {{lset} {Variables and Procedures} {Change an element in a list}}
    {{lsort} {List Handling} {Sort the elements of a list}}
    {{memory} {Interpreter Routines} {Control Tcl memory debugging capabilities.}}
    {{msgcat} {Library Procedures} {Tcl message catalog}}
    {{namespace} {Variables and Procedures} {create and manipulate contexts for commands and variables}}
    {{open} {Output} {Open a file-based or command pipeline channel}}
    {{package} {Packages and Source files} {Facilities for package loading and version control}}
    {{pid} {System Related} {Retrieve process id(s)}}
    {{pkg::create} {Packages and Source files} {Construct an appropriate \fBpackage ifneeded\fR}}
    {{pkg_mkIndex} {Packages and Source files} {Build an index for automatic loading of packages}}
    {{proc} {Variables and Procedures} {Create a Tcl procedure}}
    {{puts} {Output} {Write to a channel}}
    {{pwd} {System Related} {Return the current working directory}}
    {{re_syntax} {String Handling} {Syntax of Tcl regular expressions.}}
    {{read} {Output} {Read from a channel}}
    {{regexp} {String Handling} {Match a regular expression against a string}}
    {{registry} {Platform-specific} {Manipulate the Windows registry}}
    {{regsub} {String Handling} {Perform substitutions based on regular expression pattern matching}}
    {{rename} {Variables and Procedures} {Rename or delete a command}}
    {{resource} {Platform-specific} {Manipulate Macintosh resources}}
    {{return} {Control Constructs} {Return from a procedure}}
    {{scan} {String Handling} {Parse string using conversion specifiers in the style of sscanf}}
    {{seek} {Output} {Change the access position for an open channel}}
    {{set} {Variables and Procedures} {Read and write variables}}
    {{socket} {Output} {Open a TCP network connection}}
    {{source} {Packages and Source files} {Evaluate a file or resource as a Tcl script}}
    {{split} {List Handling} {Split a string into a proper Tcl list}}
    {{string} {String Handling} {Manipulate strings}}
    {{subst} {String Handling} {Perform backslash, command, and variable substitutions}}
    {{switch} {Control Constructs} {Evaluate one of several scripts, depending on a given value}}
    {{tell} {Output} {Return current access position for an open channel}}
    {{time} {System Related} {Time the execution of a script}}
    {{trace} {Variables and Procedures} {Monitor variable accesses, command usages and command executions}}
    {{unknown} {Interpreter Routines} {Handle attempts to use non-existent commands}}
    {{unset} {Variables and Procedures} {Delete variables}}
    {{update} {Control Constructs} {Process pending events and idle callbacks}}
    {{uplevel} {Control Constructs} {Execute a script in a different stack frame}}
    {{upvar} {Variables and Procedures} {Create link to variable in a different stack frame}}
    {{variable} {Variables and Procedures} {create and initialize a namespace variable}}
    {{vwait} {Control Constructs} {Process events until a variable is written}}
    {{while} {Control Constructs} {Execute script repeatedly as long as a condition is met}}
  }
  foreach row $data \
  {
    foreach {c1 c2 c3} $row \
    {
      foreach i {1 2 3} \
      { .ml.f.l$i insert end [set c$i] }
    }
  }