From ef6b544fe2a359cb98539f71ab2722a5887cf43d Mon Sep 17 00:00:00 2001 From: Dmitry Kalyanov Date: Sat, 11 Jul 2009 13:05:14 +0400 Subject: [PATCH] Move foreign library loading to gobject.init.lisp; separated gobject.type-info packags from gobject --- glib/cl-gtk2-glib.asd | 3 +- glib/gobject.init.lisp | 12 +++ glib/gobject.package.lisp | 9 +- glib/gobject.structs.lisp | 90 +++++++++++++------- glib/gobject.type-info.lisp | 193 +++++++++++++++++++++++++++++++++++++++++++ glib/gobject.type.lisp | 187 ----------------------------------------- 6 files changed, 269 insertions(+), 225 deletions(-) create mode 100644 glib/gobject.init.lisp create mode 100644 glib/gobject.type-info.lisp delete mode 100644 glib/gobject.type.lisp diff --git a/glib/cl-gtk2-glib.asd b/glib/cl-gtk2-glib.asd index 8ed16e6..d400d9c 100644 --- a/glib/cl-gtk2-glib.asd +++ b/glib/cl-gtk2-glib.asd @@ -8,9 +8,10 @@ (:file "glib.gstrv") (:file "glib.string") (:file "glib.quark") + (:file "gobject.init") + (:file "gobject.type-info") (:file "gobject.package") (:file "gobject.structs") - (:file "gobject.type") (:file "gobject.enum") (:file "gobject.boxed") (:file "gobject.gvalue") diff --git a/glib/gobject.init.lisp b/glib/gobject.init.lisp new file mode 100644 index 0000000..34ae64f --- /dev/null +++ b/glib/gobject.init.lisp @@ -0,0 +1,12 @@ +(defpackage :cl-gtk2-init + (:use :cl)) + +(in-package :cl-gtk2-init) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (cffi:define-foreign-library gobject + (:unix (:or "libgobject-2.0.so.0" "libgobject-2.0.so")) + (t "libgobject-2.0"))) + +(cffi:use-foreign-library gobject) + diff --git a/glib/gobject.package.lisp b/glib/gobject.package.lisp index ccd59c4..8884249 100644 --- a/glib/gobject.package.lisp +++ b/glib/gobject.package.lisp @@ -1,5 +1,5 @@ (defpackage :gobject - (:use :cl :glib :cffi :tg :bordeaux-threads :iter :closer-mop) + (:use :cl :glib :cffi :tg :bordeaux-threads :iter :closer-mop :gobject.type-info) (:export #:+g-type-invalid+ #:+g-type-void+ #:+g-type-interface+ @@ -153,13 +153,6 @@ GObject uses GValues as a generic way to pass values. It is used when calling cl (in-package :gobject) -(eval-when (:compile-toplevel :load-toplevel :execute) - (define-foreign-library gobject - (:unix (:or "libgobject-2.0.so.0" "libgobject-2.0.so")) - (t "libgobject-2.0"))) - -(use-foreign-library gobject) - (defvar *gobject-debug* nil) (defun debugf (&rest args) diff --git a/glib/gobject.structs.lisp b/glib/gobject.structs.lisp index 175dcd2..31945c6 100644 --- a/glib/gobject.structs.lisp +++ b/glib/gobject.structs.lisp @@ -1,7 +1,5 @@ (in-package :gobject) -(defctype g-type gsize) - (defcstruct g-type-interface (type g-type) (instance-type g-type)) @@ -58,32 +56,6 @@ (:abstract #. (ash 1 4)) :value-abstract) -(eval-when (:load-toplevel :compile-toplevel) - (defun gtype-make-fundamental-type (x) - (ash x 2))) - -(defconstant +g-type-invalid+ (gtype-make-fundamental-type 0)) -(defconstant +g-type-void+ (gtype-make-fundamental-type 1)) -(defconstant +g-type-interface+ (gtype-make-fundamental-type 2)) -(defconstant +g-type-char+ (gtype-make-fundamental-type 3)) -(defconstant +g-type-uchar+ (gtype-make-fundamental-type 4)) -(defconstant +g-type-boolean+ (gtype-make-fundamental-type 5)) -(defconstant +g-type-int+ (gtype-make-fundamental-type 6)) -(defconstant +g-type-uint+ (gtype-make-fundamental-type 7)) -(defconstant +g-type-long+ (gtype-make-fundamental-type 8)) -(defconstant +g-type-ulong+ (gtype-make-fundamental-type 9)) -(defconstant +g-type-int64+ (gtype-make-fundamental-type 10)) -(defconstant +g-type-uint64+ (gtype-make-fundamental-type 11)) -(defconstant +g-type-enum+ (gtype-make-fundamental-type 12)) -(defconstant +g-type-flags+ (gtype-make-fundamental-type 13)) -(defconstant +g-type-float+ (gtype-make-fundamental-type 14)) -(defconstant +g-type-double+ (gtype-make-fundamental-type 15)) -(defconstant +g-type-string+ (gtype-make-fundamental-type 16)) -(defconstant +g-type-pointer+ (gtype-make-fundamental-type 17)) -(defconstant +g-type-boxed+ (gtype-make-fundamental-type 18)) -(defconstant +g-type-param+ (gtype-make-fundamental-type 19)) -(defconstant +g-type-object+ (gtype-make-fundamental-type 20)) - (defcstruct %g-object (type-instance g-type-instance) (ref-count :uint) @@ -284,4 +256,64 @@ (private-data :uint32) (marshal :pointer) (data :pointer) - (notifiers :pointer)) \ No newline at end of file + (notifiers :pointer)) + +(defcfun g-type-class-ref (:pointer g-type-class) + (type g-type-designator)) + +(defcfun g-type-class-unref :void + (class (:pointer g-type-class))) + +(defcfun g-type-class-add-private :void + (class (:pointer g-type-class)) + (private-size gsize)) + +(defcfun g-type-register-static g-type-designator + (parent-type g-type-designator) + (type-name :string) + (info (:pointer g-type-info)) + (flags g-type-flags)) + +(defcfun g-type-register-static-simple g-type-designator + (parent-type g-type-designator) + (type-name :string) + (class-size :uint) + (class-init :pointer) + (instance-size :uint) + (instance-init :pointer) + (flags g-type-flags)) + +(defcfun g-type-add-interface-static :void + (instance-type g-type-designator) + (interface-type g-type-designator) + (info (:pointer g-interface-info))) + +(defcfun g-type-interface-add-prerequisite :void + (interface-type g-type-designator) + (prerequisite-type g-type-designator)) + +(defun g-type-from-object (object) + "Returns the GType of an @code{object} + +@arg[object]{C pointer to an object} +@return{GType designator (see @class{g-type-designator})}" + (g-type-from-instance object)) + +(defun g-type-from-class (g-class) + (g-type-name (foreign-slot-value g-class 'g-type-class 'type))) + +(defun g-type-from-instance (type-instance) + (g-type-from-class (foreign-slot-value type-instance 'g-type-instance 'class))) + +(defun g-type-from-interface (type-interface) + (g-type-name (foreign-slot-value type-interface 'g-type-interface 'type))) + +(defcfun g-type-query :void + (type g-type-designator) + (query (:pointer g-type-query))) + +(defcfun g-type-default-interface-ref :pointer + (type g-type-designator)) + +(defcfun g-type-default-interface-unref :void + (interface :pointer)) \ No newline at end of file diff --git a/glib/gobject.type-info.lisp b/glib/gobject.type-info.lisp new file mode 100644 index 0000000..b56cc6a --- /dev/null +++ b/glib/gobject.type-info.lisp @@ -0,0 +1,193 @@ +(defpackage :gobject.type-info + (:use :cl :iter :cffi :glib) + (:export #:+g-type-invalid+ + #:+g-type-void+ + #:+g-type-interface+ + #:+g-type-char+ + #:+g-type-uchar+ + #:+g-type-boolean+ + #:+g-type-int+ + #:+g-type-uint+ + #:+g-type-long+ + #:+g-type-ulong+ + #:+g-type-int64+ + #:+g-type-uint64+ + #:+g-type-enum+ + #:+g-type-flags+ + #:+g-type-float+ + #:+g-type-double+ + #:+g-type-string+ + #:+g-type-pointer+ + #:+g-type-boxed+ + #:+g-type-param+ + #:+g-type-object+ + #:g-type-name + #:g-type-from-name + #:g-type + #:g-type-children + #:g-type-parent + #:g-type-designator + #:g-type-fundamental + #:g-type-depth + #:g-type-next-base + #:g-type-is-a + #:g-type-interfaces + #:g-type-interface-prerequisites + #:g-strv-get-type + #:g-closure-get-type)) + +(in-package :gobject.type-info) + +(defctype g-type gsize) + +(eval-when (:load-toplevel :compile-toplevel) + (defun gtype-make-fundamental-type (x) + (ash x 2))) + +(defconstant +g-type-invalid+ (gtype-make-fundamental-type 0)) +(defconstant +g-type-void+ (gtype-make-fundamental-type 1)) +(defconstant +g-type-interface+ (gtype-make-fundamental-type 2)) +(defconstant +g-type-char+ (gtype-make-fundamental-type 3)) +(defconstant +g-type-uchar+ (gtype-make-fundamental-type 4)) +(defconstant +g-type-boolean+ (gtype-make-fundamental-type 5)) +(defconstant +g-type-int+ (gtype-make-fundamental-type 6)) +(defconstant +g-type-uint+ (gtype-make-fundamental-type 7)) +(defconstant +g-type-long+ (gtype-make-fundamental-type 8)) +(defconstant +g-type-ulong+ (gtype-make-fundamental-type 9)) +(defconstant +g-type-int64+ (gtype-make-fundamental-type 10)) +(defconstant +g-type-uint64+ (gtype-make-fundamental-type 11)) +(defconstant +g-type-enum+ (gtype-make-fundamental-type 12)) +(defconstant +g-type-flags+ (gtype-make-fundamental-type 13)) +(defconstant +g-type-float+ (gtype-make-fundamental-type 14)) +(defconstant +g-type-double+ (gtype-make-fundamental-type 15)) +(defconstant +g-type-string+ (gtype-make-fundamental-type 16)) +(defconstant +g-type-pointer+ (gtype-make-fundamental-type 17)) +(defconstant +g-type-boxed+ (gtype-make-fundamental-type 18)) +(defconstant +g-type-param+ (gtype-make-fundamental-type 19)) +(defconstant +g-type-object+ (gtype-make-fundamental-type 20)) + +(define-foreign-type g-type-designator () + () + (:documentation "Values of this type identify the GType. GType is designated by a its name (a string) or a numeric identifier. Functions accept GType designators as a string or integer and return them as a string. Functions @fun{g-type-name} and @fun{g-type-from-name} are used to convert between name and numeric identifier.") + (:actual-type g-type) + (:simple-parser g-type-designator)) + +(defmethod translate-from-foreign (value (type g-type-designator)) + (g-type-name value)) + +(defmethod translate-to-foreign (value (type g-type-designator)) + (etypecase value + (string (g-type-from-name value)) + (integer value) + (null +g-type-invalid+))) + +(defcfun (g-type-fundamental "g_type_fundamental") g-type-designator + "Returns the fundamental type which is the ancestor of @code{type}. +@arg[type]{GType designator (see @class{g-type-fundamental})} +@return{GType designator}" + (type g-type-designator)) + +(defcfun (%g-type-init "g_type_init") :void) + +(at-init () (%g-type-init)) + +(defcfun (g-type-name "g_type_name") :string + "Returns the name of a GType. + +@arg[type]{GType designator (see @class{g-type-designator})} +@return{a string}" + (type g-type-designator)) + +(defcfun (g-type-from-name "g_type_from_name") g-type + "Returns the numeric identifier of a GType by its name + +@arg[name]{a string - name of GType} +@return{an integer}" + (name :string)) + +(defcfun g-type-parent g-type-designator + "Returns the parent of a GType + +@arg[type]{GType designator (see @class{g-type-designator})} +@return{GType designator}" + (type g-type-designator)) + +(defcfun g-type-depth :uint + "Returns the length of the ancestry of @code{type}. This includes the @code{type} itself, so that e.g. a fundamental type has depth 1. +@arg[type]{GType designator (see @class{g-type-designator})} +@return{an integer}" + (type g-type-designator)) + +(defcfun g-type-next-base g-type-designator + "Determines the type that is derived directly from @code{root-type} which is also a base class of @code{leaf-type}. +@arg[leaf-type]{GType designator (see @class{g-type-designator})} +@arg[root-type]{GType designator} +@return{GType designator}" + (leaf-type g-type-designator) + (root-type g-type-designator)) + +(defcfun g-type-is-a :boolean + "If @code{is-a-type} is a derivable type, check whether type is a descendant of @code{is-a-type}. If @code{is-a-type} is an interface, check whether type conforms to it. +@arg[type]{GType designator (see @class{g-type-designator})} +@arg[is-a-type]{GType designator} +@return{boolean}" + (type g-type-designator) + (is-a-type g-type-designator)) + +(defcfun (%g-type-children "g_type_children") (:pointer g-type) + (type g-type-designator) + (n-children (:pointer :uint))) + +(defun g-type-children (g-type) + "Returns the list of types inherited from @code{g-type}. + +@arg[g-type]{GType designator (see @class{g-type-designator})} +@return{list of GType designators}" + (with-foreign-object (n-children :uint) + (let ((g-types-ptr (%g-type-children g-type n-children))) + (prog1 + (loop + for i from 0 below (mem-ref n-children :uint) + collect (mem-aref g-types-ptr 'g-type-designator i)) + (g-free g-types-ptr))))) + +(defcfun (%g-type-interfaces "g_type_interfaces") (:pointer g-type) + (type g-type-designator) + (n-interfaces (:pointer :uint))) + +(defun g-type-interfaces (g-type) + "Returns the list of interfaces the @code{g-type} conforms to. + +@arg[g-type]{GType designator (see @class{g-type-designator})} +@return{list of GType designators}" + (with-foreign-object (n-interfaces :uint) + (let ((g-types-ptr (%g-type-interfaces g-type n-interfaces))) + (prog1 + (loop + for i from 0 below (mem-ref n-interfaces :uint) + collect (mem-aref g-types-ptr 'g-type-designator i)) + (g-free g-types-ptr))))) + +(defcfun (%g-type-interface-prerequisites "g_type_interface_prerequisites") (:pointer g-type) + (type g-type-designator) + (n-interface-prerequisites (:pointer :uint))) + +(defun g-type-interface-prerequisites (g-type) + "Returns the prerequisites of an interface type. Prerequisite is a type that must be a superclass of an implementing class or an interface that the object must also implement. +@arg[g-type]{GType designator (see @class{g-type-designator})} +@return{list of GType designators}" + (with-foreign-object (n-interface-prerequisites :uint) + (let ((g-types-ptr (%g-type-interface-prerequisites g-type n-interface-prerequisites))) + (prog1 + (loop + for i from 0 below (mem-ref n-interface-prerequisites :uint) + collect (mem-aref g-types-ptr 'g-type-designator i)) + (g-free g-types-ptr))))) + +(defcfun g-strv-get-type g-type-designator) + +(at-init nil (g-strv-get-type)) + +(defcfun g-closure-get-type g-type-designator) + +(at-init nil (g-closure-get-type)) diff --git a/glib/gobject.type.lisp b/glib/gobject.type.lisp deleted file mode 100644 index 834d894..0000000 --- a/glib/gobject.type.lisp +++ /dev/null @@ -1,187 +0,0 @@ -(in-package :gobject) - -(define-foreign-type g-type-designator () - () - (:documentation "Values of this type identify the GType. GType is designated by a its name (a string) or a numeric identifier. Functions accept GType designators as a string or integer and return them as a string. Functions @fun{g-type-name} and @fun{g-type-from-name} are used to convert between name and numeric identifier.") - (:actual-type g-type) - (:simple-parser g-type-designator)) - -(defmethod translate-from-foreign (value (type g-type-designator)) - (g-type-name value)) - -(defmethod translate-to-foreign (value (type g-type-designator)) - (etypecase value - (string (g-type-from-name value)) - (integer value) - (null +g-type-invalid+))) - -(defcfun (g-type-fundamental "g_type_fundamental") g-type-designator - "Returns the fundamental type which is the ancestor of @code{type}. -@arg[type]{GType designator (see @class{g-type-fundamental})} -@return{GType designator}" - (type g-type-designator)) - -(defcfun (%g-type-init "g_type_init") :void) - -(at-init () (%g-type-init)) - -(defcfun (g-type-name "g_type_name") :string - "Returns the name of a GType. - -@arg[type]{GType designator (see @class{g-type-designator})} -@return{a string}" - (type g-type-designator)) - -(defcfun (g-type-from-name "g_type_from_name") g-type - "Returns the numeric identifier of a GType by its name - -@arg[name]{a string - name of GType} -@return{an integer}" - (name :string)) - -(defcfun g-type-parent g-type-designator - "Returns the parent of a GType - -@arg[type]{GType designator (see @class{g-type-designator})} -@return{GType designator}" - (type g-type-designator)) - -(defcfun g-type-depth :uint - "Returns the length of the ancestry of @code{type}. This includes the @code{type} itself, so that e.g. a fundamental type has depth 1. -@arg[type]{GType designator (see @class{g-type-designator})} -@return{an integer}" - (type g-type-designator)) - -(defcfun g-type-next-base g-type-designator - "Determines the type that is derived directly from @code{root-type} which is also a base class of @code{leaf-type}. -@arg[leaf-type]{GType designator (see @class{g-type-designator})} -@arg[root-type]{GType designator} -@return{GType designator}" - (leaf-type g-type-designator) - (root-type g-type-designator)) - -(defcfun g-type-is-a :boolean - "If @code{is-a-type} is a derivable type, check whether type is a descendant of @code{is-a-type}. If @code{is-a-type} is an interface, check whether type conforms to it. -@arg[type]{GType designator (see @class{g-type-designator})} -@arg[is-a-type]{GType designator} -@return{boolean}" - (type g-type-designator) - (is-a-type g-type-designator)) - -(defcfun g-type-class-ref (:pointer g-type-class) - (type g-type-designator)) - -(defcfun g-type-class-unref :void - (class (:pointer g-type-class))) - -(defcfun g-type-class-add-private :void - (class (:pointer g-type-class)) - (private-size gsize)) - -(defcfun g-type-default-interface-ref :pointer - (type g-type-designator)) - -(defcfun g-type-default-interface-unref :void - (interface :pointer)) - -(defcfun (%g-type-children "g_type_children") (:pointer g-type) - (type g-type-designator) - (n-children (:pointer :uint))) - -(defun g-type-children (g-type) - "Returns the list of types inherited from @code{g-type}. - -@arg[g-type]{GType designator (see @class{g-type-designator})} -@return{list of GType designators}" - (with-foreign-object (n-children :uint) - (let ((g-types-ptr (%g-type-children g-type n-children))) - (prog1 - (loop - for i from 0 below (mem-ref n-children :uint) - collect (mem-aref g-types-ptr 'g-type-designator i)) - (g-free g-types-ptr))))) - -(defcfun (%g-type-interfaces "g_type_interfaces") (:pointer g-type) - (type g-type-designator) - (n-interfaces (:pointer :uint))) - -(defun g-type-interfaces (g-type) - "Returns the list of interfaces the @code{g-type} conforms to. - -@arg[g-type]{GType designator (see @class{g-type-designator})} -@return{list of GType designators}" - (with-foreign-object (n-interfaces :uint) - (let ((g-types-ptr (%g-type-interfaces g-type n-interfaces))) - (prog1 - (loop - for i from 0 below (mem-ref n-interfaces :uint) - collect (mem-aref g-types-ptr 'g-type-designator i)) - (g-free g-types-ptr))))) - -(defcfun (%g-type-interface-prerequisites "g_type_interface_prerequisites") (:pointer g-type) - (type g-type-designator) - (n-interface-prerequisites (:pointer :uint))) - -(defun g-type-interface-prerequisites (g-type) - "Returns the prerequisites of an interface type. Prerequisite is a type that must be a superclass of an implementing class or an interface that the object must also implement. -@arg[g-type]{GType designator (see @class{g-type-designator})} -@return{list of GType designators}" - (with-foreign-object (n-interface-prerequisites :uint) - (let ((g-types-ptr (%g-type-interface-prerequisites g-type n-interface-prerequisites))) - (prog1 - (loop - for i from 0 below (mem-ref n-interface-prerequisites :uint) - collect (mem-aref g-types-ptr 'g-type-designator i)) - (g-free g-types-ptr))))) - -(defcfun g-type-register-static g-type-designator - (parent-type g-type-designator) - (type-name :string) - (info (:pointer g-type-info)) - (flags g-type-flags)) - -(defcfun g-type-register-static-simple g-type-designator - (parent-type g-type-designator) - (type-name :string) - (class-size :uint) - (class-init :pointer) - (instance-size :uint) - (instance-init :pointer) - (flags g-type-flags)) - -(defcfun g-type-add-interface-static :void - (instance-type g-type-designator) - (interface-type g-type-designator) - (info (:pointer g-interface-info))) - -(defcfun g-type-interface-add-prerequisite :void - (interface-type g-type-designator) - (prerequisite-type g-type-designator)) - -(defun g-type-from-object (object) - "Returns the GType of an @code{object} - -@arg[object]{C pointer to an object} -@return{GType designator (see @class{g-type-designator})}" - (g-type-from-instance object)) - -(defun g-type-from-class (g-class) - (g-type-name (foreign-slot-value g-class 'g-type-class 'type))) - -(defun g-type-from-instance (type-instance) - (g-type-from-class (foreign-slot-value type-instance 'g-type-instance 'class))) - -(defun g-type-from-interface (type-interface) - (g-type-name (foreign-slot-value type-interface 'g-type-interface 'type))) - -(defcfun g-strv-get-type g-type-designator) - -(at-init nil (g-strv-get-type)) - -(defcfun g-closure-get-type g-type-designator) - -(at-init nil (g-closure-get-type)) - -(defcfun g-type-query :void - (type g-type-designator) - (query (:pointer g-type-query))) \ No newline at end of file -- 1.7.10.4