projects
/
clsql.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
r9137: add defgenerics
[clsql.git]
/
sql
/
metaclasses.lisp
diff --git
a/sql/metaclasses.lisp
b/sql/metaclasses.lisp
index af8e461b774ba05b7e8fce2122642e630633b698..0efa327dd94e123518c96255ea9ffea797a970e2 100644
(file)
--- a/
sql/metaclasses.lisp
+++ b/
sql/metaclasses.lisp
@@
-45,10
+45,6
@@
:accessor object-definition
:initarg :definition
:initform nil)
:accessor object-definition
:initarg :definition
:initform nil)
- (version
- :accessor object-version
- :initarg :version
- :initform 0)
(key-slots
:accessor key-slots
:initform nil)
(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
result))
#+lispworks
-(defconstant +extra-class-options+ '(:base-table
:version :schemas
))
+(defconstant +extra-class-options+ '(:base-table))
#+lispworks
(defmethod clos::canonicalize-class-options :around
#+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
(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)))
&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)))))
(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
(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))
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)))
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)))
(register-metaclass class (nth (1+ (position :direct-slots all-keys))
all-keys)))