使用 Incr Tcl 的类对象的层次结构

Question

我正在尝试实现类/子类对象的层次结构，例如：

|-- Class1                  # mainClass
|   |-- SubClassA           # subClass
|   `-- SubClassB           # subClass
`-- Class2                  # mainClass
    |-- SubClassA           # subClass
    `-- SubClassB           # subClass

这里的要点是能够在每个主类中声明具有同名的不同子类（并使其变量独立）。

（注意：我在这里谈论的是在执行期间创建的类对象的层次结构，而不是不同类的继承。）

对 Tcl 特有的一些高级方面（命名空间、范围...）不太熟悉，我尝试了以下代码：

package require Itcl

itcl::class subClass {
  variable InternalVariable
  constructor {} {
    puts "($this)     Current namespace      : [namespace current]"
    puts "($this)     InternalVariable scope : [itcl::scope InternalVariable]"
  }
}

itcl::class mainClass {
  variable SubClassesList
  constructor {} {
    set SubClassesList {}
    puts "($this)     current namespace      : [namespace current]"
    puts "($this)     SubClassesList scope   : [itcl::scope SubClassesList]"
  }
  method newSubClass {argName} {
    lappend SubClassesList [subClass $argName]
    puts "($this)     SubClassesList         : {$SubClassesList}"
  }
}

# Create the two main classes
mainClass Class1
mainClass Class2

# Add some subclasses to Class1 and Class2
Class1 newSubClass SubClassA
Class1 newSubClass SubClassB
Class2 newSubClass SubClassC
Class2 newSubClass SubClassB

在创建SubClassB 的第二次出现时产生错误：

(::Class1)     current namespace      : ::mainClass
(::Class1)     SubClassesList scope   : @itcl ::Class1 ::mainClass::SubClassesList
(::Class2)     current namespace      : ::mainClass
(::Class2)     SubClassesList scope   : @itcl ::Class2 ::mainClass::SubClassesList
(::mainClass::SubClassA)     Current namespace      : ::subClass
(::mainClass::SubClassA)     InternalVariable scope : @itcl ::mainClass::SubClassA ::subClass::InternalVariable
(::Class1)     SubClassesList         : {SubClassA}
(::mainClass::SubClassB)     Current namespace      : ::subClass
(::mainClass::SubClassB)     InternalVariable scope : @itcl ::mainClass::SubClassB ::subClass::InternalVariable
(::Class1)     SubClassesList         : {SubClassA SubClassB}
(::mainClass::SubClassC)     Current namespace      : ::subClass
(::mainClass::SubClassC)     InternalVariable scope : @itcl ::mainClass::SubClassC ::subClass::InternalVariable
(::Class2)     SubClassesList         : {SubClassC}
command "SubClassB" already exists in namespace "::mainClass"

我可能遗漏了关于类命名空间的一点，因为我不明白变量 SubClassesList 如何具有两个不同的范围，但“相同”的命名空间/名称（来自调试输出）。

我尝试在newSubClass 方法中创建一个新的命名空间，但它并没有解决问题和/或添加了一些无法解决的变量命名空间错误...

method newSubClass {argName} {
  set SubClassName "[namespace current]::[namespace tail $this]"
  puts "($this)     SubClassName           : $SubClassName"
  namespace eval $SubClassName "lappend SubClassesList [subClass $argName]"
  puts "($this)     SubClassesList         : {$SubClassesList}"
}

有什么想法来做这样的事情吗？

P-S：出于与现有环境的兼容性原因，我使用 [incr Tcl] 在我的项目中实现类，但如果有人认为其他 OO 实现会更好/更容易，请告诉我...

---

编辑：

通过使用namespace eval + namespace inscope 在与mainClass 对象名称对应的新命名空间中创建subClass 对象找到了解决方案：

itcl::class mainClass {
  variable SubClassesList
  constructor {} {
    set SubClassesList {}
    puts "($this)     current namespace      : [namespace current]"
    puts "($this)     SubClassesList scope   : [itcl::scope SubClassesList]"
    # Create a new namespace corresponding to class name
    namespace eval $this {}
  }
  method newSubClass {argName} {
    # Create the subClass object in the $this namespace
    lappend SubClassesList [namespace inscope $this subClass $argName]
    puts "($this)     SubClassesList         : {$SubClassesList}"
  }
}

Answer 1

我认为您对 class 和 object 感到困惑：Class 是用于创建对象的蓝图或模板。在您的示例中：

• mainClass 和 subClass 是类
• Class1、Class2、SubClassA、SubClassB 和 SubClassC 是对象，也就是类的 AKA 实例

在 Itcl 中，每个类都有自己的命名空间，例如，mainClass 类拥有一个名为 ::mainClass 的命名空间——您可以在代码输出中看到这一证据：

(::Class1)     current namespace      : ::mainClass
^^^^^^^^^^

此外，每个对象都有自己的命名空间：::::。例如，SubClassB 对象拥有命名空间::mainClass:SubClass：

(::mainClass::SubClassB)     InternalVariable scope : @itcl ::mainClass::SubClassB ::subClass::InternalVariable
^^^^^^^^^^^^^^^^^^^^^^^^

这意味着，您不能有两个具有相同名称的对象——这就是您遇到的错误。如果您仍然希望示例工作，请使用 #auto 作为对象名称：

method newSubClass {argName} {
    lappend SubClassesList [subClass #auto] ;# <=== Use automatic naming
    puts "($this)     SubClassesList         : {$SubClassesList}"
}