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)))))