The minimal megawidget edit
# --------------------------------
#
# 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
}
}A demo edit
# =============
# 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] }
}
}See also edit
- http://www.geocities.com/pa_mcclamrock/wishlist-0.2.2.tar.gz
(broken) - A minimal minimal multi listbox widget
D. McC See also WISH List 0.2.2: http://www.geocities.com/pa_mcclamrock/wishlist-0.2.2.tar.gz
(broken)PWQ: Taking a devils advocate approach see A minimal minimal multi listbox widget
Zipguy 2013-07-03 - You can find out my email address by clicking on Zipguy.ulis was a great guy who passed on. So, I fixed the screenshot above (which is from my site).Also, I made the two files together, which did not work as separate files (they would have needed pkgindex.tcl and provide statement within the multilist.tcl), into one file.Then I converted it to an SDX file, using ezsdx, and provided it at demo_multil_simple.kit
. It is around 4.4k vs 12k which makes it a lot smaller. You could use SDX, or ezsdx, to unwrap it. If you're not concerned about size, then you could also download it at demo_multil_simple.exe (which is around 1.3M, but you can't see what's inside of it).It is rather simplistic, hard coded for only for 3 columns, without sorting options, but it does work well. And it does have a rather interesting resizing columns facility, built in to it.
