From 6856064edb2f180ef9003237e1907a3a9a134a81 Mon Sep 17 00:00:00 2001
From: Dmitry Kalyanov <Kalyanov.Dmitry@gmail.com>
Date: Tue, 17 Mar 2009 22:05:39 +0300
Subject: [PATCH] support for setting gvalue to values of g-boxed-class

---
 glib/gobject.foreign-gboxed.lisp |   24 +++++++++++++++++++-----
 glib/gobject.gparams.lisp        |    4 ++++
 glib/gobject.package.lisp        |    3 ++-
 3 files changed, 25 insertions(+), 6 deletions(-)

diff --git a/glib/gobject.foreign-gboxed.lisp b/glib/gobject.foreign-gboxed.lisp
index a6525c3..abae705 100644
--- a/glib/gobject.foreign-gboxed.lisp
+++ b/glib/gobject.foreign-gboxed.lisp
@@ -85,8 +85,15 @@
     (real-parse-g-boxed pointer object)
     object))
 
-(defun g-boxed->cstruct (object)
-  (let ((pointer (foreign-alloc (type-of object))))
+(defun boxed-alloc (type alloc-type)
+  (ecase alloc-type
+    (:cffi (foreign-alloc type))
+    (:boxed (let ((pointer (foreign-alloc type)))
+              (prog1 (g-boxed-copy (g-type-from-name (boxed-type-gname type)) pointer)
+                (foreign-free pointer))))))
+
+(defun g-boxed->cstruct (object &key (alloc-type :cffi))
+  (let ((pointer (boxed-alloc (type-of object) alloc-type)))
     (real-unparse-g-boxed pointer object)
     pointer))
 
@@ -337,16 +344,23 @@
       result)))
 
 (defvar *registered-boxed-types* (make-hash-table :test 'equal))
+(defvar *registered-boxed-names* (make-hash-table))
 (defun register-boxed-type (name type)
-  (setf (gethash name *registered-boxed-types*) type))
+  (setf (gethash name *registered-boxed-types*) type
+        (gethash type *registered-boxed-names*) name))
 (defun get-registered-boxed-type (name)
   (gethash name *registered-boxed-types*))
 
+(defun boxed-type-gname (type)
+  (gethash type *registered-boxed-names*))
+
 (defun set-gvalue-boxed (gvalue value)
   (if value
       (progn
-        (unless (typep value 'g-boxed-ref) (error "Can only set g-boxed-ref!"))
-        (g-value-set-boxed gvalue (pointer value)))
+        (cond
+          ((typep value 'g-boxed-ref)
+           (g-value-set-boxed gvalue (pointer value)))
+          (t (g-value-take-boxed gvalue (g-boxed->cstruct value :alloc-type :boxed)))))
       (g-value-set-boxed gvalue (null-pointer))))
 
 (defun parse-gvalue-boxed (gvalue)
diff --git a/glib/gobject.gparams.lisp b/glib/gobject.gparams.lisp
index a4593ed..005be28 100644
--- a/glib/gobject.gparams.lisp
+++ b/glib/gobject.gparams.lisp
@@ -243,6 +243,10 @@
   (g-value (:pointer g-value))
   (new-value :pointer))
 
+(defcfun g-value-take-boxed :void
+  (g-value (:pointer g-value))
+  (new-value :pointer))
+
 (defcfun g-value-get-boxed :pointer
   (g-value (:pointer g-value)))
 
diff --git a/glib/gobject.package.lisp b/glib/gobject.package.lisp
index 3ac9dab..05fb448 100644
--- a/glib/gobject.package.lisp
+++ b/glib/gobject.package.lisp
@@ -42,7 +42,8 @@
            #:parse-gvalue
            #:emit-signal
            #:g-value-unset
-           #:g-value-zero))
+           #:g-value-zero
+           #:g-value-take-boxed))
 
 (in-package :gobject)
 
-- 
1.7.10.4