Tablelist is a library package for Tcl/Tk version 8.0 or higher, written in pure Tcl/Tk code. It contains:
A tablelist widget is a multi-column listbox. The width of each column
can be dynamic (i.e., just large enough to hold all its elements, including the
header) or static (specified in characters or pixels). The columns are,
per default, resizable. The alignment of each column can be specified as
left
, right
, or center
.
The columns, rows, and cells can be configured individually. Several
of the global and column-specific options refer to the headers, implemented as
label widgets. For instance, the -labelcommand
option
specifies a Tcl command to be invoked when mouse button 1 is released over a
label. The most common value of this option is tablelist::sortByColumn
, which sorts
the items based on the respective column.
Interactive editing of the elements of a tablelist widget can be enabled for individual cells and for entire columns. A great variety of widgets from the Tk core and from the packages BWidget, Iwidgets, combobox, and Mentry is supported for being used as embedded edit window. In addition, a rich set of keyboard bindings is provided for a comfortable navigation between the editable cells.
The Tcl command corresponding to a tablelist widget is very similar to the
one associated with a normal listbox. There are column-, row-, and
cell-specific counterparts of the configure
and cget
subcommands (columnconfigure
, rowconfigure
,
cellconfigure
, ...). They can be used, among others, to
insert images into the cells and the header labels, or to insert embedded
windows into the cells. The index
, nearest
, and
see
command options refer to the rows, but similar subcommands are
provided for the columns and cells (columnindex
,
cellindex
, ...). The items can be sorted with the
sort
and sortbycolumn
command options.
The bindings defined for the body of a tablelist widget make it behave just
like a normal listbox. This includes the support for the virtual event
<<ListboxSelect>>
(which is equivalent to
<<TablelistSelect>>
). In addition, version 2.3
or higher of the widget callback package Wcb (written in pure Tcl/Tk code as
well) can be used to define callbacks for the activate
,
selection set
, and selection clear
commands, and Wcb version 3.0 or higher also supports callbacks for the
activatecell
, cellselection set
,
and cellselection clear
commands. The download
location of Wcb is
http://www.nemethi.de
Tablelist is available for free download from the same URL as Wcb. The
distribution file is tablelist3.6.tar.gz
for UNIX and
tablelist3_6.zip
for Windows. These files contain the same
information, except for the additional carriage return character preceding the
linefeed at the end of each line in the text files for Windows.
Install the package as a subdirectory of one of the directories given by the
auto_path
variable. For example, you can install it as a
directory at the same level as the Tcl and Tk script libraries. The
locations of these library directories are given by the
tcl_library
and tk_library
variables, respectively.
To install Tablelist on UNIX, cd
to the desired
directory and unpack the distribution file tablelist3.6.tar.gz
:
gunzip -c tablelist3.6.tar.gz | tar -xf -
This command will create a directory named tablelist3.6
, with
the subdirectories demos
, doc
, images
,
and scripts
.
On Windows, use WinZip or some other program capable of unpacking the
distribution file tablelist3_6.zip
into the directory
tablelist3.6
, with the subdirectories demos
,
doc
, images
, and scripts
.
Note that the directory images
and the file
tablelistEdit.tcl
in the scripts
directory are only
needed for applications making use of interactive cell editing.
Similarly, the file tablelistMove.tcl
in the same directory is
only needed for applications invoking the move
or
movecolumn
command.
Next, you should check the exact version number of your Tcl/Tk distribution,
given by the tcl_patchLevel
and tk_patchLevel
variables. If you are using Tcl/Tk version 8.2.X, 8.3.0 - 8.3.2, or
8.4a1, then you should upgrade your Tcl/Tk distribution to a higher
release. This is because a bug in these Tcl versions (fixed in Tcl 8.3.3
and 8.4a2) causes excessive memory use when calling info
exists
on non-existent array elements, and Tablelist makes a lot
of invocations of this command.
If for some reason you cannot upgrade your Tcl/Tk version, then you should
execute the Tcl script repair.tcl
in the directory
scripts
. This script makes backup copies of several files
contained in this directory, and then creates new versions of them by replacing
all invocations of info exists
for array elements with
a call to the helper procedure arrElemExists
. The patched
files work with all Tcl/Tk releases starting with 8.0, but the original ones
have a much better performance.
To be able to access the commands and variables defined in the package Tablelist, your scripts must contain one of the lines
package require Tablelist package require tablelist
You can use either one of the above two statements because the file
tablelist.tcl
contains both lines
package provide Tablelist ... package provide tablelist ...
You are free to remove one of these two lines from
tablelist.tcl
if you want to prevent the package from making
itself known under two different names. Of course, by doing so you
restrict the argument of package require
to a single
name. Notice that the examples below use the
statement package require Tablelist
.
Since the package Tablelist is implemented in its own namespace called
tablelist
, you must either invoke the
namespace import tablelist::pattern ?tablelist::pattern ...?
command to import the procedures you need, or use qualified names
like tablelist::tablelist
. In the examples below we have
chosen the latter approach.
To access Tablelist variables, you must use qualified
names. There are only two Tablelist variables that are designed to be
accessed outside the namespace tablelist
:
tablelist::version
holds the current version
number of the Tablelist package.
tablelist::library
holds the location of the
Tablelist installation directory.
The file config.tcl
in the demos
directory
contains a procedure demo::displayConfig
that displays the
configuration options of an arbitrary widget in a tablelist contained in a
newly created top-level widget and allows you to edit these options. This
procedure can prove to be quite useful during interactive GUI
development. To test it, start wish
and evaluate the file by
using the source
command as follows:
wish
was started in the demos
directory then
it is sufficient to enter
source config.tcl
wish
was started in some other directory then you can use
the tablelist::library
variable to find the location of the
file:
package require Tablelist source [file join $tablelist::library demos config.tcl]
In both cases, the script will print the following message to
stdout
:
To display the configuration options of an arbitrary widget, enter demo::displayConfig <widgetName>
It is assumed that the Tcl command associated with the widget specified by
<widgetName>
has a configure
subcommand which,
when invoked without any argument, returns a list describing all of the
available configuration options for the widget, in the common format known from
the standard Tk widgets. The demo::displayConfig
procedure
inserts the items of this list into a scrolled tablelist with 5 dynamic-width
columns and interactive sort capability, and returns the name of the newly
created tablelist widget:
package require Tablelist namespace eval demo { # # Get the current windowing system ("x11", "win32", "classic", or "aqua") # and add some entries to the Tk option database for the following # widget hierarchy within a top-level widget of the class DemoTop: # # Name Class # ----------------------------- # tf Frame # tbl Tabellist # vsb, hsb Scrollbar # bf Frame # b1, b2, b3 Button # variable winSys if {[catch {tk windowingsystem} winSys] != 0} { switch $::tcl_platform(platform) { unix { set winSys x11 } windows { set winSys win32 } macintosh { set winSys classic } } } if {[string compare $winSys "x11"] == 0} { option add *DemoTop*Font "Helvetica -12" option add *DemoTop*selectBackground #447bcd option add *DemoTop*selectForeground white } else { option add *DemoTop.tf.borderWidth 2 option add *DemoTop.tf.relief sunken option add *DemoTop.tf.tbl.borderWidth 0 option add *DemoTop.tf.tbl.highlightThickness 0 } if {[string compare $winSys "classic"] == 0} { option add *DemoTop*background #dedede } option add *DemoTop.tf.tbl.activeStyle frame option add *DemoTop.tf.tbl.background gray98 option add *DemoTop.tf.tbl.stripeBackground #e0e8f0 option add *DemoTop.tf.tbl*Entry.background ivory option add *DemoTop.tf.tbl.setGrid yes option add *DemoTop.bf.Button.width 10 } #------------------------------------------------------------------------------ # demo::displayConfig # # Displays the configuration options of the widget w in a tablelist widget # contained in a newly created top-level widget. Returns the name of the # tablelist widget. #------------------------------------------------------------------------------ proc demo::displayConfig w { if {![winfo exists $w]} { bell tk_messageBox -icon error -message "Bad window path name \"$w\"" \ -type ok return "" } # # Create a top-level widget of the class DemoTop # set top .configTop for {set n 2} {[winfo exists $top]} {incr n} { set top .configTop$n } toplevel $top -class DemoTop wm title $top "Configuration Options of the [winfo class $w] Widget \"$w\"" # # Create a scrolled tablelist widget with 5 dynamic-width # columns and interactive sort capability within the top-level # set tf $top.tf frame $tf set tbl $tf.tbl set vsb $tf.vsb set hsb $tf.hsb tablelist::tablelist $tbl \ -columns {0 "Command-Line Name" 0 "Database/Alias Name" 0 "Database Class" 0 "Default Value" 0 "Current Value"} \ -labelcommand tablelist::sortByColumn -sortcommand demo::compareAsSet \ -editendcommand demo::applyValue -height 15 -width 100 -stretch all \ -xscrollcommand [list $hsb set] -yscrollcommand [list $vsb set] $tbl columnconfigure 3 -maxwidth 30 $tbl columnconfigure 4 -maxwidth 30 -editable yes scrollbar $vsb -orient vertical -command [list $tbl yview] scrollbar $hsb -orient horizontal -command [list $tbl xview] # # Create three buttons within a frame child of the top-level widget # set bf $top.bf frame $bf set b1 $bf.b1 set b2 $bf.b2 set b3 $bf.b3 button $b1 -text "Refresh" -command [list demo::putConfig $w $tbl] button $b2 -text "Sort as set" -command [list $tbl sort] button $b3 -text "Close" -command [list destroy $top] # # Manage the widgets # . . . # # Fill the tablelist with the configuration options of the given widget # putConfig $w $tbl return $tbl }
The procedure invokes the tablelist::tablelist
command to create a
tablelist widget. The value of the -columns
option passed to this
command specifies the widths, titles, and alignments of the 5 columns.
The width of each column is given as 0
, specifying that the
column's width is to be made just large enough to hold all the elements in the
column, including its title, which is the string following the width. We
have omitted the alignment specifications (which can optionally follow the
titles), because the columns shall all be left-justified.
The command tablelist::sortByColumn
, specified as
the value of the -labelcommand
option, will be
invoked whenever mouse button 1 is released over one of the labels. This
command sorts the items based on the column corresponding to that label, in the
right order, by invoking the sortbycolumn
subcommand of the
Tcl command associated with the tablelist widget.
As seen from the creation of the button displaying the text
"Sort as set"
, the items will also be sorted by
invoking the sort
subcommand. This makes it necessary to specify a command to be used for
the comparison of the items, as the value of the -sortcommand
option. In our
example this is the demo::compareAsSet
procedure shown below.
The -editendcommand
option
specifies the command to be invoked automatically whenever the interactive
editing of a cell's contents is finished and the final contents of the
temporary embedded entry widget used for the editing are different from its
original one. Per default, the elements of a tablelist widget can only be
edited programmatically, but we enable the interactive editing for the cells of
the last column with the aid of the -editable
column configuration
option.
By specifying the value all
for the -stretch
configuration option we make
sure that all of the columns will be stretched to eliminate the blank space
that might appear at the right of the table.
For the last two columns of the tablelist we use the -maxwidth
column configuration
option, to make sure that the dynamic widths of these columns won't exceed 30
characters.
Besides the options given on the command line, our tablelist widget will
automatically inherit the ones contained in the Tk option database entries
specified in the namespace initialization preceding the
demo::displayConfig
procedure. The database name
activeStyle
corresponds to the -activestyle
configuration
option; its value frame
makes the active item appear surrounded
with a thin frame. The database name stripeBackground
corresponds to the -stripebackground
configuration option. According to this entry, every other row of the
tablelist widget will be displayed in the background color
#e0e8f0
, which improves the readability of the items and gives the
widget a nice appearance.
We populate the tablelist by invoking the demo::putConfig
procedure discussed below. The same script is associated with the
Refresh
button, as the value of its -command
configuration option. This procedure is implemented as follows:
#------------------------------------------------------------------------------ # demo::putConfig # # Outputs the configuration options of the widget w into the tablelist widget # tbl. #------------------------------------------------------------------------------ proc demo::putConfig {w tbl} { if {![winfo exists $w]} { bell tk_messageBox -icon error -message "Bad window path name \"$w\"" \ -parent [winfo toplevel $tbl] -type ok return "" } # # Display the configuration options of w in the tablelist widget tbl # $tbl delete 0 end foreach configSet [$w configure] { # # Insert the list configSet into the tablelist widget # $tbl insert end $configSet if {[llength $configSet] == 2} { $tbl rowconfigure end -foreground gray50 -selectforeground gray75 $tbl cellconfigure end -editable no } else { # # Change the colors of the first and last cell of the row # if the current value is different from the default one # set default [lindex $configSet 3] set current [lindex $configSet 4] if {[string compare $default $current] != 0} { foreach col {0 4} { $tbl cellconfigure end,$col \ -foreground red -selectforeground yellow } } } } $tbl sortbycolumn 0 $tbl activate 0 $tbl attrib widget $w }
After deleting the current items of the tablelist widget tbl
,
the procedure inserts the items of the list returned by the
configure
subcommand of the Tcl command associated with the widget
w
. For each option that is merely an abbreviated form of
some other one, we use the rowconfigure
tablelist
subcommand to change the normal and selection foreground colors of the item
just appended, and we disable the interactive editing in the last inserted cell
by using the -editable
cell configuration
option. The cellconfigure
tablelist
operation is also invoked for each real option whose current value is different
from the default one, to change the values of the -foreground
and
-selectforeground
options of the cells no. 0 and 4, containing the
command-line name of the option and its current value.
Each tablelist widget may have any number of private attributes,
which can be set and retrieved with the aid of the attrib
subcommand of the Tcl command
corresponding to the widget. The demo::putConfig
procedure
sets the widget
attribute to the name of the widget whose options
are displayed in the tablelist.
The implementation of the comparison command
demo::compareAsSet
mentioned above is quite simple:
#------------------------------------------------------------------------------ # demo::compareAsSet # # Compares two items of a tablelist widget used to display the configuration # options of an arbitrary widget. The item in which the current value is # different from the default one is considered to be less than the other; if # both items fulfil this condition or its negation then string comparison is # applied to the two option names. #------------------------------------------------------------------------------ proc demo::compareAsSet {item1 item2} { foreach {opt1 dbName1 dbClass1 default1 current1} $item1 \ {opt2 dbName2 dbClass2 default2 current2} $item2 { set changed1 [expr {[string compare $default1 $current1] != 0}] set changed2 [expr {[string compare $default2 $current2] != 0}] if {$changed1 == $changed2} { return [string compare $opt1 $opt2] } elseif {$changed1} { return -1 } else { return 1 } } }
Finally, here is the implementation of the demo::applyValue
procedure, specified as the value of the -editendcommand
option:
#------------------------------------------------------------------------------ # demo::applyValue # # Applies the new value of the configuraton option contained in the given row # of the tablelist widget tbl to the widget whose options are displayed in it, # and updates the colors of the first and last cell of the row. #------------------------------------------------------------------------------ proc demo::applyValue {tbl row col text} { # # Try to apply the new value of the option contained in # the given row to the widget whose options are displayed # in the tablelist; reject the value if the attempt fails # set w [$tbl attrib widget] set opt [$tbl cellcget $row,0 -text] if {[catch {$w configure $opt $text} result] != 0} { bell tk_messageBox -parent [winfo toplevel $tbl] -title Error \ -icon error -message $result -type ok $tbl rejectinput return "" } # # Replace the new option value with its canonical form and # update the colors of the first and last cell of the row # set text [$w cget $opt] set default [$tbl cellcget $row,3 -text] if {[string compare $default $text] == 0} { foreach col {0 4} { $tbl cellconfigure $row,$col \ -foreground "" -selectforeground "" } } else { foreach col {0 4} { $tbl cellconfigure $row,$col \ -foreground red -selectforeground yellow } } return $text }
The procedure retrieves the name of the widget whose options are displayed
in the tablelist, as the value of its widget
attribute, and
invokes the cellcget
tablelist subcommand to get the name of the option specified in the first cell
of the row whose last element was just edited. Next, it tries to apply
the new value of the option to the widget, and invokes the rejectinput
subcommand if the
attempt fails. Otherwise it replaces the new option value with its
canonical form and updates the normal and selection foreground colors of the
cells no. 0 and 4. The canonical form of the option value is given by the
cget
subcommand of the Tcl command associated with that
widget. For example, a boolean value will always be replaced with
1
or 0
, even if the entry contains the string
yes
or no
. The procedure returns this canonical
option value, thus making sure that the latter will become the new contents of
the cell that was just edited.
The file browse.tcl
in the demos
directory
contains a procedure demo::displayChildren
that displays
information about the children of an arbitrary widget in a tablelist contained
in a newly created top-level widget. To test it, start wish
and evaluate the file by using the source
command, in a similar
way as in the case of the previous example.
The script will print the following message to stdout
:
To display information about the children of an arbitrary widget, enter demo::displayChildren <widgetName>
The demo::displayChildren
command inserts some data of the
children of the widget specified by <widgetName>
into a
vertically scrolled tablelist with 9 dynamic-width columns and interactive sort
capability, and returns the name of the newly created tablelist widget.
By double-clicking on an item or invoking the first entry of a pop-up menu
within the body of the tablelist, you can display the data of the children of
the widget corresponding to the selected item, and with the second menu entry
you can display its configuration options (see the previous example for
details). To go one level up, click on the Parent
button.
package require Tablelist namespace eval demo { variable dir [file join $tablelist::library demos] # # Create two images, needed in the procedure putChildren # variable leafImg [image create bitmap -file [file join $dir leaf.xbm] \ -background coral -foreground gray50] variable compImg [image create bitmap -file [file join $dir comp.xbm] \ -background yellow -foreground gray50] } source [file join $demo::dir config.tcl] #------------------------------------------------------------------------------ # demo::displayChildren # # Displays information on the children of the widget w in a tablelist widget # contained in a newly created top-level widget. Returns the name of the # tablelist widget. #------------------------------------------------------------------------------ proc demo::displayChildren w { if {![winfo exists $w]} { bell tk_messageBox -icon error -message "Bad window path name \"$w\"" \ -type ok return "" } # # Create a top-level widget of the class DemoTop # set top .browseTop for {set n 2} {[winfo exists $top]} {incr n} { set top .browseTop$n } toplevel $top -class DemoTop # # Create a vertically scrolled tablelist widget with 9 dynamic-width # columns and interactive sort capability within the top-level # set tf $top.tf frame $tf set tbl $tf.tbl set vsb $tf.vsb tablelist::tablelist $tbl \ -columns {0 "Path Name" left 0 "Class" left 0 "X" right 0 "Y" right 0 "Width" right 0 "Height" right 0 "Mapped" center 0 "Viewable" center 0 "Manager" left} \ -labelcommand demo::labelCmd -yscrollcommand [list $vsb set] -width 0 foreach col {2 3 4 5} { $tbl columnconfigure $col -sortmode integer } foreach col {6 7} { $tbl columnconfigure $col -formatcommand demo::formatBoolean } scrollbar $vsb -orient vertical -command [list $tbl yview] # # When displaying the information about the children of any # ancestor of the label widgets, the widths of some of the # labels and thus also the widths and x coordinates of some # children may change. For this reason, make sure the items # will be updated after any change in the sizes of the labels # foreach l [$tbl labels] { bind $l <Configure> [list demo::updateItemsDelayed $tbl] } bind $tbl <Configure> [list demo::updateItemsDelayed $tbl] # # Create a pop-up menu with two command entries; bind the script # associated with its first entry to the <Double-1> event, too # set menu $top.menu menu $menu -tearoff no $menu add command -label "Display children" \ -command [list demo::putChildrenOfSelWidget $tbl] $menu add command -label "Display config" \ -command [list demo::dispConfigOfSelWidget $tbl] set bodyTag [$tbl bodytag] bind $bodyTag <<Button3>> [bind TablelistBody <Button-1>] bind $bodyTag <<Button3>> +[bind TablelistBody <ButtonRelease-1>] bind $bodyTag <<Button3>> +[list demo::postPopupMenu $top %X %Y] bind $bodyTag <Double-1> [list demo::putChildrenOfSelWidget $tbl] # # Create three buttons within a frame child of the top-level widget # set bf $top.bf frame $bf set b1 $bf.b1 set b2 $bf.b2 set b3 $bf.b3 button $b1 -text "Refresh" button $b2 -text "Parent" button $b3 -text "Close" -command [list destroy $top] # # Manage the widgets # . . . # # Fill the tablelist with the data of the given widget's children # putChildren $w $tbl return $tbl }
The procedure invokes the tablelist::tablelist
command to create a
tablelist widget. The value of the -columns
option passed to this
command specifies the widths, titles, and alignments of the 9 columns.
The width of each column is given as 0
, specifying that the
column's width is to be made just large enough to hold all the elements in the
column, including its title, which is the string following the width.
Each of the titles is followed by an alignment, which indicates how to justify
both the elements and the title of the respective column.
The command demo::labelCmd
, specified as the value of the
-labelcommand
option, will be invoked whenever mouse button 1 is released over one of the
labels. We will discuss this procedure a little later.
We specify the value 0
for the widget's -width
option, meaning that the
tablelist's width shall be made just large enough to hold all its columns.
After creating the tablelist widget, we make sure that the elements of its
columns 2, 3, 4, and 5 (displaying the x and y coordinates as well as the
widths and heights of the children) will be compared as integers when sorting
the items based on one of these columns. We do this with the aid of the
columnconfigure
tablelist operation.
The same columnconfigure
subcommand enables us to specify that,
when displaying the elements of columns 6 and 7 (having the titles
"Mapped"
and "Viewable"
, respectively), the boolean
values 1
and 0
will be replaced with the strings
"yes"
and "no"
, returned by the
demo::formatBoolean
command shown below.
After creating the vertical scrollbar, we iterate over the elements of the
list containing the path names of all header labels of the tablelist widget,
returned by the labels
subcommand of the Tcl command corresponding to the widget. For each
element of the list, we bind the procedure
demo::updateItemsDelayed
to the <Configure>
event. In this way we make sure the procedure will be invoked whenever
the header label indicated by that list element changes size.
The four invocations of the bind
command following the
creation of the pop-up menu make use of a binding tag whose name depends on the
path name of the tablelist widget and is returned by the bodytag
subcommand of the Tcl command
associated with the tablelist widget. The advantage of using this tag
instead of the path name of the tablelist's body is that this binding tag is
associated not only with the body but also with the separator frames and with
the labels displaying embedded images. This is important in our example
because we want to make sure the <<Button3>>
and
<Double-1>
events will be handled in the same way within a
label containing an embedded image as in the rest of the tablelist's
body. Both the <<Button3>>
virtual event
(used in the first three bind
commands) and the TablelistBody
binding tag (used
in the first binding script) are created by the Tablelist package. The
first three bind
commands make sure that a
<<Button3>>
virtual event will select and activate the
nearest item and will post a pop-up menu with two command entries that refer to
the widget described by that item.
We populate the tablelist by invoking the demo::putChildren
procedure, implemented as follows:
#------------------------------------------------------------------------------ # demo::putChildren # # Outputs the data of the children of the widget w into the tablelist widget # tbl. #------------------------------------------------------------------------------ proc demo::putChildren {w tbl} { # # The following check is necessary because this procedure # is also invoked by the "Refresh" and "Parent" buttons # if {![winfo exists $w]} { . . . } set top [winfo toplevel $tbl] wm title $top "Children of the [winfo class $w] Widget \"$w\"" # # Display the data of the children of the # widget w in the tablelist widget tbl # variable leafImg variable compImg $tbl resetsortinfo $tbl delete 0 end foreach c [winfo children $w] { # # Insert the data of the current child into the tablelist widget # set item {} lappend item $c [winfo class $c] [winfo x $c] [winfo y $c] \ [winfo width $c] [winfo height $c] [winfo ismapped $c] \ [winfo viewable $c] [winfo manager $c] $tbl insert end $item # # Insert an image into the first cell of the row # if {[llength [winfo children $c]] == 0} { $tbl cellconfigure end,0 -image $leafImg } else { $tbl cellconfigure end,0 -image $compImg } } # # Configure the "Refresh" and "Parent" buttons # $top.bf.b1 configure -command [list demo::putChildren $w $tbl] set b2 $top.bf.b2 set p [winfo parent $w] if {[string compare $p ""] == 0} { $b2 configure -state disabled } else { $b2 configure -state normal -command [list demo::putChildren $p $tbl] } }
After resetting the sorting information by invoking the resetsortinfo
subcommand and
deleting the current items of the tablelist widget tbl
, the
procedure iterates over the children of the specified widget and inserts the
items built from some data retrieved by using the winfo
command. For each child, it invokes the cellconfigure
tablelist
operation to set the value of the -image
option of the first cell,
containing the path name of the child. In this way, the procedure inserts
the image $leafImg
or $compImg
into the first cell,
depending upon whether the child in question is a leaf or a composite
widget. Remember that both images were created outside this procedure,
within the initialization of the demo
namespace.
The demo::formatBoolean
and demo::labelCmd
procedures mentioned above are trivial:
#------------------------------------------------------------------------------ # demo::formatBoolean # # Returns "yes" or "no", according to the specified boolean value. #------------------------------------------------------------------------------ proc demo::formatBoolean val { return [expr {$val ? "yes" : "no"}] } #------------------------------------------------------------------------------ # demo::labelCmd # # Sorts the contents of the tablelist widget tbl by its col'th column and makes # sure the items will be updated 500 ms later (because one of the items might # refer to the canvas containing the arrow that displays the sorting order). #------------------------------------------------------------------------------ proc demo::labelCmd {tbl col} { tablelist::sortByColumn $tbl $col updateItemsDelayed $tbl }
The command tablelist::sortByColumn
sorts the items
of the tablelist widget by the specified column in the right order, by invoking
the sortbycolumn
subcommand of the
Tcl command associated with the tablelist widget.
The implementation of the demo::updateItemsDelayed
command,
invoked in this procedure and already encountered in the
demo::displayChildren
procedure above, is quite simple:
#------------------------------------------------------------------------------ # demo::updateItemsDelayed # # Arranges for the items of the tablelist widget tbl to be updated 500 ms later. #------------------------------------------------------------------------------ proc demo::updateItemsDelayed tbl { # # Schedule the demo::updateItems command for execution # 500 ms later, but only if it is not yet pending # if {[string compare [$tbl attrib afterId] ""] == 0} { $tbl attrib afterId [after 500 [list demo::updateItems $tbl]] } } #------------------------------------------------------------------------------ # demo::updateItems # # Updates the items of the tablelist widget tbl. #------------------------------------------------------------------------------ proc demo::updateItems tbl { # # Reset the tablelist's "afterId" attribute # $tbl attrib afterId "" # # Update the items # set rowCount [$tbl size] for {set row 0} {$row < $rowCount} {incr row} { set c [$tbl cellcget $row,0 -text] if {![winfo exists $c]} { continue } set item {} lappend item $c [winfo class $c] [winfo x $c] [winfo y $c] \ [winfo width $c] [winfo height $c] [winfo ismapped $c] \ [winfo viewable $c] [winfo manager $c] $tbl rowconfigure $row -text $item } }
As already mentioned in the previous example, each tablelist widget may have
any number of private attributes, which can be set and retrieved with the aid
of the attrib
subcommand
of the Tcl command corresponding to the widget. The afterId
attribute is set by the demo::updateItemsDelayed
procedure when
sheduling the demo::updateItems
command for execution 500 ms
later, but only if its value is an empty string. For this reason, the
demo::updateItems
procedure resets this attribute. It also
makes use of the cellcget
tablelist subcommand to get
the path names contained in the first cell of each row, and updates the data
of the children with the aid of the rowconfigure
subcommand.
The remaining three procedures are also straight-forward. For example,
the demo::putChildrenOfSelWidget
command shown below makes use of
the curselection
subcommand to get the index of the selected row. More precisely,
curselection
returns a list, but in our case this list will have
exactly one element, hence it can be used directly as the first component of a
cell index.
#------------------------------------------------------------------------------ # demo::putChildrenOfSelWidget # # Outputs the data of the children of the selected widget into the tablelist # widget tbl. #------------------------------------------------------------------------------ proc demo::putChildrenOfSelWidget tbl { set w [$tbl cellcget [$tbl curselection],0 -text] if {![winfo exists $w]} { bell tk_messageBox -icon error -message "Bad window path name \"$w\"" \ -parent [winfo toplevel $tbl] -type ok return "" } if {[llength [winfo children $w]] == 0} { bell } else { putChildren $w $tbl } }
The script styles.tcl
in the demos
directory
demonstrates some ways of making tablelist widgets smarter and improving the
readability of their items. It creates 6 tablelist widgets, shown in the
following figure:
Here is the relevant code segment:
# # Create, configure, and populate 6 tablelist widgets # frame .f for {set n 0} { $n < 6} {incr n} { set tbl .f.tbl$n tablelist::tablelist $tbl \ -columns {0 "Label 0" 0 "Label 1" 0 "Label 2" 0 "Label 3"} \ -background gray98 -height 4 -width 40 -stretch all switch $n { 1 { ;# top right tablelist $tbl configure -showseparators yes } 2 { ;# middle left tablelist $tbl configure -stripebackground #e0e8f0 } 3 { ;# middle right tablelist $tbl configure -stripebackground #e0e8f0 -showseparators yes } 4 { ;# bottom left tablelist foreach col {1 3} { $tbl columnconfigure $col -background linen } } 5 { ;# bottom right tablelist $tbl configure -showseparators yes foreach col {1 3} { $tbl columnconfigure $col -background linen } } } foreach row {0 1 2 3} { $tbl insert end \ [list "Cell $row,0" "Cell $row,1" "Cell $row,2" "Cell $row,3"] } }
The only configuration option used here but not encountered in the first two
examples is -showseparators
. The
visual effect it produces looks nice both by itself and combined with
horizontal or vertical stripes, created by using the -stripebackground
option
and the columnconfigure
subcommand,
respectively. On the other hand, it is no good idea to mix horizontal
stripes with vertical ones.
The scripts bwidget.tcl
, iwidgets.tcl
, and
miscWidgets.tcl
in the demos
directory create a
tablelist widget displaying some parameters of 16 serial lines, and demonstrate
how to use various widgets from the Tk core and from the packages BWidget,
Iwidgets, combobox (by Bryan Oakley), and Mentry for interactive cell
editing. The following figure shows the tablelist widget, together with a
BWidget ComboBox used to edit the contents of one of its cells:
Here is the relevant code segment from the script bwidget.tcl
(the scripts iwidgets.tcl
and miscWidgets.tcl
are
similar):
package require Tk 8.3 ;# because of entry validation package require Tablelist package require BWidget wm title . "Serial Line Configuration" # # Add some entries to the Tk option database # set dir [file join $tablelist::library demos] source [file join $dir option.tcl] option add *Tablelist*Checkbutton.background ivory option add *Tablelist*Checkbutton.activeBackground ivory option add *Tablelist*Entry.background ivory # # Register some widgets from the BWidget package for interactive cell editing # tablelist::addBWidgetEntry tablelist::addBWidgetSpinBox tablelist::addBWidgetComboBox # # Create two images, to be displayed in tablelist cells with boolean values # set checkedImg [image create photo -file [file join $dir checked.gif]] set uncheckedImg [image create photo -file [file join $dir unchecked.gif]] # # Create a tablelist widget with editable columns (except the first one) # set tbl .tbl tablelist::tablelist $tbl \ -columns {0 "No." right 0 "Available" center 0 "Name" left 0 "Baud Rate" right 0 "Data Bits" center 0 "Parity" left 0 "Stop Bits" center 0 "Handshake" left 0 "Activation Date" center 0 "Activation Time" center} \ -editstartcommand editStartCmd -editendcommand editEndCmd \ -height 0 -width 0 $tbl columnconfigure 0 -sortmode integer $tbl columnconfigure 1 -name available -editable yes -editwindow checkbutton \ -formatcommand emptyStr $tbl columnconfigure 2 -name lineName -editable yes -editwindow Entry \ -sortmode dictionary $tbl columnconfigure 3 -name baudRate -editable yes -editwindow ComboBox \ -sortmode integer $tbl columnconfigure 4 -name dataBits -editable yes -editwindow SpinBox $tbl columnconfigure 5 -name parity -editable yes -editwindow ComboBox $tbl columnconfigure 6 -name stopBits -editable yes -editwindow ComboBox $tbl columnconfigure 7 -name handshake -editable yes -editwindow ComboBox $tbl columnconfigure 8 -name actDate -editable yes -editwindow Entry \ -formatcommand formatDate -sortmode integer $tbl columnconfigure 9 -name actTime -editable yes -editwindow Entry \ -formatcommand formatTime -sortmode integer proc emptyStr val { return "" } proc formatDate val { return [clock format $val -format "%Y-%m-%d"] } proc formatTime val { return [clock format $val -format "%H:%M:%S"] } # # Populate the tablelist widget; set the activation # date & time to 10 minutes past the current clock value # set clock [clock seconds] incr clock 600 for {set n 1} {$n <= 8} {incr n} { $tbl insert end [list $n 1 "Line $n" 9600 8 None 1 XON/XOFF $clock $clock] $tbl cellconfigure end,available -image $checkedImg } for {set n 9} {$n <= 16} {incr n} { $tbl insert end [list $n 0 "Line $n" 9600 8 None 1 XON/XOFF $clock $clock] $tbl cellconfigure end,available -image $uncheckedImg } button .close -text "Close" -command exit # # Manage the widgets # pack .close -side bottom -pady 10 pack $tbl -side top -expand yes -fill both
We invoke the tablelist::addBWidgetEntry
, tablelist::addBWidgetSpinBox
,
and tablelist::addBWidgetComboBox
commands to register the Entry, SpinBox, and ComboBox widgets from the BWidget
package for interactive cell editing. These commands return the values
"Entry"
, "SpinBox"
, and "ComboBox"
,
respectively, which we then use in the -editwindow
column
configuration option to set the edit window for the columns no. 2, ...,
9. In column no. 1 we use the Tk core checkbutton widget, which is
automatically registered for interactive cell editing.
Notice the use of the -name
column configuration option,
which allows us to access the columns by their names instead of by numerical
column indices. This is important, because the file
option.tcl
, which is source
d into the main script,
contains the line
option add *Tablelist.movableColumns yes
The editStartCmd
and editEndCmd
procedures shown
below use the columncget
subcommand to retrieve
the name of the column from the numerical column index.
The editStartCmd
procedure, specified as the value of the
-editstartcommand
configuration option, needs the path name of the edit window, in order to be
able to configure the widget in various ways. This is a common situation,
and Tablelist provides the editwinpath
subcommand for this
purpose:
#------------------------------------------------------------------------------ # editStartCmd # # Applies some configuration options to the edit window; if the latter is a # ComboBox, the procedure populates it. #------------------------------------------------------------------------------ proc editStartCmd {tbl row col text} { set w [$tbl editwinpath] switch [$tbl columncget $col -name] { lineName { # # Set an upper limit of 20 for the number of characters # $w configure -invalidcommand bell -validate key \ -validatecommand {expr {[string length %P] <= 20}} } baudRate { # # Populate the ComboBox and allow no more # than 6 digits in its Entry component # $w configure -values {50 75 110 300 1200 2400 4800 9600 19200 38400 57600 115200 230400 460800 921600} $w configure -invalidcommand bell -validate key -validatecommand \ {expr {[string length %P] <= 6 && [regexp {^[0-9]*$} %S]}} } dataBits { # # Configure the SpinBox # $w configure -range {5 8 1} -editable no } parity { # # Populate the ComboBox and make it non-editable # $w configure -values {None Even Odd Mark Space} -editable no } stopBits { # # Populate the ComboBox and make it non-editable # $w configure -values {1 1.5 2} -editable no } handshake { # # Populate the ComboBox and make it non-editable # $w configure -values {XON/XOFF RTS/CTS None} -editable no } actDate { # # Set an upper limit of 10 for the number of characters # and allow only digits and the "-" character in it # $w configure -invalidcommand bell -validate key -validatecommand \ {expr {[string length %P] <= 10 && [regexp {^[0-9-]*$} %S]}} } actTime { # # Set an upper limit of 8 for the number of characters # and allow only digits and the ":" character in it # $w configure -invalidcommand bell -validate key -validatecommand \ {expr {[string length %P] <= 8 && [regexp {^[0-9:]*$} %S]}} } } return $text }
The editEndCmd
procedure, specified as the value of the
-editendcommand
configuration
option, is responsible for a final validation of the edit window's text.
Another purpose of this command is to convert the text contained in the edit
window to the cell's new internal contents, which is necessary because
the internal value of the activation date and time is a clock value in seconds:
#------------------------------------------------------------------------------ # editEndCmd # # Performs a final validation of the text contained in the edit window and gets # the cell's internal contents. #------------------------------------------------------------------------------ proc editEndCmd {tbl row col text} { switch [$tbl columncget $col -name] { available { # # Update the image contained in the cell # set img [expr {$text ? $::checkedImg : $::uncheckedImg}] $tbl cellconfigure $row,$col -image $img } baudRate { # # Check whether the baud rate is an integer in the range 50..921600 # if {![regexp {^[0-9]+$} $text] || $text < 50 || $text > 921600} { bell tk_messageBox -title Error -icon error -type ok -message \ "The baud rate must be an integer in the range 50..921600" $tbl rejectinput } } actDate { # # Get the activation date in seconds from the last argument # if {[catch {clock scan $text} actDate] != 0} { bell tk_messageBox -title Error -icon error -type ok -message \ "Invalid date" $tbl rejectinput return "" } # # Check whether the activation clock value is later than the # current one; if this is the case then make sure the cells # "actDate" and "actTime" will have the same internal value # set actTime [$tbl cellcget $row,actTime -text] set actClock [clock scan [formatTime $actTime] -base $actDate] if {$actClock <= [clock seconds]} { bell tk_messageBox -title Error -icon error -type ok -message \ "The activation date & time must be in the future" $tbl rejectinput } else { $tbl cellconfigure $row,actTime -text $actClock return $actClock } } actTime { # # Get the activation clock value in seconds from the last argument # set actDate [$tbl cellcget $row,actDate -text] if {[catch {clock scan $text -base $actDate} actClock] != 0} { bell tk_messageBox -title Error -icon error -type ok -message \ "Invalid time" $tbl rejectinput return "" } # # Check whether the activation clock value is later than the # current one; if this is the case then make sure the cells # "actDate" and "actTime" will have the same internal value # if {$actClock <= [clock seconds]} { bell tk_messageBox -title Error -icon error -type ok -message \ "The activation date & time must be in the future" $tbl rejectinput } else { $tbl cellconfigure $row,actDate -text $actClock return $actClock } } } return $text }
As already mentioned above, the scripts iwidgets.tcl
and
miscWidgets.tcl
are similar to bwidget.tcl
. The
first one uses (besides the Tk core checkbutton) the entryfield, spinint,
combobox, dateentry, and timeentry widgets from the Iwidgets package and the
validation facilities specific to that library. The second script makes
use of the entry, spinbox, and checkbutton widgets from the Tk core, Bryan
Oakley's combobox, and of the mentry widgets of type "Date"
and
"Time"
, and it performs the entry validation with the aid of the
Wcb package (which is required anyway for the Mentry library).
The script embeddedWindows.tcl
in the demos
directory creates a tablelist widget whose items correspond to the Tk library
scripts. The size of each file (in bytes) is not only displayed as a
number, but is also illustrated with the aid of a frame with red background,
created as a child of an embedded frame with ivory background. The files
can be viewed by clicking on the corresponding embedded button widgets.
First, we create and populate the tablelist widget:
package require Tablelist wm title . "Tk Library Scripts" # # Add some entries to the Tk option database # set dir [file join $tablelist::library demos] source [file join $dir option.tcl] # # Create an image to be displayed in buttons embedded in a tablelist widget # set openImg [image create photo -file [file join $dir open.gif]] # # Create a vertically scrolled tablelist widget with 5 # dynamic-width columns and interactive sort capability # set tbl .tbl set vsb .vsb tablelist::tablelist $tbl \ -columns {0 "File Name" left 0 "Bar Chart" center 0 "File Size" right 0 "View" center 0 "Seen" center} \ -font "Helvetica -13" -setgrid no -yscrollcommand [list $vsb set] -width 0 $tbl columnconfigure 0 -name fileName $tbl columnconfigure 1 -formatcommand emptyStr -sortmode integer $tbl columnconfigure 2 -name fileSize -sortmode integer $tbl columnconfigure 4 -name seen scrollbar $vsb -orient vertical -command [list $tbl yview] proc emptyStr val { return "" } # # Populate the tablelist widget # cd $tk_library set maxFileSize 0 foreach fileName [lsort [glob *.tcl]] { set fileSize [file size $fileName] $tbl insert end [list $fileName $fileSize $fileSize "" no] if {$fileSize > $maxFileSize} { set maxFileSize $fileSize } }
We insert the size of each file not only into the column with the
title "File Size"
, but also into the column
"Bar Chart"
. Since we configured
this column with -formatcommand emptyStr
, the text
will remain hidden in it. It will, however, be needed when sorting the
items by that column.
To be able to create the embedded windows, we have first to implement the
creation scripts for them, as specified in the description of the -window
cell configuration
option. Here is the script that creates a frame to be embedded into the
column displaying the bar chart:
#------------------------------------------------------------------------------ # createFrame # # Creates a frame widget w to be embedded into the specified cell of the # tablelist widget tbl, as well as a child frame representing the size of the # file whose name is diplayed in the first column of the cell's row. #------------------------------------------------------------------------------ proc createFrame {tbl row col w} { # # Create the frame and replace the binding tag "Frame" # with "TablelistBody" in the list of its binding tags # frame $w -width 102 -height 14 -background ivory -borderwidth 1 \ -relief solid bindtags $w [lreplace [bindtags $w] 1 1 TablelistBody] # # Create the child frame and replace the binding tag "Frame" # with "TablelistBody" in the list of its binding tags # set fileSize [$tbl cellcget $row,fileSize -text] set width [expr {$fileSize * 100 / $::maxFileSize}] frame $w.f -width $width -background red -borderwidth 1 -relief raised bindtags $w.f [lreplace [bindtags $w] 1 1 TablelistBody] place $w.f -relheight 1.0 }
Since the frame will be embedded into the tablelist's body, we want to have
the same handling of the mouse events in the frame and in its child frame as in
the rest of the tablelist's body. To this end we replace the binding tag
Frame
(which has no own bindings anyway) with TablelistBody
, thus making sure
that the default binding scripts associated with that tag will be valid for the
parent frame and its child, too.
The creation script for the buttons used for viewing the Tk library files is quite simple:
#------------------------------------------------------------------------------ # createButton # # Creates a button widget w to be embedded into the specified cell of the # tablelist widget tbl. #------------------------------------------------------------------------------ proc createButton {tbl row col w} { button $w -image $::openImg -highlightthickness 0 -takefocus 0 \ -command [list viewFile $tbl $row] } #------------------------------------------------------------------------------ # viewFile # # Displays the contents of the file whose name is contained in the given row of # the tablelist widget tbl. #------------------------------------------------------------------------------ proc viewFile {tbl row} { set key [$tbl getkeys $row] set top .top$key if {[winfo exists $top]} { raise $top return "" } toplevel $top set fileName [$tbl cellcget $row,fileName -text] wm title $top "File \"$fileName\"" . . . # # Mark the file as seen # $tbl rowconfigure $row -font "Helvetica -13 bold" $tbl cellconfigure $row,seen -text yes }
Each file will be displayed in a text widget contained in a top-level whose
name is .top$key
, where $key
is obtained with the aid
of the getkeys
subcommand. By using the key instead of the row number, we will have a
unique name for the top-level, even if the order of the items changes due to
interactive sorting by a column. (Remember that the embedded windows will
be destroyed and automatically recreated when sorting the items or moving the
columns.)
Having implemented the creation scripts for the frames and buttons, we can
now use the cellconfigure
subcommand to
effectively create these widgets as embedded windows:
# # Create embedded windows in the columns no. 1 and 3 # set rowCount [$tbl size] for {set row 0} {$row < $rowCount} {incr row} { $tbl cellconfigure $row,1 -window createFrame $tbl cellconfigure $row,3 -window createButton }