glib: GBoxed structures slots with :count are interpreted as arrays of fixed-length
authorDmitry Kalyanov <Kalyanov.Dmitry@gmail.com>
Thu, 6 Aug 2009 06:14:09 +0000 (10:14 +0400)
committerDmitry Kalyanov <Kalyanov.Dmitry@gmail.com>
Thu, 6 Aug 2009 06:14:09 +0000 (10:14 +0400)
glib/gobject.boxed.lisp

index 5afba92..6a9e304 100644 (file)
   (iter (with cstruct-type = (generated-cstruct-name (cstruct-description-name cstruct-description)))
         (for slot in (cstruct-description-slots cstruct-description))
         (for slot-name = (cstruct-slot-description-name slot))
-        (setf (foreign-slot-value native cstruct-type slot-name)
-              (slot-value proxy slot-name))))
+        (cond
+          ((cstruct-slot-description-count slot)
+           (iter (with ptr = (foreign-slot-pointer native cstruct-type slot-name))
+                 (with array = (slot-value proxy slot-name))
+                 (for i from 0 below (cstruct-slot-description-count slot))
+                 (setf (mem-aref ptr (cstruct-slot-description-type slot) i)
+                       (aref array i))))
+          (t
+           (setf (foreign-slot-value native cstruct-type slot-name)
+                 (slot-value proxy slot-name))))))
 
 (defun copy-slots-to-proxy (proxy native cstruct-description)
   (iter (with cstruct-type = (generated-cstruct-name (cstruct-description-name cstruct-description)))
         (for slot in (cstruct-description-slots cstruct-description))
         (for slot-name = (cstruct-slot-description-name slot))
-        (setf (slot-value proxy slot-name)
-              (foreign-slot-value native cstruct-type slot-name))))
+        (cond
+          ((cstruct-slot-description-count slot)
+           (setf (slot-value proxy slot-name) (make-array (list (cstruct-slot-description-count slot))))
+           (iter (with ptr = (foreign-slot-pointer native cstruct-type slot-name))
+                 (with array = (slot-value proxy slot-name))
+                 (for i from 0 below (cstruct-slot-description-count slot))
+                 (setf (aref array i)
+                       (mem-aref ptr (cstruct-slot-description-type slot) i))))
+          (t (setf (slot-value proxy slot-name)
+                   (foreign-slot-value native cstruct-type slot-name))))))
 
 (defmethod translate-to-foreign (proxy (type boxed-cstruct-foreign-type))
   (if (null proxy)