home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / ckscripts / class < prev    next >
Encoding:
Text File  |  2020-01-01  |  6.9 KB  |  231 lines
  1. set prompt C-Kermit>
  2.  
  3. define class {
  4.  
  5.     switch \v(argc) {
  6.         :1, return \v(macro)
  7.         :2, if define \m(\%1) {
  8.                 END -999999 .... ERROR: class name "\%1" already used
  9.             }
  10.             _undefine /matching \%1* *\%1
  11.             break
  12.         :default,    break
  13.     }
  14.  
  15.     if define \%2 {
  16.         if eq inherit: \%2 {
  17.             if define \m(\%1) {
  18. ;                END -999999 .... ERROR: cannot redefine class \%1
  19.             }
  20.             local i s
  21. ;            _undefine /matching \%1* *\%1
  22.         asg s \02
  23.             for i 3 \v(argc)-1 1 {
  24.                 if not define \m(\&_[i]) {
  25.                     END -999999 ... ERROR: class \&_[i] is not defined
  26.                 }
  27.                 _asg \%1_\02_inherit \m(\%1_\02_inherit)\m(s)\&_[i]
  28.                 asg s \02    ; subsequent separator is '\02' STX ^B
  29.             }
  30.         } else if eq singleton \%2 {    ; mark singleton
  31.             _asg \%1_\02_singleton \02\02\02
  32.         } else if eq abstract \%2 {    ; mark abstract
  33.             _asg \%1_\02_abstract 1
  34.         } else {
  35.             END -999999 ... ERROR: \v(macro) doesNotUndesrtand \%1 \%2
  36.         }
  37.     }
  38.  
  39.     _define \%1 {    ; definition of a class
  40.         if = 1 \v(argc) return \v(macro)
  41.         ; propagate possible self (this) in \%s & class in \%c
  42.         local \%s \%c
  43.         asg \%s \%2
  44.         asg \%c \v(macro)
  45.  
  46.         ; build msg & argument string for class message
  47.         local i \%k \%p
  48.         for i 1 \v(argc) 2 {
  49.             asg \%k \%k\&_[i] 
  50.             asg \%p \%p {\&_[i+1]}
  51.         }
  52.  
  53.         if eq \%1 new: {
  54.  
  55.             if = 2 \v(argc) {
  56.                 END -999999 ... ERROR - \v(macro) missing object name
  57.             }
  58.             ; if define \m(\%2) {
  59.             ;    END -999999 ... ERROR: object name "\%2" already used
  60.             ; }
  61.             if define \m(\v(macro)_\02_abstract) {
  62.             ; Allow only superclass to create object part
  63.                 if = \frind(#,\%2) 0  {
  64.                    END -999999 ... ERROR - class \v(macro) is abstract
  65.                 }
  66.             }
  67.  
  68.             if define \m(\v(macro)_\02_singleton) {
  69.                 if eq \m(\v(macro)_\02_singleton) \02\02\02 {
  70.                     _asg \v(macro)_\02_singleton \%2
  71.                 } else {    ; subsequent instance
  72. ;                    _assign \%2 (\m(\v(macro)_\02_singleton) '(\\%*))
  73.                     _assign \%2 (\m(\v(macro)_\02_singleton) '\\%*)
  74.                     return \%2
  75.                 }
  76.             }
  77.  
  78.             _asg class_of_\02_\%2 \v(macro)    ; save class of this object
  79.  
  80.             _define \%2 {    ; This macro process a message to an object
  81.                 if = 1 \v(argc) return \v(macro)
  82.             local z
  83.         asg z \m(class_of_\02_\v(macro))
  84. ;                if eq \%1 class return \m(class_of_\02_\v(macro))
  85.                 if eq \%1 class return \m(z)
  86. ;        if eq \%1 superclass return \m(\v(macro)_\02_inherit)
  87.         if eq \%1 superclass return \m(\m(z)_\02_inherit)
  88.                 if eq \%1 alias {
  89.                     _asg \%2 (\v(macro) '(\\%*))
  90.                     return \%2
  91.                 }
  92.  
  93.                 ; propagate self (this) in \%s & class in \%c
  94.                 local \%s \%c
  95.                 asg \%s \v(macro)
  96.                 asg \%c \m(class_of_\02_\v(macro))
  97.  
  98.                 ; build msg & argument string for object message
  99.                 local i \%k \%p
  100.                 for i 1 \v(argc)-1 2 {
  101.                     asg \%k \%k\&_[i] 
  102.                     asg \%p \%p {\&_[i+1]}
  103.                 }
  104.  
  105.                 [~~~resolve_object_message~~~] \v(macro) \%k
  106.                 if success return \fexec(\v(return) \%p)
  107.                 END -999999
  108.  
  109.             }
  110.  
  111.             ; CLASS MESSAGE 'new:' OBTAINS:
  112.             ; 1st arg: class name
  113.             ; 2nd arg: the message
  114.             ; 3rd arg: the new object name
  115.             [~~~resolve_class_message~~~] \v(macro) \%k
  116.             if success return \fexec(\v(return) \%p)
  117.  
  118.             ; Cleanup here to get rid of used definitions
  119.  
  120.             if define \m(\v(macro)_\02_singleton) {
  121.                 if eq \m(\v(macro)_\02_singleton) \%2 {
  122.                     _asg \v(macro)_\02_singleton \02\02\02
  123.                 }
  124.             }
  125.  
  126.             _undefine /matching \%2*>>*
  127.             _define \%2
  128.  
  129.             END -999999
  130.  
  131.         } else {
  132.  
  133.             ; ALL OTHER CLASS MESSAGES:
  134.             [~~~resolve_class_message~~~] \v(macro) \%k
  135.             if success return \fexec(\v(return) \%p)
  136.             END -999999
  137.  
  138.         }
  139.  
  140.     }
  141.     
  142.     _define \%1>>initialize {
  143.         END 0
  144.     }
  145.  
  146.     _define \%1::destroy {
  147.         END 0
  148.     }
  149.  
  150.  
  151.     _define \%1>>destroy {
  152.         END 0
  153.     }
  154.  
  155.     _define \%1::new: {
  156.         return \%s
  157.     }
  158.  
  159.     return \%1    ; return class_name
  160.  
  161. }
  162.  
  163. define [~~~resolve_class_message~~~] {
  164. ; \%1 class_name
  165. ; \%2 class_message
  166. ; return applicable class_message
  167.     if define \m(\%1::\%2) return \%1::\%2 
  168.     [~~~search_inheritant_class~~~] \%1 \%2
  169.     if success return \v(return)
  170.     if define \m(class::\%2) return class::\%2
  171.     END -999999 ... ERROR: \%1 doesNotUnderstand \%2
  172. }
  173.  
  174. define [~~~search_inheritant_class~~~] {
  175.     if define \m(\%1_\02_inherit) {
  176.         local i \&w[]
  177.         for i 1 \fsplit(\m(\%1_\02_inherit),&w,\02) 1 {
  178.             if define \m(\&w[i]::\%2) return \&w[i]::\%2
  179.             [~~~search_inheritant_class~~~] \&w[i] \%2
  180.             if success return \v(return)
  181.         }
  182.     }
  183.     END -999999
  184. }
  185.  
  186. define [~~~resolve_object_message~~~] {
  187. ; \%1 object_name
  188. ; \%2 object_message
  189. ; return applicable object message and applicable object
  190. ; 1st: consider message defined for this particular object
  191. ; 2nd: consider message defined for this class & superclasses
  192. ; 4th: condider message defined for all classes.
  193.     if define \m(\%1>>\%2) return {\%1>>\%2 \%1}            ; 1st
  194.     [~~~search_inheritant_object~~~] \m(class_of_\02_\%1) \%1 \%2
  195.     if success return \v(return)                    ; 2nd
  196. ;    if define \m(class>>\%2) return {class>>\%2 class#\%1}
  197.     if define \m(class>>\%2) return {class>>\%2 \%1}             ; 4th
  198.     END -999999 ... ERROR \%1 doesNotUnderstand \%2
  199. }
  200.  
  201. define [~~~search_inheritant_object~~~] {
  202. ; \%1 class
  203. ; \%2 object
  204. ; \%3 message
  205.     if define \m(\%1>>\%3) {            ; class specific or inheritable
  206.         if not define \m(\%s) { \%1 new: \%s}
  207.         if define \m(\%1_\02_singleton) {asg \%2 \m(\%1_\02_singleton)}
  208.         return {\%1>>\%3 \%2}            ; class specific or inheritable
  209.     }
  210.  
  211. ; Consider message of selected super class
  212. ; The message is defined and superclass is part of the message
  213.     if define \m(\%3) {                            ; 3rd
  214.     if == \find(\%1,\%3) 1 {
  215.         return {\%3 \%2}
  216.     }
  217.     }
  218.  
  219.     if define \m(\%1_\02_inherit) {
  220.         local \&w[] i
  221.         for i 1 \fsplit(\m(\%1_\02_inherit),&w,\02) 1 {
  222. ;            [~~~search_inheritant_object~~~] \&w[i] \&w[i]\02#\02\%2 \%3
  223. ;           To enable virtual function in superclass delegates to implementation
  224. ;           in subclass
  225.             [~~~search_inheritant_object~~~] \&w[i] \%2 \%3
  226.             if success return \v(return)
  227.         }
  228.     }
  229.     END -999999
  230. }
  231.