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