home *** CD-ROM | disk | FTP | other *** search
- 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
- asg s \02
- 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) '(\\%*))
- _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)
- local z
- asg z \m(class_of_\02_\v(macro))
- ; if eq \%1 class return \m(class_of_\02_\v(macro))
- if eq \%1 class return \m(z)
- ; if eq \%1 superclass return \m(\v(macro)_\02_inherit)
- if eq \%1 superclass return \m(\m(z)_\02_inherit)
- 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
- ; 4th: condider message defined for all classes.
- if define \m(\%1>>\%2) return {\%1>>\%2 \%1} ; 1st
- [~~~search_inheritant_object~~~] \m(class_of_\02_\%1) \%1 \%2
- if success return \v(return) ; 2nd
- ; if define \m(class>>\%2) return {class>>\%2 class#\%1}
- if define \m(class>>\%2) return {class>>\%2 \%1} ; 4th
- 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
- }
-
- ; Consider message of selected super class
- ; The message is defined and superclass is part of the message
- if define \m(\%3) { ; 3rd
- if == \find(\%1,\%3) 1 {
- return {\%3 \%2}
- }
- }
-
- 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
- ; To enable virtual function in superclass delegates to implementation
- ; in subclass
- [~~~search_inheritant_object~~~] \&w[i] \%2 \%3
- if success return \v(return)
- }
- }
- END -999999
- }
-