[gtk-cffi-cvs] CVS gtk-cffi/cffi
CVS User rklochkov
rklochkov at common-lisp.net
Sun Oct 23 08:39:53 UTC 2011
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)
More information about the gtk-cffi-cvs
mailing list