Add gobject:get-g-type-definition function
authorDmitry Kalyanov <Kalyanov.Dmitry@gmail.com>
Thu, 12 Nov 2009 20:50:08 +0000 (23:50 +0300)
committerDmitry Kalyanov <Kalyanov.Dmitry@gmail.com>
Thu, 12 Nov 2009 20:50:08 +0000 (23:50 +0300)
doc/gobject.ref.texi
glib/gobject.generating.lisp
glib/gobject.package.lisp

index df7e0c7..94d1b0a 100644 (file)
@@ -2210,6 +2210,7 @@ Examples:
 * get-g-flags-definition::
 * get-g-interface-definition::
 * get-g-class-definition::
+* get-g-type-definition::
 * Specifying additional properties for CLOS classes::
 * Generating names for CLOS classes and accessors::
 * generate-types-hierarchy-to-file::
@@ -2576,6 +2577,25 @@ Example:
                          "image-position" "GtkPositionType" T T)))
 @end lisp
 
+@node get-g-type-definition
+@section get-g-type-definition
+
+@Function get-g-type-definition
+@lisp
+(get-g-class-definition type &optional lisp-name-package) @result{} definition
+@end lisp
+
+@table @var
+@item @var{type}
+A string naming the GEnum, GFlags, GInterface or GObject type
+@item @var{lisp-name-package}
+A package that will be used as a package for generated symbols (type name, accessor names). If not specified, symbols are interned in @code{*package*}
+@item @var{definition}
+A Lisp form that when evaluated defines the corresponding Lisp type.
+@end table
+
+Depending on a kind of @var{type}, calls @ref{get-g-enum-definition} or @ref{get-g-flags-definition} or @ref{get-g-interface-definition} or @ref{get-g-class-definition}.
+
 @node Specifying additional properties for CLOS classes
 @section Specifying additional properties for CLOS classes
 
index f9283a3..2035784 100755 (executable)
@@ -453,6 +453,23 @@ If non-@code{NIL}, specifies the function that initializes the type: string spec
                                 probable-type-initializer)))
        ,@(mapcar #'flags-value->definition items))))
 
+(defun maybe-call-type-init (type)
+  (when (and (stringp type) (zerop (g-type-numeric type)))
+    (let ((type-init-name (probable-type-init-name type)))
+      (when (foreign-symbol-pointer type-init-name)
+        (foreign-funcall-pointer (foreign-symbol-pointer type-init-name) () :int)))))
+
+(defun get-g-type-definition (type &optional lisp-name-package)
+  (maybe-call-type-init type)
+  (cond
+    ((g-type-is-a type +g-type-enum+) (get-g-enum-definition type lisp-name-package))
+    ((g-type-is-a type +g-type-flags+) (get-g-flags-definition type lisp-name-package))
+    ((g-type-is-a type +g-type-interface+) (get-g-interface-definition type lisp-name-package))
+    ((g-type-is-a type +g-type-object+) (get-g-class-definition type lisp-name-package))
+    (t (error "Do not know how to automatically generate type definition for ~A type ~A"
+              (g-type-string (g-type-fundamental type))
+              (or (g-type-string type) type)))))
+
 (defun generate-types-hierarchy-to-file (file root-type &key include-referenced prefix package exceptions prologue interfaces enums flags objects exclusions additional-properties)
   (if (not (streamp file))
       (with-open-file (stream file :direction :output :if-exists :supersede)
index fc9eb7d..8299b02 100644 (file)
            #:define-cb-methods
            #:create-fn-ref
            #:copy-boxed-slots-to-foreign
-           #:with-foreign-boxed-array)
+           #:with-foreign-boxed-array
+           #:get-g-type-definition)
   (:documentation
    "CL-GTK2-GOBJECT is a binding to GObject type system.
 For information on GObject, see its @a[http://library.gnome.org/devel/gobject/stable/]{documentation}.