Posted to tcl by aspect at Wed Sep 10 15:02:35 GMT 2014view pretty
# 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