[ulis], 2003-08-09: Just a minimal multi listboxes megawidget with resizable columns. [http://perso.wanadoo.fr/maurice.ulis/tcl/multilist.gif] ---- '''The minimal megawidget''' # -------------------------------- # # 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 [namespace code [list start $w %x]] bind $w.t [namespace code [list stop $w %x]] bind $w.t [namespace code [list resize $w %x]] # bind the select events bind $w.f.l1 <> [namespace code [list synchro $w 1 2 3]] bind $w.f.l2 <> [namespace code [list synchro $w 2 3 1]] bind $w.f.l3 <> [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''' # ============= # 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] } } } ---- [D. McC] See also WISH List 0.2.2: http://www.geocities.com/pa_mcclamrock/wishlist-0.2.2.tar.gz ---- [Category Example] | [Category GUI] | [Category Widget]