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

[CVS User rklochkov]

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

Modified Files:
	struct.lisp 
Log Message:
Finished TextBuffer support



--- /project/gtk-cffi/cvsroot/gtk-cffi/cffi/struct.lisp	2011/09/21 12:03:46	1.8
+++ /project/gtk-cffi/cvsroot/gtk-cffi/cffi/struct.lisp	2011/10/23 08:39:53	1.9
@@ -115,7 +115,7 @@
 
 (defgeneric new-struct (class)
   (:method (class)
-    (foreign-alloc class)))
+    (foreign-alloc class)))        
 
 (defgeneric free-struct (class value)
   (:method (class value)
@@ -127,9 +127,9 @@
       (let ((res (new-struct class)))
 ;        (format t "Allocated ~a~%" res)
         (mapc (lambda (slot) 
-                (let ((val (cdr (assoc slot (slot-value object 'value)))))
-                  (when val ;; FIXME: I think, that allocated struct zero-filled
-                    (setf (foreign-slot-value res class slot) val))))
+                (let ((val (assoc slot (slot-value object 'value))))
+                  (when (consp val)
+                    (setf (foreign-slot-value res class slot) (cdr val)))))
               (foreign-slot-names class))
         res)
       (slot-value object 'pointer)))
@@ -172,15 +172,18 @@
 (define-parse-method struct (class &key free out)
   (make-instance 'cffi-struct :class class :free free :out out))
 
-(defmethod translate-to-foreign ((value struct) (type cffi-struct))
-  (values (clos->new-struct (obj-class type) value) value))
+(defun %class (type value)
+  (or (obj-class type) (class-name (class-of value))))
 
-(defmethod free-translated-object (value (type cffi-struct) param)
-  (let ((class (obj-class type)))
-;    (format t "In free: ~a~%" value)
-    (when (obj-out type)
-      (struct->clos class value param))
-    (free-struct class value)))
+(defmethod translate-to-foreign ((value struct) (type cffi-object))
+  (values (clos->new-struct (%class type value) value) value))
+
+(defmethod free-translated-object (value (type cffi-struct) (param struct))
+  (let ((class (%class type param)))
+    (when (slot-boundp param 'value)
+      (when (obj-out type)
+        (struct->clos class value param))
+      (free-struct class value))))
 
 (defmethod translate-from-foreign (value (type cffi-struct))
   (let ((class (obj-class type)))
@@ -189,13 +192,15 @@
       (free-if-needed type value))))
 
 ;;; for use with pobject designator
-
-(defmethod translate-to-foreign ((value struct) (type cffi-object))
-  (values (clos->new-struct (class-name (class-of value)) value) value))
+;; pobject == (struct nil :out t)
 
 (defmethod free-translated-object (value (type cffi-object) (param struct))
-  (let ((class (class-name (class-of type))))
-    (free-struct class value)))
+  (let ((class (%class type param)))
+    (when (slot-boundp param 'value)
+      (struct->clos class value param)
+      (free-struct class value))))
+
+
 
 ;; This is needed to get correct mem-aref, when used on array of structs
 (eval-when (:compile-toplevel :load-toplevel :execute)