From: Andrey Kutejko <andy128k@gmail.com>
Date: Sun, 15 Aug 2010 11:07:56 +0000 (+0300)
Subject: added translate-to-foreign method for GSList
X-Git-Url: http://repo.macrolet.net/gitweb/?p=cl-gtk2.git;a=commitdiff_plain;h=f97b6274683cfe0373105ac0e44edd9cae362804

added translate-to-foreign method for GSList
---

diff --git a/glib/glib.glist.lisp b/glib/glib.glist.lisp
index 22ea6bc..1a8ff3c 100644
--- a/glib/glib.glist.lisp
+++ b/glib/glib.glist.lisp
@@ -51,6 +51,8 @@
   (data :pointer)
   (next :pointer))
 
+(defcfun g-slist-alloc (:pointer g-slist))
+
 (defcfun g-slist-free :void (list (:pointer g-slist)))
 
 (defun g-slist-next (list)
@@ -64,4 +66,19 @@
             (until (null-pointer-p c))
             (collect (convert-from-foreign (foreign-slot-value c 'g-slist 'data) (gslist-type-type type))))
     (when (gslist-type-free-from-foreign type)
-      (g-slist-free pointer))))
\ No newline at end of file
+      (g-slist-free pointer))))
+
+(defmethod translate-to-foreign (list (type gslist-type))
+  (let ((result (null-pointer)) last)
+    (iter (for item in list)
+          (for n = (g-slist-alloc))
+          (for ptr = (convert-to-foreign item (gslist-type-type type)))
+          (setf (foreign-slot-value n 'g-slist 'data) ptr)
+          (setf (foreign-slot-value n 'g-slist 'next) (null-pointer))
+          (when last
+            (setf (foreign-slot-value last 'g-slist 'next) n))
+          (setf last n)
+          (when (first-iteration-p)
+            (setf result n)))
+    result))
+