From: Dmitry Kalyanov Date: Sun, 12 Jul 2009 07:41:49 +0000 (+0400) Subject: Moved code X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=83211c074addf8951dab479ef7f319a85136bf88;p=cl-gtk2.git Moved code --- diff --git a/glib/cl-gtk2-glib.asd b/glib/cl-gtk2-glib.asd index e843528..da72cef 100644 --- a/glib/cl-gtk2-glib.asd +++ b/glib/cl-gtk2-glib.asd @@ -24,7 +24,6 @@ (:file "gobject.foreign-closures") (:file "gobject.foreign-gboxed") (:file "gobject.gvalue-parser") - (:file "gobject.gobject-query") (:file "gobject.meta") (:file "gobject.generating") (:file "gobject.object-defs") diff --git a/glib/gobject.ffi.lisp b/glib/gobject.ffi.lisp index 319939d..3a31969 100644 --- a/glib/gobject.ffi.lisp +++ b/glib/gobject.ffi.lisp @@ -125,11 +125,11 @@ Example: (n-interfaces (:pointer :uint))) (defcstruct g-type-interface - (:type g-type) - (:instance-type g-type)) + (:type g-type-designator) + (:instance-type g-type-designator)) (defcstruct g-type-class - (:type g-type)) + (:type g-type-designator)) (defcstruct g-type-instance (:class (:pointer g-type-class))) @@ -147,7 +147,7 @@ Example: (:value-table :pointer)) (defcstruct g-type-query - (:type g-type) + (:type g-type-designator) (:type-name (:string :free-from-foreign nil)) (:class-size :uint) (:instance-size :uint)) @@ -214,8 +214,8 @@ Example: (: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)) + (:value-type g-type-designator) + (:owner-type g-type-designator)) (defcunion g-value-data (:int :int) @@ -229,7 +229,7 @@ Example: (:pointer :pointer)) (defcstruct g-value - (:type g-type) + (:type g-type-designator) (:data g-value-data :count 2)) (defcstruct g-object-construct-param @@ -366,11 +366,11 @@ Example: (defcstruct g-param-spec-g-type (:parent-instance g-param-spec) - (:types-root g-type)) + (:types-root g-type-designator)) (defcstruct g-param-spec-class (:type-class g-type-class) - (:value-type g-type) + (:value-type g-type-designator) (:finalize :pointer) (:value-set-default :pointer) (:value-validate :pointer) @@ -956,7 +956,7 @@ Example: (defcfun g-signal-lookup :uint (name :string) - (type g-type)) + (type g-type-designator)) (defbitfield g-signal-flags :run-first :run-last :run-cleanup :no-recurse :detailed :action :no-hooks) @@ -964,9 +964,9 @@ Example: (defcstruct g-signal-query (:signal-id :uint) (:signal-name :string) - (:owner-type g-type) + (:owner-type g-type-designator) (:signal-flags g-signal-flags) - (:return-type g-type) + (:return-type g-type-designator) (:n-params :uint) (:param-types (:pointer g-type))) diff --git a/glib/gobject.gobject-query.lisp b/glib/gobject.gobject-query.lisp deleted file mode 100644 index 9e3f83e..0000000 --- a/glib/gobject.gobject-query.lisp +++ /dev/null @@ -1,197 +0,0 @@ -(in-package :gobject) - -(defstruct g-class-property-definition - "Structure describing property of a GObject class. - -See accessor functions: -@itemize{ -@item{@fun{g-class-property-definition-name}} -@item{@fun{g-class-property-definition-type}} -@item{@fun{g-class-property-definition-readable}} -@item{@fun{g-class-property-definition-writable}} -@item{@fun{g-class-property-definition-constructor}} -@item{@fun{g-class-property-definition-constructor-only}} -@item{@fun{g-class-property-definition-owner-type}} -} -" - name - type - readable - writable - constructor - constructor-only - owner-type) - -(setf (documentation 'g-class-property-definition-name 'function) - "Name of GObject class property. See @class{g-class-property-definition}. -@return{a string}") - -(setf (documentation 'g-class-property-definition-type 'function) - "Type of GObject class property. See @class{g-class-property-definition}. -@return{a GType (integer)}") - -(setf (documentation 'g-class-property-definition-readable 'function) - "Whether the GObject class property is readable. See @class{g-class-property-definition}. -@return{a boolean}") - -(setf (documentation 'g-class-property-definition-writable 'function) - "Whether the GObject class property is writable. See @class{g-class-property-definition}. -@return{a boolean}") - -(setf (documentation 'g-class-property-definition-constructor 'function) - "Whether the GObject class property can be set at object construction time. See @class{g-class-property-definition}. -@return{a boolean}") - -(setf (documentation 'g-class-property-definition-constructor-only 'function) - "Whether the GObject class property can only be set at object construction time. See @class{g-class-property-definition}. -@return{a boolean}") - -(setf (documentation 'g-class-property-definition-owner-type 'function) - "The GType on which this GObject class property was defined. See @class{g-class-property-definition}. -@return{a GType (integer)}") - -(defun parse-g-param-spec (param) - (let ((flags (foreign-slot-value param 'g-param-spec :flags))) - (make-g-class-property-definition - :name (foreign-slot-value param 'g-param-spec - :name) - :type (foreign-slot-value param 'g-param-spec - :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)))) - -(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}.} -@arg[g-type]{an integer or a string specifying the GType}" - (setf g-type (ensure-g-type g-type)) - (let ((g-class (g-type-class-ref g-type))) - (unwind-protect - (with-foreign-object (n-properties :uint) - (let ((params (g-object-class-list-properties g-class n-properties))) - (unwind-protect - (loop - for i from 0 below (mem-ref n-properties :uint) - for param = (mem-aref params :pointer i) - collect (parse-g-param-spec param)) - (g-free params)))) - (g-type-class-unref g-class)))) - -(defun class-parent (type) - (g-type-parent (ensure-g-type type))) - -(defun interface-properties (g-type) -"@return{list of properties of GObject interface @code{g-type}. Each property is described by an object of type @class{g-class-property-definition}.} -@arg[g-type]{an integer or a string specifying the GType}" - (setf g-type (ensure-g-type g-type)) - (let ((g-iface (g-type-default-interface-ref g-type))) - (unwind-protect - (with-foreign-object (n-properties :uint) - (let ((params (g-object-interface-list-properties g-iface n-properties))) - (unwind-protect - (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) - collect (make-g-class-property-definition - :name (foreign-slot-value param 'g-param-spec - :name) - :type (foreign-slot-value param 'g-param-spec - :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))) - (g-free params)))) - (g-type-default-interface-unref g-iface)))) - -(defstruct enum-item - "A structure describing a single enumeration item. - -See accessor functions: -@itemize{ -@item{@fun{enum-item-name}} -@item{@fun{enum-item-value}} -@item{@fun{enum-item-nick}} -}" - name value nick) - -(setf (documentation 'enum-item-name 'function) - "The C name of enum item, e.g. \"GTK_WINDOW_TOPLEVEL\". -@return{a string}") - -(setf (documentation 'enum-item-value 'function) - "The numeric value of enum item. -@return{an integer}") - -(setf (documentation 'enum-item-nick 'function) - "The \"nickname\" of enum item. Nickname is a short name of enum item. E.g., \"toplevel\". -@return{a string}") - -(defun get-enum-items (type) - "Gets the list of enum items that belong to GEnum type @code{type} -@arg[type]{a string or an integer specifying GEnum type} -@return{a list of @class{enum-item} objects}" - (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) - 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) - :value (foreign-slot-value enum-value 'g-enum-value - :value) - :nick (foreign-slot-value enum-value 'g-enum-value - :nick))) - (g-type-class-unref g-class)))) - -(defstruct flags-item - "A structure describing a single flags item. - -See accessor functions: -@itemize{ -@item{@fun{flags-item-name}} -@item{@fun{flags-item-value}} -@item{@fun{flags-item-nick}} -}" - name value nick) - -(setf (documentation 'flags-item-name 'function) - "The C name of flags item, e.g. \"GDK_PROPERTY_CHANGE_MASK\". -@return{a string}") - -(setf (documentation 'flags-item-value 'function) - "The numeric value of flags item. -@return{an integer}") - -(setf (documentation 'flags-item-nick 'function) - "The \"nickname\" of flags item. Nickname is a short name of flags item. E.g., \"property-change-mask\". -@return{a string}") - -(defun get-flags-items (type) - "Gets the list of flags items that belong to GFlags type @code{type} -@arg[type]{a string or an integer specifying GFlags type} -@return{a list of @class{flags-item} objects}" - (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) - 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) - :value (foreign-slot-value flags-value 'g-flags-value - :value) - :nick (foreign-slot-value flags-value 'g-flags-value - :nick))) - (g-type-class-unref g-class)))) diff --git a/glib/gobject.package.lisp b/glib/gobject.package.lisp index 0889d0b..25b6c6b 100644 --- a/glib/gobject.package.lisp +++ b/glib/gobject.package.lisp @@ -60,32 +60,11 @@ #:g-value-unset #:g-value-zero #:g-value-init - #:g-class-property-definition - #:g-class-property-definition-name - #:g-class-property-definition-type - #:g-class-property-definition-readable - #:g-class-property-definition-writable - #:g-class-property-definition-constructor - #:g-class-property-definition-constructor-only - #:g-class-property-definition-owner-type - #:class-properties - #:interface-properties - #:enum-item - #:enum-item-name - #:enum-item-value - #:enum-item-nick - #:get-enum-types - #:flags-item - #:flags-item-name - #:flags-item-value - #:flags-item-nick - #:get-flags-types #:g-type-class-ref #:g-object-class #:gobject-class #:g-param-spec #:type-instance - #:parse-g-param-spec #:g-type-class-unref #:registered-object-type-by-name #:g-type-children @@ -99,7 +78,42 @@ #:g-type-next-base #:g-type-is-a #:g-type-interfaces - #:g-type-interface-prerequisites) + #:g-type-interface-prerequisites + #: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 + #:g-class-property-definition + #:g-class-property-definition-name + #:g-class-property-definition-type + #:g-class-property-definition-readable + #:g-class-property-definition-writable + #:g-class-property-definition-constructor + #:g-class-property-definition-constructor-only + #:g-class-property-definition-owner-type + #:parse-g-param-spec + #:class-properties + #:interface-properties + #:enum-item + #:enum-item-name + #:enum-item-value + #:enum-item-nick + #:get-enum-items + #:flags-item + #:flags-item-name + #:flags-item-value + #:flags-item-nick + #:get-flags-items) (:documentation "CL-GTK2-GOBJECT is a binding to GObject type system. For information on GObject, see its @a[http://library.gnome.org/devel/gobject/stable/]{documentation}. diff --git a/glib/gobject.type-info.lisp b/glib/gobject.type-info.lisp index cb0847b..0d21def 100644 --- a/glib/gobject.type-info.lisp +++ b/glib/gobject.type-info.lisp @@ -34,7 +34,28 @@ #:g-type-interfaces #:g-type-interface-prerequisites #:g-strv-get-type - #:g-closure-get-type) + #:g-closure-get-type + #:g-class-property-definition + #:g-class-property-definition-name + #:g-class-property-definition-type + #:g-class-property-definition-readable + #:g-class-property-definition-writable + #:g-class-property-definition-constructor + #:g-class-property-definition-constructor-only + #:g-class-property-definition-owner-type + #:parse-g-param-spec + #:class-properties + #:interface-properties + #:enum-item + #:enum-item-name + #:enum-item-value + #:enum-item-nick + #:get-enum-items + #:flags-item + #:flags-item-name + #:flags-item-value + #:flags-item-nick + #:get-flags-items) (:documentation "This package contains functions for querying the basic type information from GObject type system. For an overview of GObject type system, see @a[http://library.gnome.org/devel/gobject/stable/index.html]{GObject documentation} diff --git a/glib/gobject.type-info.object.lisp b/glib/gobject.type-info.object.lisp new file mode 100644 index 0000000..c76600f --- /dev/null +++ b/glib/gobject.type-info.object.lisp @@ -0,0 +1,179 @@ +(in-package :gobject.type-info) + +(defstruct g-class-property-definition + "Structure describing property of a GObject class. + +See accessor functions: +@itemize{ +@item{@fun{g-class-property-definition-name}} +@item{@fun{g-class-property-definition-type}} +@item{@fun{g-class-property-definition-readable}} +@item{@fun{g-class-property-definition-writable}} +@item{@fun{g-class-property-definition-constructor}} +@item{@fun{g-class-property-definition-constructor-only}} +@item{@fun{g-class-property-definition-owner-type}} +} +" + name + type + readable + writable + constructor + constructor-only + owner-type) + +(setf (documentation 'g-class-property-definition-name 'function) + "Name of GObject class property. See @class{g-class-property-definition}. +@return{a string}") + +(setf (documentation 'g-class-property-definition-type 'function) + "Type of GObject class property. See @class{g-class-property-definition}. +@return{a GType (integer)}") + +(setf (documentation 'g-class-property-definition-readable 'function) + "Whether the GObject class property is readable. See @class{g-class-property-definition}. +@return{a boolean}") + +(setf (documentation 'g-class-property-definition-writable 'function) + "Whether the GObject class property is writable. See @class{g-class-property-definition}. +@return{a boolean}") + +(setf (documentation 'g-class-property-definition-constructor 'function) + "Whether the GObject class property can be set at object construction time. See @class{g-class-property-definition}. +@return{a boolean}") + +(setf (documentation 'g-class-property-definition-constructor-only 'function) + "Whether the GObject class property can only be set at object construction time. See @class{g-class-property-definition}. +@return{a boolean}") + +(setf (documentation 'g-class-property-definition-owner-type 'function) + "The GType on which this GObject class property was defined. See @class{g-class-property-definition}. +@return{a GType (integer)}") + +(defun parse-g-param-spec (param) + (let ((flags (foreign-slot-value param 'g-param-spec :flags))) + (make-g-class-property-definition + :name (foreign-slot-value param 'g-param-spec :name) + :type (foreign-slot-value param 'g-param-spec :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)))) + +(defmacro with-unwind ((var expr unwind-function) &body body) + `(let ((,var ,expr)) + (unwind-protect (progn ,@body) + (,unwind-function ,var)))) + +(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}.} +@arg[g-type]{an integer or a string specifying the GType}" + (assert (g-type-is-a g-type +g-type-object+)) + (with-unwind (g-class (g-type-class-ref g-type) g-type-class-unref) + (with-foreign-object (n-properties :uint) + (with-unwind (params (g-object-class-list-properties g-class n-properties) g-free) + (loop + for i from 0 below (mem-ref n-properties :uint) + for param = (mem-aref params :pointer i) + collect (parse-g-param-spec param)))))) + +(defun interface-properties (g-type) + "@return{list of properties of GObject interface @code{g-type}. Each property is described by an object of type @class{g-class-property-definition}.} +@arg[g-type]{an integer or a string specifying the GType}" + (assert (g-type-is-a g-type +g-type-interface+)) + (with-unwind (g-iface (g-type-default-interface-ref g-type) g-type-default-interface-unref) + (with-foreign-object (n-properties :uint) + (with-unwind (params (g-object-interface-list-properties g-iface n-properties) g-free) + (loop + for i from 0 below (mem-ref n-properties :uint) + for param = (mem-aref params :pointer i) + collect (parse-g-param-spec param)))))) + +(defstruct enum-item + "A structure describing a single enumeration item. + +See accessor functions: +@itemize{ +@item{@fun{enum-item-name}} +@item{@fun{enum-item-value}} +@item{@fun{enum-item-nick}} +}" + name value nick) + +(setf (documentation 'enum-item-name 'function) + "The C name of enum item, e.g. \"GTK_WINDOW_TOPLEVEL\". +@return{a string}") + +(setf (documentation 'enum-item-value 'function) + "The numeric value of enum item. +@return{an integer}") + +(setf (documentation 'enum-item-nick 'function) + "The \"nickname\" of enum item. Nickname is a short name of enum item. E.g., \"toplevel\". +@return{a string}") + +(defun get-enum-items (type) + "Gets the list of enum items that belong to GEnum type @code{type} +@arg[type]{a string or an integer specifying GEnum type} +@return{a list of @class{enum-item} objects}" + (assert (g-type-is-a type +g-type-enum+)) + (let ((g-class (g-type-class-ref 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) + 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) + :value (foreign-slot-value enum-value 'g-enum-value + :value) + :nick (foreign-slot-value enum-value 'g-enum-value + :nick))) + (g-type-class-unref g-class)))) + +(defstruct flags-item + "A structure describing a single flags item. + +See accessor functions: +@itemize{ +@item{@fun{flags-item-name}} +@item{@fun{flags-item-value}} +@item{@fun{flags-item-nick}} +}" + name value nick) + +(setf (documentation 'flags-item-name 'function) + "The C name of flags item, e.g. \"GDK_PROPERTY_CHANGE_MASK\". +@return{a string}") + +(setf (documentation 'flags-item-value 'function) + "The numeric value of flags item. +@return{an integer}") + +(setf (documentation 'flags-item-nick 'function) + "The \"nickname\" of flags item. Nickname is a short name of flags item. E.g., \"property-change-mask\". +@return{a string}") + +(defun get-flags-items (type) + "Gets the list of flags items that belong to GFlags type @code{type} +@arg[type]{a string or an integer specifying GFlags type} +@return{a list of @class{flags-item} objects}" + (assert (g-type-is-a type +g-type-flags+)) + (let ((g-class (g-type-class-ref 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) + 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) + :value (foreign-slot-value flags-value 'g-flags-value + :value) + :nick (foreign-slot-value flags-value 'g-flags-value + :nick))) + (g-type-class-unref g-class))))