Inheritance Tcl：从tablelist继承

如何从

tablelist

继承自己的类？ 此代码不起作用（命令继承时失败）

构造函数应该如何编写

另外，表列表的版本为4.8

---

谢谢。

Tablelist不使用[incr Tcl]（或Tcl的任何其他对象系统），因此不能从中继承。

Tablelist不使用[incr Tcl]（或Tcl的任何其他对象系统），因此不能从中继承。

虽然不能从Tablelist继承，因为它不是可继承的类，您可以将其包装起来，并在外部添加功能。在最简单的情况下——修改或添加方法——只需委托即可完成。以下是如何（使用TclOO）：

然后您可以从

WrappedTablelist

继承并添加/定义所需的行为。使用

unknown

进行委托初始化有点混乱，但是tablelist有大量的方法，所以在这里列出它们会有点痛苦

---

您可能可以在itcl中使用类似的方案，但我不太清楚。

虽然您不能从tablelist继承，因为它不是一个可继承的类，但您可以将其包装并在外部添加功能。在最简单的情况下——修改或添加方法——只需委托即可完成。以下是如何（使用TclOO）：

然后您可以从

WrappedTablelist

继承并添加/定义所需的行为。使用

unknown

进行委托初始化有点混乱，但是tablelist有大量的方法，所以在这里列出它们会有点痛苦

您可能可以在itcl中使用类似的方案，但我不太清楚这一点

package require tablelist

::itcl::class myTableList {
    inherit ::tablelist
}

### This metaclass makes doing the construction look like standard Tk.
oo::class create WidgetWrapper {
    # It's a metaclass, so it inherits from oo::class
    superclass oo::class

    method unknown {methodName args} {
        # See if we actually got a widget name; do the construction if so
        if {[string match .* $methodName]} {
            set widgetName $methodName

            # There's a few steps which can't be done inside the constructor but have to
            # be at the factory level.
            set obj [my new $widgetName {*}$args]
            rename $obj $widgetName

            # Tk widget factories *MUST* return the path name as the name of the widget.
            # It *MUST NOT* be colon-qualified, and it *MUST* refer to a widget.
            return $widgetName
        }

        # Don't know what's going on; pass off to standard error generation
        next $methodName {*}$args
    }
    unexport new create unknown
}

### This does the actual wrapping.
WidgetWrapper create WrappedTablelist {
    constructor {pathName args} {
        # Make the widget and *rename* it to a known name inside the object's
        # private namespace. This is magical and works.
        rename [tablelist::tablelist $pathName {*}$args] widget
    }

    # Delegate unknown method calls to the underlying widget; if they succeed,
    # bake the delegation in more permanently as a forward.
    method unknown {methodName args} {
        try {
            return [widget $methodName {*}$args]
        } on ok {} {
            oo::objdefine [self] forward $methodName widget $methodName
        }
    }
}