import - Tcl 如何从导入的例程中确定导入器的命名空间

Question

我正在努力尝试在 Tcl 8.4.18 中实现一个简单的面向对象的系统。我看过 Itcl、stooops、XOTtcl 等……但还没有决定是否要使用它们，尤其是如果我可以用另一种简单的方法来做的话。无论如何，让我们说我有一个命名空间

namespace eval Object {
    namespace export setvar

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

然后我用另一个命名空间“子类化”

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

我可以像这样设置变量

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

输出“2”。但是，我想简化代码，以便来自 Object 命名空间的例程“setvar”可以确定它是从“Model”命名空间调用的。像这样的东西:

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

然后称之为

Model::setvar foo 2

但这不起作用，因为 [namespace current] 返回“::Object”而不是“::Model”。根据文档，这是因为导入只是引用回 Object 命名空间。

使用例程 setvar 的原因是尝试实现一个变量覆盖，以便我可以从 Model 中使用 foo 如果它存在，否则从 Object 中获取它。

有没有其他方法可以做到这一点？或者我应该只使用其他工具之一？

谢谢

Answer 1

您正在寻找的代码很棘手，但可以做到(关键是 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
}

如果您使用的是 8.5(或更高版本)，请考虑替换最后一个 set和:

namespace upvar $myspace $name var
set var $value

一旦事情开始变得复杂，工作就会容易得多。如果失败，请使用 upvar (几乎和 Tcl 8.0 一样容易使用，但速度不如 Tcl 8.0 快，便携):

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