Pragana's Tcl Guide

Old notes

12Dec98 subst command

Creating widgets in script-only

In this weekly note we will see how to create an widget simulating the real ones (generally implemented in C) using only a script. The widget creation command, in our case tableform, must create a new command that evaluates commands supported by the widget class.
Our widget is a table suitable for showing and editing table data in a database. It's only option during the creation is -lines, that sets the number of rows the widget will have.
In the top and left side, we'll have some butoon-like objects, similar to the ones found in spreadsheets.

Let's see some of the code. First we create a frame to use like a container widget. In our example, we use the table geometry manager from BLT's tk extension. You could do almost the same with the new grid geometry manager in tk8.0.

proc tableform { w args } {
        global $w
        frame $w
        table $w

Here we create an array op with all options. This is possible, because each -option is followed by it's (only one) value. Then, if -lines is found, it's value is used to setup a variable (array) with index -lines. By storing all options in an array variable with the same basename as the widget, we keep our namespace clean.
At this time we create the first column, with button-like labels. Finally the option -lines is removed from the array of options to not be reprocessed by the frame configuration command.

        array set op $args
        foreach option [array names op] {
                switch -- $option {
                -lines {
                        set ${w}(lines) $op(-lines)
                        for {set i 0} {$i <= $op(-lines)} {incr i} {
                                table $w [label $w.b$i -relief raised -width 2] $i,0
                        }
                        unset op(-lines)
                        }
                        }
        }

Now we are ready to pass the remaining options to the container frame and make it "invisible" by renaming its command. We set also the column counter (another array element) to its initial value.

        eval $w config [array get op]
        rename $w ${w}(frame)
        set ${w}(col) 1

Then we can create a procedure for the widget instance being defined. A problem here is that we haven't the name of the widget in advance, so doing something like:

proc $w { args } { ... body with $w in use ... }

doesn't work, because $w will not be substituted. (It's not an argument, but the name of the procedure!)

Instead, we need something like a lamdba function from Lisp. We can use regsub to our rescue for doing this variable substitution, in a manner similar of that used for binding events to functions.
The idea is to do:

regsub -all %w { ... body with %w substituted for the real widget name ... } $w body
proc $w { args } $body

So, we first create a body by changing all occurances of %w (our fake name) by $w (the real widget name), say "in compile time". Next, we use the replace string as the body for our definition.

Here is the final procedure:

#
# create a tableform "table-like" widget
#
proc tableform { w args } {
    global $w
    frame $w
    table $w
    array set op $args
    foreach option [array names op] {
        switch -- $option {
        -lines {
            set ${w}(lines) $op(-lines)
            for {set i 0} {$i <= $op(-lines)} {incr i} {
                table $w [label $w.b$i -relief raised -width 2] $i,0
            }
            unset op(-lines)
        }
        }
    }
    eval $w config [array get op]
    rename $w ${w}(frame)
    set ${w}(col) 1
    regsub -all %w {
        global %w
        if {$cmd != "addcol"} { return }       
        set j [set %w(col)]
        set lines [set %w(lines)]
        set op(-width) 10
        set op(-justify) left
        set op(-text) ""
        set op(-takefocus) 1
        array set op $args
        table %w [label %w.c$j -relief raised -width $op(-width) \
            -text $op(-text) -takefocus 0] 0,$j -fill x
        for {set i 1} {$i <= $lines} {incr i} {
            set e [entry %w.e$i,$j -border 0 -bg white \
                -highlightcolor black -highlightbackground gray90 \
                -width $op(-width) -highlightthickness 1 \
                -takefocus $op(-takefocus) -justify $op(-justify)
            table %w $e $i,$j
            if {$i > 1} {
                bind $e <Up> "focus %w.e[expr $i-1],$j"
            }
            if {$i < $lines} {
                bind $e <Down> "focus %w.e[expr $i+1],$j"
            }
        }
        incr j
        set %w(col) $j
    } $w body
    proc $w { cmd args } $body
}

If you want to see a screenshot of this widget in action, please go here.

Using the new widget

Let us see how to create a widget instance with this newly defined command. The tableform in the middle part of the screenshot above was created with:

tableform .itens -lines 15
.itens addcol -text item -width 5
.itens addcol -text código -width 8
.itens addcol -text descrição -width 40
.itens addcol -text "pr.unit." -width 11
.itens addcol -text subtotal -width 11

The supported options for the widget instance are: -width, -justify, -takefocus and -text. The widget creating command supports, besides -lines as shown above, all options for the regular frame command, which controls its container frame.

Back Home