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

[CVS User rklochkov]

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

Modified Files:
	defslots.lisp g-value.lisp package.lisp 
Log Message:
Fixed examples. Changed cell properties for tree-column to be set as :attributes
Fixed double init in g-value.


--- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/defslots.lisp	2012/08/19 16:22:30	1.14
+++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/defslots.lisp	2012/10/07 12:02:11	1.15
@@ -160,14 +160,15 @@
              (,gtk-name ,class (callback ,cb-name) data))
            (,gtk-name ,class func data))))))
 
-(defmacro set-callback (object setter cb-standard func data destroy-notify)
+(defmacro set-callback (object setter cb-standard func data destroy-notify
+                        &rest add-params)
   `(let ((func ,func) (data ,data))
      (if (functionp func)
-         (,setter ,object
+         (,setter ,object , at add-params
                   (callback ,cb-standard)
                   func
                   (callback free-storage))
-         (,setter ,object func data 
+         (,setter ,object , at add-params func data 
                   (or ,destroy-notify
                       (if (or (null data) 
                               (pointerp data) (typep data 'g-object))
--- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-value.lisp	2012/08/24 19:27:54	1.7
+++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-value.lisp	2012/10/07 12:02:11	1.8
@@ -5,6 +5,7 @@
 ;;;
 ;;; Copyright (C) 2007, Roman Klochkov <kalimehtar at mail.ru>
 ;;;
+(declaim (optimize debug))
 
 (in-package :g-object-cffi)
 
@@ -60,8 +61,9 @@
 (defcfun g-value-unset :void (g-value pobject))
 
 (defmethod unset ((g-value g-value))
-  (when (/= (g-type g-value) 0)
-    (g-value-unset g-value)))
+  ;(when (/= (g-type g-value) 0)
+    (format t "Unset value ~a~%" g-value)
+    (g-value-unset g-value))
 
 (defun init-g-value (ptr type value value-p)
   (macrolet ((gtypecase (x &rest body)
@@ -87,6 +89,7 @@
           (g-value-set ptr value %type))))))
 
 (defmethod init ((g-value g-value) &key (value nil value-p) g-type)
+  (format t "init ~a~%" g-value) 
   (init-g-value (pointer g-value) g-type value value-p))
   
   
@@ -172,8 +175,9 @@
           (#.(keyword->g-type :interface)
              (g-value-get-object value))
           (t
-           (funcall (select-accessor 
-                     fundamental-type :g-value-get-) value)))))
+           (when (/= fundamental-type 0) 
+             (funcall (select-accessor 
+                     fundamental-type :g-value-get-) value))))))
           ;(format t "g-val value:~a~%" res) 
           res)))))
 
@@ -185,18 +189,23 @@
     ;(format t "g-val2: ~a~%" l)
     l))
 
-(defmethod free ((g-value g-value))
-  (g-value-unset g-value)
-  (foreign-free (pointer g-value)))
+(defmethod free :before ((g-value g-value))
+  (g-value-unset g-value))
 
 (defvar *g-value* (make-instance 'g-value))
 
 (defmacro with-g-value (val &body body)
+  "This macro allows recursive *g-value* binding"
   `(progn
-     (init *g-value* , at val)
-     (unwind-protect
-          (progn
-            , at body
-            (value *g-value*))
-       (unset *g-value*))))
+     (let* ((changed? (/= 0 (g-type *g-value*)))
+            (*g-value* (if changed? (make-instance 'g-value) *g-value*)))
+       (init *g-value* , at val)
+       (unwind-protect
+            (progn
+              , at body
+              (value *g-value*))
+         (if changed? 
+             (free *g-value*)
+             (unset *g-value*))))))
+
 
--- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/package.lisp	2012/07/29 15:13:59	1.11
+++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/package.lisp	2012/10/07 12:02:11	1.12
@@ -26,6 +26,9 @@
    #:storage
    ;; slot
    #:data
+   
+   ;; callback
+   #:free-storage
 
    ;; macro
    #:with-object