((info :initarg :info
:accessor g-boxed-foreign-info
:initform (error "info must be specified"))
- (free-from-foreign :initarg :free-from-foreign
- :initform nil
- :accessor g-boxed-foreign-free-from-foreign)
- (free-to-foreign :initarg :free-to-foreign
- :initform nil
- :accessor g-boxed-foreign-free-to-foreign)
- (for-callback :initarg :for-callback
- :initform nil
- :accessor g-boxed-foreign-for-callback))
+ (return-p :initarg :return-p
+ :accessor g-boxed-foreign-return-p
+ :initform nil))
(:actual-type :pointer))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun get-g-boxed-foreign-info (name)
(get name 'g-boxed-foreign-info)))
-(define-parse-method g-boxed-foreign (name &key free-from-foreign free-to-foreign for-callback)
+(defvar *g-type-name->g-boxed-foreign-info* (make-hash-table :test 'equal))
+
+(defun get-g-boxed-foreign-info-for-gtype (g-type-designator)
+ (or (gethash (g-type-string g-type-designator) *g-type-name->g-boxed-foreign-info*)
+ (error "Unknown GBoxed type '~A'" (g-type-string g-type-designator))))
+
+(defgeneric make-foreign-type (info &key return-p))
+
+(define-parse-method g-boxed-foreign (name &rest options)
(let ((info (get-g-boxed-foreign-info name)))
(assert info nil "Unknown foreign GBoxed type ~A" name)
- (make-instance 'g-boxed-foreign-type
- :info info
- :free-from-foreign free-from-foreign
- :free-to-foreign free-to-foreign
- :for-callback for-callback)))
+ (make-foreign-type info :return-p (member :return options))))
+
+(defgeneric boxed-copy-fn (type-info native)
+ (:method (type-info native)
+ (g-boxed-copy (g-boxed-info-g-type type-info) native)))
+
+(defmethod boxed-copy-fn :before (type-info native)
+ (format t "(boxed-copy-fn ~A ~A)~%" (g-boxed-info-name type-info) native))
+
+(defgeneric boxed-free-fn (type-info native)
+ (:method (type-info native)
+ (g-boxed-free (g-boxed-info-g-type type-info) native)))
+
+(defmethod boxed-free-fn :before (type-info native)
+ (format t "(boxed-free-fn ~A ~A)~%" (g-boxed-info-name type-info) native))
+
+(defmethod has-callback-cleanup ((type g-boxed-foreign-type))
+ t)
(eval-when (:load-toplevel :compile-toplevel :execute)
(defstruct (g-boxed-cstruct-wrapper-info (:include g-boxed-info))
cstruct
slots))
-(defmacro define-g-boxed-cstruct (name cstruct-name g-type-name &body slots)
+(defclass boxed-cstruct-foreign-type (g-boxed-foreign-type) ())
+
+(defmacro define-g-boxed-cstruct (name g-type-name &body slots)
`(progn
(defstruct ,name
- ,@(iter (for (name type &key initarg) in slots)
+ ,@(iter (for (name type &key count initarg) in slots)
(collect (list name initarg))))
- (defcstruct ,cstruct-name
- ,@(iter (for (name type &key initarg) in slots)
- (collect `(,name ,type))))
+ (defcstruct ,(generated-cstruct-name name)
+ ,@(iter (for (name type &key count initarg) in slots)
+ (collect `(,name ,type ,@(when count `(:count ,count))))))
(eval-when (:compile-toplevel :load-toplevel :execute)
(setf (get ',name 'g-boxed-foreign-info)
(make-g-boxed-cstruct-wrapper-info :name ',name
:g-type ,g-type-name
- :cstruct ',cstruct-name
+ :cstruct ',(generated-cstruct-name name)
:slots ',(iter (for (name type &key initarg) in slots)
- (collect name)))))))
-
-(defgeneric create-temporary-native (type proxy)
- (:documentation "Creates a native structure (or passes a pointer to copy contained in PROXY)
-that contains the same data that the PROXY contains and returns a pointer to it.
-
-This call is always paired by call to FREE-TEMPORARY-NATIVE and calls may be nested."))
-
-(defgeneric free-temporary-native (type proxy native-ptr)
- (:documentation "Frees the native structure that was previously created
-by CREATE-TEMPORARY-NATIVE for the same PROXY.
-
-Also reads data from native structure pointer to by NATIVE-PTR
-and sets the PROXY to contain the same data.
-
-This call is always paired by call to CREATE-TEMPORARY-NATIVE and calls may be nested."))
-
-(defgeneric create-proxy-for-native (type native-ptr)
- (:documentation "Creates a proxy that is initialized by data contained in native
-structured pointed to by NATIVE-PTR.
-
-Created proxy should not be linked to NATIVE-PTR and should have
-indefinite lifetime (until garbage collector collects it). Specifically,
-if proxy need a pointer to native structure, it should make a copy of
-a structure.
-
-If proxy requires finalization, finalizers should be added."))
-
-(defgeneric create-reference-proxy (type native-ptr)
- (:documentation "Creates a reference proxy for a native structure pointed to by NATIVE-PTR.
-
-Reference proxy's lifetime is bound to duration of a callback. When the
-callback returns the reference proxy is declared invalid and operations on it are errors.
-
-This call is always paired by call to FREE-REFERENCE-PROXY and calls will not nest."))
-
-(defgeneric free-reference-proxy (type proxy native-ptr)
- (:documentation "Frees a reference proxy PROXY previously created by call to
-CREATE-REFERENCE-PROXY. This call should ensure that all changes on PROXY are
-reflected in native structure pointed to by NATIVE-PTR.
-
-After a call to FREE-REFERENCE-PROXY, PROXY is declared invalid and using it is an error,
-operations on it should signal erros.
-
-This call is always paired by call to CREATE-REFERENCE-PROXY."))
-
-(defmethod create-temporary-native ((type g-boxed-cstruct-wrapper-info) proxy)
- (format t "create-temporary-native~%")
- (let* ((native-structure-type (g-boxed-cstruct-wrapper-info-cstruct type))
- (native-structure (foreign-alloc native-structure-type)))
- (iter (for slot in (g-boxed-cstruct-wrapper-info-slots type))
- (setf (foreign-slot-value native-structure native-structure-type slot)
- (slot-value proxy slot)))
- native-structure))
-
-(defmethod free-temporary-native ((type g-boxed-cstruct-wrapper-info) proxy native-structure)
- (format t "free-temporary-native~%")
- (let ((native-structure-type (g-boxed-cstruct-wrapper-info-cstruct type)))
- (iter (for slot in (g-boxed-cstruct-wrapper-info-slots type))
- (setf (slot-value proxy slot)
- (foreign-slot-value native-structure native-structure-type slot))))
- (foreign-free native-structure))
-
-(defmethod create-proxy-for-native ((type g-boxed-cstruct-wrapper-info) native-structure)
- (format t "create-proxy-for-native~%")
- (let* ((native-structure-type (g-boxed-cstruct-wrapper-info-cstruct type))
- (proxy (make-instance (g-boxed-info-name type))))
- (iter (for slot in (g-boxed-cstruct-wrapper-info-slots type))
- (setf (slot-value proxy slot)
- (foreign-slot-value native-structure native-structure-type slot)))
- proxy))
-
-(defmethod create-reference-proxy ((type g-boxed-cstruct-wrapper-info) native-structure)
- (format t "create-reference-proxy~%")
- (create-proxy-for-native type native-structure))
-
-(defmethod free-reference-proxy ((type g-boxed-cstruct-wrapper-info) proxy native-structure)
- (format t "free-reference-proxy~%")
- (let ((native-structure-type (g-boxed-cstruct-wrapper-info-cstruct type)))
- (iter (for slot in (g-boxed-cstruct-wrapper-info-slots type))
- (setf (foreign-slot-value native-structure native-structure-type slot)
- (slot-value proxy slot)))))
-
-(defmethod translate-to-foreign (proxy (type g-boxed-foreign-type))
- (if proxy
- (let* ((info (g-boxed-foreign-info type)))
- (values (create-temporary-native info proxy) proxy))
- (null-pointer)))
-
-(defmethod free-translated-object (native-structure (type g-boxed-foreign-type) proxy)
+ (collect name)))
+ (gethash ,g-type-name *g-type-name->g-boxed-foreign-info*)
+ (get ',name 'g-boxed-foreign-info)))))
+
+(defmethod make-foreign-type ((info g-boxed-cstruct-wrapper-info) &key return-p)
+ (make-instance 'boxed-cstruct-foreign-type :info info :return-p return-p))
+
+(defun memcpy (target source bytes)
+ (iter (for i from 0 below bytes)
+ (setf (mem-aref target :uchar i)
+ (mem-aref source :uchar i))))
+
+(defmethod boxed-copy-fn ((info g-boxed-cstruct-wrapper-info) native)
+ (if (g-boxed-info-g-type info)
+ (g-boxed-copy (g-boxed-info-g-type info) native)
+ (let ((copy (foreign-alloc (g-boxed-cstruct-wrapper-info-cstruct info))))
+ (memcpy copy native (foreign-type-size (g-boxed-cstruct-wrapper-info-cstruct info)))
+ copy)))
+
+(defmethod boxed-free-fn ((info g-boxed-cstruct-wrapper-info) native)
+ (if (g-boxed-info-g-type info)
+ (g-boxed-free (g-boxed-info-g-type info) native)
+ (foreign-free native)))
+
+(defmethod translate-to-foreign (proxy (type boxed-cstruct-foreign-type))
+ (if (null proxy)
+ (null-pointer)
+ (let* ((info (g-boxed-foreign-info type))
+ (native-structure-type (g-boxed-cstruct-wrapper-info-cstruct info)))
+ (with-foreign-object (native-structure native-structure-type)
+ (iter (for slot in (g-boxed-cstruct-wrapper-info-slots info))
+ (setf (foreign-slot-value native-structure native-structure-type slot)
+ (slot-value proxy slot)))
+ (values (boxed-copy-fn info native-structure) proxy)))))
+
+(defmethod free-translated-object (native-structure (type boxed-cstruct-foreign-type) proxy)
(when proxy
- (free-temporary-native (g-boxed-foreign-info type) proxy native-structure)))
+ (let* ((info (g-boxed-foreign-info type))
+ (native-structure-type (g-boxed-cstruct-wrapper-info-cstruct info)))
+ (iter (for slot in (g-boxed-cstruct-wrapper-info-slots info))
+ (setf (slot-value proxy slot)
+ (foreign-slot-value native-structure native-structure-type slot)))
+ (boxed-free-fn info native-structure))))
-(defmethod translate-from-foreign (native-structure (type g-boxed-foreign-type))
- (unless (null-pointer-p native-structure)
- (let* ((info (g-boxed-foreign-info type)))
- (cond
- ((g-boxed-foreign-for-callback type)
- (create-reference-proxy info native-structure))
- ((or (g-boxed-foreign-free-to-foreign type)
- (g-boxed-foreign-free-from-foreign type))
- (error "Feature not yet handled"))
- (t (create-proxy-for-native info native-structure))))))
-
-(defmethod cleanup-translated-object-for-callback ((type g-boxed-foreign-type) proxy native-structure)
+(defmethod translate-from-foreign (native-structure (type boxed-cstruct-foreign-type))
(unless (null-pointer-p native-structure)
- (free-reference-proxy (g-boxed-foreign-info type) proxy native-structure)))
+ (let* ((info (g-boxed-foreign-info type))
+ (native-structure-type (g-boxed-cstruct-wrapper-info-cstruct info))
+ (proxy-structure-type (g-boxed-info-name info))
+ (proxy (make-instance proxy-structure-type)))
+ (iter (for slot in (g-boxed-cstruct-wrapper-info-slots info))
+ (setf (slot-value proxy slot)
+ (foreign-slot-value native-structure native-structure-type slot)))
+ (when (g-boxed-foreign-return-p type)
+ (boxed-free-fn info native-structure))
+ proxy)))
-(defmethod has-callback-cleanup ((type g-boxed-foreign-type))
- t)
+(defmethod cleanup-translated-object-for-callback ((type boxed-cstruct-foreign-type) proxy native-structure)
+ (when proxy
+ (let* ((info (g-boxed-foreign-info type))
+ (native-structure-type (g-boxed-cstruct-wrapper-info-cstruct info)))
+ (iter (for slot in (g-boxed-cstruct-wrapper-info-slots info))
+ (setf (foreign-slot-value native-structure native-structure-type slot)
+ (slot-value proxy slot))))))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defstruct (g-boxed-opaque-wrapper-info (:include g-boxed-info))
alloc free))
+(define-foreign-type boxed-opaque-foreign-type (g-boxed-foreign-type) ())
+
(defclass g-boxed-opaque ()
((pointer :initarg :pointer
:initform nil
:accessor g-boxed-opaque-pointer)))
-(defmethod create-temporary-native ((type g-boxed-opaque-wrapper-info) proxy)
- (declare (ignore type))
- (g-boxed-opaque-pointer proxy))
+(defmethod make-foreign-type ((info g-boxed-opaque-wrapper-info) &key return-p)
+ (make-instance 'boxed-opaque-foreign-type :info info :return-p return-p))
-(defmethod free-temporary-native ((type g-boxed-opaque-wrapper-info) proxy native-structure)
- (declare (ignore type proxy native-structure)))
+(defmethod translate-to-foreign (proxy (type boxed-opaque-foreign-type))
+ (prog1 (g-boxed-opaque-pointer proxy)
+ (when (g-boxed-foreign-return-p type)
+ (tg:cancel-finalization proxy)
+ (setf (g-boxed-opaque-pointer proxy) nil))))
-(defmethod create-reference-proxy ((type g-boxed-opaque-wrapper-info) native-structure)
- (make-instance (g-boxed-info-g-type type) :pointer native-structure))
+(defmethod free-translated-object (native (type boxed-opaque-foreign-type) param)
+ (declare (ignore native type param)))
-(defmethod free-reference-proxy ((type g-boxed-opaque-wrapper-info) proxy native-structure)
- (declare (ignore type native-structure))
- (setf (g-boxed-opaque-pointer proxy) nil))
+(defun make-boxed-free-finalizer (type pointer)
+ (lambda () (boxed-free-fn type pointer)))
+
+(defmethod translate-from-foreign (native (foreign-type boxed-opaque-foreign-type))
+ (let* ((type (g-boxed-foreign-info foreign-type))
+ (proxy (make-instance (g-boxed-info-name type) :pointer native)))
+ (tg:finalize proxy (make-boxed-free-finalizer type native))))
-(defmethod create-proxy-for-native ((type g-boxed-opaque-wrapper-info) native-structure)
- (let* ((g-type (g-boxed-info-g-type type))
- (native-copy (g-boxed-copy g-type native-structure)))
- (flet ((finalizer () (g-boxed-free g-type native-copy)))
- (let ((proxy (make-instance (g-boxed-opaque-wrapper-info-g-type type) :pointer native-copy)))
- (tg:finalize proxy #'finalizer)
- proxy))))
+(defmethod cleanup-translated-object-for-callback ((type boxed-opaque-foreign-type) proxy native)
+ (tg:cancel-finalization proxy)
+ (setf (g-boxed-opaque-pointer proxy) nil))
(defmacro define-g-boxed-opaque (name g-type-name &key
(alloc (error "Alloc must be specified")))
(defmethod initialize-instance :after ((,instance ,name) &key &allow-other-keys)
(unless (g-boxed-opaque-pointer ,instance)
(let ((,native-copy ,alloc))
- (flet ((,finalizer () (g-boxed-free ,g-type-name ,native-copy)))
+ (flet ((,finalizer () (boxed-free-fn ,g-type-name ,native-copy)))
(setf (g-boxed-opaque-pointer ,instance) ,native-copy)
- (finalize ,instance #',finalizer)))))
+ (finalize ,instance (make-boxed-free-finalizer (get ',name 'g-boxed-foreign-info) ,native-copy))))))
(eval-when (:compile-toplevel :load-toplevel :execute)
(setf (get ',name 'g-boxed-foreign-info)
(make-g-boxed-opaque-wrapper-info :name ',name
- :g-type ,g-type-name))))))
+ :g-type ,g-type-name)
+ (gethash ,g-type-name *g-type-name->g-boxed-foreign-info*)
+ (get ',name 'g-boxed-foreign-info))))))
(defstruct var-structure
name
(destructuring-bind (name type &key count initform) slot
(make-var-structure-slot :name name :type type :count count :initform initform)))
+(defun ensure-list (thing)
+ (if (listp thing)
+ thing
+ (list thing)))
+
(defun parse-variants (parent variants)
(iter (for var-descr in variants)
(for (options variant-name . slots) in variants)
(defun generated-cunion-name (symbol)
(or (get symbol 'generated-cunion-name)
- (setf (get symbol 'generated-cunion-name) (gensym (format nil "GEN-~A-CSTRUCT-" (symbol-name symbol))))))
+ (setf (get symbol 'generated-cunion-name) (gensym (format nil "GEN-~A-CUNION-" (symbol-name symbol))))))
(defun generate-cstruct-1 (struct)
`(defcstruct ,(generated-cstruct-name (var-structure-name struct))
,@(iter (for slot in (var-struct-all-slots struct))
(collect `(,(var-structure-slot-name slot) ,(var-structure-slot-type slot)
,@(when (var-structure-slot-count slot)
- (list `(:count ,(var-structure-slot-count slot)))))))))
+ `(:count ,(var-structure-slot-count slot))))))))
(defun generate-c-structures (structure)
(iter (for str in (all-structures structure))
(defmethod make-load-form ((object g-boxed-variant-cstruct-info) &optional env)
(make-load-form-saving-slots object :environment env))
-(defmacro define-boxed-variant-cstruct (name g-type-name &body slots)
+(define-foreign-type boxed-variant-cstruct-foreign-type () ())
+
+(defmethod make-foreign-type ((info g-boxed-variant-cstruct-info) &key return-p)
+ (make-instance 'boxed-variant-cstruct-foreign-type :info info :return-p return-p))
+
+(defmacro define-g-boxed-variant-cstruct (name g-type-name &body slots)
(let* ((structure (parse-variant-structure-definition name slots)))
`(progn ,@(generate-c-structures structure)
,@(generate-unions structure)
:native-type-decision-procedure
,(generate-native-type-decision-procedure structure)
:proxy-type-decision-procedure
- ,(generate-proxy-type-decision-procedure structure)))))))
+ ,(generate-proxy-type-decision-procedure structure))
+ (gethash ,g-type-name *g-type-name->g-boxed-foreign-info*)
+ (get ',name 'g-boxed-foreign-info))))))
(defun decide-native-type (info proxy)
(funcall (g-boxed-variant-cstruct-info-native-type-decision-procedure info) proxy))
-(defmethod create-temporary-native ((type g-boxed-variant-cstruct-info) proxy)
- (multiple-value-bind (actual-cstruct slots) (decide-native-type type proxy)
- (let ((native-structure (foreign-alloc
- (generated-cstruct-name
- (var-structure-name
- (g-boxed-variant-cstruct-info-root type))))))
- (iter (for slot in slots)
- (setf (foreign-slot-value native-structure actual-cstruct slot)
- (slot-value proxy slot)))
- native-structure)))
+(defmethod boxed-copy-fn ((info g-boxed-variant-cstruct-info) native)
+ (if (g-boxed-info-g-type info)
+ (g-boxed-copy (g-boxed-info-g-type info) native)
+ (let ((copy (foreign-alloc (generated-cstruct-name (g-boxed-info-name info)))))
+ (memcpy copy native (foreign-type-size (generated-cstruct-name (g-boxed-info-name info))))
+ copy)))
+
+(defmethod boxed-free-fn ((info g-boxed-variant-cstruct-info) native)
+ (if (g-boxed-info-g-type info)
+ (g-boxed-free (g-boxed-info-g-type info) native)
+ (foreign-free native)))
+
+(defmethod translate-to-foreign (proxy (foreign-type boxed-variant-cstruct-foreign-type))
+ (if (null proxy)
+ (null-pointer)
+ (let ((type (g-boxed-foreign-info foreign-type)))
+ (multiple-value-bind (actual-cstruct slots) (decide-native-type type proxy)
+ (with-foreign-object (native-structure (generated-cstruct-name
+ (var-structure-name
+ (g-boxed-variant-cstruct-info-root type))))
+ (iter (for slot in slots)
+ (setf (foreign-slot-value native-structure actual-cstruct slot)
+ (slot-value proxy slot)))
+ (values (boxed-copy-fn type native-structure) proxy))))))
(defun decide-proxy-type (info native-structure)
(funcall (g-boxed-variant-cstruct-info-proxy-type-decision-procedure info) native-structure))
-(defmethod free-temporary-native ((type g-boxed-variant-cstruct-info) proxy native-ptr)
- (multiple-value-bind (actual-struct slots actual-cstruct) (decide-proxy-type type native-ptr)
- (unless (eq (type-of proxy) actual-struct)
- (restart-case
- (error "Expected type of boxed variant structure ~A and actual type ~A do not match"
- (type-of proxy) actual-struct)
- (skip-parsing-values () (return-from free-temporary-native))))
- (iter (for slot in slots)
- (setf (slot-value proxy slot)
- (foreign-slot-value native-ptr actual-cstruct slot)))))
-
-(defmethod create-proxy-for-native ((type g-boxed-variant-cstruct-info) native-ptr)
- (multiple-value-bind (actual-struct slots actual-cstruct) (decide-proxy-type type native-ptr)
- (let ((proxy (make-instance actual-struct)))
- (iter (for slot in slots)
- (setf (slot-value proxy slot)
- (foreign-slot-value native-ptr actual-cstruct slot)))
- proxy)))
+(defmethod free-translated-object (native (foreign-type boxed-variant-cstruct-foreign-type) proxy)
+ (when proxy
+ (let ((type (g-boxed-foreign-info foreign-type)))
+ (multiple-value-bind (actual-struct slots actual-cstruct) (decide-proxy-type type native)
+ (unless (eq (type-of proxy) actual-struct)
+ (restart-case
+ (error "Expected type of boxed variant structure ~A and actual type ~A do not match"
+ (type-of proxy) actual-struct)
+ (skip-parsing-values () (return-from free-translated-object))))
+ (iter (for slot in slots)
+ (setf (slot-value proxy slot)
+ (foreign-slot-value native actual-cstruct slot)))))))
+
+(defmethod translate-from-foreign (native (foreign-type g-boxed-variant-cstruct-info))
+ (unless (null-pointer-p native)
+ (let ((type (g-boxed-foreign-info foreign-type)))
+ (multiple-value-bind (actual-struct slots actual-cstruct) (decide-proxy-type type native)
+ (let ((proxy (make-instance actual-struct)))
+ (iter (for slot in slots)
+ (setf (slot-value proxy slot)
+ (foreign-slot-value native actual-cstruct slot)))
+ proxy)))))
+
+(defmethod cleanup-translated-object-for-callback ((foreign-type g-boxed-variant-cstruct-info) proxy native)
+ (when proxy
+ (let ((type (g-boxed-foreign-info foreign-type)))
+ (multiple-value-bind (actual-cstruct slots) (decide-native-type type proxy)
+ (iter (for slot in slots)
+ (setf (foreign-slot-value native actual-cstruct slot)
+ (slot-value proxy slot)))))))
+
+(defgeneric boxed-parse-g-value (gvalue-ptr info))
+
+(defgeneric boxed-set-g-value (gvalue-ptr info proxy))
+
+(defmethod parse-g-value-for-type (gvalue-ptr (type-numeric (eql +g-type-boxed+)) parse-kind)
+ (declare (ignore parse-kind))
+ (if (g-type= (g-value-type gvalue-ptr) (g-strv-get-type))
+ (convert-from-foreign (g-value-get-boxed gvalue-ptr) '(glib:gstrv :free-from-foreign nil))
+ (let ((boxed-type (get-g-boxed-foreign-info-for-gtype type-numeric)))
+ (boxed-parse-g-value gvalue-ptr boxed-type))))
+
+(defmethod set-gvalue-for-type (gvalue-ptr (type-numeric (eql +g-type-boxed+)) value)
+ (if (g-type= (g-value-type gvalue-ptr) (g-strv-get-type))
+ (g-value-set-boxed gvalue-ptr (convert-to-foreign value '(glib:gstrv :free-from-foreign nil)))
+ (let ((boxed-type (get-g-boxed-foreign-info-for-gtype type-numeric)))
+ (boxed-set-g-value gvalue-ptr boxed-type value))))
+
+(defmethod boxed-parse-g-value (gvalue-ptr (info g-boxed-cstruct-wrapper-info))
+ (translate-from-foreign (g-value-get-boxed gvalue-ptr) (make-foreign-type info :return-p nil)))
+
+(defmethod boxed-set-g-value (gvalue-ptr (info g-boxed-cstruct-wrapper-info) proxy)
+ (g-value-take-boxed gvalue-ptr (translate-to-foreign proxy (make-foreign-type info :return-p nil))))
+
+(defmethod boxed-parse-g-value (gvalue-ptr (info g-boxed-variant-cstruct-info))
+ (translate-from-foreign (g-value-get-boxed gvalue-ptr) (make-foreign-type info :return-p nil)))
+
+(defmethod boxed-set-g-value (gvalue-ptr (info g-boxed-variant-cstruct-info) proxy)
+ (g-value-take-boxed gvalue-ptr (translate-to-foreign proxy (make-foreign-type info :return-p nil))))
-(defmethod create-reference-proxy ((type g-boxed-variant-cstruct-info) native-ptr)
- (create-proxy-for-native type native-ptr))
+(defmethod boxed-parse-g-value (gvalue-ptr (info g-boxed-opaque-wrapper-info))
+ (translate-from-foreign (boxed-copy-fn info (g-value-get-boxed gvalue-ptr)) (make-foreign-type info :return-p nil)))
-(defmethod free-reference-proxy ((type g-boxed-variant-cstruct-info) proxy native-ptr)
- (multiple-value-bind (actual-cstruct slots) (decide-native-type type proxy)
- (iter (for slot in slots)
- (setf (foreign-slot-value native-ptr actual-cstruct slot)
- (slot-value proxy slot)))))
+(defmethod boxed-set-g-value (gvalue-ptr (info g-boxed-opaque-wrapper-info) proxy)
+ (g-value-set-boxed gvalue-ptr (translate-to-foreign proxy (make-foreign-type info :return-p nil))))
projects / cl-gtk2.git / blobdiff