glib/gobject.boxed.lisp

   1 (in-package :gobject)
   2
   3 (define-foreign-type g-boxed-foreign-type ()
   4   ((info :initarg :info
   5          :accessor g-boxed-foreign-info
   6          :initform (error "info must be specified"))
   7    (return-p :initarg :return-p
   8              :accessor g-boxed-foreign-return-p
   9              :initform nil))
  10   (:actual-type :pointer))
  11
  12 (eval-when (:compile-toplevel :load-toplevel :execute)
  13   (defstruct g-boxed-info
  14     name
  15     g-type))
  16
  17 (eval-when (:compile-toplevel :load-toplevel :execute)
  18   (defun get-g-boxed-foreign-info (name)
  19     (get name 'g-boxed-foreign-info)))
  20
  21 (defvar *g-type-name->g-boxed-foreign-info* (make-hash-table :test 'equal))
  22
  23 (defun get-g-boxed-foreign-info-for-gtype (g-type-designator)
  24   (or (gethash (g-type-string g-type-designator) *g-type-name->g-boxed-foreign-info*)
  25       (error "Unknown GBoxed type '~A'" (g-type-string g-type-designator))))
  26
  27 (defgeneric make-foreign-type (info &key return-p))
  28
  29 (define-parse-method g-boxed-foreign (name &rest options)
  30   (let ((info (get-g-boxed-foreign-info name)))
  31     (assert info nil "Unknown foreign GBoxed type ~A" name)
  32     (make-foreign-type info :return-p (member :return options))))
  33
  34 (defgeneric boxed-copy-fn (type-info native)
  35   (:method (type-info native)
  36     (g-boxed-copy (g-boxed-info-g-type type-info) native)))
  37
  38 (defmethod boxed-copy-fn :before (type-info native)
  39   (format t "(boxed-copy-fn ~A ~A)~%" (g-boxed-info-name type-info) native))
  40
  41 (defgeneric boxed-free-fn (type-info native)
  42   (:method (type-info native)
  43     (g-boxed-free (g-boxed-info-g-type type-info) native)))
  44
  45 (defmethod boxed-free-fn :before (type-info native)
  46   (format t "(boxed-free-fn ~A ~A)~%" (g-boxed-info-name type-info) native))
  47
  48 (defmethod has-callback-cleanup ((type g-boxed-foreign-type))
  49   t)
  50
  51 (eval-when (:load-toplevel :compile-toplevel :execute)
  52   (defstruct (g-boxed-cstruct-wrapper-info (:include g-boxed-info))
  53     cstruct
  54     slots))
  55
  56 (defclass boxed-cstruct-foreign-type (g-boxed-foreign-type) ())
  57
  58 (defmacro define-g-boxed-cstruct (name g-type-name &body slots)
  59   `(progn
  60      (defstruct ,name
  61        ,@(iter (for (name type &key count initarg) in slots)
  62                (collect (list name initarg))))
  63      (defcstruct ,(generated-cstruct-name name)
  64        ,@(iter (for (name type &key count initarg) in slots)
  65                (collect `(,name ,type ,@(when count `(:count ,count))))))
  66      (eval-when (:compile-toplevel :load-toplevel :execute)
  67        (setf (get ',name 'g-boxed-foreign-info)
  68              (make-g-boxed-cstruct-wrapper-info :name ',name
  69                                                 :g-type ,g-type-name
  70                                                 :cstruct ',(generated-cstruct-name name)
  71                                                 :slots ',(iter (for (name type &key initarg) in slots)
  72                                                                (collect name)))
  73              (gethash ,g-type-name *g-type-name->g-boxed-foreign-info*)
  74              (get ',name 'g-boxed-foreign-info)))))
  75
  76 (defmethod make-foreign-type ((info g-boxed-cstruct-wrapper-info) &key return-p)
  77   (make-instance 'boxed-cstruct-foreign-type :info info :return-p return-p))
  78
  79 (defun memcpy (target source bytes)
  80   (iter (for i from 0 below bytes)
  81         (setf (mem-aref target :uchar i)
  82               (mem-aref source :uchar i))))
  83
  84 (defmethod boxed-copy-fn ((info g-boxed-cstruct-wrapper-info) native)
  85   (if (g-boxed-info-g-type info)
  86       (g-boxed-copy (g-boxed-info-g-type info) native)
  87       (let ((copy (foreign-alloc (g-boxed-cstruct-wrapper-info-cstruct info))))
  88         (memcpy copy native (foreign-type-size (g-boxed-cstruct-wrapper-info-cstruct info)))
  89         copy)))
  90
  91 (defmethod boxed-free-fn ((info g-boxed-cstruct-wrapper-info) native)
  92   (if (g-boxed-info-g-type info)
  93       (g-boxed-free (g-boxed-info-g-type info) native)
  94       (foreign-free native)))
  95
  96 (defmethod translate-to-foreign (proxy (type boxed-cstruct-foreign-type))
  97   (if (null proxy)
  98       (null-pointer)
  99       (let* ((info (g-boxed-foreign-info type))
 100              (native-structure-type (g-boxed-cstruct-wrapper-info-cstruct info)))
 101         (with-foreign-object (native-structure native-structure-type)
 102           (iter (for slot in (g-boxed-cstruct-wrapper-info-slots info))
 103                 (setf (foreign-slot-value native-structure native-structure-type slot)
 104                       (slot-value proxy slot)))
 105           (values (boxed-copy-fn info native-structure) proxy)))))
 106
 107 (defmethod free-translated-object (native-structure (type boxed-cstruct-foreign-type) proxy)
 108   (when proxy
 109     (let* ((info (g-boxed-foreign-info type))
 110            (native-structure-type (g-boxed-cstruct-wrapper-info-cstruct info)))
 111       (iter (for slot in (g-boxed-cstruct-wrapper-info-slots info))
 112             (setf (slot-value proxy slot)
 113                   (foreign-slot-value native-structure native-structure-type slot)))
 114       (boxed-free-fn info native-structure))))
 115
 116 (defmethod translate-from-foreign (native-structure (type boxed-cstruct-foreign-type))
 117   (unless (null-pointer-p native-structure)
 118     (let* ((info (g-boxed-foreign-info type))
 119            (native-structure-type (g-boxed-cstruct-wrapper-info-cstruct info))
 120            (proxy-structure-type (g-boxed-info-name info))
 121            (proxy (make-instance proxy-structure-type)))
 122       (iter (for slot in (g-boxed-cstruct-wrapper-info-slots info))
 123             (setf (slot-value proxy slot)
 124                   (foreign-slot-value native-structure native-structure-type slot)))
 125       (when (g-boxed-foreign-return-p type)
 126         (boxed-free-fn info native-structure))
 127       proxy)))
 128
 129 (defmethod cleanup-translated-object-for-callback ((type boxed-cstruct-foreign-type) proxy native-structure)
 130   (when proxy
 131     (let* ((info (g-boxed-foreign-info type))
 132            (native-structure-type (g-boxed-cstruct-wrapper-info-cstruct info)))
 133       (iter (for slot in (g-boxed-cstruct-wrapper-info-slots info))
 134             (setf (foreign-slot-value native-structure native-structure-type slot)
 135                   (slot-value proxy slot))))))
 136
 137 (eval-when (:compile-toplevel :load-toplevel :execute)
 138   (defstruct (g-boxed-opaque-wrapper-info (:include g-boxed-info))
 139     alloc free))
 140
 141 (define-foreign-type boxed-opaque-foreign-type (g-boxed-foreign-type) ())
 142
 143 (defclass g-boxed-opaque ()
 144   ((pointer :initarg :pointer
 145             :initform nil
 146             :accessor g-boxed-opaque-pointer)))
 147
 148 (defmethod make-foreign-type ((info g-boxed-opaque-wrapper-info) &key return-p)
 149   (make-instance 'boxed-opaque-foreign-type :info info :return-p return-p))
 150
 151 (defmethod translate-to-foreign (proxy (type boxed-opaque-foreign-type))
 152   (prog1 (g-boxed-opaque-pointer proxy)
 153     (when (g-boxed-foreign-return-p type)
 154       (tg:cancel-finalization proxy)
 155       (setf (g-boxed-opaque-pointer proxy) nil))))
 156
 157 (defmethod free-translated-object (native (type boxed-opaque-foreign-type) param)
 158   (declare (ignore native type param)))
 159
 160 (defun make-boxed-free-finalizer (type pointer)
 161   (lambda () (boxed-free-fn type pointer)))
 162
 163 (defmethod translate-from-foreign (native (foreign-type boxed-opaque-foreign-type))
 164   (let* ((type (g-boxed-foreign-info foreign-type))
 165          (proxy (make-instance (g-boxed-info-name type) :pointer native)))
 166     (tg:finalize proxy (make-boxed-free-finalizer type native))))
 167
 168 (defmethod cleanup-translated-object-for-callback ((type boxed-opaque-foreign-type) proxy native)
 169   (tg:cancel-finalization proxy)
 170   (setf (g-boxed-opaque-pointer proxy) nil))
 171
 172 (defmacro define-g-boxed-opaque (name g-type-name &key
 173                                  (alloc (error "Alloc must be specified")))
 174   (let ((native-copy (gensym "NATIVE-COPY-"))
 175         (instance (gensym "INSTANCE-"))
 176         (finalizer (gensym "FINALIZER-")))
 177     `(progn (defclass ,name (g-boxed-opaque) ())
 178             (defmethod initialize-instance :after ((,instance ,name) &key &allow-other-keys)
 179               (unless (g-boxed-opaque-pointer ,instance)
 180                 (let ((,native-copy ,alloc))
 181                   (flet ((,finalizer () (boxed-free-fn ,g-type-name ,native-copy)))
 182                     (setf (g-boxed-opaque-pointer ,instance) ,native-copy)
 183                     (finalize ,instance (make-boxed-free-finalizer (get ',name 'g-boxed-foreign-info) ,native-copy))))))
 184             (eval-when (:compile-toplevel :load-toplevel :execute)
 185               (setf (get ',name 'g-boxed-foreign-info)
 186                     (make-g-boxed-opaque-wrapper-info :name ',name
 187                                                       :g-type ,g-type-name)
 188                     (gethash ,g-type-name *g-type-name->g-boxed-foreign-info*)
 189                     (get ',name 'g-boxed-foreign-info))))))
 190
 191 (defstruct var-structure
 192   name
 193   parent
 194   slots
 195   discriminator-slot
 196   variants)
 197
 198 (defstruct var-structure-variant
 199   discriminating-values
 200   structure)
 201
 202 (defstruct var-structure-slot
 203   name
 204   type
 205   initform
 206   count)
 207
 208 (defmethod make-load-form ((object var-structure) &optional env)
 209   (make-load-form-saving-slots object :environment env))
 210
 211 (defmethod make-load-form ((object var-structure-slot) &optional env)
 212   (make-load-form-saving-slots object :environment env))
 213
 214 (defmethod make-load-form ((object var-structure-variant) &optional env)
 215   (make-load-form-saving-slots object :environment env))
 216
 217 (defun var-struct-all-slots (struct)
 218   (when struct
 219     (append (var-struct-all-slots (var-structure-parent struct))
 220             (var-structure-slots struct))))
 221
 222 (defun all-structures (structure)
 223   (append (iter (for variant in (var-structure-variants structure))
 224                 (appending (all-structures (var-structure-variant-structure variant))))
 225           (list structure)))
 226
 227 (defun parse-variant-structure-definition (name slots &optional parent)
 228   (iter (with result = (make-var-structure :name name
 229                                            :parent parent
 230                                            :slots nil
 231                                            :discriminator-slot nil
 232                                            :variants nil))
 233         (for slot in slots)
 234         (if (eq :variant (first slot))
 235             (progn
 236               (when (var-structure-discriminator-slot result)
 237                 (error "Structure has more than one discriminator slot"))
 238               (setf (var-structure-discriminator-slot result) (second slot)
 239                     (var-structure-variants result) (parse-variants result (nthcdr 2 slot))))
 240             (push (parse-slot slot) (var-structure-slots result)))
 241         (finally (setf (var-structure-slots result)
 242                        (reverse (var-structure-slots result)))
 243                  (return result))))
 244
 245 (defun parse-slot (slot)
 246   (destructuring-bind (name type &key count initform) slot
 247     (make-var-structure-slot :name name :type type :count count :initform initform)))
 248
 249 (defun ensure-list (thing)
 250   (if (listp thing)
 251       thing
 252       (list thing)))
 253
 254 (defun parse-variants (parent variants)
 255   (iter (for var-descr in variants)
 256         (for (options variant-name . slots) in variants)
 257         (for variant =
 258              (make-var-structure-variant
 259               :discriminating-values (ensure-list options)
 260               :structure (parse-variant-structure-definition variant-name slots parent)))
 261         (collect variant)))
 262
 263 (defun generated-cstruct-name (symbol)
 264   (or (get symbol 'generated-cstruct-name)
 265       (setf (get symbol 'generated-cstruct-name) (gensym (format nil "GEN-~A-CSTRUCT-" (symbol-name symbol))))))
 266
 267 (defun generated-cunion-name (symbol)
 268   (or (get symbol 'generated-cunion-name)
 269       (setf (get symbol 'generated-cunion-name) (gensym (format nil "GEN-~A-CUNION-" (symbol-name symbol))))))
 270
 271 (defun generate-cstruct-1 (struct)
 272   `(defcstruct ,(generated-cstruct-name (var-structure-name struct))
 273      ,@(iter (for slot in (var-struct-all-slots struct))
 274              (collect `(,(var-structure-slot-name slot) ,(var-structure-slot-type slot)
 275                          ,@(when (var-structure-slot-count slot)
 276                                  `(:count ,(var-structure-slot-count slot))))))))
 277
 278 (defun generate-c-structures (structure)
 279   (iter (for str in (all-structures structure))
 280         (collect (generate-cstruct-1 str))))
 281
 282 (defun generate-union-1 (struct)
 283   `(defcunion ,(generated-cunion-name (var-structure-name struct))
 284      ,@(iter (for variant in (all-structures struct))
 285              (unless (eq struct variant)
 286                (collect `(,(var-structure-name variant)
 287                            ,(generated-cunion-name (var-structure-name variant))))))))
 288
 289 (defun generate-unions (struct)
 290   (iter (for str in (all-structures struct))
 291         (collect (generate-union-1 str))))
 292
 293 (defun generate-structure-1 (str)
 294   `(defstruct ,(if (var-structure-parent str)
 295                    `(,(var-structure-name str) (:include ,(var-structure-name (var-structure-parent str))
 296                                                          (,(var-structure-discriminator-slot (var-structure-parent str))
 297                                                            ,(first (var-structure-variant-discriminating-values
 298                                                                     (find str
 299                                                                           (var-structure-variants
 300                                                                            (var-structure-parent str))
 301                                                                           :key #'var-structure-variant-structure))))))
 302                    `,(var-structure-name str))
 303      ,@(iter (for slot in (var-structure-slots str))
 304              (collect `(,(var-structure-slot-name slot)
 305                          ,(var-structure-slot-initform slot))))))
 306
 307 (defun generate-structures (str)
 308   (iter (for variant in (reverse (all-structures str)))
 309         (collect (generate-structure-1 variant))))
 310
 311 (defun generate-native-type-decision-procedure-1 (str proxy-var)
 312   (if (null (var-structure-discriminator-slot str))
 313       `(values ',(generated-cstruct-name (var-structure-name str))
 314                ',(mapcar #'var-structure-slot-name (var-struct-all-slots str)))
 315       `(typecase ,proxy-var
 316          ,@(iter (for variant in (var-structure-variants str))
 317                  (for v-str = (var-structure-variant-structure variant))
 318                  (collect `(,(var-structure-name v-str)
 319                              ,(generate-native-type-decision-procedure-1 v-str proxy-var))))
 320          (,(var-structure-name str)
 321           (values ',(generated-cstruct-name (var-structure-name str))
 322                   ',(mapcar #'var-structure-slot-name (var-struct-all-slots str)))))))
 323
 324 (defun generate-proxy-type-decision-procedure-1 (str native-var)
 325   (if (null (var-structure-discriminator-slot str))
 326       `(values ',(var-structure-name str)
 327                ',(mapcar #'var-structure-slot-name (var-struct-all-slots str))
 328                ',(generated-cstruct-name (var-structure-name str)))
 329       `(case (foreign-slot-value ,native-var
 330                                  ',(generated-cstruct-name (var-structure-name str))
 331                                  ',(var-structure-discriminator-slot str))
 332          ,@(iter (for variant in (var-structure-variants str))
 333                  (for v-str = (var-structure-variant-structure variant))
 334                  (collect `(,(var-structure-variant-discriminating-values variant)
 335                              ,(generate-proxy-type-decision-procedure-1
 336                                v-str
 337                                native-var))))
 338          (t (values ',(var-structure-name str)
 339                     ',(mapcar #'var-structure-slot-name (var-struct-all-slots str))
 340                     ',(generated-cstruct-name (var-structure-name str)))))))
 341
 342 (defun generate-proxy-type-decision-procedure (str)
 343   (let ((native (gensym "NATIVE-")))
 344     `(lambda (,native)
 345        ,(generate-proxy-type-decision-procedure-1 str native))))
 346
 347 (defun generate-native-type-decision-procedure (str)
 348   (let ((proxy (gensym "PROXY-")))
 349     `(lambda (,proxy)
 350        ,(generate-native-type-decision-procedure-1 str proxy))))
 351
 352 (defun compile-proxy-type-decision-procedure (str)
 353   (compile nil (generate-proxy-type-decision-procedure str)))
 354
 355 (defun compile-native-type-decision-procedure (str)
 356   (compile nil (generate-native-type-decision-procedure str)))
 357
 358 (defstruct (g-boxed-variant-cstruct-info (:include g-boxed-info))
 359   root
 360   native-type-decision-procedure
 361   proxy-type-decision-procedure)
 362
 363 (defmethod make-load-form ((object g-boxed-variant-cstruct-info) &optional env)
 364   (make-load-form-saving-slots object :environment env))
 365
 366 (define-foreign-type boxed-variant-cstruct-foreign-type () ())
 367
 368 (defmethod make-foreign-type ((info g-boxed-variant-cstruct-info) &key return-p)
 369   (make-instance 'boxed-variant-cstruct-foreign-type :info info :return-p return-p))
 370
 371 (defmacro define-g-boxed-variant-cstruct (name g-type-name &body slots)
 372   (let* ((structure (parse-variant-structure-definition name slots)))
 373     `(progn ,@(generate-c-structures structure)
 374             ,@(generate-unions structure)
 375             ,@(generate-structures structure)
 376             (eval-when (:compile-toplevel :load-toplevel :execute)
 377               (setf (get ',name 'g-boxed-foreign-info)
 378                     (make-g-boxed-variant-cstruct-info :name ',name
 379                                                        :g-type ,g-type-name
 380                                                        :root ,structure
 381                                                        :native-type-decision-procedure
 382                                                        ,(generate-native-type-decision-procedure structure)
 383                                                        :proxy-type-decision-procedure
 384                                                        ,(generate-proxy-type-decision-procedure structure))
 385                     (gethash ,g-type-name *g-type-name->g-boxed-foreign-info*)
 386                     (get ',name 'g-boxed-foreign-info))))))
 387
 388 (defun decide-native-type (info proxy)
 389   (funcall (g-boxed-variant-cstruct-info-native-type-decision-procedure info) proxy))
 390
 391 (defmethod boxed-copy-fn ((info g-boxed-variant-cstruct-info) native)
 392   (if (g-boxed-info-g-type info)
 393       (g-boxed-copy (g-boxed-info-g-type info) native)
 394       (let ((copy (foreign-alloc (generated-cstruct-name (g-boxed-info-name info)))))
 395         (memcpy copy native (foreign-type-size (generated-cstruct-name (g-boxed-info-name info))))
 396         copy)))
 397
 398 (defmethod boxed-free-fn ((info g-boxed-variant-cstruct-info) native)
 399   (if (g-boxed-info-g-type info)
 400       (g-boxed-free (g-boxed-info-g-type info) native)
 401       (foreign-free native)))
 402
 403 (defmethod translate-to-foreign (proxy (foreign-type boxed-variant-cstruct-foreign-type))
 404   (if (null proxy)
 405       (null-pointer)
 406       (let ((type (g-boxed-foreign-info foreign-type)))
 407         (multiple-value-bind (actual-cstruct slots) (decide-native-type type proxy)
 408           (with-foreign-object (native-structure (generated-cstruct-name
 409                                                   (var-structure-name
 410                                                    (g-boxed-variant-cstruct-info-root type))))
 411             (iter (for slot in slots)
 412                   (setf (foreign-slot-value native-structure actual-cstruct slot)
 413                         (slot-value proxy slot)))
 414             (values (boxed-copy-fn type native-structure) proxy))))))
 415
 416 (defun decide-proxy-type (info native-structure)
 417   (funcall (g-boxed-variant-cstruct-info-proxy-type-decision-procedure info) native-structure))
 418
 419 (defmethod free-translated-object (native (foreign-type boxed-variant-cstruct-foreign-type) proxy)
 420   (when proxy
 421     (let ((type (g-boxed-foreign-info foreign-type)))
 422       (multiple-value-bind (actual-struct slots actual-cstruct) (decide-proxy-type type native)
 423         (unless (eq (type-of proxy) actual-struct)
 424           (restart-case
 425               (error "Expected type of boxed variant structure ~A and actual type ~A do not match"
 426                      (type-of proxy) actual-struct)
 427             (skip-parsing-values () (return-from free-translated-object))))
 428         (iter (for slot in slots)
 429               (setf (slot-value proxy slot)
 430                     (foreign-slot-value native actual-cstruct slot)))))))
 431
 432 (defmethod translate-from-foreign (native (foreign-type g-boxed-variant-cstruct-info))
 433   (unless (null-pointer-p native)
 434     (let ((type (g-boxed-foreign-info foreign-type)))
 435       (multiple-value-bind (actual-struct slots actual-cstruct) (decide-proxy-type type native)
 436         (let ((proxy (make-instance actual-struct)))
 437           (iter (for slot in slots)
 438                 (setf (slot-value proxy slot)
 439                       (foreign-slot-value native actual-cstruct slot)))
 440           proxy)))))
 441
 442 (defmethod cleanup-translated-object-for-callback ((foreign-type g-boxed-variant-cstruct-info) proxy native)
 443   (when proxy
 444     (let ((type (g-boxed-foreign-info foreign-type)))
 445       (multiple-value-bind (actual-cstruct slots) (decide-native-type type proxy)
 446         (iter (for slot in slots)
 447               (setf (foreign-slot-value native actual-cstruct slot)
 448                     (slot-value proxy slot)))))))
 449
 450 (defgeneric boxed-parse-g-value (gvalue-ptr info))
 451
 452 (defgeneric boxed-set-g-value (gvalue-ptr info proxy))
 453
 454 (defmethod parse-g-value-for-type (gvalue-ptr (type-numeric (eql +g-type-boxed+)) parse-kind)
 455   (declare (ignore parse-kind))
 456   (if (g-type= (g-value-type gvalue-ptr) (g-strv-get-type))
 457       (convert-from-foreign (g-value-get-boxed gvalue-ptr) '(glib:gstrv :free-from-foreign nil))
 458       (let ((boxed-type (get-g-boxed-foreign-info-for-gtype type-numeric)))
 459         (boxed-parse-g-value gvalue-ptr boxed-type))))
 460
 461 (defmethod set-gvalue-for-type (gvalue-ptr (type-numeric (eql +g-type-boxed+)) value)
 462   (if (g-type= (g-value-type gvalue-ptr) (g-strv-get-type))
 463       (g-value-set-boxed gvalue-ptr (convert-to-foreign value '(glib:gstrv :free-from-foreign nil)))
 464       (let ((boxed-type (get-g-boxed-foreign-info-for-gtype type-numeric)))
 465         (boxed-set-g-value gvalue-ptr boxed-type value))))
 466
 467 (defmethod boxed-parse-g-value (gvalue-ptr (info g-boxed-cstruct-wrapper-info))
 468   (translate-from-foreign (g-value-get-boxed gvalue-ptr) (make-foreign-type info :return-p nil)))
 469
 470 (defmethod boxed-set-g-value (gvalue-ptr (info g-boxed-cstruct-wrapper-info) proxy)
 471   (g-value-take-boxed gvalue-ptr (translate-to-foreign proxy (make-foreign-type info :return-p nil))))
 472
 473 (defmethod boxed-parse-g-value (gvalue-ptr (info g-boxed-variant-cstruct-info))
 474   (translate-from-foreign (g-value-get-boxed gvalue-ptr) (make-foreign-type info :return-p nil)))
 475
 476 (defmethod boxed-set-g-value (gvalue-ptr (info g-boxed-variant-cstruct-info) proxy)
 477   (g-value-take-boxed gvalue-ptr (translate-to-foreign proxy (make-foreign-type info :return-p nil))))
 478
 479 (defmethod boxed-parse-g-value (gvalue-ptr (info g-boxed-opaque-wrapper-info))
 480   (translate-from-foreign (boxed-copy-fn info (g-value-get-boxed gvalue-ptr)) (make-foreign-type info :return-p nil)))
 481
 482 (defmethod boxed-set-g-value (gvalue-ptr (info g-boxed-opaque-wrapper-info) proxy)
 483   (g-value-set-boxed gvalue-ptr (translate-to-foreign proxy (make-foreign-type info :return-p nil))))