X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql%2Fmetaclasses.lisp;h=0efa327dd94e123518c96255ea9ffea797a970e2;hb=a4097e19c5157e87b9991549bc44f3ef598aeb90;hp=a0b94716461ac2683559dab24189eeb57e79c5a4;hpb=e3ed4080f0a28d94e81aad7452fb1f81e1e50253;p=clsql.git

diff --git a/sql/metaclasses.lisp b/sql/metaclasses.lisp
index a0b9471..0efa327 100644
--- a/sql/metaclasses.lisp
+++ b/sql/metaclasses.lisp
@@ -45,10 +45,6 @@
     :accessor object-definition
     :initarg :definition
     :initform nil)
-   (version
-    :accessor object-version
-    :initarg :version
-    :initform 0)
    (key-slots
     :accessor key-slots
     :initform nil)
@@ -117,7 +113,7 @@ of the default method.  The extra allowed options are the value of the
     result))
 
 #+lispworks
-(defconstant +extra-class-options+ '(:base-table :version :schemas))
+(defconstant +extra-class-options+ '(:base-table))
 
 #+lispworks 
 (defmethod clos::canonicalize-class-options :around
@@ -181,7 +177,7 @@ of the default method.  The extra allowed options are the value of the
 (defmethod initialize-instance :around ((class standard-db-class)
                                         &rest all-keys
 					&key direct-superclasses base-table
-                                        schemas version qualifier
+                                        qualifier
 					&allow-other-keys)
   (let ((root-class (find-class 'standard-db-object nil))
 	(vmc (find-class 'standard-db-class)))
@@ -203,16 +199,12 @@ of the default method.  The extra allowed options are the value of the
                                                         (car base-table)
                                                         base-table))
                                                (class-name class)))))
-    (setf (object-version class) version)
-    (mapc (lambda (schema)
-            (pushnew (class-name class) (gethash schema *object-schemas*)))
-          (if (listp schemas) schemas (list schemas)))
     (register-metaclass class (nth (1+ (position :direct-slots all-keys))
                                    all-keys))))
 
 (defmethod reinitialize-instance :around ((class standard-db-class)
                                           &rest all-keys
-                                          &key base-table schemas version
+                                          &key base-table 
                                           direct-superclasses qualifier
                                           &allow-other-keys)
   (let ((root-class (find-class 'standard-db-object nil))
@@ -235,10 +227,6 @@ of the default method.  The extra allowed options are the value of the
                                                 direct-superclasses)
 		   (remove-keyword-arg all-keys :direct-superclasses)))
         (call-next-method)))
-  (setf (object-version class) version)
-  (mapc (lambda (schema)
-          (pushnew (class-name class) (gethash schema *object-schemas*)))
-        (if (listp schemas) schemas (list schemas)))
   (register-metaclass class (nth (1+ (position :direct-slots all-keys))
                                  all-keys)))
 
@@ -461,19 +449,16 @@ implementations."
   (let ((slots (call-next-method))
 	desired-sequence
 	output-slots)
-
     (dolist (c (compute-class-precedence-list class))
       (dolist (s (class-direct-slots c))
 	(let ((name (slot-definition-name s)))
 	  (unless (find name desired-sequence)
-	    (setq desired-sequence (append desired-sequence (list name)))))))
-    ;; desired-sequence is reversed at this time
+	    (push name desired-sequence)))))
     (dolist (desired desired-sequence)
       (let ((slot (find desired slots :key #'slot-definition-name)))
 	(assert slot)
 	(push slot output-slots)))
-
-    (nreverse output-slots)))
+    output-slots))
 
 (defun compute-lisp-type-from-slot-specification (slotd specified-type)
   "Computes the Lisp type for a user-specified type. Needed for OpenMCL
@@ -592,7 +577,7 @@ which does type checking before storing a value in a slot."
 
 (defun slotdef-for-slot-with-class (slot class)
   (find-if #'(lambda (d) (eql slot (slot-definition-name d)))
-	   (ordered-class-slots class)))
+	   (class-slots class)))
 
 #+ignore
 (eval-when (:compile-toplevel :load-toplevel :execute)