chiark / gitweb /
Improved multithreading support
[clg] / glib / gtype.lisp
CommitLineData
112ac1d3 1;; Common Lisp bindings for GTK+ v2.x
74821f75 2;; Copyright 2000-2006 Espen S. Johnsen <espen@users.sf.net>
560af5c5 3;;
112ac1d3 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:
560af5c5 11;;
112ac1d3 12;; The above copyright notice and this permission notice shall be
13;; included in all copies or substantial portions of the Software.
560af5c5 14;;
112ac1d3 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
8f12a0ff 23;; $Id: gtype.lisp,v 1.62 2007-06-06 10:43:54 espen Exp $
560af5c5 24
25(in-package "GLIB")
26
27(use-prefix "g")
28
e0349dbd 29;; Initialize the glib type system
30(defbinding type-init () nil)
31(type-init)
560af5c5 32
1199ddd2 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)))
560af5c5 37
e74cfcab 38(deftype gtype () 'symbol)
39
75689fea 40(define-type-method alien-type ((type gtype))
41 (declare (ignore type))
e74cfcab 42 (alien-type 'type-number))
43
74821f75 44(define-type-method size-of ((type gtype) &key (inlined t))
45 (assert-inlined type inlined)
e74cfcab 46 (size-of 'type-number))
47
74821f75 48(define-type-method to-alien-form ((type gtype) gtype &optional copy-p)
49 (declare (ignore type copy-p))
e74cfcab 50 `(find-type-number ,gtype t))
51
74821f75 52(define-type-method to-alien-function ((type gtype) &optional copy-p)
53 (declare (ignore type copy-p))
e74cfcab 54 #'(lambda (gtype)
55 (find-type-number gtype t)))
56
74821f75 57(define-type-method from-alien-form ((type gtype) form &key ref)
58 (declare (ignore type ref))
59 `(type-from-number ,form))
e74cfcab 60
74821f75 61(define-type-method from-alien-function ((type gtype) &key ref)
62 (declare (ignore type ref))
e74cfcab 63 #'(lambda (type-number)
63752532 64 (type-from-number type-number)))
e74cfcab 65
74821f75 66(define-type-method writer-function ((type gtype) &key temp (inlined t))
67 (declare (ignore temp))
68 (assert-inlined type inlined)
e74cfcab 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
74821f75 73(define-type-method reader-function ((type gtype) &key ref (inlined t))
74 (declare (ignore ref))
75 (assert-inlined type inlined)
e74cfcab 76 (let ((reader (reader-function 'type-number)))
74821f75 77 #'(lambda (location &optional (offset 0))
63752532 78 (type-from-number (funcall reader location offset)))))
e74cfcab 79
80
93aa67db 81(eval-when (:compile-toplevel :load-toplevel :execute)
d4b21b08 82 (defclass type-query (struct)
93aa67db 83 ((type-number :allocation :alien :type type-number)
74821f75 84 (name :allocation :alien :type (copy-of string))
93aa67db 85 (class-size :allocation :alien :type unsigned-int)
86 (instance-size :allocation :alien :type unsigned-int))
d168bafd 87 (:metaclass struct-class)))
93aa67db 88
89
e74cfcab 90(defbinding type-query (type) nil
91 ((find-type-number type t) type-number)
74821f75 92 ((make-instance 'type-query) type-query :in/return))
93aa67db 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))
560af5c5 99
d4b21b08 100(defbinding type-class-ref (type) pointer
101 ((find-type-number type t) type-number))
560af5c5 102
74821f75 103(defbinding type-class-unref () nil
104 (class pointer))
93aa67db 105
d4b21b08 106(defbinding type-class-peek (type) pointer
107 ((find-type-number type t) type-number))
93aa67db 108
560af5c5 109
74821f75 110
d4b21b08 111;;;; Mapping between lisp types and glib types
560af5c5 112
dfa4f314 113(defvar *registered-types* ())
114(defvar *registered-type-aliases* ())
44f47f3d 115(defvar *registered-static-types* ())
dfa4f314 116(defvar *lisp-type-to-type-number* (make-hash-table))
117(defvar *type-number-to-lisp-type* (make-hash-table))
d4b21b08 118
119(defbinding %type-from-name () type-number
120 (name string))
121
dfa4f314 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
d32cbb7a 128(defun type-from-glib-name (name)
129 (type-from-number (type-number-from-glib-name name) t))
130
dfa4f314 131(defun register-type (type id)
74821f75 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))))
dfa4f314 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)
74821f75 159 (apply #'register-new-type type))
d32cbb7a 160 (reverse *registered-static-types*))
58a1fb1d 161 (mapc #'(lambda (type)
dfa4f314 162 (register-type-alias (car type) (cdr type)))
163 *registered-type-aliases*))
164
165(pushnew 'reinitialize-all-types
166 #+cmu *after-save-initializations*
74821f75 167 #+sbcl *init-hooks*
168 #+clisp custom:*init-hooks*)
dfa4f314 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)
560af5c5 176 (etypecase type
177 (integer type)
dfa4f314 178 (string (type-number-from-glib-name type error-p))
d4b21b08 179 (symbol
dfa4f314 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))))
560af5c5 184
4de90d10 185(defun type-from-number (type-number &optional error)
186 (multiple-value-bind (type found)
dfa4f314 187 (gethash type-number *type-number-to-lisp-type*)
e7dbc3bf 188 (if found
189 type
dfa4f314 190 (let ((name (find-foreign-type-name type-number)))
e7dbc3bf 191 (cond
cd859052 192 ((and name (not (= (type-number-from-glib-name name nil) type-number)))
e7dbc3bf 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)))))))
560af5c5 200
dfa4f314 201(defbinding (find-foreign-type-name "g_type_name") (type) (copy-of string)
d4b21b08 202 ((find-type-number type t) type-number))
203
204(defun type-number-of (object)
205 (find-type-number (type-of object) t))
206
21299acf 207(eval-when (:compile-toplevel :load-toplevel :execute)
dfa4f314 208 (defvar *type-initializers* ())
209 (defun %find-types-in-library (pathname prefixes ignore)
74821f75 210 (let ((process
211 (run-program
212 "/usr/bin/nm"
213 #+clisp :arguments
e3b11dff 214 (list #-darwin"--defined-only" #-darwin"-D" "-g" #+darwin"-f"
215 #+darwin"-s" #+darwin"__TEXT" #+darwin"__text"
216 (namestring (truename pathname)))
74821f75 217 :output :stream :wait nil)))
21299acf 218 (unwind-protect
219 (loop
e3b11dff 220 as line = (read-line
221 #+(or cmu sbcl) (process-output process)
222 #+clisp process
223 nil)
224 as symbol = (when line
225 (let ((pos (position #\Space line :from-end t)))
226 #-darwin(subseq line (1+ pos))
d998fbdd 227 #+darwin
e3b11dff 228 (when (char= (char line (1- pos)) #\T)
229 (subseq line (+ pos 2)))))
230 while line
21299acf 231 when (and
e3b11dff 232 symbol (> (length symbol) 9)
8672dc09 233 (not (char= (char symbol 0) #\_))
dfa4f314 234 (or
235 (not prefixes)
236 (some #'(lambda (prefix)
237 (and
238 (> (length symbol) (length prefix))
239 (string= prefix symbol :end2 (length prefix))))
240 (mklist prefixes)))
241 (string= "_get_type" symbol :start2 (- (length symbol) 9))
21299acf 242 (not (member symbol ignore :test #'string=)))
243 collect symbol)
74821f75 244 (#+(or cmu sbcl)process-close
245 #+clisp close
246 process)))))
21299acf 247
560af5c5 248
8f12a0ff 249(defmacro init-types-in-library (system library &key prefix ignore)
250 (let* ((filename (asdf:component-pathname (asdf:find-component (asdf:find-system system) library)))
251 (names (%find-types-in-library filename prefix ignore)))
21299acf 252 `(progn
253 ,@(mapcar #'(lambda (name)
254 `(progn
255 (defbinding (,(intern name) ,name) () type-number)
dfa4f314 256 (,(intern name))
257 (pushnew ',(intern name) *type-initializers*)))
21299acf 258 names))))
259
dfa4f314 260(defun find-type-init-function (type-number)
735a29da 261 (loop
262 for type-init in *type-initializers*
263 when (= type-number (funcall type-init))
264 do (return type-init)))
265
266(defun register-type-as (type-number)
267 (or
268 (find-type-init-function type-number)
269 (find-foreign-type-name type-number)
270 (error "Unknown type-number: ~A" type-number)))
dfa4f314 271
272(defun default-type-init-name (type)
273 (find-symbol (format nil "~A_~A_get_type"
274 (package-prefix *package*)
275 (substitute #\_ #\- (string-downcase type)))))
276
21299acf 277
15cbdefc 278(eval-when (:compile-toplevel :load-toplevel :execute)
279 (defclass type-info (struct)
280 ((class-size :allocation :alien :type (unsigned 16) :initarg :class-size)
281 (base-init :allocation :alien :type pointer)
282 (base-finalize :allocation :alien :type pointer)
283 (class-init :allocation :alien :type pointer)
284 (class-finalize :allocation :alien :type pointer)
285 (class-data :allocation :alien :type pointer)
286 (instance-size :allocation :alien :type (unsigned 16)
287 :initarg :instance-size)
288 (n-preallocs :allocation :alien :type (unsigned 16))
289 (instance-init :allocation :alien :type pointer)
290 (value-table :allocation :alien :type pointer))
291 (:metaclass struct-class)))
292
293(defbinding %type-register-static () type-number
e7dbc3bf 294 (parent-type type-number)
15cbdefc 295 (name string)
296 (info type-info)
297 (0 unsigned-int))
298
92a07e63 299(defun register-new-type (type parent &optional foreign-name)
15cbdefc 300 (let ((parent-info (type-query parent)))
301 (with-slots ((parent-number type-number) class-size instance-size) parent-info
302 (let ((type-number
303 (%type-register-static
304 parent-number
92a07e63 305 (or foreign-name (default-alien-type-name type))
15cbdefc 306 (make-instance 'type-info :class-size class-size :instance-size instance-size))))
44f47f3d 307 (pushnew (list type parent foreign-name) *registered-static-types* :key #'car)
308 (setf (gethash type *lisp-type-to-type-number*) type-number)
309 (setf (gethash type-number *type-number-to-lisp-type*) type)
310 type-number))))
15cbdefc 311
312
21299acf 313
314;;;; Metaclass for subclasses of ginstance
315
316(eval-when (:compile-toplevel :load-toplevel :execute)
317 (defclass ginstance-class (proxy-class)
6497583a 318 ((gtype :initarg :gtype :initform nil :reader ginstance-class-gtype))))
cd859052 319
320
1eaa1bd6 321(defun update-size (class)
322 (let ((type-number (find-type-number class)))
323 (cond
74821f75 324 ((not (foreign-size-p class))
325 (setf (foreign-size class) (type-instance-size type-number)))
1eaa1bd6 326 ((and
74821f75 327 (foreign-size-p class)
328 (not (= (type-instance-size type-number) (foreign-size class))))
1eaa1bd6 329 (warn "Size mismatch for class ~A" class)))))
330
09f6e237 331
cd859052 332(defmethod finalize-inheritance ((class ginstance-class))
74821f75 333 (prog1
334 #+clisp(call-next-method)
335 (let* ((class-name (class-name class))
336 (super (most-specific-proxy-superclass class))
337 (gtype (or
338 (first (ginstance-class-gtype class))
339 (default-alien-type-name class-name)))
340 (type-number
341 (or
342 (find-type-number class-name)
343 (let ((type-number
344 (if (or
345 (symbolp gtype)
346 (type-number-from-glib-name gtype nil))
347 (register-type class-name gtype)
348 (register-new-type class-name (class-name super) gtype))))
349 (type-class-ref type-number)
350 type-number))))
584285fb 351 #+nil
74821f75 352 (when (and
353 (supertype type-number)
354 (not (eq (class-name super) (supertype type-number))))
355 (warn "Super class mismatch between CLOS and GObject for ~A"
356 class-name)))
357 (update-size class))
358 #-clisp(call-next-method))
1eaa1bd6 359
360
361(defmethod shared-initialize ((class ginstance-class) names &rest initargs)
74821f75 362 (declare (ignore names initargs))
1eaa1bd6 363 (call-next-method)
364 (when (class-finalized-p class)
365 (update-size class)))
366
4de90d10 367
21299acf 368(defmethod validate-superclass ((class ginstance-class) (super standard-class))
369 (subtypep (class-name super) 'ginstance))
370
560af5c5 371
93aa67db 372;;;; Superclass for wrapping types in the glib type system
560af5c5 373
374(eval-when (:compile-toplevel :load-toplevel :execute)
af338f4a 375 (defclass ginstance (ref-counted-object)
09f6e237 376 (;(class :allocation :alien :type pointer :offset 0)
377 )
378 (:metaclass proxy-class)
379 (:size #.(size-of 'pointer))))
560af5c5 380
74821f75 381(defun ref-type-number (location &optional offset)
382 (declare (ignore location offset)))
383
384(setf (symbol-function 'ref-type-number) (reader-function 'type-number))
385
895c9a9e 386(defun %type-number-of-ginstance (location)
74821f75 387 (let ((class (ref-pointer location)))
388 (ref-type-number class)))
560af5c5 389
74821f75 390(defmethod make-proxy-instance :around ((class ginstance-class) location
391 &rest initargs)
d168bafd 392 (declare (ignore class))
895c9a9e 393 (let ((class (labels ((find-known-class (type-number)
394 (or
395 (find-class (type-from-number type-number) nil)
396 (unless (zerop type-number)
397 (find-known-class (type-parent type-number))))))
398 (find-known-class (%type-number-of-ginstance location)))))
74821f75 399 ;; Note that chancing the class argument should not alter "the
8958fa4a 400 ;; ordered set of applicable methods" as specified in the
401 ;; Hyperspec
d168bafd 402 (if class
8958fa4a 403 (apply #'call-next-method class location initargs)
404 (error "Object at ~A has an unkown type number: ~A"
405 location (%type-number-of-ginstance location)))))
406
560af5c5 407
d4b21b08 408;;;; Registering fundamental types
409
63752532 410(register-type 'nil "void")
d4b21b08 411(register-type 'pointer "gpointer")
412(register-type 'char "gchar")
413(register-type 'unsigned-char "guchar")
414(register-type 'boolean "gboolean")
d4b21b08 415(register-type 'int "gint")
73383a9e 416(register-type-alias 'integer 'int)
dfa4f314 417(register-type-alias 'fixnum 'int)
d4b21b08 418(register-type 'unsigned-int "guint")
419(register-type 'long "glong")
420(register-type 'unsigned-long "gulong")
421(register-type 'single-float "gfloat")
422(register-type 'double-float "gdouble")
a8cb9408 423(register-type 'pathname "gchararray")
4de90d10 424(register-type 'string "gchararray")
d4b21b08 425
426
62f12808 427;;;; Introspection of type information
d4b21b08 428
e77e7713 429(defvar *derivable-type-info* (make-hash-table))
d4b21b08 430
62f12808 431(defun register-derivable-type (type id expander &optional dependencies)
d4b21b08 432 (register-type type id)
e77e7713 433 (let ((type-number (register-type type id)))
62f12808 434 (setf
435 (gethash type-number *derivable-type-info*)
436 (list expander dependencies))))
d4b21b08 437
4de90d10 438(defun find-type-info (type)
439 (dolist (super (cdr (type-hierarchy type)))
e77e7713 440 (let ((info (gethash super *derivable-type-info*)))
4de90d10 441 (return-if info))))
442
62f12808 443(defun expand-type-definition (type forward-p options)
444 (let ((expander (first (find-type-info type))))
445 (funcall expander (find-type-number type t) forward-p options)))
d4b21b08 446
74821f75 447
d4b21b08 448(defbinding type-parent (type) type-number
449 ((find-type-number type t) type-number))
450
451(defun supertype (type)
452 (type-from-number (type-parent type)))
453
337933d8 454(defbinding %type-interfaces (type) pointer
455 ((find-type-number type t) type-number)
456 (n-interfaces unsigned-int :out))
457
458(defun type-interfaces (type)
459 (multiple-value-bind (array length) (%type-interfaces type)
460 (unwind-protect
d168bafd 461 (map-c-vector 'list #'identity array 'type-number length)
337933d8 462 (deallocate-memory array))))
463
464(defun implements (type)
465 (mapcar #'type-from-number (type-interfaces type)))
466
d4b21b08 467(defun type-hierarchy (type)
468 (let ((type-number (find-type-number type t)))
469 (unless (= type-number 0)
470 (cons type-number (type-hierarchy (type-parent type-number))))))
471
472(defbinding (type-is-p "g_type_is_a") (type super) boolean
473 ((find-type-number type) type-number)
474 ((find-type-number super) type-number))
475
476(defbinding %type-children () pointer
477 (type-number type-number)
478 (num-children unsigned-int :out))
479
480(defun map-subtypes (function type &optional prefix)
481 (let ((type-number (find-type-number type t)))
482 (multiple-value-bind (array length) (%type-children type-number)
483 (unwind-protect
d168bafd 484 (map-c-vector
d4b21b08 485 'nil
486 #'(lambda (type-number)
487 (when (or
488 (not prefix)
dfa4f314 489 (string-prefix-p prefix (find-foreign-type-name type-number)))
d4b21b08 490 (funcall function type-number))
491 (map-subtypes function type-number prefix))
492 array 'type-number length)
493 (deallocate-memory array)))))
494
495(defun find-types (prefix)
496 (let ((type-list nil))
e77e7713 497 (maphash
498 #'(lambda (type-number expander)
499 (declare (ignore expander))
500 (map-subtypes
501 #'(lambda (type-number)
502 (pushnew type-number type-list))
503 type-number prefix))
504 *derivable-type-info*)
d4b21b08 505 type-list))
506
74821f75 507(defun find-type-dependencies (type &optional options)
508 (let ((find-dependencies (second (find-type-info type))))
509 (when find-dependencies
510 (remove-duplicates
511 (mapcar #'find-type-number
512 (funcall find-dependencies (find-type-number type t) options))))))
513
514
515;; The argument is a list where each elements is on the form
584285fb 516;; (type . dependencies). This function will not handle indirect
8f12a0ff 517;; dependencies and types depending on them selves.
74821f75 518(defun sort-types-topologicaly (unsorted)
519 (flet ((depend-p (type1)
520 (find-if #'(lambda (type2)
521 (and
522 ;; If a type depends a subtype it has to be
523 ;; forward defined
524 (not (type-is-p (car type2) (car type1)))
525 (find (car type2) (cdr type1))))
526 unsorted)))
527 (let ((sorted
528 (loop
529 while unsorted
530 nconc (multiple-value-bind (sorted remaining)
531 (delete-collect-if
532 #'(lambda (type)
533 (or (not (cdr type)) (not (depend-p type))))
534 unsorted)
535 (cond
536 ((not sorted)
537 ;; We have a circular dependency which have to
538 ;; be resolved
539 (let ((selected
540 (find-if
541 #'(lambda (type)
542 (every
543 #'(lambda (dep)
544 (or
545 (not (type-is-p (car type) dep))
546 (not (find dep unsorted :key #'car))))
547 (cdr type)))
548 unsorted)))
549 (unless selected
550 (error "Couldn't resolve circular dependency"))
551 (setq unsorted (delete selected unsorted))
552 (list selected)))
553 (t
554 (setq unsorted remaining)
555 sorted))))))
556
557 ;; Mark types which have to be forward defined
558 (loop
559 for tmp on sorted
560 as (type . dependencies) = (first tmp)
561 collect (cons type (and
562 dependencies
563 (find-if #'(lambda (type)
564 (find (car type) dependencies))
565 (rest tmp))
566 t))))))
d4b21b08 567
568
569(defun expand-type-definitions (prefix &optional args)
dfa4f314 570 (flet ((type-options (type-number)
571 (let ((name (find-foreign-type-name type-number)))
4de90d10 572 (cdr (assoc name args :test #'string=)))))
d4b21b08 573
e77e7713 574 (let ((type-list
575 (delete-if
576 #'(lambda (type-number)
dfa4f314 577 (let ((name (find-foreign-type-name type-number)))
e77e7713 578 (or
579 (getf (type-options type-number) :ignore)
580 (find-if
581 #'(lambda (options)
582 (and
583 (string-prefix-p (first options) name)
80a09c29 584 (getf (cdr options) :ignore-prefix)
585 (not (some
586 #'(lambda (exception)
587 (string= name exception))
588 (getf (cdr options) :except)))))
e77e7713 589 args))))
590 (find-types prefix))))
21299acf 591
e77e7713 592 (dolist (type-number type-list)
dfa4f314 593 (let ((name (find-foreign-type-name type-number)))
e77e7713 594 (register-type
595 (getf (type-options type-number) :type (default-type-name name))
735a29da 596 (register-type-as type-number))))
21299acf 597
74821f75 598 ;; This is needed for some unknown reason to get type numbers right
599 (mapc #'find-type-dependencies type-list)
600
601 (let ((sorted-type-list
602 #+clisp (mapcar #'list type-list)
603 #-clisp
604 (sort-types-topologicaly
605 (mapcar
606 #'(lambda (type)
607 (cons type (find-type-dependencies type (type-options type))))
608 type-list))))
62f12808 609 `(progn
610 ,@(mapcar
21299acf 611 #'(lambda (pair)
612 (destructuring-bind (type . forward-p) pair
613 (expand-type-definition type forward-p (type-options type))))
614 sorted-type-list)
62f12808 615 ,@(mapcar
21299acf 616 #'(lambda (pair)
617 (destructuring-bind (type . forward-p) pair
618 (when forward-p
619 (expand-type-definition type nil (type-options type)))))
62f12808 620 sorted-type-list))))))
e77e7713 621
d4b21b08 622(defmacro define-types-by-introspection (prefix &rest args)
4de90d10 623 (expand-type-definitions prefix args))
21299acf 624
74821f75 625(defexport define-types-by-introspection (prefix &rest args)
fbd2b3d9 626 (list-autoexported-symbols (expand-type-definitions prefix args)))
74821f75 627
21299acf 628
629;;;; Initialize all non static types in GObject
630
8f12a0ff 631(init-types-in-library glib "libgobject-2.0")