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