[gtk-cffi-cvs] CVS gtk-cffi/g-lib

[CVS User rklochkov]

Update of /project/gtk-cffi/cvsroot/gtk-cffi/g-lib
In directory tiger.common-lisp.net:/tmp/cvs-serv27495/g-lib

Modified Files:
	array.lisp package.lisp 
Log Message:
Some refactoring. Now we can use (show #(1 2 3)) or (show '(1 2 3)) to lookup
through the sequence in GTK list view



--- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/array.lisp	2011/08/28 10:31:30	1.2
+++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/array.lisp	2011/09/10 16:26:10	1.3
@@ -7,11 +7,11 @@
 
 (in-package :g-lib-cffi)
 
-(defvar *array-length*)
+(defvar *array-length* (foreign-alloc :uint))
 
-(defmacro with-array (&body body)
-  `(with-foreign-object (*array-length* :uint)
-     , at body))
+;(defmacro with-array (&body body)
+;  `(with-foreign-object (*array-length* :uint)
+;     , at body)
      
 
 (define-foreign-type cffi-array ()
@@ -38,12 +38,19 @@
 (defcfun g-free :void (var :pointer))
 
 (defmethod translate-from-foreign (ptr (cffi-array cffi-array))
-  (assert (boundp '*array-length*) nil 
-          "Array should be returned in WITH-ARRAY form")
   (let ((array-length (mem-ref *array-length* :uint)))
-    (let ((res (make-array array-length)))
+    (let* ((res (make-array array-length))
+           (el-type (element-type cffi-array))
+           (struct (and (consp el-type) (eq (car el-type) 'struct))))
       (iter
         (for i from 0 below array-length)
-        (setf (aref res i) (mem-aref ptr (element-type cffi-array) i)))
+        (setf (aref res i)
+              (if struct
+                  ;; if this is array of structs, we shouldn't think, that
+                  ;; elements are pointers to struct
+                  (convert-from-foreign 
+                   (inc-pointer ptr (* (foreign-type-size (second el-type)) i))
+                   el-type)
+                  (mem-aref ptr el-type i))))
       (g-free ptr)
       res)))
--- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/package.lisp	2011/08/26 17:16:13	1.2
+++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/package.lisp	2011/09/10 16:26:10	1.3
@@ -19,7 +19,6 @@
    #:g-quark
    #:g-error
    #:garray
-   #:with-array
    #:*array-length*
 
    #:timeout-add