chiark - git - mdw - clg/blob - glib/gtype.lisp

   1 ;; Common Lisp bindings for GTK+ v2.x
   2 ;; Copyright 2000-2006 Espen S. Johnsen <espen@users.sf.net>
   3 ;;
   4 ;; Permission is hereby granted, free of charge, to any person obtaining
   5 ;; a copy of this software and associated documentation files (the
   6 ;; "Software"), to deal in the Software without restriction, including
   7 ;; without limitation the rights to use, copy, modify, merge, publish,
   8 ;; distribute, sublicense, and/or sell copies of the Software, and to
   9 ;; permit persons to whom the Software is furnished to do so, subject to
  10 ;; the following conditions:
  11 ;;
  12 ;; The above copyright notice and this permission notice shall be
  13 ;; included in all copies or substantial portions of the Software.
  14 ;;
  15 ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  16 ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  17 ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
  18 ;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
  19 ;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
  20 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
  21 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
  22
  23 ;; $Id: gtype.lisp,v 1.63 2007-06-18 13:01:06 espen Exp $
  24
  25 (in-package "GLIB")
  26
  27 (use-prefix "g")
  28
  29 ;; Initialize the glib type system
  30 (defbinding type-init () nil)
  31 (type-init)
  32
  33 (eval-when (:compile-toplevel :load-toplevel :execute)
  34   (defbinding (bitsize-of-gtype "bitsize_of_gtype") () unsigned-int))
  35
  36 (deftype type-number () `(unsigned-byte ,(bitsize-of-gtype)))
  37
  38 (deftype gtype () 'symbol)
  39
  40 (define-type-method alien-type ((type gtype))
  41   (declare (ignore type))
  42   (alien-type 'type-number))
  43
  44 (define-type-method size-of ((type gtype) &key (inlined t))
  45   (assert-inlined type inlined)
  46   (size-of 'type-number))
  47
  48 (define-type-method to-alien-form ((type gtype) gtype &optional copy-p)
  49   (declare (ignore type copy-p))
  50   `(find-type-number ,gtype t))
  51
  52 (define-type-method to-alien-function ((type gtype) &optional copy-p)
  53   (declare (ignore type copy-p))
  54   #'(lambda (gtype)
  55       (find-type-number gtype t)))
  56
  57 (define-type-method from-alien-form ((type gtype) form &key ref)
  58   (declare (ignore type ref))
  59   `(type-from-number ,form))
  60
  61 (define-type-method from-alien-function ((type gtype) &key ref)
  62   (declare (ignore type ref))
  63   #'(lambda (type-number)
  64       (type-from-number type-number)))
  65
  66 (define-type-method writer-function ((type gtype) &key temp (inlined t))
  67   (declare (ignore temp))
  68   (assert-inlined type inlined)
  69   (let ((writer (writer-function 'type-number)))
  70     #'(lambda (gtype location &optional (offset 0))
  71         (funcall writer (find-type-number gtype t) location offset))))
  72
  73 (define-type-method reader-function ((type gtype) &key ref (inlined t))
  74   (declare (ignore ref))
  75   (assert-inlined type inlined)
  76   (let ((reader (reader-function 'type-number)))
  77     #'(lambda (location &optional (offset 0))
  78         (type-from-number (funcall reader location offset)))))
  79
  80
  81 (eval-when (:compile-toplevel :load-toplevel :execute)
  82   (defclass type-query (struct)
  83     ((type-number :allocation :alien :type type-number)
  84      (name :allocation :alien :type (copy-of string))
  85      (class-size :allocation :alien :type unsigned-int)
  86      (instance-size :allocation :alien :type unsigned-int))
  87     (:metaclass struct-class)))
  88
  89
  90 (defbinding type-query (type) nil
  91   ((find-type-number type t) type-number)
  92   ((make-instance 'type-query) type-query :in/return))
  93
  94 (defun type-instance-size (type)
  95   (slot-value (type-query type) 'instance-size))
  96
  97 (defun type-class-size (type)
  98   (slot-value (type-query type) 'class-size))
  99
 100 (defbinding type-class-ref (type) pointer
 101   ((find-type-number type t) type-number))
 102
 103 (defbinding type-class-unref () nil
 104   (class pointer))
 105
 106 (defbinding type-class-peek (type) pointer
 107   ((find-type-number type t) type-number))
 108
 109
 110
 111 ;;;; Mapping between lisp types and glib types
 112
 113 (defvar *registered-types* ())
 114 (defvar *registered-type-aliases* ())
 115 (defvar *registered-static-types* ())
 116 (defvar *lisp-type-to-type-number* (make-hash-table))
 117 (defvar *type-number-to-lisp-type* (make-hash-table))
 118
 119 (defbinding %type-from-name () type-number
 120   (name string))
 121
 122 (defun type-number-from-glib-name (name &optional (error-p t))
 123   (let ((type-number (%type-from-name name)))
 124     (cond
 125      ((not (zerop type-number)) type-number)
 126      (error-p (error "Invalid gtype name: ~A" name)))))
 127
 128 (defun type-from-glib-name (name)
 129   (type-from-number (type-number-from-glib-name name) t))
 130
 131 (defun register-type (type id)
 132   (cond
 133    ((find-type-number type))
 134    ((not id) (warn "Can't register type with no foreign id: ~A" type))
 135    (t
 136     (pushnew (cons type id) *registered-types* :key #'car)
 137     (let ((type-number
 138            (typecase id
 139              (string (type-number-from-glib-name id))
 140              (symbol (funcall id)))))
 141       (setf (gethash type *lisp-type-to-type-number*) type-number)
 142       (setf (gethash type-number *type-number-to-lisp-type*) type)
 143       type-number))))
 144
 145 (defun register-type-alias (type alias)
 146   (pushnew (cons type alias) *registered-type-aliases* :key #'car)
 147   (setf
 148    (gethash type *lisp-type-to-type-number*)
 149    (find-type-number alias t)))
 150
 151 (defun reinitialize-all-types ()
 152   (clrhash *lisp-type-to-type-number*)
 153   (clrhash *type-number-to-lisp-type*)
 154   (type-init) ; initialize the glib type system
 155   (mapc #'(lambda (type)
 156             (register-type (car type) (cdr type)))
 157         *registered-types*)
 158   (mapc #'(lambda (type)
 159             (apply #'register-new-type type))
 160         (reverse *registered-static-types*))
 161   (mapc #'(lambda (type)
 162             (register-type-alias (car type) (cdr type)))
 163         *registered-type-aliases*))
 164
 165 (pushnew 'reinitialize-all-types
 166   #+cmu *after-save-initializations*
 167   #+sbcl *init-hooks*
 168   #+clisp custom:*init-hooks*)
 169
 170 #+cmu
 171 (pushnew 'system::reinitialize-global-table ; we shouldn't have to do this?
 172  *after-save-initializations*)
 173
 174
 175 (defun find-type-number (type &optional error-p)
 176   (etypecase type
 177     (integer type)
 178     (string (type-number-from-glib-name type error-p))
 179     (symbol
 180      (or
 181       (gethash type *lisp-type-to-type-number*)
 182       (and error-p (error "Type not registered: ~A" type))))
 183     (class (find-type-number (class-name type) error-p))))
 184
 185 (defun type-from-number (type-number &optional error)
 186   (multiple-value-bind (type found)
 187       (gethash type-number *type-number-to-lisp-type*)
 188     (if found
 189         type
 190       (let ((name (find-foreign-type-name type-number)))
 191         (cond
 192          ((and name (not (= (type-number-from-glib-name name nil) type-number)))
 193           ;; This is a hack because GdkEvent seems to be registered
 194           ;; multiple times
 195           (type-from-number (type-number-from-glib-name name)))
 196          ((and error name)
 197           (error "Type number not registered: ~A (~A)" type-number name))
 198          ((and error)
 199           (error "Invalid type number: ~A" type-number)))))))
 200
 201 (defbinding (find-foreign-type-name "g_type_name") (type) (copy-of string)
 202   ((find-type-number type t) type-number))
 203
 204 (defun type-number-of (object)
 205   (find-type-number (type-of object) t))
 206
 207 ;; For #+(SBCL WIN32):
 208 ;;   The first 2 lines of the output from "pexports" are:
 209 ;;   LIBRARY XXX.dll
 210 ;;   EXPORTS
 211 ;;   We don't do anything to skip these 2 lines because they won't pass the
 212 ;;   WHEN (AND ...) in the LOOP
 213 ;;   - cph 19-May-2007
 214
 215 (eval-when (:compile-toplevel :load-toplevel :execute)
 216   (defvar *type-initializers* ())
 217   (defun %find-types-in-library (pathname prefixes ignore)
 218     (let ((outname (tmpname "types")))
 219       (unwind-protect
 220           (let ((asdf::*verbose-out* nil))
 221             (asdf:run-shell-command "nm ~A ~A > ~A"
 222              #-darwin "--defined-only --dynamic --extern-only"
 223              #+darwin "-f -s __TEXT __text"
 224              (namestring (truename pathname)) outname)
 225             ;; Note about win32 port:
 226             ;;   1. (TRUENAME PATHNAME) will bomb.
 227             ;;   2. either
 228             ;;        pexports "d:\\whatever\\bin\\zlib1.dll"
 229             ;;      or
 230             ;;        pexports d:/whatever/bin/zlib1.dll
 231             ;;      anything else will bomb.  this is why ~S is used below.
 232             #+win32
 233             (asdf:run-shell-command "pexports ~S > ~A"
 234              (namestring pathname) outname)
 235
 236             (with-open-file (output outname)
 237               (loop
 238                as line = (read-line output nil)
 239                as symbol = (when line
 240                              #-win32
 241                              (let ((pos (position #\space line :from-end t)))
 242                                #-darwin(subseq line (1+ pos))
 243                                #+darwin
 244                                (when (char= (char line (1- pos)) #\T)
 245                                  (subseq line (+ pos 2))))
 246                              #+win32
 247                              (subseq line 0 (1- (length line))))
 248                while line
 249                when (and
 250                      symbol (> (length symbol) 9)
 251                      (not (char= (char symbol 0) #\_))
 252                      (or
 253                       (not prefixes)
 254                       (some #'(lambda (prefix)
 255                                 (and
 256                                  (> (length symbol) (length prefix))
 257                                  (string= prefix symbol :end2 (length prefix))))
 258                        (mklist prefixes)))
 259                      (string= "_get_type" symbol :start2 (- (length symbol) 9))
 260                      (not (member symbol ignore :test #'string=)))
 261                collect symbol)))
 262         (delete-file outname)))))
 263
 264
 265 (defmacro init-types-in-library (system library &key prefix ignore)
 266   (let* ((filename (asdf:component-pathname (asdf:find-component (asdf:find-system system) library)))
 267          (names (%find-types-in-library filename prefix ignore)))
 268     `(progn
 269        ,@(mapcar #'(lambda (name)
 270                      `(progn
 271                         (defbinding (,(intern name) ,name) () type-number)
 272                         (,(intern name))
 273                         (pushnew ',(intern name) *type-initializers*)))
 274                  names))))
 275
 276 (defun find-type-init-function (type-number)
 277   (loop
 278    for type-init in *type-initializers*
 279    when (= type-number (funcall type-init))
 280    do (return type-init)))
 281
 282 (defun register-type-as (type-number)
 283   (or
 284    (find-type-init-function type-number)
 285    (find-foreign-type-name type-number)
 286    (error "Unknown type-number: ~A" type-number)))
 287
 288 (defun default-type-init-name (type)
 289   (find-symbol (format nil "~A_~A_get_type"
 290                 (package-prefix *package*)
 291                 (substitute #\_ #\- (string-downcase type)))))
 292
 293
 294 (eval-when (:compile-toplevel :load-toplevel :execute)
 295   (defclass type-info (struct)
 296     ((class-size :allocation :alien :type (unsigned 16) :initarg :class-size)
 297      (base-init :allocation :alien :type pointer)
 298      (base-finalize :allocation :alien :type pointer)
 299      (class-init :allocation :alien :type pointer)
 300      (class-finalize :allocation :alien :type pointer)
 301      (class-data :allocation :alien :type pointer)
 302      (instance-size :allocation :alien :type (unsigned 16)
 303                     :initarg :instance-size)
 304      (n-preallocs :allocation :alien :type (unsigned 16))
 305      (instance-init :allocation :alien :type pointer)
 306      (value-table :allocation :alien :type pointer))
 307     (:metaclass struct-class)))
 308
 309 (defbinding %type-register-static () type-number
 310   (parent-type type-number)
 311   (name string)
 312   (info type-info)
 313   (0 unsigned-int))
 314
 315 (defun register-new-type (type parent &optional foreign-name)
 316   (let ((parent-info (type-query parent)))
 317     (with-slots ((parent-number type-number) class-size instance-size) parent-info
 318       (let ((type-number
 319              (%type-register-static
 320               parent-number
 321               (or foreign-name (default-alien-type-name type))
 322               (make-instance 'type-info :class-size class-size :instance-size instance-size))))
 323         (pushnew (list type parent foreign-name) *registered-static-types* :key #'car)
 324         (setf (gethash type *lisp-type-to-type-number*) type-number)
 325         (setf (gethash type-number *type-number-to-lisp-type*) type)
 326         type-number))))
 327
 328
 329
 330 ;;;; Metaclass for subclasses of ginstance
 331
 332 (eval-when (:compile-toplevel :load-toplevel :execute)
 333   (defclass ginstance-class (proxy-class)
 334     ((gtype :initarg :gtype :initform nil :reader ginstance-class-gtype))))
 335
 336
 337 (defun update-size (class)
 338   (let ((type-number (find-type-number class)))
 339     (cond
 340      ((not (foreign-size-p class))
 341       (setf (foreign-size class) (type-instance-size type-number)))
 342      ((and
 343        (foreign-size-p class)
 344        (not (= (type-instance-size type-number) (foreign-size class))))
 345       (warn "Size mismatch for class ~A" class)))))
 346
 347
 348 (defmethod finalize-inheritance ((class ginstance-class))
 349   (prog1
 350       #+clisp(call-next-method)
 351     (let* ((class-name (class-name class))
 352            (super (most-specific-proxy-superclass class))
 353            (gtype (or
 354                    (first (ginstance-class-gtype class))
 355                    (default-alien-type-name class-name)))
 356            (type-number
 357             (or
 358              (find-type-number class-name)
 359              (let ((type-number
 360                     (if (or
 361                          (symbolp gtype)
 362                          (type-number-from-glib-name gtype nil))
 363                         (register-type class-name gtype)
 364                       (register-new-type class-name (class-name super) gtype))))
 365                (type-class-ref type-number)
 366                type-number))))
 367       #+nil
 368       (when (and
 369              (supertype type-number)
 370              (not (eq (class-name super) (supertype type-number))))
 371         (warn "Super class mismatch between CLOS and GObject for ~A"
 372               class-name)))
 373     (update-size class))
 374   #-clisp(call-next-method))
 375
 376
 377 (defmethod shared-initialize ((class ginstance-class) names &rest initargs)
 378   (declare (ignore names initargs))
 379   (call-next-method)
 380   (when (class-finalized-p class)
 381     (update-size class)))
 382
 383
 384 (defmethod validate-superclass ((class ginstance-class) (super standard-class))
 385   (subtypep (class-name super) 'ginstance))
 386
 387
 388 ;;;; Superclass for wrapping types in the glib type system
 389
 390 (eval-when (:compile-toplevel :load-toplevel :execute)
 391   (defclass ginstance (ref-counted-object)
 392     (;(class :allocation :alien :type pointer :offset 0)
 393      )
 394     (:metaclass proxy-class)
 395     (:size #.(size-of 'pointer))))
 396
 397 (defun ref-type-number (location &optional offset)
 398   (declare (ignore location offset)))
 399
 400 (setf (symbol-function 'ref-type-number) (reader-function 'type-number))
 401
 402 (defun %type-number-of-ginstance (location)
 403   (let ((class (ref-pointer location)))
 404     (ref-type-number class)))
 405
 406 (defmethod make-proxy-instance :around ((class ginstance-class) location
 407                                         &rest initargs)
 408   (declare (ignore class))
 409   (let ((class (labels ((find-known-class (type-number)
 410                           (or
 411                            (find-class (type-from-number type-number) nil)
 412                            (unless (zerop type-number)
 413                              (find-known-class (type-parent type-number))))))
 414                  (find-known-class (%type-number-of-ginstance location)))))
 415     ;; Note that chancing the class argument should not alter "the
 416     ;; ordered set of applicable methods" as specified in the
 417     ;; Hyperspec
 418     (if class
 419         (apply #'call-next-method class location initargs)
 420       (error "Object at ~A has an unkown type number: ~A"
 421        location (%type-number-of-ginstance location)))))
 422
 423
 424 ;;;; Registering fundamental types
 425
 426 (register-type 'nil "void")
 427 (register-type 'pointer "gpointer")
 428 (register-type 'char "gchar")
 429 (register-type 'unsigned-char "guchar")
 430 (register-type 'boolean "gboolean")
 431 (register-type 'int "gint")
 432 (register-type-alias 'integer 'int)
 433 (register-type-alias 'fixnum 'int)
 434 (register-type 'unsigned-int "guint")
 435 (register-type 'long "glong")
 436 (register-type 'unsigned-long "gulong")
 437 (register-type 'single-float "gfloat")
 438 (register-type 'double-float "gdouble")
 439 (register-type 'pathname "gchararray")
 440 (register-type 'string "gchararray")
 441
 442
 443 ;;;; Introspection of type information
 444
 445 (defvar *derivable-type-info* (make-hash-table))
 446
 447 (defun register-derivable-type (type id expander &optional dependencies)
 448   (register-type type id)
 449   (let ((type-number (register-type type id)))
 450     (setf
 451      (gethash type-number *derivable-type-info*)
 452      (list expander dependencies))))
 453
 454 (defun find-type-info (type)
 455   (dolist (super (cdr (type-hierarchy type)))
 456     (let ((info (gethash super *derivable-type-info*)))
 457       (return-if info))))
 458
 459 (defun expand-type-definition (type forward-p options)
 460   (let ((expander (first (find-type-info type))))
 461     (funcall expander (find-type-number type t) forward-p options)))
 462
 463
 464 (defbinding type-parent (type) type-number
 465   ((find-type-number type t) type-number))
 466
 467 (defun supertype (type)
 468   (type-from-number (type-parent type)))
 469
 470 (defbinding %type-interfaces (type) pointer
 471   ((find-type-number type t) type-number)
 472   (n-interfaces unsigned-int :out))
 473
 474 (defun type-interfaces (type)
 475   (multiple-value-bind (array length) (%type-interfaces type)
 476     (unwind-protect
 477         (map-c-vector 'list #'identity array 'type-number length)
 478       (deallocate-memory array))))
 479
 480 (defun implements (type)
 481   (mapcar #'type-from-number (type-interfaces type)))
 482
 483 (defun type-hierarchy (type)
 484   (let ((type-number (find-type-number type t)))
 485     (unless (= type-number 0)
 486       (cons type-number (type-hierarchy (type-parent type-number))))))
 487
 488 (defbinding (type-is-p "g_type_is_a") (type super) boolean
 489   ((find-type-number type) type-number)
 490   ((find-type-number super) type-number))
 491
 492 (defbinding %type-children () pointer
 493   (type-number type-number)
 494   (num-children unsigned-int :out))
 495
 496 (defun map-subtypes (function type &optional prefix)
 497   (let ((type-number (find-type-number type t)))
 498     (multiple-value-bind (array length) (%type-children type-number)
 499       (unwind-protect
 500           (map-c-vector
 501            'nil
 502            #'(lambda (type-number)
 503                (when (or
 504                       (not prefix)
 505                       (string-prefix-p prefix (find-foreign-type-name type-number)))
 506                  (funcall function type-number))
 507                (map-subtypes function type-number prefix))
 508            array 'type-number length)
 509         (deallocate-memory array)))))
 510
 511 (defun find-types (prefix)
 512   (let ((type-list nil))
 513     (maphash
 514      #'(lambda (type-number expander)
 515          (declare (ignore expander))
 516          (map-subtypes
 517           #'(lambda (type-number)
 518               (pushnew type-number type-list))
 519           type-number prefix))
 520      *derivable-type-info*)
 521     type-list))
 522
 523 (defun find-type-dependencies (type &optional options)
 524   (let ((find-dependencies (second (find-type-info type))))
 525     (when find-dependencies
 526       (remove-duplicates
 527        (mapcar #'find-type-number
 528         (funcall find-dependencies (find-type-number type t) options))))))
 529
 530
 531 ;; The argument is a list where each elements is on the form
 532 ;; (type . dependencies). This function will not handle indirect
 533 ;; dependencies and types depending on them selves.
 534 (defun sort-types-topologicaly (unsorted)
 535   (flet ((depend-p (type1)
 536            (find-if #'(lambda (type2)
 537                         (and
 538                          ;; If a type depends a subtype it has to be
 539                          ;; forward defined
 540                          (not (type-is-p (car type2) (car type1)))
 541                          (find (car type2) (cdr type1))))
 542                     unsorted)))
 543     (let ((sorted
 544            (loop
 545             while unsorted
 546             nconc (multiple-value-bind (sorted remaining)
 547                       (delete-collect-if
 548                        #'(lambda (type)
 549                            (or (not (cdr type)) (not (depend-p type))))
 550                        unsorted)
 551                     (cond
 552                      ((not sorted)
 553                       ;; We have a circular dependency which have to
 554                       ;; be resolved
 555                       (let ((selected
 556                              (find-if
 557                               #'(lambda (type)
 558                                   (every
 559                                    #'(lambda (dep)
 560                                        (or
 561                                         (not (type-is-p (car type) dep))
 562                                         (not (find dep unsorted :key #'car))))
 563                                    (cdr type)))
 564                               unsorted)))
 565                         (unless selected
 566                           (error "Couldn't resolve circular dependency"))
 567                         (setq unsorted (delete selected unsorted))
 568                         (list selected)))
 569                      (t
 570                       (setq unsorted remaining)
 571                       sorted))))))
 572
 573       ;; Mark types which have to be forward defined
 574       (loop
 575        for tmp on sorted
 576        as (type . dependencies) = (first tmp)
 577        collect (cons type (and
 578                            dependencies
 579                            (find-if #'(lambda (type)
 580                                         (find (car type) dependencies))
 581                                     (rest tmp))
 582                            t))))))
 583
 584
 585 (defun expand-type-definitions (prefix &optional args)
 586   (flet ((type-options (type-number)
 587            (let ((name (find-foreign-type-name type-number)))
 588              (cdr (assoc name args :test #'string=)))))
 589
 590    (let ((type-list
 591           (delete-if
 592            #'(lambda (type-number)
 593                (let ((name (find-foreign-type-name type-number)))
 594                  (or
 595                   (getf (type-options type-number) :ignore)
 596                   (find-if
 597                    #'(lambda (options)
 598                        (and
 599                         (string-prefix-p (first options) name)
 600                         (getf (cdr options) :ignore-prefix)
 601                         (not (some
 602                               #'(lambda (exception)
 603                                   (string= name exception))
 604                               (getf (cdr options) :except)))))
 605                    args))))
 606            (find-types prefix))))
 607
 608      (dolist (type-number type-list)
 609        (let ((name (find-foreign-type-name type-number)))
 610          (register-type
 611           (getf (type-options type-number) :type (default-type-name name))
 612           (register-type-as type-number))))
 613
 614      ;; This is needed for some unknown reason to get type numbers right
 615      (mapc #'find-type-dependencies type-list)
 616
 617      (let ((sorted-type-list
 618             #+clisp (mapcar #'list type-list)
 619             #-clisp
 620             (sort-types-topologicaly
 621              (mapcar
 622               #'(lambda (type)
 623                   (cons type (find-type-dependencies type (type-options type))))
 624               type-list))))
 625        `(progn
 626           ,@(mapcar
 627              #'(lambda (pair)
 628                  (destructuring-bind (type . forward-p) pair
 629                    (expand-type-definition type forward-p (type-options type))))
 630              sorted-type-list)
 631           ,@(mapcar
 632              #'(lambda (pair)
 633                  (destructuring-bind (type . forward-p) pair
 634                    (when forward-p
 635                      (expand-type-definition type nil (type-options type)))))
 636              sorted-type-list))))))
 637
 638 (defmacro define-types-by-introspection (prefix &rest args)
 639   (expand-type-definitions prefix args))
 640
 641 (defexport define-types-by-introspection (prefix &rest args)
 642   (list-autoexported-symbols (expand-type-definitions prefix args)))
 643
 644
 645 ;;;; Initialize all non static types in GObject
 646
 647 (init-types-in-library glib "libgobject-2.0")