Posted to tcl by aspect at Wed Sep 10 15:02:35 GMT 2014view raw
- # a klass is a place for defining additional "class definition" methods, in addition
- # to those normally available via oo::define.
- oo::class create klass {
- superclass oo::class
- constructor {Script} {
- oo::define [self] superclass [self class] ;# every klass is a subclass of klass. hm.
- set myns [self namespace] ;# create a namespace that wraps ::oo::define
- ;# and will be extended with our methods
- foreach cmd [map {namespace tail} [info commands ::oo::define::*]] {
- if {$cmd ne "self"} {
- interp alias {} ${myns}::$cmd {} ::oo::define [self] $cmd
- }
- }
- foreach cmd [info object methods [self] -all] {
- if {$cmd ni {new create destroy}} {
- interp alias {} ${myns}::$cmd {} [self] $cmd
- }
- }
- try $Script ;# instead of [next]
- }
- }
- # AbstractBase is a klass which provides "abstractmethod"
- klass create AbstractBase {
- variable abstractmethods
- constructor args {
- set abstractmethods {}
- next {*}$args
- oo::define [self] constructor {args} [format {
- debug log {Constructing an abstract instance [self] that needs %1$s}
- next {*}$args
- set mymethods [info class methods [self] -all]
- foreach m %1$s {
- if {$m ni $mymethods} {
- throw {CLASS ABSTRACTMETHOD} "abstract method $m not provided in [self]!"
- }
- }
- } [list $abstractmethods]]
- }
- method abstractmethod {name} {
- lappend abstractmethods $name
- }
- }
- # now attempt to use it
- AbstractBase create Channish {
- abstractmethod read
- abstractmethod write
- # method, constructor, etc
- }
- Channish create Try {
- method read {args} {}
- method write {} {}
- }
- Channish create Try2 {
- method read {args} {}
- } ;# error!
- ;# the three (?) inheritance hierarchies in play here confuse the heck out of me