X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql%2Fmetaclasses.lisp;h=ac0592087e6add41f5d3ed03428b5f3056b638a2;hb=9a70270bf9a1d60323ded33ce52bd0904544c70b;hp=af8e461b774ba05b7e8fce2122642e630633b698;hpb=c339a403634db7fc71308bb6da91e81af4cde1bb;p=clsql.git diff --git a/sql/metaclasses.lisp b/sql/metaclasses.lisp index af8e461..ac05920 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 @@ -155,7 +151,7 @@ of the default method. The extra allowed options are the value of the ((typep arg 'sql-ident) (slot-value arg 'name)) ((stringp arg) - (intern (string-upcase arg))))) + (intern (symbol-name-default-case arg))))) (defun column-name-from-arg (arg) (cond ((symbolp arg) @@ -163,7 +159,7 @@ of the default method. The extra allowed options are the value of the ((typep arg 'sql-ident) (slot-value arg 'name)) ((stringp arg) - (intern (string-upcase arg))))) + (intern (symbol-name-default-case arg))))) (defun remove-keyword-arg (arglist akey) @@ -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)))