Re: Uploaded cl-uncommonsql 1.2.1-1 (source all) to usql

--Nq2Wo0NMKNjxTN9z
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline

On Thu, Aug 28, 2003 at 12:58:15PM -0400, Adam Di Carlo wrote:
> Source: cl-uncommonsql

Hi,

Here is a patch to get this version (err, I think it is this version) of
UncommonSQL to build on LispWorks/Windows. I use LispWorks 4.3.6.

Cheers.


-- 
Ng Pheng Siong <[email protected]> 

http://firewall.rulemaker.net  -+- Manage Your Firewall Rulebase Changes
http://sandbox.rulemaker.net/ngps -+- Open Source Python Crypto & SSL

--Nq2Wo0NMKNjxTN9z
Content-Type: text/plain; charset=us-ascii
Content-Disposition: attachment; filename="usql.diff"

--- metaclasses.lisp.org	Fri Dec  6 01:37:14 2002
+++ metaclasses.lisp	Tue Sep 16 14:19:50 2003
@@ -441,11 +441,15 @@
 						standard-effective-slot-definition)
   ())
 
-(defmethod direct-slot-definition-class ((class view-metaclass) initargs)
+(defgeneric direct-slot-definition-class (view-metaclass &rest initargs))
+
+(defmethod direct-slot-definition-class ((class view-metaclass) &rest initargs)
   (declare (ignore initargs))
   (find-class 'view-class-direct-slot-definition))
 
-(defmethod effective-slot-definition-class ((class view-metaclass) initargs)
+(defgeneric effective-slot-definition-class (view-metaclass &rest initargs))
+
+(defmethod effective-slot-definition-class ((class view-metaclass) &rest initargs)
   (declare (ignore initargs))
   (find-class 'view-class-effective-slot-definition))
 
--- context.lisp.org	Tue Sep 16 14:23:00 2003
+++ context.lisp	Tue Sep 16 14:23:58 2003
@@ -76,6 +76,7 @@
 (defmethod odcl::generate-new-oid ((self database) class)
   (sequence-next (sequence-from-class class)))
 
+#-lispworks
 (defmethod odcl::generate-copy ((self standard-db-object) new-oid)
   (let* ((*db-initializing* t)
          (copy-of-self (make-instance (type-of self))))
@@ -87,6 +88,18 @@
     (setf (slot-value copy-of-self 'oid) new-oid)
     copy-of-self))
   
+#+lispworks
+(defmethod odcl::generate-copy ((self standard-db-object) new-oid)
+  (let* ((*db-initializing* t)
+         (copy-of-self (make-instance (type-of self))))
+    (dolist (slot (class-slots (find-class (type-of self))))
+      (when (member (view-class-slot-db-kind slot) '(:key :base))
+        (let ((slot-name (slot-value slot 'name)))
+          (setf (slot-value copy-of-self slot-name)
+                (slot-value self slot-name)))))
+    (setf (slot-value copy-of-self 'oid) new-oid)
+    copy-of-self))
+  
 (defun instance-key-to-qualifier (key)
   (destructuring-bind (class-name &rest key-values)
       key
@@ -142,16 +155,6 @@
         (unbound (gensym)))
     (dolist (slot (class-slots (class-of instance)))
       (let ((name (slot-definition-name slot)))
-        (push (cons name (if (slot-boundp instance name)
-                             (slot-value instance name)
-                             unbound)) ss)))
-    (cons :snapshot (cons unbound ss))))
-
-(defmethod instance-snapshot ((instance standard-db-object) &aux ss)
-  (let ((*db-deserializing* t)
-        (unbound (gensym)))
-    (dolist (slot (pcl:class-slots (pcl:class-of instance)))
-      (let ((name (slot-value slot 'pcl::name)))
         (push (cons name (if (slot-boundp instance name)
                              (slot-value instance name)
                              unbound)) ss)))

--Nq2Wo0NMKNjxTN9z--