From 4802d4231cbe4a3043b6bd477bdcf01309d50b15 Mon Sep 17 00:00:00 2001 From: Dmitry Kalyanov Date: Thu, 6 Aug 2009 10:14:09 +0400 Subject: [PATCH] glib: GBoxed structures slots with :count are interpreted as arrays of fixed-length --- glib/gobject.boxed.lisp | 24 ++++++++++++++++++++---- 1 file changed, 20 insertions(+), 4 deletions(-) diff --git a/glib/gobject.boxed.lisp b/glib/gobject.boxed.lisp index 5afba92..6a9e304 100644 --- a/glib/gobject.boxed.lisp +++ b/glib/gobject.boxed.lisp @@ -124,15 +124,31 @@ (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) -- 1.7.10.4