home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
ckscripts
/
class
< prev
next >
Wrap
Text File
|
2020-01-01
|
7KB
|
231 lines
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
}