Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv24835/src

Modified Files: classes.lisp Log Message: doc-strings slot-makunbound-using-class init transients after persistents

Date: Thu Sep 16 06:14:04 2004 Author: blee

Index: elephant/src/classes.lisp diff -u elephant/src/classes.lisp:1.9 elephant/src/classes.lisp:1.10 --- elephant/src/classes.lisp:1.9 Sat Sep 4 10:16:11 2004 +++ elephant/src/classes.lisp Thu Sep 16 06:14:04 2004 @@ -46,8 +46,8 @@ (defmethod initialize-instance :before ((instance persistent) &rest initargs &key from-oid) - (declare (ignore initargs)) "Sets the OID." + (declare (ignore initargs)) (if (not from-oid) (setf (oid instance) (next-oid *store-controller*)) (setf (oid instance) from-oid)) @@ -56,27 +56,12 @@ (defclass persistent-object (persistent) ((%persistent-slots :transient t)) (:documentation "Superclass of all user-defined persistent -classes") +classes. To make some slots not persisted, use the +:transient flag.") (:metaclass persistent-metaclass))

-#| -(defmethod compute-class-precedence-list :around ((class persistent-metaclass)) - (let ((cpl (call-next-method)) - (persistent-object (find-class 'persistent-object))) - (if (member persistent-object cpl :test #'eq) - cpl - (let ((std-obj (find-class 'standard-object)) - (ccpl (copy-list cpl))) - (loop for c on ccpl - when (eq (cadr c) std-obj) - do - (setf (cdr c) (cons persistent-object - (cons (find-class 'persistent) (cdr c)))) - (return nil)) - ccpl)))) -|# - (defmethod shared-initialize :around ((class persistent-metaclass) slot-names &rest args &key direct-superclasses) + "Ensures we inherit from persistent-object." (let* ((persistent-metaclass (find-class 'persistent-metaclass)) (persistent-object (find-class 'persistent-object)) (not-already-persistent (loop for superclass in direct-superclasses @@ -88,7 +73,11 @@ (call-next-method))))

(defmethod shared-initialize :around ((instance persistent-object) slot-names &rest initargs &key &allow-other-keys) - "This seems to be necessary because it is typical for implementations to optimize setting the slots via initforms and initargs in such a way that slot-value-using-class et al aren't used." + "Initializes the persistent slots via initargs or forms. +This seems to be necessary because it is typical for +implementations to optimize setting the slots via initforms +and initargs in such a way that slot-value-using-class et al +aren't used. Calls the next method for the transient slots." (let* ((class (class-of instance)) (persistent-slot-names (persistent-slot-names class))) (flet ((persistent-slot-p (item) @@ -100,8 +89,6 @@ (persistent-slot-inits (if (eq slot-names t) persistent-slot-names (remove-if-not #'persistent-slot-p slot-names)))) - ;; let the implementation initialize the transient slots - (apply #'call-next-method instance transient-slot-inits initargs) ;; initialize the persistent slots (flet ((initialize-from-initarg (slot-def) (loop for initarg in initargs @@ -119,31 +106,41 @@ (let ((initfun (slot-definition-initfunction slot-def))) (when initfun (setf (slot-value-using-class class instance slot-def) - (funcall initfun)))))))))) + (funcall initfun)))))) + ;; let the implementation initialize the transient slots + (apply #'call-next-method instance transient-slot-inits initargs)))))

(defmethod slot-value-using-class :around (class (instance persistent-object) (slot-def persistent-slot-definition)) - (declare (ignore class)) + "Get the slot value from the database." + (declare (optimize (speed 3)) + (ignore class)) (let ((name (slot-definition-name slot-def))) (persistent-slot-reader instance name)))

(defmethod (setf slot-value-using-class) :around (new-value class (instance persistent-object) (slot-def persistent-slot-definition)) - (declare (ignore class)) + "Set the slot value in the database." + (declare (optimize (speed 3)) + (ignore class)) (let ((name (slot-definition-name slot-def))) (persistent-slot-writer new-value instance name)))

(defmethod slot-boundp-using-class :around (class (instance persistent-object) (slot-def persistent-slot-definition)) - (declare (ignore class)) + "Checks if the slot exists in the database." + (declare (optimize (speed 3)) + (ignore class)) (let ((name (slot-definition-name slot-def))) (persistent-slot-boundp instance name)))

(defmethod slot-makunbound-using-class :around (class (instance persistent-object) (slot-def persistent-slot-definition)) - (declare (ignore class)) - (buffer-write-int (oid instance) *key-buf*) - (let ((key-length (serialize (slot-definition-name slot-def) *key-buf*))) + "Deletes the slot from the database." + (declare (optimize (speed 3)) + (ignore class)) + (with-buffer-streams (key-buf) + (buffer-write-int (oid instance) key-buf) + (serialize (slot-definition-name slot-def) key-buf) (db-delete-buffered - (controller-db *store-controller*) - (buffer-stream-buffer *key-buf*) - key-length + (controller-db *store-controller*) key-buf :transaction *current-transaction* - :auto-commit *auto-commit*))) + :auto-commit *auto-commit*)) + instance)