From ddaa0292b675c0336e20dfcca1ce3c7dcfc8ccee Mon Sep 17 00:00:00 2001 From: Dmitry Kalyanov Date: Sun, 12 Jul 2009 10:25:40 +0400 Subject: [PATCH] refactoring: separated gobject.ffi with ffi definitions --- glib/cl-gtk2-glib.asd | 10 +- glib/gobject.boxed.lisp | 17 - glib/gobject.closures.lisp | 31 - glib/gobject.enum.lisp | 9 - glib/gobject.ffi.lisp | 984 +++++++++++++++++++++++++ glib/gobject.ffi.package.lisp | 196 +++++ glib/gobject.foreign-closures.lisp | 13 +- glib/gobject.foreign-gobject-subclassing.lisp | 31 +- glib/gobject.foreign-gobject.lisp | 17 +- glib/gobject.gobject-query.lisp | 36 +- glib/gobject.gparams.lisp | 326 -------- glib/gobject.gvalue-parser.lisp | 2 +- glib/gobject.gvalue.lisp | 28 - glib/gobject.object.lisp | 110 --- glib/gobject.package.lisp | 2 +- glib/gobject.signals.lisp | 44 +- glib/gobject.structs.lisp | 307 +------- glib/gobject.type-designator.lisp | 48 ++ glib/gobject.type-info.lisp | 142 +--- gtk/gtk.widget.lisp | 38 +- 20 files changed, 1310 insertions(+), 1081 deletions(-) delete mode 100644 glib/gobject.boxed.lisp delete mode 100644 glib/gobject.closures.lisp delete mode 100644 glib/gobject.enum.lisp create mode 100644 glib/gobject.ffi.lisp create mode 100644 glib/gobject.ffi.package.lisp delete mode 100644 glib/gobject.gparams.lisp delete mode 100644 glib/gobject.object.lisp create mode 100644 glib/gobject.type-designator.lisp diff --git a/glib/cl-gtk2-glib.asd b/glib/cl-gtk2-glib.asd index d400d9c..e843528 100644 --- a/glib/cl-gtk2-glib.asd +++ b/glib/cl-gtk2-glib.asd @@ -9,16 +9,16 @@ (:file "glib.string") (:file "glib.quark") (:file "gobject.init") + + (:file "gobject.ffi.package") + (:file "gobject.type-designator") + (:file "gobject.ffi") (:file "gobject.type-info") + (:file "gobject.package") (:file "gobject.structs") - (:file "gobject.enum") - (:file "gobject.boxed") (:file "gobject.gvalue") - (:file "gobject.gparams") - (:file "gobject.closures") (:file "gobject.signals") - (:file "gobject.object") (:file "gobject.foreign") (:file "gobject.foreign-gobject") (:file "gobject.foreign-closures") diff --git a/glib/gobject.boxed.lisp b/glib/gobject.boxed.lisp deleted file mode 100644 index aecec85..0000000 --- a/glib/gobject.boxed.lisp +++ /dev/null @@ -1,17 +0,0 @@ -(in-package :gobject) - -(defcfun g-boxed-copy :pointer - (boxed-type g-type-designator) - (src-boxed :pointer)) - -(defcfun g-boxed-free :void - (boxed-type g-type-designator) - (boxed :pointer)) - -(defcfun g-boxed-type-register-static g-type-designator - (name :string) - (copy-fn :pointer) - (free-fn :pointer)) - -(defcfun g-pointer-type-register-static g-type-designator - (name :string)) \ No newline at end of file diff --git a/glib/gobject.closures.lisp b/glib/gobject.closures.lisp deleted file mode 100644 index 26c8e71..0000000 --- a/glib/gobject.closures.lisp +++ /dev/null @@ -1,31 +0,0 @@ -(in-package :gobject) - -(defcfun g-closure-ref (:pointer g-closure) - (closure (:pointer g-closure))) - -(defcfun g-closure-sink :void - (closure (:pointer g-closure))) - -(defcfun g-closure-unref :void - (closure (:pointer g-closure))) - -(defcfun g-closure-invalidate :void - (closure (:pointer g-closure))) - -(defcfun g-closure-add-finalize-notifier :void - (closure (:pointer g-closure)) - (notify-data :pointer) - (notify-func :pointer)) - -(defcfun g-closure-add-invalidate-notifier :void - (closure (:pointer g-closure)) - (notify-data :pointer) - (notify-func :pointer)) - -(defcfun g-closure-new-simple (:pointer g-closure) - (sizeof-closure :uint) - (data :pointer)) - -(defcfun g-closure-set-marshal :void - (closure (:pointer g-closure)) - (marshal :pointer)) \ No newline at end of file diff --git a/glib/gobject.enum.lisp b/glib/gobject.enum.lisp deleted file mode 100644 index ed86b28..0000000 --- a/glib/gobject.enum.lisp +++ /dev/null @@ -1,9 +0,0 @@ -(in-package :gobject) - -(defcfun g-enum-register-static g-type-designator - (name :string) - (static-values (:pointer g-enum-value))) - -(defcfun g-flags-register-static g-type-designator - (name :string) - (static-values (:pointer g-flags-value))) \ No newline at end of file diff --git a/glib/gobject.ffi.lisp b/glib/gobject.ffi.lisp new file mode 100644 index 0000000..319939d --- /dev/null +++ b/glib/gobject.ffi.lisp @@ -0,0 +1,984 @@ +(in-package :gobject.ffi) + +(defcfun (g-type-fundamental "g_type_fundamental") g-type-designator + "Returns the fundamental type which is the ancestor of @code{type}. + +Example: +@pre{ +\(g-type-fundamental \"GtkWindowType\") +=> \"GEnum\" +\(g-type-fundamental \"GtkLabel\") +=> \"GObject\" +} +@arg[type]{GType designator (see @class{g-type-designator})} +@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.@see{g-type-from-name} + +Example: +@pre{ +\(g-type-from-name \"GtkLabel\") +=> 7151952 +\(g-type-name 7151952) +=> \"GtkLabel\" +} +@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. @see{g-type-name} + +Example: +@pre{ +\(g-type-from-name \"GtkLabel\") +=> 7151952 +\(g-type-name 7151952) +=> \"GtkLabel\" +} +@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. @see{g-type-chilren} + +Example: +@pre{ +\(g-type-parent \"GtkLabel\") +=> \"GtkMisc\" +} +@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. + +Example: +@pre{ +\(g-type-depth \"GtkLabel\") +=> 6 +} +@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}. + +Example: +@pre{ +\(g-type-next-base \"GtkButton\" \"GtkWidget\") +=> \"GtkContainer\" +} +@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. + +Example: +@pre{ +\(g-type-is-a \"GtkButton\" \"GtkWidget\") +=> T +\(g-type-is-a \"GtkButton\" \"AtkImplementorIface\") +=> T +\(g-type-is-a \"GtkButton\" \"GtkLabel\") +=> NIL +} +@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))) + +(defcfun (%g-type-interface-prerequisites "g_type_interface_prerequisites") (:pointer g-type) + (type g-type-designator) + (n-interface-prerequisites (:pointer :uint))) + +(defcfun g-strv-get-type g-type-designator + "Returns the type designator (see @class{g-type-designator}) for GStrv type. As a side effect, ensures that the type is registered.") + +(at-init nil (g-strv-get-type)) + +(defcfun g-closure-get-type g-type-designator + "Returns the type designator (see @class{g-type-designator}) for GClosure type. As a side effect, ensure that the type is registered.") + +(at-init nil (g-closure-get-type)) + +(defcfun (%g-type-interfaces "g_type_interfaces") (:pointer g-type) + (type g-type-designator) + (n-interfaces (:pointer :uint))) + +(defcstruct g-type-interface + (:type g-type) + (:instance-type g-type)) + +(defcstruct g-type-class + (:type g-type)) + +(defcstruct g-type-instance + (:class (:pointer g-type-class))) + +(defcstruct g-type-info + (:class-size :uint16) + (:base-init-fn :pointer) + (:base-finalize-fn :pointer) + (:class-init-fn :pointer) + (:class-finalize-fn :pointer) + (:class-data :pointer) + (:instance-size :uint16) + (:n-preallocs :uint16) + (:instance-init-fn :pointer) + (:value-table :pointer)) + +(defcstruct g-type-query + (:type g-type) + (:type-name (:string :free-from-foreign nil)) + (:class-size :uint) + (:instance-size :uint)) + +(defbitfield g-type-fundamental-flags + :classed + :instantiatable + :derivable + :deep-derivable) + +(defcstruct g-type-fundamental-info + (:type-flags g-type-fundamental-flags)) + +(defcstruct g-interface-info + (:interface-init :pointer) + (:interface-finalize :pointer) + (:interface-data :pointer)) + +(defcstruct g-type-value-table + (:value-init :pointer) + (:value-free :pointer) + (:value-copy :pointer) + (:value-peek-pointer :pointer) + (:collect-format (:string :free-from-foreign nil :free-to-foreign nil)) + (:collect-value :pointer) + (:lcopy-format (:string :free-from-foreign nil :free-to-foreign nil)) + (:lcopy-value :pointer)) + +(defbitfield g-type-flags + (:abstract #. (ash 1 4)) + :value-abstract) + +(defcstruct %g-object + (:type-instance g-type-instance) + (:ref-count :uint) + (:data :pointer)) + +(defctype %g-initially-unowned %g-object) + +(defcstruct g-object-class + (:type-class g-type-class) + (:construct-properties :pointer) + (:constructor :pointer) + (:set-property :pointer) + (:get-property :pointer) + (:dispose :pointer) + (:finalize :pointer) + (:dispatch-properties-changed :pointer) + (:notify :pointer) + (:constructed :pointer) + (:pdummy :pointer :count 7)) + +(defbitfield g-param-flags + :readable + :writable + :construct + :construct-only + :lax-validation + :static-name + :nick + :blurb) + +(defcstruct g-param-spec + (:type-instance g-type-instance) + (:name (:string :free-from-foreign nil :free-to-foreign nil)) + (:flags g-param-flags) + (:value-type g-type) + (:owner-type g-type)) + +(defcunion g-value-data + (:int :int) + (:uint :uint) + (:long :long) + (:ulong :ulong) + (:int64 :int64) + (:uint64 :uint64) + (:float :float) + (:double :double) + (:pointer :pointer)) + +(defcstruct g-value + (:type g-type) + (:data g-value-data :count 2)) + +(defcstruct g-object-construct-param + (:param-spec (:pointer g-param-spec)) + (:value (:pointer g-value))) + +(defcstruct g-parameter + (:name (:string :free-from-foreign nil :free-to-foreign nil)) + (:value g-value)) + +(defcstruct g-enum-value + (:value :int) + (:name (:string :free-from-foreign nil :free-to-foreign nil)) + (:nick (:string :free-from-foreign nil :free-to-foreign nil))) + +(defcstruct g-enum-class + (:type-class g-type-class) + (:minimum :int) + (:maximum :int) + (:n-values :uint) + (:values (:pointer g-enum-value))) + +(defcstruct g-flags-value + (:value :uint) + (:name (:string :free-from-foreign nil :free-to-foreign nil)) + (:nick (:string :free-from-foreign nil :free-to-foreign nil))) + +(defcstruct g-flags-class + (:type-class g-type-class) + (:mask :uint) + (:n-values :uint) + (:values (:pointer g-flags-value))) + +(defcstruct g-param-spec-boolean + (:parent-instance g-param-spec) + (:default-value :boolean)) + +(defcstruct g-param-spec-char + (:parent-instance g-param-spec) + (:minimum :int8) + (:maximum :int8) + (:default-value :int8)) + +(defcstruct g-param-spec-uchar + (:parent-instance g-param-spec) + (:minimum :uint8) + (:maximum :uint8) + (:default-value :uint8)) + +(defcstruct g-param-spec-int + (:parent-instance g-param-spec) + (:minimum :int) + (:maximum :int) + (:default-value :int)) + +(defcstruct g-param-spec-uint + (:parent-instance g-param-spec) + (:minimum :uint) + (:maximum :uint) + (:default-value :uint)) + +(defcstruct g-param-spec-long + (:parent-instance g-param-spec) + (:minimum :long) + (:maximum :long) + (:default-value :ulong)) + +(defcstruct g-param-spec-ulong + (:parent-instance g-param-spec) + (:minimum :ulong) + (:maximum :ulong) + (:default-value :ulong)) + +(defcstruct g-param-spec-int64 + (:parent-instance g-param-spec) + (:minimum :uint64) + (:maximum :uint64) + (:default-value :uint64)) + +(defcstruct g-param-spec-uint64 + (:parent-instance g-param-spec) + (:minimum :uint64) + (:maximum :uint64) + (:default-value :uint64)) + +(defcstruct g-param-spec-float + (:parent-instance g-param-spec) + (:minimum :float) + (:maximum :float) + (:default-value :float) + (:epsilon :float)) + +(defcstruct g-param-spec-double + (:parent-instance g-param-spec) + (:minimum :double) + (:maximum :double) + (:default-value :double) + (:epsilon :double)) + +(defcstruct g-param-spec-enum + (:parent-instance g-param-spec) + (:enum-class (:pointer g-enum-class)) + (:default-value :int)) + +(defcstruct g-param-spec-flags + (:parent-instance g-param-spec) + (:flags-class (:pointer g-flags-class)) + (:default-value :uint)) + +(defcstruct g-param-spec-string + (:parent-instance g-param-spec) + (:default-value (:string :free-to-foreign nil :free-from-foreign nil)) + (:cset-first (:string :free-to-foreign nil :free-from-foreign nil)) + (:cset-nth (:string :free-to-foreign nil :free-from-foreign nil)) + (:substitutor :char) + (:flags-for-null :uint)) + +(defcstruct g-param-spec-param + (:parent-instance g-param-spec)) + +(defcstruct g-param-spec-boxed + (:parent-instance g-param-spec)) + +(defcstruct g-param-spec-pointer + (:parent-instance g-param-spec)) + +(defcstruct g-param-spec-object + (:parent-instance g-param-spec)) + +(defcstruct g-param-spec-value-array + (:parent-instance g-param-spec) + (:element-spec (:pointer g-param-spec)) + (:fixed-n-elements :uint)) + +(defcstruct g-param-spec-g-type + (:parent-instance g-param-spec) + (:types-root g-type)) + +(defcstruct g-param-spec-class + (:type-class g-type-class) + (:value-type g-type) + (:finalize :pointer) + (:value-set-default :pointer) + (:value-validate :pointer) + (:values-cmp :pointer)) + +(defcstruct g-closure + (:private-data :uint32) + (:marshal :pointer) + (:data :pointer) + (: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)) + +(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)) + +(defcfun g-boxed-copy :pointer + (boxed-type g-type-designator) + (src-boxed :pointer)) + +(defcfun g-boxed-free :void + (boxed-type g-type-designator) + (boxed :pointer)) + +(defcfun g-boxed-type-register-static g-type-designator + (name :string) + (copy-fn :pointer) + (free-fn :pointer)) + +(defcfun g-pointer-type-register-static g-type-designator + (name :string)) + +(defcfun g-closure-ref (:pointer g-closure) + (closure (:pointer g-closure))) + +(defcfun g-closure-sink :void + (closure (:pointer g-closure))) + +(defcfun g-closure-unref :void + (closure (:pointer g-closure))) + +(defcfun g-closure-invalidate :void + (closure (:pointer g-closure))) + +(defcfun g-closure-add-finalize-notifier :void + (closure (:pointer g-closure)) + (notify-data :pointer) + (notify-func :pointer)) + +(defcfun g-closure-add-invalidate-notifier :void + (closure (:pointer g-closure)) + (notify-data :pointer) + (notify-func :pointer)) + +(defcfun g-closure-new-simple (:pointer g-closure) + (sizeof-closure :uint) + (data :pointer)) + +(defcfun g-closure-set-marshal :void + (closure (:pointer g-closure)) + (marshal :pointer)) + +(defcfun g-enum-register-static g-type-designator + (name :string) + (static-values (:pointer g-enum-value))) + +(defcfun g-flags-register-static g-type-designator + (name :string) + (static-values (:pointer g-flags-value))) + +(defcfun g-param-spec-boolean (:pointer g-param-spec-boolean) + (name :string) + (nick :string) + (blurb :string) + (default-value :boolean) + (flags g-param-flags)) + +(defcfun g-value-set-boolean :void + (g-value (:pointer g-value)) + (new-value :boolean)) + +(defcfun g-value-get-boolean :boolean + (g-value (:pointer g-value))) + +(defcfun g-param-spec-char (:pointer g-param-spec-char) + (name :string) + (nick :string) + (blurb :string) + (minimum :int8) + (maximum :int8) + (default-value :int8) + (flags g-param-flags)) + +(defcfun g-value-set-char :void + (g-value (:pointer g-value)) + (new-value :char)) + +(defcfun g-value-get-char :char + (g-value (:pointer g-value))) + +(defcfun g-param-spec-uchar (:pointer g-param-spec-uchar) + (name :string) + (nick :string) + (blurb :string) + (minimum :uint8) + (maximum :uint8) + (default-value :uint8) + (flags g-param-flags)) + +(defcfun g-value-set-uchar :void + (g-value (:pointer g-value)) + (new-value :uchar)) + +(defcfun g-value-get-uchar :uchar + (g-value (:pointer g-value))) + +(defcfun g-param-spec-int (:pointer g-param-spec-int) + (name :string) + (nick :string) + (blurb :string) + (minimum :int) + (maximum :int) + (default-value :int) + (flags g-param-flags)) + +(defcfun g-value-set-int :void + (g-value (:pointer g-value)) + (new-value :int)) + +(defcfun g-value-get-int :int + (g-value (:pointer g-value))) + +(defcfun g-param-spec-uint (:pointer g-param-spec-uint) + (name :string) + (nick :string) + (blurb :string) + (minimum :uint) + (maximum :uint) + (default-value :uint) + (flags g-param-flags)) + +(defcfun g-value-set-uint :void + (g-value (:pointer g-value)) + (new-value :uint)) + +(defcfun g-value-get-uint :uint + (g-value (:pointer g-value))) + +(defcfun g-param-spec-long (:pointer g-param-spec-long) + (name :string) + (nick :string) + (blurb :string) + (minimum :long) + (maximum :long) + (default-value :long) + (flags g-param-flags)) + +(defcfun g-value-set-long :void + (g-value (:pointer g-value)) + (new-value :long)) + +(defcfun g-value-get-long :long + (g-value (:pointer g-value))) + +(defcfun g-param-spec-ulong (:pointer g-param-spec-ulong) + (name :string) + (nick :string) + (blurb :string) + (minimum :ulong) + (maximum :ulong) + (default-value :ulong) + (flags g-param-flags)) + +(defcfun g-value-set-ulong :void + (g-value (:pointer g-value)) + (new-value :ulong)) + +(defcfun g-value-get-ulong :ulong + (g-value (:pointer g-value))) + +(defcfun g-param-spec-int64 (:pointer g-param-spec-int64) + (name :string) + (nick :string) + (blurb :string) + (minimum :int64) + (maximum :int64) + (default-value :int64) + (flags g-param-flags)) + +(defcfun g-value-set-int64 :void + (g-value (:pointer g-value)) + (new-value :int64)) + +(defcfun g-value-get-int64 :int64 + (g-value (:pointer g-value))) + +(defcfun g-param-spec-uint64 (:pointer g-param-spec-uint64) + (name :string) + (nick :string) + (blurb :string) + (minimum :uint64) + (maximum :uint64) + (default-value :uint64) + (flags g-param-flags)) + +(defcfun g-value-set-uint64 :void + (g-value (:pointer g-value)) + (new-value :uint64)) + +(defcfun g-value-get-uint64 :uint64 + (g-value (:pointer g-value))) + +(defcfun g-param-spec-float (:pointer g-param-spec-float) + (name :string) + (nick :string) + (blurb :string) + (minimum :float) + (maximum :float) + (default-value :float) + (flags g-param-flags)) + +(defcfun g-value-set-float :void + (g-value (:pointer g-value)) + (new-value :float)) + +(defcfun g-value-get-float :float + (g-value (:pointer g-value))) + +(defcfun g-param-spec-double (:pointer g-param-spec-double) + (name :string) + (nick :string) + (blurb :string) + (minimum :double) + (maximum :double) + (default-value :double) + (flags g-param-flags)) + +(defcfun g-value-set-double :void + (g-value (:pointer g-value)) + (new-value :double)) + +(defcfun g-value-get-double :double + (g-value (:pointer g-value))) + +(defcfun g-param-spec-enum (:pointer g-param-spec-enum) + (name :string) + (nick :string) + (blurb :string) + (enum-type g-type-designator) + (default-value :int) + (flags g-param-flags)) + +(defcfun g-value-set-enum :void + (g-value (:pointer g-value)) + (new-value :int)) + +(defcfun g-value-get-enum :int + (g-value (:pointer g-value))) + +(defcfun g-param-spec-flags (:pointer g-param-spec-flags) + (name :string) + (nick :string) + (blurb :string) + (flags-type g-type-designator) + (default-value :int) + (flags g-param-flags)) + +(defcfun g-value-set-flags :void + (g-value (:pointer g-value)) + (new-value :int)) + +(defcfun g-value-get-flags :int + (g-value (:pointer g-value))) + +(defcfun g-param-spec-string (:pointer g-param-spec-string) + (name :string) + (nick :string) + (blurb :string) + (default-value :string) + (flags g-param-flags)) + +(defcfun g-value-set-string :void + (g-value (:pointer g-value)) + (new-value :string)) + +(defcfun g-value-get-string (:string :free-from-foreign nil) + (g-value (:pointer g-value))) + +(defcfun g-param-spec-param (:pointer g-param-spec-param) + (name :string) + (nick :string) + (blurb :string) + (param-type g-type-designator) + (flags g-param-flags)) + +(defcfun g-value-set-param :void + (g-value (:pointer g-value)) + (new-value (:pointer g-param-spec))) + +(defcfun g-value-get-param (:pointer g-param-spec) + (g-value (:pointer g-value))) + +(defcfun g-param-spec-boxed (:pointer g-param-spec-boxed) + (name :string) + (nick :string) + (blurb :string) + (boxed-type g-type-designator) + (flags g-param-flags)) + +(defcfun g-value-set-boxed :void + (g-value (:pointer g-value)) + (new-value :pointer)) + +(defcfun g-value-take-boxed :void + (g-value (:pointer g-value)) + (new-value :pointer)) + +(defcfun g-value-get-boxed :pointer + (g-value (:pointer g-value))) + +(defcfun g-param-spec-pointer (:pointer g-param-spec-pointer) + (name :string) + (nick :string) + (blurb :string) + (flags g-param-flags)) + +(defcfun g-value-set-pointer :void + (g-value (:pointer g-value)) + (new-value :pointer)) + +(defcfun g-value-get-pointer :pointer + (g-value (:pointer g-value))) + +(defcfun g-param-spec-object (:pointer g-param-spec-object) + (name :string) + (nick :string) + (blurb :string) + (object-type g-type-designator) + (flags g-param-flags)) + +(defcfun g-value-set-object :void + (g-value (:pointer g-value)) + (new-value :pointer)) + +(defcfun g-value-get-object :pointer + (g-value (:pointer g-value))) + +(defcfun g-param-spec-value-array (:pointer g-param-spec-value-array) + (name :string) + (nick :string) + (blurb :string) + (element-spec (:pointer g-param-spec)) + (flags g-param-flags)) + +(defcfun (g-param-spec-g-type "g_param_spec_gtype") (:pointer g-param-spec-g-type) + (name :string) + (nick :string) + (blurb :string) + (types-root g-type-designator) + (flags g-param-flags)) + +(defcfun (g-value-set-g-type "g_value_set_gtype") :void + (g-value (:pointer g-value)) + (new-value g-type-designator)) + +(defcfun (g-value-get-g-type "g_value_get_gtype") g-type-designator + (g-value (:pointer g-value))) + +(defcfun g-param-spec-ref-sink (:pointer g-param-spec) + (param-spec (:pointer g-param-spec))) + +(defcfun g-param-spec-unref :void + (param-spec (:pointer g-param-spec))) + +(defcfun g-param-value-set-default :void + (param-spec (:pointer g-param-spec)) + (value (:pointer g-value))) + +(defcfun g-param-value-defaults :boolean + (param-spec (:pointer g-param-spec)) + (value (:pointer g-value))) + +(defcfun g-param-value-validate :boolean + (param-spec (:pointer g-param-spec)) + (value (:pointer g-value))) + +(defcfun g-param-spec-get-name :string + (param-spec (:pointer g-param-spec))) + +(defcfun g-param-spec-get-nick :string + (param-spec (:pointer g-param-spec))) + +(defcfun g-param-spec-get-blurb :string + (param-spec (:pointer g-param-spec))) + +(defcfun g-value-init (:pointer g-value) + "Initializes the GValue @code{value} with the default value of @code{type} + +@arg[value]{a C pointer to the GValue structure} +@arg[type]{an integer specifying the GType}" + (value (:pointer g-value)) + (type g-type-designator)) + +(defcfun g-value-copy :void + (src-value (:pointer g-value)) + (dst-value (:pointer g-value))) + +(defcfun g-value-reset (:pointer g-value) + (value (:pointer g-value))) + +(defcfun g-value-unset (:pointer g-value) + "Clears the current value in @code{value} and \"unsets\" the type, releasing all resources associated with this GValue. An unset value is the same as an unitialized GValue. + +@arg[value]{a C pointer to the GValue structure}" + (value (:pointer g-value))) + +(defcfun g-value-set-instance :void + (value (:pointer g-value)) + (instance :pointer)) + +(defcfun g-strdup-value-contents :string + (value (:pointer g-value))) + +(defcfun g-object-class-install-property :void + (class (:pointer g-object-class)) + (property-id :uint) + (param-spec (:pointer g-param-spec))) + +(defcfun g-object-class-find-property (:pointer g-param-spec) + (class (:pointer g-object-class)) + (property-name :string)) + +(defcfun g-object-class-list-properties (:pointer (:pointer g-param-spec)) + (class (:pointer g-object-class)) + (n-properties (:pointer :uint))) + +(defcfun g-object-class-override-property :void + (class (:pointer g-object-class)) + (property-id :uint) + (name :string)) + +(defcfun g-object-interface-install-property :void + (interface :pointer) + (param-spec (:pointer g-param-spec))) + +(defcfun g-object-interface-find-property (:pointer g-param-spec) + (interface :pointer) + (property-name :string)) + +(defcfun g-object-interface-list-properties (:pointer g-param-spec) + (interface :pointer) + (n-properties (:pointer :uint))) + +(defcfun g-object-newv :pointer + (object-type g-type-designator) + (n-parameter :uint) + (parameters (:pointer g-parameter))) + +(defcfun g-object-ref :pointer + (object :pointer)) + +(defcfun g-object-unref :void + (object :pointer)) + +(defcfun g-object-ref-sink :pointer + (object :pointer)) + +(defcfun g-object-is-floating :boolean + (object :pointer)) + +(defcfun g-object-force-floating :void + (object :pointer)) + +(defcfun g-object-weak-ref :void + (object :pointer) + (notify :pointer) + (data :pointer)) + +(defcfun g-object-weak-unref :void + (object :pointer) + (notify :pointer) + (data :pointer)) + +(defcfun g-object-add-toggle-ref :void + (object :pointer) + (notifty :pointer) + (data :pointer)) + +(defcfun g-object-remove-toggle-ref :void + (object :pointer) + (notifty :pointer) + (data :pointer)) + +(defcfun g-object-notify :void + (object :pointer) + (property-name :string)) + +(defcfun g-object-freeze-notify :void + (object :pointer)) + +(defcfun g-object-thaw-notify :void + (object :pointer)) + +(defcfun g-object-get-data :pointer + (object :pointer) + (key :string)) + +(defcfun g-object-set-data :void + (object :pointer) + (key :string) + (new-value :pointer)) + +(defcfun g-object-set-data-full :void + (object :pointer) + (key :string) + (data :pointer) + (destory :pointer)) + +(defcfun g-object-steal-data :pointer + (object :pointer) + (key :string)) + +(defcfun g-object-set-property :void + (object :pointer) + (property-name :string) + (value (:pointer g-value))) + +(defcfun g-object-get-property :void + (object :pointer) + (property-name :string) + (value (:pointer g-value))) + +(defcfun g-signal-connect-closure :ulong + (instance :pointer) + (detailed-signal :string) + (closure (:pointer g-closure)) + (after :boolean)) + +(defcfun g-signal-emitv :void + (instance-and-params (:pointer g-value)) + (signal-id :uint) + (detail g-quark) + (return-value (:pointer g-value))) + +(defcfun g-signal-lookup :uint + (name :string) + (type g-type)) + +(defbitfield g-signal-flags + :run-first :run-last :run-cleanup :no-recurse :detailed :action :no-hooks) + +(defcstruct g-signal-query + (:signal-id :uint) + (:signal-name :string) + (:owner-type g-type) + (:signal-flags g-signal-flags) + (:return-type g-type) + (:n-params :uint) + (:param-types (:pointer g-type))) + +(defcfun g-signal-query :void + (signal-id :uint) + (query (:pointer g-signal-query))) + +(defcstruct lisp-closure + (:parent-instance g-closure) + (:function-id :pointer)) + +(defcstruct g-object-struct + (:type-instance g-type-instance) + (:ref-count :uint) + (:qdata :pointer)) diff --git a/glib/gobject.ffi.package.lisp b/glib/gobject.ffi.package.lisp new file mode 100644 index 0000000..bc8c29b --- /dev/null +++ b/glib/gobject.ffi.package.lisp @@ -0,0 +1,196 @@ +(defpackage :gobject.ffi + (:use :cl :cffi :glib :trivial-garbage) + (:export #:g-type + #:g-type-designator + #:g-type-name + #:g-type-from-name + #:g-type + #:g-type-fundamental + #:%g-type-init + #:g-type-name + #:g-type-from-name + #:g-type-parent + #:g-type-depth + #:g-type-next-base + #:g-type-is-a + #:%g-type-children + #:%g-type-interface-prerequisites + #:g-strv-get-type + #:g-closure-get-type + #:%g-type-interfaces + #:g-type-interface + #:g-type-class + #:g-type-instance + #:g-type-info + #:g-type-query + #:g-type-fundamental-flags + #:g-type-fundamental-info + #:g-interface-info + #:g-type-value-table + #:g-type-flags + #:%g-object + #:%g-initially-unowned + #:g-object-class + #:g-param-flags + #:g-param-spec + #:g-value-data + #:g-value + #:g-object-construct-param + #:g-parameter + #:g-enum-value + #:g-enum-class + #:g-flags-value + #:g-flags-class + #:g-param-spec-boolean + #:g-param-spec-char + #:g-param-spec-uchar + #:g-param-spec-int + #:g-param-spec-uint + #:g-param-spec-long + #:g-param-spec-ulong + #:g-param-spec-int64 + #:g-param-spec-uint64 + #:g-param-spec-float + #:g-param-spec-double + #:g-param-spec-enum + #:g-param-spec-flags + #:g-param-spec-string + #:g-param-spec-param + #:g-param-spec-boxed + #:g-param-spec-pointer + #:g-param-spec-object + #:g-param-spec-value-array + #:g-param-spec-g-type + #:g-param-spec-class + #:g-closure + #:g-type-class-ref + #:g-type-class-unref + #:g-type-class-add-private + #:g-type-register-static + #:g-type-register-static-simple + #:g-type-add-interface-static + #:g-type-interface-add-prerequisite + #:g-type-query + #:g-type-default-interface-ref + #:g-type-default-interface-unref + #:g-boxed-copy + #:g-boxed-free + #:g-boxed-type-register-static + #:g-pointer-type-register-static + #:g-closure-ref + #:g-closure-sink + #:g-closure-unref + #:g-closure-invalidate + #:g-closure-add-finalize-notifier + #:g-closure-add-invalidate-notifier + #:g-closure-new-simple + #:g-closure-set-marshal + #:g-enum-register-static + #:g-flags-register-static + #:g-param-spec-boolean + #:g-value-set-boolean + #:g-value-get-boolean + #:g-param-spec-char + #:g-value-set-char + #:g-value-get-char + #:g-param-spec-uchar + #:g-value-set-uchar + #:g-value-get-uchar + #:g-param-spec-int + #:g-value-set-int + #:g-value-get-int + #:g-param-spec-uint + #:g-value-set-uint + #:g-value-get-uint + #:g-param-spec-long + #:g-value-set-long + #:g-value-get-long + #:g-param-spec-ulong + #:g-value-set-ulong + #:g-value-get-ulong + #:g-param-spec-int64 + #:g-value-set-int64 + #:g-value-get-int64 + #:g-param-spec-uint64 + #:g-value-set-uint64 + #:g-value-get-uint64 + #:g-param-spec-float + #:g-value-set-float + #:g-value-get-float + #:g-param-spec-double + #:g-value-set-double + #:g-value-get-double + #:g-param-spec-enum + #:g-value-set-enum + #:g-value-get-enum + #:g-param-spec-flags + #:g-value-set-flags + #:g-value-get-flags + #:g-param-spec-string + #:g-value-set-string + #:g-value-get-string + #:g-param-spec-param + #:g-value-set-param + #:g-value-get-param + #:g-param-spec-boxed + #:g-value-set-boxed + #:g-value-take-boxed + #:g-value-get-boxed + #:g-param-spec-pointer + #:g-value-set-pointer + #:g-value-get-pointer + #:g-param-spec-object + #:g-value-set-object + #:g-value-get-object + #:g-param-spec-value-array + #:g-param-spec-g-type + #:g-value-set-g-type + #:g-value-get-g-type + #:g-param-spec-ref-sink + #:g-param-spec-unref + #:g-param-value-set-default + #:g-param-value-defaults + #:g-param-value-validate + #:g-param-spec-get-name + #:g-param-spec-get-nick + #:g-param-spec-get-blurb + #:g-value-init + #:g-value-copy + #:g-value-reset + #:g-value-unset + #:g-value-set-instance + #:g-strdup-value-contents + #:g-object-class-install-property + #:g-object-class-find-property + #:g-object-class-list-properties + #:g-object-class-override-property + #:g-object-interface-install-property + #:g-object-interface-find-property + #:g-object-interface-list-properties + #:g-object-newv + #:g-object-ref + #:g-object-unref + #:g-object-ref-sink + #:g-object-is-floating + #:g-object-force-floating + #:g-object-weak-ref + #:g-object-weak-unref + #:g-object-add-toggle-ref + #:g-object-remove-toggle-ref + #:g-object-notify + #:g-object-freeze-notify + #:g-object-thaw-notify + #:g-object-get-data + #:g-object-set-data + #:g-object-set-data-full + #:g-object-steal-data + #:g-object-set-property + #:g-object-get-property + #:g-signal-connect-closure + #:g-signal-emitv + #:g-signal-lookup + #:g-signal-flags + #:g-signal-query + #:g-signal-query + #:lisp-closure + #:g-object-struct)) diff --git a/glib/gobject.foreign-closures.lisp b/glib/gobject.foreign-closures.lisp index ee1ab44..0b30da8 100644 --- a/glib/gobject.foreign-closures.lisp +++ b/glib/gobject.foreign-closures.lisp @@ -1,9 +1,5 @@ (in-package :gobject) -(defcstruct lisp-closure - (parent-instance g-closure) - (function-id :pointer)) - (defcallback lisp-closure-finalize :void ((data :pointer) (closure (:pointer lisp-closure))) (declare (ignore data)) @@ -22,7 +18,7 @@ (marshal-data :pointer)) (declare (ignore invocation-hint marshal-data)) (let* ((args (parse-closure-arguments count-of-args args)) - (function-id (foreign-slot-value closure 'lisp-closure 'function-id)) + (function-id (foreign-slot-value closure 'lisp-closure :function-id)) (return-type (and (not (null-pointer-p return-value)) (gvalue-type return-value))) (fn (get-stable-pointer-value function-id)) @@ -37,9 +33,8 @@ (defun create-closure (fn) (let ((function-id (allocate-stable-pointer fn)) - (closure (g-closure-new-simple (foreign-type-size 'lisp-closure) - (null-pointer)))) - (setf (foreign-slot-value closure 'lisp-closure 'function-id) function-id) + (closure (g-closure-new-simple (foreign-type-size 'lisp-closure) (null-pointer)))) + (setf (foreign-slot-value closure 'lisp-closure :function-id) function-id) (g-closure-add-finalize-notifier closure (null-pointer) (callback lisp-closure-finalize)) (g-closure-set-marshal closure (callback lisp-closure-marshal)) @@ -63,5 +58,5 @@ If @code{after} is true, then the function will be called after the default hand after)) (defun finalize-lisp-closure (closure) - (let ((function-id (foreign-slot-value closure 'lisp-closure 'function-id))) + (let ((function-id (foreign-slot-value closure 'lisp-closure :function-id))) (free-stable-pointer function-id))) \ No newline at end of file diff --git a/glib/gobject.foreign-gobject-subclassing.lisp b/glib/gobject.foreign-gobject-subclassing.lisp index 0ee4e9b..d41d5bb 100644 --- a/glib/gobject.foreign-gobject-subclassing.lisp +++ b/glib/gobject.foreign-gobject-subclassing.lisp @@ -14,13 +14,13 @@ (setf (gethash (pointer-address object) *lisp-objects-references*) (gethash (pointer-address object) *foreign-gobjects*)))) (defun instance-init (instance class) - (debugf "Initializing instance ~A for type ~A (creating ~A)~%" instance (g-type-name (foreign-slot-value class 'g-type-class 'type)) *current-creating-object*) + (debugf "Initializing instance ~A for type ~A (creating ~A)~%" instance (g-type-name (foreign-slot-value class 'g-type-class :type)) *current-creating-object*) (unless (gethash (pointer-address instance) *lisp-objects-pointers*) (debugf " Proceeding with initialization...") (setf (gethash (pointer-address instance) *lisp-objects-pointers*) t (gethash (pointer-address instance) *lisp-objects-references*) (or *current-creating-object* - (let* ((g-type (foreign-slot-value class 'g-type-class 'type)) + (let* ((g-type (foreign-slot-value class 'g-type-class :type)) (type-name (g-type-name g-type)) (lisp-type-info (gethash type-name *registered-types*)) (lisp-class (object-type-class lisp-type-info))) @@ -78,7 +78,7 @@ (t (error "Unknown type: ~A (~A)" property-g-type (g-type-name property-g-type))))))) (defun install-properties (class) - (let* ((name (g-type-name (foreign-slot-value class 'g-type-class 'type))) + (let* ((name (g-type-name (foreign-slot-value class 'g-type-class :type))) (lisp-type-info (gethash name *registered-types*))) (iter (for property in (object-type-properties lisp-type-info)) (for param-spec = (property->param-spec property)) @@ -138,8 +138,8 @@ (let* ((interface-info (list name interface)) (interface-info-ptr (allocate-stable-pointer interface-info))) (with-foreign-object (info 'g-interface-info) - (setf (foreign-slot-value info 'g-interface-info 'interface-init) (callback c-interface-init) - (foreign-slot-value info 'g-interface-info 'interface-data) interface-info-ptr) + (setf (foreign-slot-value info 'g-interface-info :interface-init) (callback c-interface-init) + (foreign-slot-value info 'g-interface-info :interface-data) interface-info-ptr) (g-type-add-interface-static (g-type-from-name name) (ensure-g-type interface) info)))) (defun add-interfaces (name) @@ -151,9 +151,9 @@ (defun class-init (class data) (declare (ignore data)) (debugf "class-init for ~A~%" (g-type-name (g-type-from-class class))) - (setf (foreign-slot-value class 'g-object-class 'get-property) + (setf (foreign-slot-value class 'g-object-class :get-property) (callback c-object-property-get) - (foreign-slot-value class 'g-object-class 'set-property) + (foreign-slot-value class 'g-object-class :set-property) (callback c-object-property-set)) (install-properties class)) @@ -161,9 +161,9 @@ (defun object-property-get (object property-id g-value pspec) (declare (ignore property-id)) (let* ((lisp-object (gethash (pointer-address object) *lisp-objects-references*)) - (property-name (foreign-slot-value pspec 'g-param-spec 'name)) - (property-type (foreign-slot-value pspec 'g-param-spec 'value-type)) - (type-name (g-type-name (foreign-slot-value pspec 'g-param-spec 'owner-type))) + (property-name (foreign-slot-value pspec 'g-param-spec :name)) + (property-type (foreign-slot-value pspec 'g-param-spec :value-type)) + (type-name (g-type-name (foreign-slot-value pspec 'g-param-spec :owner-type))) (lisp-type-info (gethash type-name *registered-types*)) (property-info (find property-name (object-type-properties lisp-type-info) :test 'string= :key 'first)) (property-get-fn (fourth property-info))) @@ -179,8 +179,8 @@ (defun object-property-set (object property-id value pspec) (declare (ignore property-id)) (let* ((lisp-object (gethash (pointer-address object) *lisp-objects-references*)) - (property-name (foreign-slot-value pspec 'g-param-spec 'name)) - (type-name (g-type-name (foreign-slot-value pspec 'g-param-spec 'owner-type))) + (property-name (foreign-slot-value pspec 'g-param-spec :name)) + (type-name (g-type-name (foreign-slot-value pspec 'g-param-spec :owner-type))) (lisp-type-info (gethash type-name *registered-types*)) (property-info (find property-name (object-type-properties lisp-type-info) :test 'string= :key 'first)) (property-set-fn (fifth property-info)) @@ -203,7 +203,12 @@ (with-foreign-object (query 'g-type-query) (g-type-query (g-type-from-name ,parent) query) (with-foreign-slots ((class-size instance-size) query g-type-query) - (g-type-register-static-simple (g-type-from-name ,parent) ,name class-size (callback c-class-init) instance-size (callback c-instance-init) nil))) + (g-type-register-static-simple (g-type-from-name ,parent) + ,name + (foreign-slot-value query 'g-type-query :class-size) + (callback c-class-init) + (foreign-slot-value query 'g-type-query :instance-size) + (callback c-instance-init) nil))) (add-interfaces ,name)) (defmethod initialize-instance :before ((object ,class) &key pointer) (unless (or pointer (and (slot-boundp object 'gobject::pointer) diff --git a/glib/gobject.foreign-gobject.lisp b/glib/gobject.foreign-gobject.lisp index 503fe00..215110f 100644 --- a/glib/gobject.foreign-gobject.lisp +++ b/glib/gobject.foreign-gobject.lisp @@ -18,13 +18,8 @@ (defvar *lisp-objects-pointers* (make-hash-table :test 'equal)) (defvar *current-creating-object* nil) -(defcstruct g-object-struct - (type-instance g-type-instance) - (ref-count :uint) - (qdata :pointer)) - (defun ref-count (pointer) - (foreign-slot-value (if (pointerp pointer) pointer (pointer pointer)) 'g-object-struct 'ref-count)) + (foreign-slot-value (if (pointerp pointer) pointer (pointer pointer)) 'g-object-struct :ref-count)) (defmethod initialize-instance :around ((obj g-object) &key) (let ((*current-creating-object* obj)) @@ -233,7 +228,7 @@ (not (member :readable (foreign-slot-value param-spec 'g-param-spec - 'flags)))) + :flags)))) (error 'property-unreadable-error :property-name property-name :class-name (g-type-name object-type))) @@ -241,11 +236,11 @@ (not (member :writable (foreign-slot-value param-spec 'g-param-spec - 'flags)))) + :flags)))) (error 'property-unwritable-error :property-name property-name :class-name (g-type-name object-type))) - (foreign-slot-value param-spec 'g-param-spec 'value-type)) + (foreign-slot-value param-spec 'g-param-spec :value-type)) (defun g-object-type-property-type (object-type property-name &key assert-readable assert-writable) @@ -278,8 +273,8 @@ for arg-type in args-types for arg-g-type = (if arg-type (ensure-g-type arg-type) (g-object-type-property-type object-type arg-name)) for parameter = (mem-aref parameters 'g-parameter i) - do (setf (foreign-slot-value parameter 'g-parameter 'name) arg-name) - do (set-g-value (foreign-slot-value parameter 'g-parameter 'value) + do (setf (foreign-slot-value parameter 'g-parameter :name) arg-name) + do (set-g-value (foreign-slot-value parameter 'g-parameter :value) arg-value arg-g-type :zero-g-value t)) (unwind-protect diff --git a/glib/gobject.gobject-query.lisp b/glib/gobject.gobject-query.lisp index 6753d53..9e3f83e 100644 --- a/glib/gobject.gobject-query.lisp +++ b/glib/gobject.gobject-query.lisp @@ -51,18 +51,18 @@ See accessor functions: @return{a GType (integer)}") (defun parse-g-param-spec (param) - (let ((flags (foreign-slot-value param 'g-param-spec 'flags))) + (let ((flags (foreign-slot-value param 'g-param-spec :flags))) (make-g-class-property-definition :name (foreign-slot-value param 'g-param-spec - 'name) + :name) :type (foreign-slot-value param 'g-param-spec - 'value-type) + :value-type) :readable (not (null (member :readable flags))) :writable (not (null (member :writable flags))) :constructor (not (null (member :construct flags))) :constructor-only (not (null (member :construct-only flags))) :owner-type (foreign-slot-value param 'g-param-spec - 'owner-type)))) + :owner-type)))) (defun class-properties (g-type) "@return{list of properties of GObject class @code{g-type}. Each property is described by an object of type @class{g-class-property-definition}.} @@ -95,18 +95,18 @@ See accessor functions: (loop for i from 0 below (mem-ref n-properties :uint) for param = (mem-aref params :pointer i) - for flags = (foreign-slot-value param 'g-param-spec 'flags) + for flags = (foreign-slot-value param 'g-param-spec :flags) collect (make-g-class-property-definition :name (foreign-slot-value param 'g-param-spec - 'name) + :name) :type (foreign-slot-value param 'g-param-spec - 'value-type) + :value-type) :readable (not (null (member :readable flags))) :writable (not (null (member :writable flags))) :constructor (not (null (member :construct flags))) :constructor-only (not (null (member :construct-only flags))) :owner-type (foreign-slot-value param 'g-param-spec - 'owner-type))) + :owner-type))) (g-free params)))) (g-type-default-interface-unref g-iface)))) @@ -140,17 +140,17 @@ See accessor functions: (let ((g-class (g-type-class-ref (ensure-g-type type)))) (unwind-protect (loop - with n = (foreign-slot-value g-class 'g-enum-class 'n-values) - with values = (foreign-slot-value g-class 'g-enum-class 'values) + with n = (foreign-slot-value g-class 'g-enum-class :n-values) + with values = (foreign-slot-value g-class 'g-enum-class :values) for i from 0 below n for enum-value = (mem-aref values 'g-enum-value i) collect (make-enum-item :name (foreign-slot-value enum-value 'g-enum-value - 'name) + :name) :value (foreign-slot-value enum-value 'g-enum-value - 'value) + :value) :nick (foreign-slot-value enum-value 'g-enum-value - 'nick))) + :nick))) (g-type-class-unref g-class)))) (defstruct flags-item @@ -183,15 +183,15 @@ See accessor functions: (let ((g-class (g-type-class-ref (ensure-g-type type)))) (unwind-protect (loop - with n = (foreign-slot-value g-class 'g-flags-class 'n-values) - with values = (foreign-slot-value g-class 'g-flags-class 'values) + with n = (foreign-slot-value g-class 'g-flags-class :n-values) + with values = (foreign-slot-value g-class 'g-flags-class :values) for i from 0 below n for flags-value = (mem-aref values 'g-flags-value i) collect (make-flags-item :name (foreign-slot-value flags-value 'g-flags-value - 'name) + :name) :value (foreign-slot-value flags-value 'g-flags-value - 'value) + :value) :nick (foreign-slot-value flags-value 'g-flags-value - 'nick))) + :nick))) (g-type-class-unref g-class)))) diff --git a/glib/gobject.gparams.lisp b/glib/gobject.gparams.lisp deleted file mode 100644 index 9f93478..0000000 --- a/glib/gobject.gparams.lisp +++ /dev/null @@ -1,326 +0,0 @@ -(in-package :gobject) - -(defcfun g-param-spec-boolean (:pointer g-param-spec-boolean) - (name :string) - (nick :string) - (blurb :string) - (default-value :boolean) - (flags g-param-flags)) - -(defcfun g-value-set-boolean :void - (g-value (:pointer g-value)) - (new-value :boolean)) - -(defcfun g-value-get-boolean :boolean - (g-value (:pointer g-value))) - -(defcfun g-param-spec-char (:pointer g-param-spec-char) - (name :string) - (nick :string) - (blurb :string) - (minimum :int8) - (maximum :int8) - (default-value :int8) - (flags g-param-flags)) - -(defcfun g-value-set-char :void - (g-value (:pointer g-value)) - (new-value :char)) - -(defcfun g-value-get-char :char - (g-value (:pointer g-value))) - -(defcfun g-param-spec-uchar (:pointer g-param-spec-uchar) - (name :string) - (nick :string) - (blurb :string) - (minimum :uint8) - (maximum :uint8) - (default-value :uint8) - (flags g-param-flags)) - -(defcfun g-value-set-uchar :void - (g-value (:pointer g-value)) - (new-value :uchar)) - -(defcfun g-value-get-uchar :uchar - (g-value (:pointer g-value))) - -(defcfun g-param-spec-int (:pointer g-param-spec-int) - (name :string) - (nick :string) - (blurb :string) - (minimum :int) - (maximum :int) - (default-value :int) - (flags g-param-flags)) - -(defcfun g-value-set-int :void - (g-value (:pointer g-value)) - (new-value :int)) - -(defcfun g-value-get-int :int - (g-value (:pointer g-value))) - -(defcfun g-param-spec-uint (:pointer g-param-spec-uint) - (name :string) - (nick :string) - (blurb :string) - (minimum :uint) - (maximum :uint) - (default-value :uint) - (flags g-param-flags)) - -(defcfun g-value-set-uint :void - (g-value (:pointer g-value)) - (new-value :uint)) - -(defcfun g-value-get-uint :uint - (g-value (:pointer g-value))) - -(defcfun g-param-spec-long (:pointer g-param-spec-long) - (name :string) - (nick :string) - (blurb :string) - (minimum :long) - (maximum :long) - (default-value :long) - (flags g-param-flags)) - -(defcfun g-value-set-long :void - (g-value (:pointer g-value)) - (new-value :long)) - -(defcfun g-value-get-long :long - (g-value (:pointer g-value))) - -(defcfun g-param-spec-ulong (:pointer g-param-spec-ulong) - (name :string) - (nick :string) - (blurb :string) - (minimum :ulong) - (maximum :ulong) - (default-value :ulong) - (flags g-param-flags)) - -(defcfun g-value-set-ulong :void - (g-value (:pointer g-value)) - (new-value :ulong)) - -(defcfun g-value-get-ulong :ulong - (g-value (:pointer g-value))) - -(defcfun g-param-spec-int64 (:pointer g-param-spec-int64) - (name :string) - (nick :string) - (blurb :string) - (minimum :int64) - (maximum :int64) - (default-value :int64) - (flags g-param-flags)) - -(defcfun g-value-set-int64 :void - (g-value (:pointer g-value)) - (new-value :int64)) - -(defcfun g-value-get-int64 :int64 - (g-value (:pointer g-value))) - -(defcfun g-param-spec-uint64 (:pointer g-param-spec-uint64) - (name :string) - (nick :string) - (blurb :string) - (minimum :uint64) - (maximum :uint64) - (default-value :uint64) - (flags g-param-flags)) - -(defcfun g-value-set-uint64 :void - (g-value (:pointer g-value)) - (new-value :uint64)) - -(defcfun g-value-get-uint64 :uint64 - (g-value (:pointer g-value))) - -(defcfun g-param-spec-float (:pointer g-param-spec-float) - (name :string) - (nick :string) - (blurb :string) - (minimum :float) - (maximum :float) - (default-value :float) - (flags g-param-flags)) - -(defcfun g-value-set-float :void - (g-value (:pointer g-value)) - (new-value :float)) - -(defcfun g-value-get-float :float - (g-value (:pointer g-value))) - -(defcfun g-param-spec-double (:pointer g-param-spec-double) - (name :string) - (nick :string) - (blurb :string) - (minimum :double) - (maximum :double) - (default-value :double) - (flags g-param-flags)) - -(defcfun g-value-set-double :void - (g-value (:pointer g-value)) - (new-value :double)) - -(defcfun g-value-get-double :double - (g-value (:pointer g-value))) - -(defcfun g-param-spec-enum (:pointer g-param-spec-enum) - (name :string) - (nick :string) - (blurb :string) - (enum-type g-type-designator) - (default-value :int) - (flags g-param-flags)) - -(defcfun g-value-set-enum :void - (g-value (:pointer g-value)) - (new-value :int)) - -(defcfun g-value-get-enum :int - (g-value (:pointer g-value))) - -(defcfun g-param-spec-flags (:pointer g-param-spec-flags) - (name :string) - (nick :string) - (blurb :string) - (flags-type g-type-designator) - (default-value :int) - (flags g-param-flags)) - -(defcfun g-value-set-flags :void - (g-value (:pointer g-value)) - (new-value :int)) - -(defcfun g-value-get-flags :int - (g-value (:pointer g-value))) - -(defcfun g-param-spec-string (:pointer g-param-spec-string) - (name :string) - (nick :string) - (blurb :string) - (default-value :string) - (flags g-param-flags)) - -(defcfun g-value-set-string :void - (g-value (:pointer g-value)) - (new-value :string)) - -(defcfun g-value-get-string (:string :free-from-foreign nil) - (g-value (:pointer g-value))) - -(defcfun g-param-spec-param (:pointer g-param-spec-param) - (name :string) - (nick :string) - (blurb :string) - (param-type g-type-designator) - (flags g-param-flags)) - -(defcfun g-value-set-param :void - (g-value (:pointer g-value)) - (new-value (:pointer g-param-spec))) - -(defcfun g-value-get-param (:pointer g-param-spec) - (g-value (:pointer g-value))) - -(defcfun g-param-spec-boxed (:pointer g-param-spec-boxed) - (name :string) - (nick :string) - (blurb :string) - (boxed-type g-type-designator) - (flags g-param-flags)) - -(defcfun g-value-set-boxed :void - (g-value (:pointer g-value)) - (new-value :pointer)) - -(defcfun g-value-take-boxed :void - (g-value (:pointer g-value)) - (new-value :pointer)) - -(defcfun g-value-get-boxed :pointer - (g-value (:pointer g-value))) - -(defcfun g-param-spec-pointer (:pointer g-param-spec-pointer) - (name :string) - (nick :string) - (blurb :string) - (flags g-param-flags)) - -(defcfun g-value-set-pointer :void - (g-value (:pointer g-value)) - (new-value :pointer)) - -(defcfun g-value-get-pointer :pointer - (g-value (:pointer g-value))) - -(defcfun g-param-spec-object (:pointer g-param-spec-object) - (name :string) - (nick :string) - (blurb :string) - (object-type g-type-designator) - (flags g-param-flags)) - -(defcfun g-value-set-object :void - (g-value (:pointer g-value)) - (new-value :pointer)) - -(defcfun g-value-get-object :pointer - (g-value (:pointer g-value))) - -(defcfun g-param-spec-value-array (:pointer g-param-spec-value-array) - (name :string) - (nick :string) - (blurb :string) - (element-spec (:pointer g-param-spec)) - (flags g-param-flags)) - -(defcfun (g-param-spec-g-type "g_param_spec_gtype") (:pointer g-param-spec-g-type) - (name :string) - (nick :string) - (blurb :string) - (types-root g-type-designator) - (flags g-param-flags)) - -(defcfun (g-value-set-g-type "g_value_set_gtype") :void - (g-value (:pointer g-value)) - (new-value g-type-designator)) - -(defcfun (g-value-get-g-type "g_value_get_gtype") g-type-designator - (g-value (:pointer g-value))) - -(defcfun g-param-spec-ref-sink (:pointer g-param-spec) - (param-spec (:pointer g-param-spec))) - -(defcfun g-param-spec-unref :void - (param-spec (:pointer g-param-spec))) - -(defcfun g-param-value-set-default :void - (param-spec (:pointer g-param-spec)) - (value (:pointer g-value))) - -(defcfun g-param-value-defaults :boolean - (param-spec (:pointer g-param-spec)) - (value (:pointer g-value))) - -(defcfun g-param-value-validate :boolean - (param-spec (:pointer g-param-spec)) - (value (:pointer g-value))) - -(defcfun g-param-spec-get-name :string - (param-spec (:pointer g-param-spec))) - -(defcfun g-param-spec-get-nick :string - (param-spec (:pointer g-param-spec))) - -(defcfun g-param-spec-get-blurb :string - (param-spec (:pointer g-param-spec))) \ No newline at end of file diff --git a/glib/gobject.gvalue-parser.lisp b/glib/gobject.gvalue-parser.lisp index f06ea41..dbbf824 100644 --- a/glib/gobject.gvalue-parser.lisp +++ b/glib/gobject.gvalue-parser.lisp @@ -1,7 +1,7 @@ (in-package :gobject) (defun gvalue-type (gvalue) - (foreign-slot-value gvalue 'g-value 'type)) + (foreign-slot-value gvalue 'g-value :type)) (defmacro ev-case (keyform &body clauses) "Macro that is an analogue of CASE except that it evaluates keyforms" diff --git a/glib/gobject.gvalue.lisp b/glib/gobject.gvalue.lisp index b5c92b9..ed67c9b 100644 --- a/glib/gobject.gvalue.lisp +++ b/glib/gobject.gvalue.lisp @@ -1,13 +1,5 @@ (in-package :gobject) -(defcfun g-value-init (:pointer g-value) - "Initializes the GValue @code{value} with the default value of @code{type} - -@arg[value]{a C pointer to the GValue structure} -@arg[type]{an integer specifying the GType}" - (value (:pointer g-value)) - (type g-type-designator)) - (defun g-value-zero (g-value) "Initializes the GValue in \"unset\" state. @@ -16,23 +8,3 @@ for i from 0 below (foreign-type-size 'g-value) do (setf (mem-ref g-value :uchar i) 0))) -(defcfun g-value-copy :void - (src-value (:pointer g-value)) - (dst-value (:pointer g-value))) - -(defcfun g-value-reset (:pointer g-value) - (value (:pointer g-value))) - -(defcfun g-value-unset (:pointer g-value) - "Clears the current value in @code{value} and \"unsets\" the type, releasing all resources associated with this GValue. An unset value is the same as an unitialized GValue. - -@arg[value]{a C pointer to the GValue structure}" - (value (:pointer g-value))) - -(defcfun g-value-set-instance :void - (value (:pointer g-value)) - (instance :pointer)) - -(defcfun g-strdup-value-contents :string - (value (:pointer g-value))) - diff --git a/glib/gobject.object.lisp b/glib/gobject.object.lisp deleted file mode 100644 index 4ae1038..0000000 --- a/glib/gobject.object.lisp +++ /dev/null @@ -1,110 +0,0 @@ -(in-package :gobject) - -(defcfun g-object-class-install-property :void - (class (:pointer g-object-class)) - (property-id :uint) - (param-spec (:pointer g-param-spec))) - -(defcfun g-object-class-find-property (:pointer g-param-spec) - (class (:pointer g-object-class)) - (property-name :string)) - -(defcfun g-object-class-list-properties (:pointer (:pointer g-param-spec)) - (class (:pointer g-object-class)) - (n-properties (:pointer :uint))) - -(defcfun g-object-class-override-property :void - (class (:pointer g-object-class)) - (property-id :uint) - (name :string)) - -(defcfun g-object-interface-install-property :void - (interface :pointer) - (param-spec (:pointer g-param-spec))) - -(defcfun g-object-interface-find-property (:pointer g-param-spec) - (interface :pointer) - (property-name :string)) - -(defcfun g-object-interface-list-properties (:pointer g-param-spec) - (interface :pointer) - (n-properties (:pointer :uint))) - -(defcfun g-object-newv :pointer - (object-type g-type-designator) - (n-parameter :uint) - (parameters (:pointer g-parameter))) - -(defcfun g-object-ref :pointer - (object :pointer)) - -(defcfun g-object-unref :void - (object :pointer)) - -(defcfun g-object-ref-sink :pointer - (object :pointer)) - -(defcfun g-object-is-floating :boolean - (object :pointer)) - -(defcfun g-object-force-floating :void - (object :pointer)) - -(defcfun g-object-weak-ref :void - (object :pointer) - (notify :pointer) - (data :pointer)) - -(defcfun g-object-weak-unref :void - (object :pointer) - (notify :pointer) - (data :pointer)) - -(defcfun g-object-add-toggle-ref :void - (object :pointer) - (notifty :pointer) - (data :pointer)) - -(defcfun g-object-remove-toggle-ref :void - (object :pointer) - (notifty :pointer) - (data :pointer)) - -(defcfun g-object-notify :void - (object :pointer) - (property-name :string)) - -(defcfun g-object-freeze-notify :void - (object :pointer)) - -(defcfun g-object-thaw-notify :void - (object :pointer)) - -(defcfun g-object-get-data :pointer - (object :pointer) - (key :string)) - -(defcfun g-object-set-data :void - (object :pointer) - (key :string) - (new-value :pointer)) - -(defcfun g-object-set-data-full :void - (object :pointer) - (key :string) - (data :pointer) - (destory :pointer)) - -(defcfun g-object-steal-data :pointer - (object :pointer) - (key :string)) - -(defcfun g-object-set-property :void - (object :pointer) - (property-name :string) - (value (:pointer g-value))) - -(defcfun g-object-get-property :void - (object :pointer) - (property-name :string) - (value (:pointer g-value))) \ No newline at end of file diff --git a/glib/gobject.package.lisp b/glib/gobject.package.lisp index 8884249..0889d0b 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 :gobject.type-info) + (:use :cl :glib :cffi :tg :bordeaux-threads :iter :closer-mop :gobject.ffi :gobject.type-info) (:export #:+g-type-invalid+ #:+g-type-void+ #:+g-type-interface+ diff --git a/glib/gobject.signals.lisp b/glib/gobject.signals.lisp index 394280c..99fe636 100644 --- a/glib/gobject.signals.lisp +++ b/glib/gobject.signals.lisp @@ -1,37 +1,5 @@ (in-package :gobject) -(defcfun g-signal-connect-closure :ulong - (instance :pointer) - (detailed-signal :string) - (closure (:pointer g-closure)) - (after :boolean)) - -(defcfun g-signal-emitv :void - (instance-and-params (:pointer g-value)) - (signal-id :uint) - (detail g-quark) - (return-value (:pointer g-value))) - -(defcfun g-signal-lookup :uint - (name :string) - (type g-type)) - -(defbitfield g-signal-flags - :run-first :run-last :run-cleanup :no-recurse :detailed :action :no-hooks) - -(defcstruct g-signal-query - (signal-id :uint) - (signal-name :string) - (owner-type g-type) - (signal-flags g-signal-flags) - (return-type g-type) - (n-params :uint) - (param-types (:pointer g-type))) - -(defcfun g-signal-query :void - (signal-id :uint) - (query (:pointer g-signal-query))) - (defun unmangle-type (type) (logxor type (ldb (byte 1 0) type)));;subtract the G_SIGNAL_TYPE_STATIC_SCOPE @@ -46,19 +14,19 @@ (error "Signal ~A not found on object ~A" signal-name object)) (with-foreign-object (q 'g-signal-query) (g-signal-query signal-id q) - (with-foreign-object (params 'g-value (+ 1 (foreign-slot-value q 'g-signal-query 'n-params))) + (with-foreign-object (params 'g-value (+ 1 (foreign-slot-value q 'g-signal-query :n-params))) (set-g-value (mem-aref params 'g-value 0) object (g-type-from-object (pointer object)) :zero-g-value t) - (iter (for i from 0 below (foreign-slot-value q 'g-signal-query 'n-params)) + (iter (for i from 0 below (foreign-slot-value q 'g-signal-query :n-params)) (for arg in args) - (for type = (unmangle-type (mem-aref (foreign-slot-value q 'g-signal-query 'param-types) 'g-type i))) + (for type = (unmangle-type (mem-aref (foreign-slot-value q 'g-signal-query :param-types) 'g-type i))) (set-g-value (mem-aref params 'g-value (1+ i)) arg type :zero-g-value t)) (prog1 - (if (= (foreign-slot-value q 'g-signal-query 'return-type) +g-type-void+) + (if (= (foreign-slot-value q 'g-signal-query :return-type) +g-type-void+) (g-signal-emitv params signal-id signal-name (null-pointer)) (with-foreign-object (return-value 'g-value) (g-value-zero return-value) - (g-value-init return-value (foreign-slot-value q 'g-signal-query 'return-type)) + (g-value-init return-value (foreign-slot-value q 'g-signal-query :return-type)) (prog1 (parse-gvalue return-value) (g-value-unset return-value)))) - (iter (for i from 0 below (foreign-slot-value q 'g-signal-query 'n-params)) + (iter (for i from 0 below (foreign-slot-value q 'g-signal-query :n-params)) (g-value-unset (mem-aref params 'g-value (1+ i))))))))) \ No newline at end of file diff --git a/glib/gobject.structs.lisp b/glib/gobject.structs.lisp index 31945c6..1af1e69 100644 --- a/glib/gobject.structs.lisp +++ b/glib/gobject.structs.lisp @@ -1,297 +1,5 @@ (in-package :gobject) -(defcstruct g-type-interface - (type g-type) - (instance-type g-type)) - -(defcstruct g-type-class - (type g-type)) - -(defcstruct g-type-instance - (class (:pointer g-type-class))) - -(defcstruct g-type-info - (class-size :uint16) - (base-init-fn :pointer) - (base-finalize-fn :pointer) - (class-init-fn :pointer) - (class-finalize-fn :pointer) - (class-data :pointer) - (instance-size :uint16) - (n-preallocs :uint16) - (instance-init-fn :pointer) - (value-table :pointer)) - -(defcstruct g-type-query - (type g-type) - (type-name (:string :free-from-foreign nil)) - (class-size :uint) - (instance-size :uint)) - -(defbitfield g-type-fundamental-flags - :classed - :instantiatable - :derivable - :deep-derivable) - -(defcstruct g-type-fundamental-info - (type-flags g-type-fundamental-flags)) - -(defcstruct g-interface-info - (interface-init :pointer) - (interface-finalize :pointer) - (interface-data :pointer)) - -(defcstruct g-type-value-table - (value-init :pointer) - (value-free :pointer) - (value-copy :pointer) - (value-peek-pointer :pointer) - (collect-format (:string :free-from-foreign nil :free-to-foreign nil)) - (collect-value :pointer) - (lcopy-format (:string :free-from-foreign nil :free-to-foreign nil)) - (lcopy-value :pointer)) - -(defbitfield g-type-flags - (:abstract #. (ash 1 4)) - :value-abstract) - -(defcstruct %g-object - (type-instance g-type-instance) - (ref-count :uint) - (data :pointer)) - -(defctype %g-initially-unowned %g-object) - -(defcstruct g-object-class - (type-class g-type-class) - (construct-properties :pointer) - (constructor :pointer) - (set-property :pointer) - (get-property :pointer) - (dispose :pointer) - (finalize :pointer) - (dispatch-properties-changed :pointer) - (notify :pointer) - (constructed :pointer) - (pdummy :pointer :count 7)) - -(defbitfield g-param-flags - :readable - :writable - :construct - :construct-only - :lax-validation - :static-name - :nick - :blurb) - -(defcstruct g-param-spec - (type-instance g-type-instance) - (name (:string :free-from-foreign nil :free-to-foreign nil)) - (flags g-param-flags) - (value-type g-type) - (owner-type g-type)) - -(defcunion g-value-data - (int :int) - (uint :uint) - (long :long) - (ulong :ulong) - (int64 :int64) - (uint64 :uint64) - (float :float) - (double :double) - (pointer :pointer)) - -(defcstruct g-value - (type g-type) - (data g-value-data :count 2)) - -(defcstruct g-object-construct-param - (param-spec (:pointer g-param-spec)) - (value (:pointer g-value))) - -(defcstruct g-parameter - (name (:string :free-from-foreign nil :free-to-foreign nil)) - (value g-value)) - -(defcstruct g-enum-value - (value :int) - (name (:string :free-from-foreign nil :free-to-foreign nil)) - (nick (:string :free-from-foreign nil :free-to-foreign nil))) - -(defcstruct g-enum-class - (type-class g-type-class) - (minimum :int) - (maximum :int) - (n-values :uint) - (values (:pointer g-enum-value))) - -(defcstruct g-flags-value - (value :uint) - (name (:string :free-from-foreign nil :free-to-foreign nil)) - (nick (:string :free-from-foreign nil :free-to-foreign nil))) - -(defcstruct g-flags-class - (type-class g-type-class) - (mask :uint) - (n-values :uint) - (values (:pointer g-flags-value))) - -(defcstruct g-param-spec-boolean - (parent-instance g-param-spec) - (default-value :boolean)) - -(defcstruct g-param-spec-char - (parent-instance g-param-spec) - (minimum :int8) - (maximum :int8) - (default-value :int8)) - -(defcstruct g-param-spec-uchar - (parent-instance g-param-spec) - (minimum :uint8) - (maximum :uint8) - (default-value :uint8)) - -(defcstruct g-param-spec-int - (parent-instance g-param-spec) - (minimum :int) - (maximum :int) - (default-value :int)) - -(defcstruct g-param-spec-uint - (parent-instance g-param-spec) - (minimum :uint) - (maximum :uint) - (default-value :uint)) - -(defcstruct g-param-spec-long - (parent-instance g-param-spec) - (minimum :long) - (maximum :long) - (default-value :ulong)) - -(defcstruct g-param-spec-ulong - (parent-instance g-param-spec) - (minimum :ulong) - (maximum :ulong) - (default-value :ulong)) - -(defcstruct g-param-spec-int64 - (parent-instance g-param-spec) - (minimum :uint64) - (maximum :uint64) - (default-value :uint64)) - -(defcstruct g-param-spec-uint64 - (parent-instance g-param-spec) - (minimum :uint64) - (maximum :uint64) - (default-value :uint64)) - -(defcstruct g-param-spec-float - (parent-instance g-param-spec) - (minimum :float) - (maximum :float) - (default-value :float) - (epsilon :float)) - -(defcstruct g-param-spec-double - (parent-instance g-param-spec) - (minimum :double) - (maximum :double) - (default-value :double) - (epsilon :double)) - -(defcstruct g-param-spec-enum - (parent-instance g-param-spec) - (enum-class (:pointer g-enum-class)) - (default-value :int)) - -(defcstruct g-param-spec-flags - (parent-instance g-param-spec) - (flags-class (:pointer g-flags-class)) - (default-value :uint)) - -(defcstruct g-param-spec-string - (parent-instance g-param-spec) - (default-value (:string :free-to-foreign nil :free-from-foreign nil)) - (cset-first (:string :free-to-foreign nil :free-from-foreign nil)) - (cset-nth (:string :free-to-foreign nil :free-from-foreign nil)) - (substitutor :char) - (flags-for-null :uint)) - -(defcstruct g-param-spec-param - (parent-instance g-param-spec)) - -(defcstruct g-param-spec-boxed - (parent-instance g-param-spec)) - -(defcstruct g-param-spec-pointer - (parent-instance g-param-spec)) - -(defcstruct g-param-spec-object - (parent-instance g-param-spec)) - -(defcstruct g-param-spec-value-array - (parent-instance g-param-spec) - (element-spec (:pointer g-param-spec)) - (fixed-n-elements :uint)) - -(defcstruct g-param-spec-g-type - (parent-instance g-param-spec) - (types-root g-type)) - -(defcstruct g-param-spec-class - (type-class g-type-class) - (value-type g-type) - (finalize :pointer) - (value-set-default :pointer) - (value-validate :pointer) - (values-cmp :pointer)) - -(defcstruct g-closure - (private-data :uint32) - (marshal :pointer) - (data :pointer) - (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} @@ -300,20 +8,11 @@ (g-type-from-instance object)) (defun g-type-from-class (g-class) - (g-type-name (foreign-slot-value g-class 'g-type-class 'type))) + (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))) + (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)) + (g-type-name (foreign-slot-value type-interface 'g-type-interface :type))) -(defcfun g-type-default-interface-unref :void - (interface :pointer)) \ No newline at end of file diff --git a/glib/gobject.type-designator.lisp b/glib/gobject.type-designator.lisp new file mode 100644 index 0000000..7cf8bf7 --- /dev/null +++ b/glib/gobject.type-designator.lisp @@ -0,0 +1,48 @@ +(in-package :gobject.ffi) + +(defctype g-type gsize) + +(define-foreign-type g-type-designator () + () + (:documentation "Values of this CFFI foreign 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. + +Numeric identifier of GType may be different between different program runs. But string identifier of GType does not change.") + (: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 0))) + +(defcfun (g-type-name "g_type_name") :string + "Returns the name of a GType.@see{g-type-from-name} + +Example: +@pre{ +\(g-type-from-name \"GtkLabel\") +=> 7151952 +\(g-type-name 7151952) +=> \"GtkLabel\" +} +@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. @see{g-type-name} + +Example: +@pre{ +\(g-type-from-name \"GtkLabel\") +=> 7151952 +\(g-type-name 7151952) +=> \"GtkLabel\" +} +@arg[name]{a string - name of GType} +@return{an integer}" + (name :string)) \ No newline at end of file diff --git a/glib/gobject.type-info.lisp b/glib/gobject.type-info.lisp index 846f3fe..cb0847b 100644 --- a/glib/gobject.type-info.lisp +++ b/glib/gobject.type-info.lisp @@ -1,5 +1,5 @@ (defpackage :gobject.type-info - (:use :cl :iter :cffi :glib) + (:use :cl :iter :cffi :glib :gobject.ffi) (:export #:+g-type-invalid+ #:+g-type-void+ #:+g-type-interface+ @@ -104,129 +104,6 @@ This is a list of variables and functions that correspond to basic types: (defconstant +g-type-param+ (gtype-make-fundamental-type 19) "The fundamental type from which all GParamSpec types are derived.") (defconstant +g-type-object+ (gtype-make-fundamental-type 20) "The fundamental type for GObject.") -(define-foreign-type g-type-designator () - () - (:documentation "Values of this CFFI foreign 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. - -Numeric identifier of GType may be different between different program runs. But string identifier of GType does not change.") - (: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}. - -Example: -@pre{ -\(g-type-fundamental \"GtkWindowType\") -=> \"GEnum\" -\(g-type-fundamental \"GtkLabel\") -=> \"GObject\" -} -@arg[type]{GType designator (see @class{g-type-designator})} -@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.@see{g-type-from-name} - -Example: -@pre{ -\(g-type-from-name \"GtkLabel\") -=> 7151952 -\(g-type-name 7151952) -=> \"GtkLabel\" -} -@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. @see{g-type-name} - -Example: -@pre{ -\(g-type-from-name \"GtkLabel\") -=> 7151952 -\(g-type-name 7151952) -=> \"GtkLabel\" -} -@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. @see{g-type-chilren} - -Example: -@pre{ -\(g-type-parent \"GtkLabel\") -=> \"GtkMisc\" -} -@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. - -Example: -@pre{ -\(g-type-depth \"GtkLabel\") -=> 6 -} -@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}. - -Example: -@pre{ -\(g-type-next-base \"GtkButton\" \"GtkWidget\") -=> \"GtkContainer\" -} -@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. - -Example: -@pre{ -\(g-type-is-a \"GtkButton\" \"GtkWidget\") -=> T -\(g-type-is-a \"GtkButton\" \"AtkImplementorIface\") -=> T -\(g-type-is-a \"GtkButton\" \"GtkLabel\") -=> NIL -} -@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}.@see{g-type-parent} @@ -246,10 +123,6 @@ Example: 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. @@ -268,10 +141,6 @@ Example: 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. @@ -290,12 +159,3 @@ Example: collect (mem-aref g-types-ptr 'g-type-designator i)) (g-free g-types-ptr))))) -(defcfun g-strv-get-type g-type-designator - "Returns the type designator (see @class{g-type-designator}) for GStrv type. As a side effect, ensures that the type is registered.") - -(at-init nil (g-strv-get-type)) - -(defcfun g-closure-get-type g-type-designator - "Returns the type designator (see @class{g-type-designator}) for GClosure type. As a side effect, ensure that the type is registered.") - -(at-init nil (g-closure-get-type)) diff --git a/gtk/gtk.widget.lisp b/gtk/gtk.widget.lisp index 38bb750..5be60b9 100644 --- a/gtk/gtk.widget.lisp +++ b/gtk/gtk.widget.lisp @@ -13,33 +13,33 @@ (export 'widget-flags) (defcstruct %gtk-requisition - (width :int) - (height :int)) + (:width :int) + (:height :int)) (defcstruct %gtk-allocation - (x :int) - (y :int) - (width :int) - (height :int)) + (:x :int) + (:y :int) + (:width :int) + (:height :int)) (defcstruct %gtk-widget - (object %gtk-object) - (private-flags :uint16) - (state state-type) - (saved-state state-type) - (name (:pointer :char)) - (style :pointer) - (requisition %gtk-requisition) - (allocation %gtk-allocation) - (window :pointer) - (parent :pointer)) + (:object %gtk-object) + (:private-flags :uint16) + (:state state-type) + (:saved-state state-type) + (:name (:pointer :char)) + (:style :pointer) + (:requisition %gtk-requisition) + (:allocation %gtk-allocation) + (:window :pointer) + (:parent :pointer)) (defun widget-state (widget) - (foreign-slot-value (pointer widget) '%gtk-widget 'state)) + (foreign-slot-value (pointer widget) '%gtk-widget :state)) (export 'widget-state) (defun widget-saved-state (widget) - (foreign-slot-value (pointer widget) '%gtk-widget 'saved-state)) + (foreign-slot-value (pointer widget) '%gtk-widget :saved-state)) (export 'widget-saved-state) @@ -448,7 +448,7 @@ (unwind-protect (let ((g-param-spec (gtk-widget-class-find-style-property class property-name))) (unless g-param-spec (error "Widget ~A has no style-property named '~A'" widget property-name)) - (foreign-slot-value g-param-spec 'gobject::g-param-spec 'gobject::value-type)) + (foreign-slot-value g-param-spec 'gobject:g-param-spec :value-type)) (g-type-class-unref class)))) (defun widget-child-property-value (widget property-name &optional property-type) -- 1.7.10.4