Home : Tcl/Tk : Objects

Creating Object Commands

When you have to roll your own

Overview
The Basic Approach
The Robust Approach
Adding Method Arguments
Cleaning Up the Stack Trace
Acknowledgements

Overview

There are several ways to model objects (data plus methods which act on that data) in pure Tcl. If you truly want to write object-oriented code, you can use one of the many OO extensions to Tcl; more typically, though, you're writing an extension which should stand by itself, and you want to give it an object-based flavor. The usual model is exemplified by Tk widgets: write a command that creates objects of the desired class. This constructor command creates a new Tcl command named after the object. To manipulate the object, use its command. By convention, the first argument to the object command specifies the method to execute; any remaining arguments are method specific.

This document describes how such simple objects can be created. In particular, it discusses the basic or naive approach to creating object commands, and then a more robust approach which works properly in the context of namespaces and packages. The focus is on the mechanism by which the object command is created. Finally, it addresses how to pass arguments to the object's methods.

This document explicitly does not cover advanced topics like object-oriented inheritance. To begin with, I have no wish to perpetrate yet another object-oriented framework. My fundamental assumption is that the programmer wishes to create an extension that has object semantics without requiring that the users of the extension pay the cost of a full-fledged object-oriented framework.

The Basic Approach

The basic approach to creating such an object is straightforward. Suppose you wish to create a "dog" object. Each dog should have a name and a color, and might be registered with the AKC. In addition, each dog should be able to bark. The dog's color and AKC flag should be set at creation, and retrievable later. For convenience, we will assume that the dog's name works as the name of a Tcl command; in practice this is unlikely to be so, and the dog's real name should be an attribute of the object.

Storing the Data: Data about all dogs will be put in the DogInfo array. Given a dog's name, $name, the dog's color and AKC flag will be stored as follows:

    set DogInfo($name-color) $color
    set DogInfo($name-akcflag) $akcflag

Handling Methods: We will need a private command to handle all of the method invocations. The command will take the dog's name as its first argument, and the method name as the second argument; if any methods have additional arguments, an args argument can be used to collect them, as shown below. For now, we will assume that the methods have no additional arguments.

Our private command might look like this:

    proc DogMethods {name method} {
        global DogInfo
        switch -exact -- $method {
            color -
            akcflag {
                return $DogInfo($name-$method)
            }
            bark {
                puts "$name says 'Woof!'"
            }
        }
    }

This version of DogMethods handles all of the methods itself; an alternative, solution is to write a procedure for each method, as we will see below.

Creating the Object Command: We have data; we have methods; now we need a constructor to wrap them up together. Our constructor might look like this:

    proc dog {name color {akcflag no}} {
        global DogInfo

        set DogInfo($name-color) $color
        set DogInfo($name-akcflag) $akcflag

        proc $name {method}  "DogMethods $name \$method"

        return $name
    }

This procedure stashes the dog's data in the DogInfo array, and then creates a new procecure, named after the dog, which does nothing more than pass its name and argument to DogMethods.

Using the Object: Having made these definitions, we can create a dog object and use it as shown in the following dialog:

    % dog Fido brown
    Fido
    % dog Montmorency gray yes
    Montmorency
    % Fido color
    brown
    % Fido bark
    Fido says 'Woof!'
    %

Problems with the Basic Approach: The basic approach illustrates the concepts adequately, but has some serious problems:

The object code lives in the global namespace. It should probably be written as a package with its own namespace, as described in the Guide to Success with Namespaces and Packages.
The object's constructor does not properly handle namespaces. Ideally, the following code should yield two different dogs, ::Foo::Fido and ::Bar::Fido.
```
       namespace eval ::Foo:: {
           dog Fido brown
       }

       namespace eval ::Bar:: {
           dog Fido gray
       }
       
```
Instead, since dog is defined in the global namespace, both calls to dog create the command ::Fido. Moreover, both dogs are using the same entries in DogInfo. In short, with the basic approach there can only be one dog named Fido.
As a corollary of the previous problem, any new dog Fido replaces any existing dog Fido (and, indeed, any existing command called Fido) silently and without warning.

The Robust Approach

First, the object must be placed in its own package and namespace. How to do so is adequately described in the Guide to Success with Namespaces and Packages, so I won't go into great detail; it suffices to say that the dog constructor will be part of the dog package, and that all code in the dog package will reside in the dog namespace. For example, the constructor's full name will now be ::dog::dog, or for purposes of typing at the command line, dog::dog.

The basic approach's remaining problems all stem from how the object was named. Practically speaking, an object of the kind we are discussing is simply a new Tcl command. As such, creating it should be like creating a new command using proc:

If the command name is fully qualified, then the command should be created in the specified namespace:
```
       % dog::dog ::Foo::Fido brown
       ::Foo::Fido
       
```

If the command name is relative, then the command should be created relative to the caller's namespace:

       % dog::dog Fido brown
       ::Fido
       % dog::dog Foo::Fido brown
       ::Foo::Fido
       % namespace eval Bar {
           dog::dog Fido gray
       }
       ::Bar::Fido

Following these rules has two important consequences: dog objects can be protected by namespaces just as normal commands are, and every dog object is guaranteed to have a unique name and therefore a unique key into the DogInfo array.

With these points in mind, let's reimplement the dog object. The object will reside in the package "dog" and the namespace "dog".

Storing the Data: The data will be stored in an array, just as in the basic approach, except that the array will be placed in the "dog" namespace:

    package provide dog 1.0

    namespace eval ::dog:: {
        # $name-color       The dog's color
        # $name-akcflag     AKC, yes or no
        variable DogInfo

        # Export public commands
        namespace export dog
    }

Handling Methods: Methods are handled as in the basic approach, except that the method handler lives in the "dog" namespace. Also, note that DogInfo is declared using variable rather than global.

    proc ::dog::DogMethods {name method} {
        variable DogInfo
        switch -exact -- $method {
            color -
            akcflag {
                return $DogInfo($name-$method)
            }
            bark {
                puts "$name says 'Woof!'"
            }
        }
    }

Creating the Object Command: Creating the object command becomes much more involved. We must do the following things:

Convert the object name given us into a fully-qualified command name.
Verify that no command with that name already exists.
Place the object's data into the data array.
Create the object command.

Qualifying the object's name: If the name begins with "::", then it is already fully qualified. Otherwise, we must determine the caller's namespace and append the object's name to it. The namespace current command returns the fully-qualified name of the current namespace; we use the uplevel command to call it in the caller's context, thus retrieving the caller's namespace:

    if {![string match "::*" $name]} {
        # Get caller's namespace;
        # append :: if not global namespace.
        set ns [uplevel 1 namespace current]
        if {"::" != $ns} {
            append ns "::"
        }

        set name "$ns$name"
    }

Checking the Name: Next, we must verify that the name is unique. The info commands command returns a list of the names of the commands that match a particular pattern; if the list is empty, no commands matched. Since we have the fully-qualified name, we can try to match it exactly:

    if {"" != [info commands $name]} {
        return -code error  "command name \"$name\" already exists"
    }

Note that this use of info commands will fail if the name contains characters used by Tcl's "glob" pattern matcher, e.g., '*', '?', '[', and ']'. Also, our use of the '-' character as a separator in our indices into DogInfo array means that hyphens are dangerous as well. You may wish to explicitly check for such characters, and generate an error if any are found.

Note the use of the return -code error command to return the error, rather than the error command. The two commands are nearly equivalent but for the stack trace produced; when return -code error is used, the stack trace begins with the call to ::dog::dog. This makes it clear that the caller of ::dog::dog made the mistake.

I should end this section by saying that checking the command name for pre-existence is somewhat controversial. Most of use are used to sourcing the same file many times in a row while interactively testing and debugging Tcl code; if the file creates a dog object, it will be necessary either to destroy it before sourcing the file a second time, or to exit the Tcl shell and start over. On the other hand, you'll never be plagued by silent name collisions. Take your pick.

Putting It Together: Putting all this together, we end up with the following constructor:

    proc ::dog::dog {name color {akcflag no}} {
        variable DogInfo

        # FIRST, qualify the name.
        if {![string match "::*" $name]} {
            # Get caller's namespace;
            # append :: if not global namespace.
            set ns [uplevel 1 namespace current]
            if {"::" != $ns} {
                append ns "::"
            }

            set name "$ns$name"
        }

        # NEXT, Check the name
        if {"" != [info commands $name]} {
            return -code error  "command name \"$name\" already exists"
        }

        # NEXT, Save the data
        set DogInfo($name-color) $color
        set DogInfo($name-akcflag) $akcflag

        # NEXT, Create the object.
        proc $name {method}  "::dog::DogMethods $name \$method"

        return $name
    }

Using the Object: Having made these definitions, we can now create dog objects in different namespaces, as shown in the following dialog:

    % dog::dog Fido brown
    ::Fido
    % namespace eval Foo {
        dog::dog Fido gray yes
    }
    ::Foo::Fido
    % Fido color
    brown
    % Foo::Fido color
    gray
    % namespace eval Foo {Fido bark}
    ::Foo::Fido says 'Woof!'
    % dog::dog Fido white
    command name '::Fido' already exists
    % puts $errorInfo
    command name '::Fido' already exists
        while executing
    "dog::dog Fido white"
    %

Adding Method Arguments

We now have a dog object that is robust when namespaces are used and which properly reports errors to the user. However, none of its methods take any arguments. In any real application,

Many methods will take arguments.
The arguments will vary from method to method.

Moreover, the method code is likely to be longer than will reasonably fit in the body of a single switch command. This section shows how to place each method into its own procedure, and also how to pass arguments to methods.

To aid in the examples, we will define two additional methods, chase and getdata. The chase method will tell the dog to chase something, and the getdata method will put the dog's attribute values into an array provided by the user.

Passing the Arguments: The object command should collect any arguments following the method name and pass them along to ::dog::DogMethods. To do this, we use the standard args argument. Within ::dog::dog, then, we define the object command as follows:

    proc $name {method args}  "::dog::DogMethods $name \$method \$args"

Next, ::dog::DogMethods must accept the new arguments. Since the arguments are passed to it as a single value, we don't use the standard args argument; instead, we will call it argList:

    proc ::dog::DogMethods {name method argList} {
        .
        .
        .
    }

Method Procedures: Each method will get its own method procedure. The procedure's name will be the method name, prefixed by "Op"; this prefix allows method names like "set" to be used without confusion. The procedure will take whatever arguments it needs, beginning with the name of the object; this has the advantage that Tcl will do most or all of the argument checking for us. If a method needs three arguments, Tcl will raise an error if it is passed two or four arguments.

The following is the color method's procedure.

proc ::dog::Opcolor {name} {
    variable DogInfo

    return $DogInfo($name-color)
}

This method takes no arguments, and so the procedure has only one argument, the object's name. The new chase method takes one argument, the name of the thing being chased:

proc ::dog::Opchase {name quarry} {
    puts "$name chases after $quarry."
}

Finally, the new getdata method looks like this:

proc ::dog::Opgetdata {name arrayName} {
    variable DogInfo

    upvar 3 $arrayName theArray

    array set theArray  [list color [Opcolor $name]  akcflag [Opakcflag $name]]

    return
}

Note here the use of upvar 3 to access the caller's array. The method's scope is 3 levels below the object's caller: one level for the object command, one level for dog::DogMethods, and one level for the method procedure itself.

Note also that a method routine can call the other methods without qualification, as ::dog::Opgetdata calls Opcolor.

Dispatching the Methods: The procedure ::dog::DogMethods must now call the method procedures instead of handling the methods itself. The code to do so looks like this:

    if {[catch "Op$method $name $argList" result]} {
        regsub -- "Op$method" $result  "$name $method" result
        return -code error $result
    } else {
        return $result
    }

First, we call the method procedure, catching any error. The script argument to the catch command is in double quotes, so $argList is automatically broken up into its component arguments. If there is an error, we replace the method procedure's name in the error message with the object command's name and the method name, and pass the error message along. Otherwise, we pass along the method procedure's return value to the caller.

Putting It Together: Putting all this together, we now have the following code:

package provide dog 1.0

namespace eval ::dog:: {
    # $name-color       The dog's color
    # $name-akcflag     AKC, yes or no
    variable DogInfo

    # Export public commands
    namespace export dog
}

proc ::dog::dog {name color {akcflag no}} {
    variable DogInfo

    # FIRST, qualify the name.
    if {![string match "::*" $name]} {
        # Get caller's namespace; #
        # append :: if not global namespace.
        set ns [uplevel 1 namespace current]
        if {"::" != $ns} {
            append ns "::"
        }
        
        set name "$ns$name"
    }

    # NEXT, Check the name
    if {"" != [info command $name]} {
        return -code error  "command name \"$name\" already exists"
    }

    # NEXT, Save the data
    set DogInfo($name-color) $color
    set DogInfo($name-akcflag) $akcflag
    
    # NEXT, Create the object.
    proc $name {method args}  "::dog::DogMethods $name \$method \$args"
    
    return $name
}

proc ::dog::DogMethods {name method argList} {
    variable DogInfo
    switch -exact -- $method {
        color -
        akcflag -
        bark -
        chase -
        getdata {
            if {[catch "Op$method $name $argList"  result]} {
                regsub -- "Op$method" $result  "$name $method" result
                return -code error $result
            } else {
                return $result
            }
        }
        default {
            return -code error  "\"$name $method\" is not defined"
        }
    }
}

proc ::dog::Opcolor {name} {
    variable DogInfo

    return $DogInfo($name-color)
}

proc ::dog::Opakcflag {name} {
    variable DogInfo

    return $DogInfo($name-akcflag)
}

proc ::dog::Opbark {name} {
    puts "$name says 'Woof!'"
}

proc ::dog::Opchase {name quarry} {
    puts "$name chases after $quarry."
}

proc ::dog::Opgetdata {name arrayName} {
    variable DogInfo

    upvar 3 $arrayName theArray

    array set theArray  [list color [Opcolor $name]  akcflag [Opakcflag $name]]

    return
}

Using the Object: Having made these definitions, we can now call methods with arguments, and get appropriate error messages if we call them in error:

    % dog::dog Fido brown
    ::Fido
    % Fido color
    brown
    % Fido color black
    called "::Fido color" with too many arguments
    % Fido chase Fluffy
    ::Fido chases after Fluffy
    % Fido chase
    no value given for parameter "quarry" to "::Fido chase"
    % Fido getdata myArray
    % parray myArray
    myArray(akcFlag) = no
    myArray(color)   = brown
    %

Cleaning Up the Stack Trace

When the error or return -code error commands are used to raise an error, Tcl builds a nice stack trace and places it in the standard variable errorInfo. It's the value of errorInfo you see if you execute a script and an uncaught error occurs. If we pass the wrong number of arguments to one of the dog object's methods, here's what happens:

    % dog::dog Fido brown
    % Fido color black
    called "::Fido color" with too many arguments
    % puts $errorInfo
    called "::Fido color" with too many arguments
        while executing
    "::dog::DogMethods ::Fido $method $args"
        (procedure "Fido" line 1)
        invoked from within
    "Fido color black"
    %

The ::dog::DogMethods procedure should be completely hidden, and yet there it is, in front of everybody. The reason is that the error is caught and raised again within ::dog::DogMethods. Ideally, the error should be raised in the object command itself, ::Fido in this case.

This may seem like a minor problem; if it offends you, it is easily handled, though it makes the object command a little more complicated. Replace the proc command in ::dog::dog with this one:

    proc $name {method args} [format {
        if {[catch {::dog::DogMethods %s $method $args}  result]} {
            return -code error $result
        } else {
            return $result
        }
    } $name]

Note the use of the format command to create the procedure's body; this is often the easiest way to escape "quoting hell".

In the new version, the object command catches any errors from lower levels and raises them again using return -code error. Now the error trace looks like this:

    % dog::dog Fido brown
    % Fido color black
    called "::Fido color" with too many arguments
    % puts $errorInfo
    called "::Fido color" with too many arguments
        while executing
    "Fido color black"
    %

Acknowledgements

I created this guide as a memory-aid for myself, but also as a means of learning from those more knowledgeable as myself. I'd particulary like to mention Donald G. Porter for his helpful comments and suggestions; thanks largely to his input, this is a much more thorough guide than I had originally intended.

If you have questions, comments, or suggestions about this page, feel free to contact me at will@wjduquette.com.