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