[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-serv31071/g-lib

Modified Files:
	array.lisp list.lisp loadlib.lisp package.lisp 
Log Message:
Refactored freeable
Added loadlib to gio
Fixed compilation without loading



--- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/array.lisp	2011/12/31 17:20:56	1.5
+++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/array.lisp	2012/01/25 19:15:08	1.6
@@ -10,12 +10,17 @@
 (defvar *array-length* (foreign-alloc :uint))
 
 ;; TODO: add with-pointer-to-vector-data optimization
-(define-foreign-type cffi-array ()
+(define-foreign-type cffi-array (freeable)
   ((element-type :initarg :type :accessor element-type))
   (:actual-type :pointer))
 
-(define-parse-method garray (type)
-  (make-instance 'cffi-array :type type))
+(define-parse-method garray (type &key free)
+  (make-instance 'cffi-array :type type :free free))
+
+(defcfun g-free :void (var :pointer))
+
+(defmethod free-ptr ((type cffi-array) ptr)
+  (g-free ptr))
 
 (defmethod translate-to-foreign (value (cffi-array cffi-array))
   (if (pointerp value)
@@ -27,11 +32,10 @@
           (setf (mem-aref res type i) (elt value i)))
         res)))
 
-(defmethod free-translated-object (value (cffi-array cffi-array) param)
-  (declare (ignore param))
-  (foreign-free value))
+;(defmethod free-translated-object (ptr (cffi-array cffi-array) param)
+;  (declare (ignore param))
+;  (free-if-needed cffi-array ptr :free-func #'foreign-free))
 
-(defcfun g-free :void (var :pointer))
 
 (defmethod translate-from-foreign (ptr (cffi-array cffi-array))
   (let ((array-length (mem-ref *array-length* :uint)))
@@ -41,5 +45,4 @@
         (for i from 0 below array-length)
         (setf (aref res i)
               (mem-aref ptr el-type i)))
-      (g-free ptr)
       res)))
--- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/list.lisp	2011/09/21 12:03:47	1.5
+++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/list.lisp	2012/01/25 19:15:08	1.6
@@ -35,13 +35,11 @@
           (t (mem-ref data *list-type*))) *list*))
 
 (define-foreign-type g-list (freeable)
-  ((list-type :initarg :type :accessor list-type 
+  ((list-type :initarg :elt :accessor list-type 
               :documentation "If null, then list is of pointers or GObjects"))
+  (:simple-parser g-list)
   (:actual-type :pointer))
 
-(define-parse-method g-list (&optional type &key free)
-  (make-instance 'g-list :type type :free free))
-
 (defmethod free-ptr ((type g-list) ptr)
   (g-list-free ptr))
 
@@ -50,7 +48,6 @@
   (let ((*list* nil)
         (*list-type* (list-type g-list)))
     (g-list-foreach ptr (callback list-collect) (null-pointer))
-    (g-list-free ptr)  ;; FIXME: if exists GLists, that shouldn't be freed 
     (nreverse *list*)))
 
 (defmethod translate-to-foreign (lisp-list (g-list g-list))
@@ -66,18 +63,14 @@
             lisp-list)
       (g-list-reverse p))))
 
-(defmethod free-translated-object (ptr (type g-list) param)
-  (free-if-needed type ptr))
 
 ;; Copy-paste fom g-list. Bad, but what to do?
 (define-foreign-type g-slist (freeable)
-  ((list-type :initarg :type :accessor list-type 
+  ((list-type :initarg :elt :accessor list-type 
               :documentation "If null, then list is of pointers or GObjects"))
+  (:simple-parser g-slist)
   (:actual-type :pointer))
 
-(define-parse-method g-slist (&optional type &key free)
-  (make-instance 'g-slist :type type :free free))
-
 (defcfun g-slist-free :void (g-slist :pointer))
 (defcfun g-slist-foreach :void 
   (g-list :pointer) (func :pointer) (data :pointer))
@@ -93,7 +86,6 @@
   (let ((*list* nil)
         (*list-type* (list-type g-slist)))
     (g-slist-foreach ptr (callback list-collect) (null-pointer))
-    (g-slist-free ptr)
     (nreverse *list*)))
 
 (defmethod translate-to-foreign (lisp-list (g-slist g-slist))
@@ -109,6 +101,20 @@
             lisp-list)
       (g-slist-reverse p))))
 
-(defmethod free-translated-object (ptr (type g-slist) param)
-  (free-if-needed type ptr))
+(define-foreign-type string-list (freeable)
+  ()
+  (:actual-type :pointer)
+  (:simple-parser string-list))
+
+(defcfun g-strfreev :void (ptr :pointer))
 
+(defmethod free-ptr ((type string-list) ptr)
+  (g-strfreev ptr))
+
+(defmethod translate-from-foreign (ptr (type string-list))
+  (declare (type foreign-pointer ptr))
+  (iter      
+    (for i from 0)
+    (for pstr = (mem-aref ptr :pointer i))
+    (while (not (null-pointer-p pstr)))
+    (collect (convert-from-foreign pstr :string))))
--- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/loadlib.lisp	2011/04/25 19:16:07	1.1.1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/loadlib.lisp	2012/01/25 19:15:08	1.2
@@ -8,8 +8,11 @@
 
 (in-package #:g-lib-cffi)
 
-(define-foreign-library :g-lib
-  (:unix "libglib-2.0.so")
-  (:windows "libglib-2.0-0.dll"))
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (define-foreign-library :g-lib
+    (:unix "libglib-2.0.so")
+    (:windows "libglib-2.0-0.dll"))
 
-(load-foreign-library :g-lib)
\ No newline at end of file
+  (load-foreign-library :g-lib))
+
+(defctype gsize :int)
\ No newline at end of file
--- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/package.lisp	2011/10/23 08:39:53	1.5
+++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/package.lisp	2012/01/25 19:15:08	1.6
@@ -18,6 +18,8 @@
    #:g-list
    #:g-slist
    #:g-quark
+   #:string-list
+   #:variant-type
 
    #:g-error
    #:get-error