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

Modified Files:
	error.lisp g-lib-cffi.asd package.lisp quark.lisp variant.lisp 
Log Message:
Changed from cffi to cffi-objects
Dropped GTK-STRING



--- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/error.lisp	2011/10/23 08:39:53	1.2
+++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/error.lisp	2012/02/12 17:29:41	1.3
@@ -26,7 +26,7 @@
   "GError struct"
   (domain g-quark)
   (errno :int)
-  (message gtk-string))
+  (message :string))
 
 (defun get-error (g-error)
   (let ((p (mem-ref (pointer g-error) :pointer)))
--- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/g-lib-cffi.asd	2011/08/26 17:16:13	1.2
+++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/g-lib-cffi.asd	2012/02/12 17:29:41	1.3
@@ -14,7 +14,7 @@
   :author "Roman Klochkov <kalimehtar at mail.ru>"
   :version "0.1"
   :license "BSD"
-  :depends-on (cffi-object)
+  :depends-on (cffi-objects iterate gtk-cffi-utils)
   :components
   ((:file package)
    (:file loadlib :depends-on (package))
@@ -22,5 +22,6 @@
    (:file quark :depends-on (loadlib))
    (:file array :depends-on (loadlib))
    (:file error :depends-on (quark))
+   (:file variant :depends-on (error))
    (:file file :depends-on (loadlib))
    (:file mainloop :depends-on (loadlib))))
\ No newline at end of file
--- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/package.lisp	2012/01/25 19:15:08	1.6
+++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/package.lisp	2012/02/12 17:29:41	1.7
@@ -9,7 +9,7 @@
 
 (defpackage #:g-lib-cffi
   (:nicknames #:g-lib #:glib)
-  (:use #:common-lisp #:cffi #:cffi-object #:iterate #:alexandria)
+  (:use #:common-lisp #:cffi-objects #:iterate #:alexandria)
   (:export
    ;; gerror macro
    #:with-g-error
@@ -20,6 +20,7 @@
    #:g-quark
    #:string-list
    #:variant-type
+   #:variant
 
    #:g-error
    #:get-error
--- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/quark.lisp	2011/08/26 17:16:13	1.2
+++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/quark.lisp	2012/02/12 17:29:41	1.3
@@ -12,9 +12,9 @@
 
 (defctype g-quark :uint32)
 
-(defcfun g-quark-to-string gtk-string (quark g-quark))
+(defcfun g-quark-to-string :string (quark g-quark))
 
-(defcfun g-intern-string :pointer (string gtk-string))
+(defcfun g-intern-string :pointer (string :string))
 
-(defcfun g-intern-static-string :pointer (string gtk-dyn-string))
+(defcfun g-intern-static-string :pointer (string (pstring :free :none)))
 
--- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/variant.lisp	2012/01/28 13:44:45	1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/variant.lisp	2012/02/12 17:29:41	1.2
@@ -8,7 +8,7 @@
 (in-package #:g-lib-cffi)
 
 (define-foreign-type variant-type (freeable)
-  ((free :initform t))
+  ()
   (:actual-type :pointer)
   (:simple-parser variant-type))
 
@@ -22,10 +22,41 @@
 
 (defmethod translate-from-foreign (ptr (type variant-type))
   (declare (type foreign-pointer ptr))
-  (when ptr
+  (when (not (null-pointer-p ptr))
     (foreign-string-to-lisp 
      (g-variant-type-peek-string ptr)
      :count (g-variant-type-get-string-length ptr))))
 
-(defmethod translate-to-foreign (str (type variant-type))
+(defmethod translate-to-foreign ((str string) (type variant-type))
   (g-variant-type-new str))
+
+(define-foreign-type variant (freeable)
+  ((free :initform t))
+  (:actual-type :pointer)
+  (:simple-parser variant))
+
+(defcfun g-variant-parse :pointer
+  (type variant-type) (text :pointer) (limit :pointer) (end :pointer)
+  (g-error g-error))
+
+(defcfun g-variant-print (:string :free-from-foreign t)
+  (variant :pointer) (annotate :boolean))
+
+(defcfun g-variant-unref :void (variant :pointer))
+
+(defmethod free-ptr ((type variant) ptr)
+  (g-variant-unref ptr))
+
+(defmethod translate-from-foreign (ptr (type variant-type))
+  (g-variant-print ptr t))
+
+(defmethod translate-to-foreign ((str string) (type variant-type))
+  (destructuring-bind (fstr len) (foreign-string-alloc str)
+    (let (ptr)
+      (with-g-error g-error
+        (setf ptr
+              (g-variant-parse (null-pointer) fstr (inc-pointer fstr len)
+                               (null-pointer) g-error))
+        (when (null-pointer-p ptr) (error "GError: ~a" g-error)))
+      (foreign-string-free str)
+      ptr)))