glib/gobject.type-info.lisp

   1 (defpackage :gobject.type-info
   2   (:use :cl :iter :cffi :glib)
   3   (:export #:+g-type-invalid+
   4            #:+g-type-void+
   5            #:+g-type-interface+
   6            #:+g-type-char+
   7            #:+g-type-uchar+
   8            #:+g-type-boolean+
   9            #:+g-type-int+
  10            #:+g-type-uint+
  11            #:+g-type-long+
  12            #:+g-type-ulong+
  13            #:+g-type-int64+
  14            #:+g-type-uint64+
  15            #:+g-type-enum+
  16            #:+g-type-flags+
  17            #:+g-type-float+
  18            #:+g-type-double+
  19            #:+g-type-string+
  20            #:+g-type-pointer+
  21            #:+g-type-boxed+
  22            #:+g-type-param+
  23            #:+g-type-object+
  24            #:g-type-name
  25            #:g-type-from-name
  26            #:g-type
  27            #:g-type-children
  28            #:g-type-parent
  29            #:g-type-designator
  30            #:g-type-fundamental
  31            #:g-type-depth
  32            #:g-type-next-base
  33            #:g-type-is-a
  34            #:g-type-interfaces
  35            #:g-type-interface-prerequisites
  36            #:g-strv-get-type
  37            #:g-closure-get-type))
  38
  39 (in-package :gobject.type-info)
  40
  41 (defctype g-type gsize)
  42
  43 (eval-when (:load-toplevel :compile-toplevel)
  44   (defun gtype-make-fundamental-type (x)
  45     (ash x 2)))
  46
  47 (defconstant +g-type-invalid+ (gtype-make-fundamental-type 0))
  48 (defconstant +g-type-void+ (gtype-make-fundamental-type 1))
  49 (defconstant +g-type-interface+ (gtype-make-fundamental-type 2))
  50 (defconstant +g-type-char+ (gtype-make-fundamental-type 3))
  51 (defconstant +g-type-uchar+ (gtype-make-fundamental-type 4))
  52 (defconstant +g-type-boolean+ (gtype-make-fundamental-type 5))
  53 (defconstant +g-type-int+ (gtype-make-fundamental-type 6))
  54 (defconstant +g-type-uint+ (gtype-make-fundamental-type 7))
  55 (defconstant +g-type-long+ (gtype-make-fundamental-type 8))
  56 (defconstant +g-type-ulong+ (gtype-make-fundamental-type 9))
  57 (defconstant +g-type-int64+ (gtype-make-fundamental-type 10))
  58 (defconstant +g-type-uint64+ (gtype-make-fundamental-type 11))
  59 (defconstant +g-type-enum+ (gtype-make-fundamental-type 12))
  60 (defconstant +g-type-flags+ (gtype-make-fundamental-type 13))
  61 (defconstant +g-type-float+ (gtype-make-fundamental-type 14))
  62 (defconstant +g-type-double+ (gtype-make-fundamental-type 15))
  63 (defconstant +g-type-string+ (gtype-make-fundamental-type 16))
  64 (defconstant +g-type-pointer+ (gtype-make-fundamental-type 17))
  65 (defconstant +g-type-boxed+ (gtype-make-fundamental-type 18))
  66 (defconstant +g-type-param+ (gtype-make-fundamental-type 19))
  67 (defconstant +g-type-object+ (gtype-make-fundamental-type 20))
  68
  69 (define-foreign-type g-type-designator ()
  70   ()
  71   (:documentation "Values of this type identify the GType. GType is designated by a its name (a string) or a numeric identifier. Functions accept GType designators as a string or integer and return them as a string. Functions @fun{g-type-name} and @fun{g-type-from-name} are used to convert between name and numeric identifier.")
  72   (:actual-type g-type)
  73   (:simple-parser g-type-designator))
  74
  75 (defmethod translate-from-foreign (value (type g-type-designator))
  76   (g-type-name value))
  77
  78 (defmethod translate-to-foreign (value (type g-type-designator))
  79   (etypecase value
  80     (string (g-type-from-name value))
  81     (integer value)
  82     (null +g-type-invalid+)))
  83
  84 (defcfun (g-type-fundamental "g_type_fundamental") g-type-designator
  85   "Returns the fundamental type which is the ancestor of @code{type}.
  86 @arg[type]{GType designator (see @class{g-type-fundamental})}
  87 @return{GType designator}"
  88   (type g-type-designator))
  89
  90 (defcfun (%g-type-init "g_type_init") :void)
  91
  92 (at-init () (%g-type-init))
  93
  94 (defcfun (g-type-name "g_type_name") :string
  95   "Returns the name of a GType.
  96
  97 @arg[type]{GType designator (see @class{g-type-designator})}
  98 @return{a string}"
  99   (type g-type-designator))
 100
 101 (defcfun (g-type-from-name "g_type_from_name") g-type
 102   "Returns the numeric identifier of a GType by its name
 103
 104 @arg[name]{a string - name of GType}
 105 @return{an integer}"
 106   (name :string))
 107
 108 (defcfun g-type-parent g-type-designator
 109   "Returns the parent of a GType
 110
 111 @arg[type]{GType designator (see @class{g-type-designator})}
 112 @return{GType designator}"
 113   (type g-type-designator))
 114
 115 (defcfun g-type-depth :uint
 116   "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.
 117 @arg[type]{GType designator (see @class{g-type-designator})}
 118 @return{an integer}"
 119   (type g-type-designator))
 120
 121 (defcfun g-type-next-base g-type-designator
 122   "Determines the type that is derived directly from @code{root-type} which is also a base class of @code{leaf-type}.
 123 @arg[leaf-type]{GType designator (see @class{g-type-designator})}
 124 @arg[root-type]{GType designator}
 125 @return{GType designator}"
 126   (leaf-type g-type-designator)
 127   (root-type g-type-designator))
 128
 129 (defcfun g-type-is-a :boolean
 130   "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.
 131 @arg[type]{GType designator (see @class{g-type-designator})}
 132 @arg[is-a-type]{GType designator}
 133 @return{boolean}"
 134   (type g-type-designator)
 135   (is-a-type g-type-designator))
 136
 137 (defcfun (%g-type-children "g_type_children") (:pointer g-type)
 138   (type g-type-designator)
 139   (n-children (:pointer :uint)))
 140
 141 (defun g-type-children (g-type)
 142   "Returns the list of types inherited from @code{g-type}.
 143
 144 @arg[g-type]{GType designator (see @class{g-type-designator})}
 145 @return{list of GType designators}"
 146   (with-foreign-object (n-children :uint)
 147     (let ((g-types-ptr (%g-type-children g-type n-children)))
 148       (prog1
 149           (loop
 150              for i from 0 below (mem-ref n-children :uint)
 151              collect (mem-aref g-types-ptr 'g-type-designator i))
 152         (g-free g-types-ptr)))))
 153
 154 (defcfun (%g-type-interfaces "g_type_interfaces") (:pointer g-type)
 155   (type g-type-designator)
 156   (n-interfaces (:pointer :uint)))
 157
 158 (defun g-type-interfaces (g-type)
 159   "Returns the list of interfaces the @code{g-type} conforms to.
 160
 161 @arg[g-type]{GType designator (see @class{g-type-designator})}
 162 @return{list of GType designators}"
 163   (with-foreign-object (n-interfaces :uint)
 164     (let ((g-types-ptr (%g-type-interfaces g-type n-interfaces)))
 165       (prog1
 166           (loop
 167              for i from 0 below (mem-ref n-interfaces :uint)
 168              collect (mem-aref g-types-ptr 'g-type-designator i))
 169         (g-free g-types-ptr)))))
 170
 171 (defcfun (%g-type-interface-prerequisites "g_type_interface_prerequisites") (:pointer g-type)
 172   (type g-type-designator)
 173   (n-interface-prerequisites (:pointer :uint)))
 174
 175 (defun g-type-interface-prerequisites (g-type)
 176   "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.
 177 @arg[g-type]{GType designator (see @class{g-type-designator})}
 178 @return{list of GType designators}"
 179   (with-foreign-object (n-interface-prerequisites :uint)
 180     (let ((g-types-ptr (%g-type-interface-prerequisites g-type n-interface-prerequisites)))
 181       (prog1
 182           (loop
 183              for i from 0 below (mem-ref n-interface-prerequisites :uint)
 184              collect (mem-aref g-types-ptr 'g-type-designator i))
 185         (g-free g-types-ptr)))))
 186
 187 (defcfun g-strv-get-type g-type-designator)
 188
 189 (at-init nil (g-strv-get-type))
 190
 191 (defcfun g-closure-get-type g-type-designator)
 192
 193 (at-init nil (g-closure-get-type))