Re: Uploaded cl-uncommonsql 1.2.1-1 (source all) to usql
Martin Simmons <[email protected]> Tue, 16 Sep 2003 11:10:49 +0100
| Newsgroups | gmane.lisp.uncommon-sql |
|---|---|
| Message-ID | <[email protected]> |
>>>>> On Tue, 16 Sep 2003 16:52:59 +0800, Ng Pheng Siong <[email protected]> said: Ng> --- metaclasses.lisp.org Fri Dec 6 01:37:14 2002 Ng> +++ metaclasses.lisp Tue Sep 16 14:19:50 2003 Ng> @@ -441,11 +441,15 @@ Ng> standard-effective-slot-definition) Ng> ()) Ng> -(defmethod direct-slot-definition-class ((class view-metaclass) initargs) Ng> +(defgeneric direct-slot-definition-class (view-metaclass &rest initargs)) Ng> + Ng> +(defmethod direct-slot-definition-class ((class view-metaclass) &rest initargs) Ng> (declare (ignore initargs)) Ng> (find-class 'view-class-direct-slot-definition)) Hi there, If this is clos:direct-slot-definition-class (look like it), then you probably don't want the defgeneric in the cl-uncommonsql sources (the generic is part of the CLOS implementation). Also, to make the code support systems with the original lambda-list (e.g. LW < 4.3), I suggest something like: (defmethod direct-slot-definition-class ((class view-metaclass) #+(and lispworks (not lispworks4.1) (not lispworks4.2)) &rest initargs) ...) [ don't use #+lispworks4.3 because that will be false for LW > 4.3 ] Ditto for effective-slot-definition-class. Ng> --- context.lisp.org Tue Sep 16 14:23:00 2003 Ng> +++ context.lisp Tue Sep 16 14:23:58 2003 Ng> @@ -76,6 +76,7 @@ Ng> (defmethod odcl::generate-new-oid ((self database) class) Ng> (sequence-next (sequence-from-class class))) Ng> +#-lispworks Ng> (defmethod odcl::generate-copy ((self standard-db-object) new-oid) Ng> (let* ((*db-initializing* t) Ng> (copy-of-self (make-instance (type-of self)))) Ng> @@ -87,6 +88,18 @@ Ng> (setf (slot-value copy-of-self 'oid) new-oid) Ng> copy-of-self)) Ng> +#+lispworks Ng> +(defmethod odcl::generate-copy ((self standard-db-object) new-oid) Ng> + (let* ((*db-initializing* t) Ng> + (copy-of-self (make-instance (type-of self)))) Ng> + (dolist (slot (class-slots (find-class (type-of self)))) Ng> + (when (member (view-class-slot-db-kind slot) '(:key :base)) Ng> + (let ((slot-name (slot-value slot 'name))) Using slot-definition-name might be better here (could be portable too). -- Martin Simmons Email: [email protected] Xanalys Ltd, Compass House, Vision Park TEL: +44 1223 257944 Histon, Cambridge CB4 9AD, England. FAX: +44 1223 257812