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