So, here comes the table widget support library for the tkTable widget.
I thougt it's a good idea to post it to the list again.
There are two files: lib_table.tcl and icon_table.gif
Copy lib_table.tcl into .../lib and icon_table.gif into .../images, where
"..." means the root directory of vtcl. The table widget will be
automatically added by the next start of vtcl. To use the table widget you
have to install TkTable as a package in the Tcl directory.
Initial options and tags are somewhat Windows-specific. Non-Windows users
may want to modify the command "set vTcl(table,insert)" in "proc
vTcl:lib_table:setup" and "proc vTcl:lib_table:default_tags".
According to Stef Pillaert the following change is necessary:
bordercursor crosshair
I send the commented version of lib_table.tcl, in any case, and I also
attached a simple utility script (optarr.tcl); see the comments in the
files for more details. Extra comments explain how to create a lib_xxx.tcl
support library for not supported widgets.
Once more: it's an old experimental version. I hope it's useful, though.
Gergely
##############################################################################
#
# lib_table.tcl - table widget support library
#
# for Jeffrey Hobbs' tkTable widget
# (http://www.hobbs.wservice.com/tcl/capp/tkTable/)
# by Gergely Megyeri <[EMAIL PROTECTED]>
# initial hack v0.1
# contains some Windows-specific stuff
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
#> You can take this file as a starting point of making a
#> widget support library.
#> Comments that begin with #> are explanations that
#> (hopefully) help you to adopt this file for your widget.
#> Generally, where you see "table" change it to the name of your
#> widget.
#> This file is to add only one widget. If you want to add support
#> to a widget library with more widgets, you should also look at
#> other lib_xxx.tcl files for more example.
#> vTcl finds and loads library files automatically. We just have to
#> put a lib_xxx.tcl file in the lib-subdir of vTcl. Each library
#> file must define a procedure, vTcl:widget:lib:lib_xxx.
#> This procedure is called at vTcl-startup and makes the new
#> widgets available to vTcl.
#
# Initializes this library
#
proc vTcl:widget:lib:lib_table {args} {
global vTcl table
#> Add code here to load the extension, widget package, etc.
# Try to load tkTable library extension
if [catch {package require Tktable}] {
return
}
# setup required variables
vTcl:lib_table:setup
#> Paint a toolbar-icon as a 20x20 pixels gif-file and copy
#> it into the images-subdir.
#> Here we look for that file. If it does not exist we
#> use a default icon.
#> Than we create an image from that file and register our
#> widget for the toolbar.
# add items to toolbar
set img_file [file join $vTcl(VTCL_HOME) images icon_table.gif]
if {![file exists $img_file]} {
set img_file [file join $vTcl(VTCL_HOME) images unknown.gif]
}
image create photo "ctl_table" -file $img_file
vTcl:toolbar_add table table ctl_table ""
}
#> This proc is called from our init-proc. It sets the
#> required variables so vTcl can handle our widget.
proc vTcl:lib_table:setup {} {
global vTcl
#> Add configuration options here, that are to be used
#> whenever creating a new widget of this type.
#> This creates a nearly Windows style table.
#
# additional attributes to set on insert
#
set vTcl(table,insert) "\
-fg black -bg white -relief flat -borderwidth 2\
-cols 6 -rows 6 -width 6 -height 6 \
-titlerows 1 -titlecols 0 \
-colstretchmode last -rowstretchmode last \
-resizeborder col \
-cursor arrow -bordercursor size_we \
-selectmode extended"
#
# add to valid class list
#
lappend vTcl(classes) Table
#> The next part is probably the ugliest one. We have to
#> list all the widget specific options of our widget.
#> We have to list only those options that are specific
#> for this widget. Standard options don't have to be listed.
#> A list of standard options can be found in lib/globals.tcl
#> under "set vTcl(opt,list) ...".
#> We have to add a description record for each option
#> listed. This description is used by the Attribute Editor.
#> So, to complete this part, I took the reference doc of
#> the widget, filtered out the widget specific options,
#> made the list and completed the description records
#> according to the description found in the doc.
#
# register additional options that might be on Table widgets,
# and the option information that the Attribute Editor needs.
#
lappend vTcl(opt,list) \
-autoclear \
-bordercursor \
-browsecommand \
-cache \
-colorigin \
-cols \
-colseparator \
-colstretchmode \
-coltagcommand \
-colwidth \
-command \
-drawmode \
-flashmode \
-flashtime \
-maxheight \
-maxwidth \
-multiline \
-resizeborders \
-rowheight \
-roworigin \
-rows \
-rowseparator \
-rowstretchmode \
-rowtagcommand \
-selectioncommand \
-selectmode \
-selecttitles \
-selecttype \
-titlecols \
-titlerows \
-usecommand \
-validate \
-validatecommand
#> Each option gets one element in this array. The value assigned is
#> a list of 4 elements. These elements are:
#> - name of the option as it should appear in the Attribute Editor
#> - ?? I have never used this value
#> - option type
#> - list of choices (valid values) for the option
#> used only for type "choice"
#>
#> Valid option types and their apperiance
#> boolean - Yes/No radiobutton
#> choice - listbox with valid values
#> menu - menu editor window
#> color - color selection window
#> command - window to edit the command
#> type (or something else) - free editable entry field
#>
#> See the utility file (optarr.tcl) to generate a skeleton
#> for this list.
set vTcl(opt,-autoclear) {autoclear {} boolean {}}
set vTcl(opt,-bordercursor) {bordercursor {} type {}}
set vTcl(opt,-browsecommand) {browsecmd {} command {}}
set vTcl(opt,-cache) {cache {} boolean {}}
set vTcl(opt,-cols) {cols {} type {}}
set vTcl(opt,-colorigin) {{col origin} {} type {}}
set vTcl(opt,-colseparator) {{col separ.} {} type {}}
set vTcl(opt,-colstretchmode) {{col stretch} {} choice {none unset all
last}}
set vTcl(opt,-coltagcommand) {{col tagcmd} {} command {}}
set vTcl(opt,-colwidth) {{col width} {} type {}}
set vTcl(opt,-command) {command {} command {}}
set vTcl(opt,-drawmode) {drawmode {} choice {compatible
slow fast single}}
set vTcl(opt,-flashmode) {flashmode {} boolean {}}
set vTcl(opt,-flashtime) {flashtime {} type {}}
set vTcl(opt,-maxheight) {{max height} {} type {}}
set vTcl(opt,-maxwidth) {{max width} {} type {}}
set vTcl(opt,-multiline) {multiline {} boolean {}}
set vTcl(opt,-resizeborders) {resizebrdrs {} choice {both none row
col}}
set vTcl(opt,-rows) {rows {} type {}}
set vTcl(opt,-rowheight) {{row height} {} type {}}
set vTcl(opt,-roworigin) {{row origin} {} type {}}
set vTcl(opt,-rowseparator) {{row separ.} {} type {}}
set vTcl(opt,-rowstretchmode) {{row stretch} {} choice {none unset all
last fill}}
set vTcl(opt,-rowtagcommand) {{row tagcmd} {} command {}}
set vTcl(opt,-selectioncommand) {{selection cmd} {} command {}}
set vTcl(opt,-selectmode) {{select mode} {} choice {browse single
multiple extended}}
set vTcl(opt,-selecttitles) {{select titles} {} boolean {}}
set vTcl(opt,-selecttype) {{select type} {} choice {cell row col
both}}
set vTcl(opt,-titlecols) {{title cols} {} type {}}
set vTcl(opt,-titlerows) {{title rows} {} type {}}
set vTcl(opt,-usecommand) {{use cmd} {} boolean {}}
set vTcl(opt,-validate) {validate {} boolean {}}
set vTcl(opt,-validatecommand) {{validate cmd} {} command {}}
#
# define dump procedures for widget types
#
set vTcl(Table,dump_opt) vTcl:lib_table:dump_widget_opt
#
# define whether or not do dump children of a class
#
set vTcl(Table,dump_children) 1
}
#> This procedure returns a tcl procedure call that will be
#> executed after a widget of this type is created and inserted.
#> Be careful! This call gets part of a one line command
#> separated by semicolons (;). So return a string *without*
#> newlines!
#> For the table widget a special procedure was created
#> to set some tags to achieve a Windows-like look.
#
# individual widget commands executed after insert
#
proc vTcl:widget:table:inscmd {target} {
return "::vTcl:lib_table:default_tags $target"
}
proc vTcl:lib_table:default_tags {target} {
# nearly Windows style table
$target tag config title -bg gray -fg black -relief raised
$target tag config active -fg black -bg white -relief solid
$target tag config sel -fg white -relief flat
return
}
#> These two procedures are used to save a widget's
#> configuration into the target file.
#
# per-widget-class dump procedures
#
# Utility proc. Ignore undefined tag options
#
# returns:
# 1 means save the option
# 0 means don't save it
proc vTcl:lib_table:save_option {opt} {
set v [lindex $opt 4]
if {($opt == "") || [string match *unknown* $v]} {
return 0
} else {
return 1
}
}
#> This proc is called for each widget when the user selects
#> save. The proc must return a tcl script, that goes into
#> the target file. The returned script, when executed, must
#> reproduce the widget with the actual configuration.
#> It's important to save all relevant information.
#> See also other lib_xxx.tcl files for more example.
# Utility proc. Dump a table widget.
proc vTcl:lib_table:dump_widget_opt {target basename} {
global vTcl
set result ""
#> first add the widget command
#> $vTcl(tab) is used for indentation
set result "$vTcl(tab)table $basename"
#> add options. The vTcl procs get_opts and clean_pairs
#> help us a lot
#> vTcl:get_opts filters out the -class option and options
#> that have the default value
#> vTcl:clean_pairs does some formatting stuff
set opt [vTcl:get_opts [$target configure]]
if {$opt != ""} {
append result " \\\n[vTcl:clean_pairs $opt]\n"
} else {
append result "\n"
}
#> And here the tricky part: the table widget has tags.
#> We must save the tag-settings also!
foreach tn [$target tag names] {
set opt [$target tag configure $tn]
set keep_opt {}
foreach e $opt {
if [vTcl:lib_table:save_option $e] {
lappend keep_opt $e
}
}
set opt [vTcl:get_opts $keep_opt]
if {$opt != ""} {
append result "$vTcl(tab)$basename tag configure $tn \\\n[vTcl:clean_pairs
$opt]\n"
}
}
#> add bindings defined for this widget
append result [vTcl:dump_widget_bind $target $basename]
return $result
}
#> Simple utility to create a skeleton for the
#> options array vTcl(opt,-xxx)
#> options list
set ol [list \
-autoclear \
-bordercursor \
-browsecommand \
-browsecmd \
-cache \
-colorigin \
-cols \
-colseparator \
-colstretchmode \
-coltagcommand \
-colwidth \
-command \
-drawmode \
-flashmode \
-flashtime \
-maxheight \
-maxwidth \
-multiline \
-resizeborders \
-rowheight \
-roworigin \
-rows \
-rowseparator \
-rowstretchmode \
-rowtagcommand \
-selcmd \
-selectioncommand \
-selectmode \
-selecttitles \
-selecttype \
-titlecols \
-titlerows \
-usecommand \
-validate \
-validatecommand \
-vcmd ]
set f [open optarr.txt w]
foreach o $ol {
puts $f [format "%-31s {%-16s %-7s %-10s %-s}" "set vTcl(opt,$o)" [string range $o 1
end ] "{}" type "{}"]
}
close $f
icon_table.gif
--------------------------------------------------------------------------
Gergely Megyeri -- Lehrstuhl fuer Informationstechnik im Maschinenwesen
itm -- Technische Universitaet Muenchen
--------------------------------------------------------------------------
[EMAIL PROTECTED] * Tel: +49 89 289 16442 * http://www.itm.tum.de/~gm
icon_table.gif