Tcl: Inherit from tablelist

Question

Как я могу наследовать свой собственный класс от tablelist? Этот код не работает (не в состоянии по команде inherit)

package require tablelist 

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

И как должен быть конструктор написаны?

P.S. tablelist версия is 4.8

Спасибо.

Answer 1

Хотя вы не можете наследовать из таблицы таблиц, так как это не наследуемый класс, вы можете использовать и добавить функциональность снаружи. В простейших случаях - модификация или добавление методов - вы можете сделать это с просто делегированием. Вот как (с помощью TclOO):

### 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 
     } 
    } 
} 

Тогда вы можете просто наследовать от WrappedTablelist и добавлять/определять поведение, которые вы хотите. Использование unknown для инициализации делегации немного грязно, но в таблицеlist есть огромное количество методов, поэтому перечисление их всех здесь было бы немного болезненным.

Возможно, вы используете аналогичные схемы с itcl, но я не знаю, что это так хорошо.

Answer 2

Tablelist не использует [incr Tcl] (или любую другую объектную систему для Tcl) и, следовательно, не может быть унаследован.