X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/5f2222a91d6270c93cdff276a33893525b58435a..02b6647eb230bbe95383971f6158275a7ca85166:/glib/glib.lisp

diff --git a/glib/glib.lisp b/glib/glib.lisp
index 6ee1488..e8ca9ca 100644
--- a/glib/glib.lisp
+++ b/glib/glib.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: glib.lisp,v 1.20 2004/11/21 17:37:24 espen Exp $
+;; $Id: glib.lisp,v 1.22 2004/12/26 11:40:58 espen Exp $
 
 
 (in-package "GLIB")
@@ -225,11 +225,35 @@
     `(destroy-glist ,glist ',element-type)))
 
 (defmethod cleanup-function ((type (eql 'glist)) &rest args)
-  (declare (ignore type args))
+  (declare (ignore type))
   (destructuring-bind (element-type) args
     #'(lambda (glist)
 	(destroy-glist glist element-type))))
 
+(defmethod writer-function ((type (eql 'glist)) &rest args)
+  (declare (ignore type))
+  (destructuring-bind (element-type) args
+    #'(lambda (list location &optional (offset 0))
+	(setf 
+	 (sap-ref-sap location offset)
+	 (make-glist element-type list)))))
+
+(defmethod reader-function ((type (eql 'glist)) &rest args)
+  (declare (ignore type))
+  (destructuring-bind (element-type) args
+    #'(lambda (location &optional (offset 0))
+	(unless (null-pointer-p (sap-ref-sap location offset))
+	  (map-glist 'list #'identity (sap-ref-sap location offset) element-type)))))
+
+(defmethod destroy-function ((type (eql 'glist)) &rest args)
+  (declare (ignore type))
+  (destructuring-bind (element-type) args
+    #'(lambda (location &optional (offset 0))
+	(unless (null-pointer-p (sap-ref-sap location offset))
+	  (destroy-glist (sap-ref-sap location offset) element-type)
+	  (setf (sap-ref-sap location offset) (make-pointer 0))))))
+
+
 
 ;;;; Single linked list (GSList)
 
@@ -305,16 +329,38 @@
 	(map-glist 'list #'identity gslist element-type))))
 
 (defmethod cleanup-form (gslist (type (eql 'gslist)) &rest args)
-  (declare (ignore type args))
+  (declare (ignore type))
   (destructuring-bind (element-type) args
     `(destroy-gslist ,gslist ',element-type)))
 
 (defmethod cleanup-function ((type (eql 'gslist)) &rest args)
-  (declare (ignore type args))
+  (declare (ignore type))
   (destructuring-bind (element-type) args
     #'(lambda (gslist)
 	(destroy-gslist gslist element-type))))
 
+(defmethod writer-function ((type (eql 'gslist)) &rest args)
+  (declare (ignore type))
+  (destructuring-bind (element-type) args
+    #'(lambda (list location &optional (offset 0))
+	(setf 
+	 (sap-ref-sap location offset)
+	 (make-gslist element-type list)))))
+
+(defmethod reader-function ((type (eql 'gslist)) &rest args)
+  (declare (ignore type))
+  (destructuring-bind (element-type) args
+    #'(lambda (location &optional (offset 0))
+	(unless (null-pointer-p (sap-ref-sap location offset))
+	  (map-glist 'list #'identity (sap-ref-sap location offset) element-type)))))
+
+(defmethod destroy-function ((type (eql 'gslist)) &rest args)
+  (declare (ignore type))
+  (destructuring-bind (element-type) args
+    #'(lambda (location &optional (offset 0))
+	(unless (null-pointer-p (sap-ref-sap location offset))
+	  (destroy-gslist (sap-ref-sap location offset) element-type)
+	  (setf (sap-ref-sap location offset) (make-pointer 0))))))
 
 
 ;;; Vector
@@ -429,3 +475,32 @@
       (deallocate-memory ,(if (eq length '*) 
 			      `(sap+ location  ,(- +size-of-int+))
 			    'location)))))
+
+(defmethod writer-function ((type (eql 'vector)) &rest args)
+  (declare (ignore type))
+  (destructuring-bind (element-type &optional (length '*)) args
+    #'(lambda (vector location &optional (offset 0))
+	(setf 
+	 (sap-ref-sap location offset)
+	 (make-c-vector element-type length vector)))))
+
+(defmethod reader-function ((type (eql 'vector)) &rest args)
+  (declare (ignore type))
+  (destructuring-bind (element-type &optional (length '*)) args
+    (if (eq length '*)
+	(error "Can't create reader function for vector of variable size")
+      #'(lambda (location &optional (offset 0))
+	  (unless (null-pointer-p (sap-ref-sap location offset))
+	    (map-c-vector 'vector #'identity (sap-ref-sap location offset) 
+	     element-type length))))))
+
+(defmethod destroy-function ((type (eql 'vector)) &rest args)
+  (declare (ignore type))
+  (destructuring-bind (element-type &optional (length '*)) args
+    (if (eq length '*)
+	(error "Can't create destroy function for vector of variable size")
+      #'(lambda (location &optional (offset 0))
+	  (unless (null-pointer-p (sap-ref-sap location offset))
+	    (destroy-c-vector 
+	     (sap-ref-sap location offset) element-type length)
+	    (setf (sap-ref-sap location offset) (make-pointer 0)))))))