[elephant-cvs] CVS update: elephant/src/classes.lisp

[blee at common-lisp.net]

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)