[rjain-utils-cvs] CVS formulate/src

[rjain]

Update of /project/rjain-utils/cvsroot/formulate/src
In directory cl-net:/tmp/cvs-serv27785/src

Modified Files:
	metaobjects.lisp 
Log Message:
try to add support for class redefinition... doesn't quite work...


--- /project/rjain-utils/cvsroot/formulate/src/metaobjects.lisp	2009/11/19 00:44:14	1.3
+++ /project/rjain-utils/cvsroot/formulate/src/metaobjects.lisp	2009/12/25 20:59:19	1.4
@@ -13,7 +13,8 @@
                        :initarg formulator-options
                        :accessor formulator-options)))
 
-(defclass formulated-direct-slot-definition (formulated-slot-definition standard-direct-slot-definition)
+(defclass formulated-direct-slot-definition (formulated-slot-definition
+                                             standard-direct-slot-definition)
   ())
 
 (defmethod initialize-instance :after ((instance formulated-direct-slot-definition)
@@ -36,7 +37,8 @@
   ;; a source.
   'formulated-direct-slot-definition)
 
-(defclass formulated-effective-slot-definition (formulated-slot-definition standard-effective-slot-definition)
+(defclass formulated-effective-slot-definition (formulated-slot-definition
+                                                standard-effective-slot-definition)
   ())
 
 (defmethod effective-slot-definition-class ((class formulated-class) &key &allow-other-keys)
@@ -81,4 +83,18 @@
 
 (defun slot-formulator (object slot-name)
   (let ((*get-formulator* t))
-    (slot-value object slot-name)))
\ No newline at end of file
+    (slot-value object slot-name)))
+
+(defmethod reinitialize-instance :after ((class formulated-class) &key)
+  ;; TODO: u-i-f-r-c is not being called... find out why
+  (eval `(defmethod update-instance-for-redefined-class :after
+             ((instance ,(class-name class)) added discarded plist &rest initargs)
+           ;; update formulae in slots
+           ,@(mapcar (lambda (slotd)
+                       `(unless (or (find ,(slot-definition-name slotd) added)
+                                    ,(subtypep (formulator-class slotd) 'dynamic-formula-formulator-mixin))
+                          (setf (formulator-formula (slot-formulator instance ,(slot-definition-name slotd)))
+                                ,(slot-definition-initform slotd))
+                          (setf (formulator-formula-function (slot-formulator instance ,(slot-definition-name slotd)))
+                                ,(slot-definition-initfunction slotd))))
+                     (class-slots class)))))