r9114: fixes for list-indexes

[clsql.git] / sql / metaclasses.lisp

diff --git a/sql/metaclasses.lisp b/sql/metaclasses.lisp
index 34e6c696cd9e1a8af59be50d93989abc51e7fe0d..0efa327dd94e123518c96255ea9ffea797a970e2 100644 (file)
--- a/sql/metaclasses.lisp
+++ b/sql/metaclasses.lisp
@@ -37,7 +37,7 @@
 ;; ------------------------------------------------------------
 ;; metaclass: view-class
 
-(defclass view-metaclass (standard-class)
+(defclass standard-db-class (standard-class)
   ((view-table
     :accessor view-table
     :initarg :view-table)
@@ -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)
@@ -91,7 +87,7 @@
 
 #+lispworks 
 (defmethod clos::canonicalize-defclass-slot :around
-  ((prototype view-metaclass) slot)
+  ((prototype standard-db-class) slot)
  "\\lw\\ signals an error on unknown slot options; so this method
 removes any extra allowed options before calling the default method
 and returns the canonicalized extra options concatenated to the result
@@ -117,11 +113,11 @@ 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
-    ((prototype view-metaclass) class-options)
+    ((prototype standard-db-class) class-options)
   "\\lw\\ signals an error on unknown class options; so this method
 removes any extra allowed options before calling the default method
 and returns the canonicalized extra options concatenated to the result
@@ -145,7 +141,7 @@ of the default method.  The extra allowed options are the value of the
     result))
 
 
-(defmethod validate-superclass ((class view-metaclass)
+(defmethod validate-superclass ((class standard-db-class)
                                (superclass standard-class))
   t)
 
@@ -178,13 +174,13 @@ of the default method.  The extra allowed options are the value of the
       (pop-arg mylist))
     newlist))
 
-(defmethod initialize-instance :around ((class view-metaclass)
+(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 'view-metaclass)))
+       (vmc (find-class 'standard-db-class)))
     (setf (view-class-qualifier class)
           (car qualifier))
     (if root-class
@@ -203,20 +199,16 @@ 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 view-metaclass)
+(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))
-       (vmc (find-class 'view-metaclass)))
+       (vmc (find-class 'standard-db-class)))
     (setf (view-table class)
           (table-name-from-arg (sql-escape (or (and base-table
                                                     (if (listp base-table)
@@ -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)))
 
@@ -284,9 +272,9 @@ of the default method.  The extra allowed options are the value of the
                                           (ordered-class-slots class)))))
 
 #+(or allegro openmcl)
-(defmethod finalize-inheritance :after ((class view-metaclass))
+(defmethod finalize-inheritance :after ((class standard-db-class))
   ;; KMRL for slots without a type set, openmcl sets type-predicate to ccl:false
-  ;; for view-metaclass
+  ;; for standard-db-class
   #+openmcl
   (mapcar 
    #'(lambda (s)
@@ -437,13 +425,13 @@ all NULL values retrieved are converted by DATABASE-NULL-VALUE")
                                                standard-effective-slot-definition)
   ())
 
-(defmethod direct-slot-definition-class ((class view-metaclass)
+(defmethod direct-slot-definition-class ((class standard-db-class)
                                          #+kmr-normal-dsdc &rest
                                          initargs)
   (declare (ignore initargs))
   (find-class 'view-class-direct-slot-definition))
 
-(defmethod effective-slot-definition-class ((class view-metaclass)
+(defmethod effective-slot-definition-class ((class standard-db-class)
                                            #+kmr-normal-esdc &rest
                                            initargs)
   (declare (ignore initargs))
@@ -455,7 +443,7 @@ all NULL values retrieved are converted by DATABASE-NULL-VALUE")
   (class-precedence-list class))
 
 #-(or sbcl cmu)
-(defmethod compute-slots ((class view-metaclass))
+(defmethod compute-slots ((class standard-db-class))
   "Need to sort order of class slots so they are the same across
 implementations."
   (let ((slots (call-next-method))
@@ -506,7 +494,7 @@ which does type checking before storing a value in a slot."
 ;; what kind of database value (if any) is stored there, generates and
 ;; verifies the column name.
 
-(defmethod compute-effective-slot-definition ((class view-metaclass)
+(defmethod compute-effective-slot-definition ((class standard-db-class)
                                              #+kmr-normal-cesd slot-name
                                              direct-slots)
   #+kmr-normal-cesd (declare (ignore slot-name))