Added support for pseudo type COPY-OF

[clg] / glib / proxy.lisp

diff --git a/glib/proxy.lisp b/glib/proxy.lisp
index eeecae10dcaad03ed8ec7f5daf18a0303996da00..f5c3f6e4330097b0ce195b39b05e2b2871226bb4 100644 (file)
--- a/glib/proxy.lisp
+++ b/glib/proxy.lisp
@@ -15,7 +15,7 @@
 ;; License along with this library; if not, write to the Free Software
 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 
-;; $Id: proxy.lisp,v 1.11 2004-11-06 21:39:58 espen Exp $
+;; $Id: proxy.lisp,v 1.14 2004-11-19 13:02:51 espen Exp $
 
 (in-package "GLIB")
 
@@ -224,8 +224,7 @@ (defmethod instance-finalizer ((instance proxy))
 ;;     (unless (find-method #'unreference-foreign nil (list (class-of class) t) nil)
 ;;       (error "No matching method for UNREFERENCE-INSTANCE when called with class ~A" class))
     #'(lambda ()
-       (when (instance-cached-p location)
-         (remove-cached-instance location))
+       (remove-cached-instance location)
        (unreference-foreign class location))))
 
 
@@ -366,6 +365,26 @@ (defmethod to-alien-function ((class proxy-class) &rest args)
   (declare (ignore class args))
   #'proxy-location)
 
+(defmethod copy-from-alien-form (location (class proxy-class) &rest args)
+  (declare (ignore args))
+  (let ((class-name (class-name class)))
+    `(ensure-proxy-instance ',class-name
+      (reference-foreign ',class-name ,location))))
+
+(defmethod copy-from-alien-function ((class proxy-class) &rest args)
+  (declare (ignore args))  
+  #'(lambda (location)
+      (ensure-proxy-instance class (reference-foreign class location))))
+
+(defmethod copy-to-alien-form (instance (class proxy-class) &rest args)
+  (declare (ignore args))
+  `(reference-foreign ',(class-name class) (proxy-location ,instance)))
+
+(defmethod copy-to-alien-function ((class proxy-class) &rest args)
+  (declare (ignore class args))
+  #'(lambda (instance)
+      (reference-foreign class (proxy-location instance))))
+
 (defmethod writer-function ((class proxy-class) &rest args)
   (declare (ignore args))
   #'(lambda (instance location &optional (offset 0))
@@ -377,7 +396,9 @@ (defmethod writer-function ((class proxy-class) &rest args)
 (defmethod reader-function ((class proxy-class) &rest args)
   (declare (ignore args))
   #'(lambda (location &optional (offset 0))
-      (ensure-proxy-instance class (sap-ref-sap location offset))))
+      (let ((instance (sap-ref-sap location offset)))
+       (unless (null-pointer-p instance)
+         (ensure-proxy-instance class (reference-foreign class instance))))))
 
 (defmethod destroy-function ((class proxy-class) &rest args)
   (declare (ignore args))
@@ -409,9 +430,11 @@ (defclass struct (proxy)
 
 (defmethod initialize-instance ((struct struct) &rest initargs)
   (declare (ignore initargs))
-  (setf 
-   (slot-value struct 'location)
-   (allocate-memory (proxy-instance-size (class-of struct))))
+  (unless (slot-boundp struct 'location)
+    (let ((size (proxy-instance-size (class-of struct))))
+      (if (zerop size)
+         (error "~A has zero size" (class-of struct))
+         (setf (slot-value struct 'location) (allocate-memory size)))))
   (call-next-method))
 
 
@@ -426,13 +449,6 @@ (defmethod reference-foreign ((class struct-class) location)
 (defmethod unreference-foreign ((class struct-class) location)
   (deallocate-memory location))
 
-(defmethod reader-function ((class struct-class) &rest args)
-  (declare (ignore args))
-  #'(lambda (location &optional (offset 0))
-      (let ((instance (sap-ref-sap location offset)))
-       (unless (null-pointer-p instance)
-         (ensure-proxy-instance class (reference-foreign class instance))))))
-
 
 (defclass static-struct-class (struct-class)
   ())