set prompt C-Kermit>

define class {

    switch \v(argc) {
        :1, return \v(macro)
        :2, if define \m(\%1) {
                END -999999 .... ERROR: class name "\%1" already used
            }
            _undefine /matching \%1* *\%1
            break
        :default,    break
    }

    if define \%2 {
        if eq inherit: \%2 {
            if define \m(\%1) {
                END -999999 .... ERROR: cannot redefine class \%1
            }
            local i s
            _undefine /matching \%1* *\%1
            for i 3 \v(argc)-1 1 {
                if not define \m(\&_[i]) {
                    END -999999 ... ERROR: class \&_[i] is not defined
                }
                _asg \%1_\02_inherit \m(\%1_\02_inherit)\m(s)\&_[i]
                asg s \02    ; subsequent separator is '\02' STX ^B
            }
        } else if eq singleton \%2 {    ; mark singleton
            _asg \%1_\02_singleton \02\02\02
        } else if eq abstract \%2 {    ; mark abstract
            _asg \%1_\02_abstract 1
        } else {
            END -999999 ... ERROR: \v(macro) doesNotUndesrtand \%1 \%2
        }
    }

    _define \%1 {    ; definition of a class
        if = 1 \v(argc) return \v(macro)
        ; propagate possible self (this) in \%s & class in \%c
        local \%s \%c
        asg \%s \%2
        asg \%c \v(macro)

        ; build msg & argument string for class message
        local i \%k \%p
        for i 1 \v(argc) 2 {
            asg \%k \%k\&_[i] 
            asg \%p \%p {\&_[i+1]}
        }

        if eq \%1 new: {

            if = 2 \v(argc) {
                END -999999 ... ERROR - \v(macro) missing object name
            }
            if define \m(\%2) {
                END -999999 ... ERROR: object name "\%2" already used
            }
            if define \m(\v(macro)_\02_abstract) {
            ; Allow only superclass to create object part
                if = \frind(#,\%2) 0  {
                   END -999999 ... ERROR - class \v(macro) is abstract
                }
            }

            if define \m(\v(macro)_\02_singleton) {
                if eq \m(\v(macro)_\02_singleton) \02\02\02 {
                    _asg \v(macro)_\02_singleton \%2
                } else {    ; subsequent instance
                    _assign \%2 (\m(\v(macro)_\02_singleton) '(\\%*))
                    return \%2
                }
            }

            _asg class_of_\02_\%2 \v(macro)    ; save class of this object

            _define \%2 {    ; This macro process a message to an object
                if = 1 \v(argc) return \v(macro)
    
                if eq \%1 class return \m(class_of_\02_\v(macro))
                if eq \%1 alias {
                    _asg \%2 (\v(macro) '(\\%*))
                    return \%2
                }

                ; propagate self (this) in \%s & class in \%c
                local \%s \%c
                asg \%s \v(macro)
                asg \%c \m(class_of_\02_\v(macro))

                ; build msg & argument string for object message
                local i \%k \%p
                for i 1 \v(argc)-1 2 {
                    asg \%k \%k\&_[i] 
                    asg \%p \%p {\&_[i+1]}
                }

                [~~~resolve_object_message~~~] \v(macro) \%k
                if success return \fexec(\v(return) \%p)
                END -999999

            }

            ; CLASS MESSAGE 'new:' OBTAINS:
            ; 1st arg: class name
            ; 2nd arg: the message
            ; 3rd arg: the new object name
            [~~~resolve_class_message~~~] \v(macro) \%k
            if success return \fexec(\v(return) \%p)

            ; Cleanup here to get rid of used definitions

            if define \m(\v(macro)_\02_singleton) {
                if eq \m(\v(macro)_\02_singleton) \%2 {
                    _asg \v(macro)_\02_singleton \02\02\02
                }
            }

            _undefine /matching \%2*>>*
            _define \%2

            END -999999

        } else {

            ; ALL OTHER CLASS MESSAGES:
            [~~~resolve_class_message~~~] \v(macro) \%k
            if success return \fexec(\v(return) \%p)
            END -999999

        }

    }
    
    _define \%1>>initialize {
        END 0
    }

    _define \%1::destroy {
        END 0
    }


    _define \%1>>destroy {
        END 0
    }

    _define \%1::new: {
        return \%s
    }

    return \%1    ; return class_name

}

define [~~~resolve_class_message~~~] {
; \%1 class_name
; \%2 class_message
; return applicable class_message
    if define \m(\%1::\%2) return \%1::\%2 
    [~~~search_inheritant_class~~~] \%1 \%2
    if success return \v(return)
    if define \m(class::\%2) return class::\%2
    END -999999 ... ERROR: \%1 doesNotUnderstand \%2
}

define [~~~search_inheritant_class~~~] {
    if define \m(\%1_\02_inherit) {
        local i \&w[]
        for i 1 \fsplit(\m(\%1_\02_inherit),&w,\02) 1 {
            if define \m(\&w[i]::\%2) return \&w[i]::\%2
            [~~~search_inheritant_class~~~] \&w[i] \%2
            if success return \v(return)
        }
    }
    END -999999
}

define [~~~resolve_object_message~~~] {
; \%1 object_name
; \%2 object_message
; return applicable object message and applicable object
; 1st: consider message defined for this particular object
; 2nd: consider message defined for this class & superclasses
; 3rd: condider message defined for all classes.
    if define \m(\%1>>\%2) return {\%1>>\%2 \%1}
    [~~~search_inheritant_object~~~] \m(class_of_\02_\%1) \%1 \%2
    if success return \v(return)
    if define \m(class>>\%2) return {class>>\%2 class#\%1}
    END -999999 ... ERROR \%1 doesNotUnderstand \%2
}

define [~~~search_inheritant_object~~~] {
; \%1 class
; \%2 object
; \%3 message
    if define \m(\%1>>\%3) {            ; class specific or inheritable
        if not define \m(\%s) { \%1 new: \%s}
        if define \m(\%1_\02_singleton) {asg \%2 \m(\%1_\02_singleton)}
        return {\%1>>\%3 \%2}            ; class specific or inheritable
    }
    if define \m(\%1_\02_inherit) {
        local \&w[] i
        for i 1 \fsplit(\m(\%1_\02_inherit),&w,\02) 1 {
            [~~~search_inheritant_object~~~] \&w[i] \&w[i]\02#\02\%2 \%3
            if success return \v(return)
        }
    }
    END -999999
}
