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 

但是，这并不工作，因为[命名空间电流]返回“：对象”，而不是“::模型”。根据文档，这是因为输入只是引用回Object对象命名空间。

使用例程setvar的原因是尝试和实现一个变量覆盖，以便我可以在模型中使用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）：

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