Question

I am wrestling with trying to implement a simple object-oriented like system in Tcl 8.4.18. I’ve looked at Itcl, stooops, XOTtcl, etc… and haven’t decided if I want to use them, especially if I can do it another simple way. Anyway, lets says I have a namespace

namespace eval Object {
    namespace export setvar

    proc setvar { model name value } {
        set ${model}::${name} $value
    }
}

and then I “subclass” if with another namespace

namespace eval Model {
    namespace import ::Object::*
    variable foo 0
}

I can set the variable like this

Model::setvar Model foo 2
puts $Model::foo

which outputs “2”. However, I would like to simplify the code so that the routine “setvar” from the Object namespace can determine that it is being called from the “Model” namespace. Something like this:

proc setvar { name value } {
    set myspace [namespace current]
    set ${namespace}::${name} $value
}

and then call it like

Model::setvar foo 2

but that doesn’t work because [namespace current] returns “::Object” and not “::Model”. According to the documentation that is because the importation just makes a reference back to the Object namespace.

The reason to use the routine setvar is to try and implement a variable override so that I can use foo from Model if it exists, otherwise get it from Object.

Are there any other methods to do this? Or should I just use one of the other tools?

Thanks

Answer 1

The code you are looking for is tricky, but possible to do (the key is namespace which):

proc setvar { name value } {
    set cmdnameScript [list namespace which [lindex [info level 0] 0]]
    set myspace [namespace qualifiers [uplevel 1 $cmdnameScript]]]
    set ${myspace}::${name} $value
}

If you’re using 8.5 (or later), consider replacing that last set with:

namespace upvar $myspace $name var
set var $value

It’s a lot easier to work with once things start to get complicated. Failing that, do use upvar (almost as easy to work with, not as fast, portable back as far as Tcl 8.0):

upvar 0 ${myspace}::$name var
set var $value