glib/gobject.type-info.object.lisp

   1 (in-package :gobject.type-info)
   2
   3 (defstruct g-class-property-definition
   4   "Structure describing property of a GObject class.
   5
   6 See accessor functions:
   7 @itemize{
   8 @item{@fun{g-class-property-definition-name}}
   9 @item{@fun{g-class-property-definition-type}}
  10 @item{@fun{g-class-property-definition-readable}}
  11 @item{@fun{g-class-property-definition-writable}}
  12 @item{@fun{g-class-property-definition-constructor}}
  13 @item{@fun{g-class-property-definition-constructor-only}}
  14 @item{@fun{g-class-property-definition-owner-type}}
  15 }
  16 "
  17   name
  18   type
  19   readable
  20   writable
  21   constructor
  22   constructor-only
  23   owner-type)
  24
  25 (setf (documentation 'g-class-property-definition-name 'function)
  26       "Name of GObject class property. See @class{g-class-property-definition}.
  27 @return{a string}")
  28
  29 (setf (documentation 'g-class-property-definition-type 'function)
  30       "Type of GObject class property. See @class{g-class-property-definition}.
  31 @return{a GType (integer)}")
  32
  33 (setf (documentation 'g-class-property-definition-readable 'function)
  34       "Whether the GObject class property is readable. See @class{g-class-property-definition}.
  35 @return{a boolean}")
  36
  37 (setf (documentation 'g-class-property-definition-writable 'function)
  38       "Whether the GObject class property is writable. See @class{g-class-property-definition}.
  39 @return{a boolean}")
  40
  41 (setf (documentation 'g-class-property-definition-constructor 'function)
  42       "Whether the GObject class property can be set at object construction time. See @class{g-class-property-definition}.
  43 @return{a boolean}")
  44
  45 (setf (documentation 'g-class-property-definition-constructor-only 'function)
  46       "Whether the GObject class property can only be set at object construction time. See @class{g-class-property-definition}.
  47 @return{a boolean}")
  48
  49 (setf (documentation 'g-class-property-definition-owner-type 'function)
  50       "The GType on which this GObject class property was defined. See @class{g-class-property-definition}.
  51 @return{a GType (integer)}")
  52
  53 (defun parse-g-param-spec (param)
  54   (let ((flags (foreign-slot-value param 'g-param-spec :flags)))
  55     (make-g-class-property-definition
  56      :name (foreign-slot-value param 'g-param-spec :name)
  57      :type (foreign-slot-value param 'g-param-spec :value-type)
  58      :readable (not (null (member :readable flags)))
  59      :writable (not (null (member :writable flags)))
  60      :constructor (not (null (member :construct flags)))
  61      :constructor-only (not (null (member :construct-only flags)))
  62      :owner-type (foreign-slot-value param 'g-param-spec :owner-type))))
  63
  64 (defmacro with-unwind ((var expr unwind-function) &body body)
  65   `(let ((,var ,expr))
  66      (unwind-protect (progn ,@body)
  67        (,unwind-function ,var))))
  68
  69 (defun class-properties (g-type)
  70   "@return{list of properties of GObject class @code{g-type}. Each property is described by an object of type @class{g-class-property-definition}.}
  71 @arg[g-type]{an integer or a string specifying the GType}"
  72   (assert (g-type-is-a g-type +g-type-object+))
  73   (with-unwind (g-class (g-type-class-ref g-type) g-type-class-unref)
  74     (with-foreign-object (n-properties :uint)
  75       (with-unwind (params (g-object-class-list-properties g-class n-properties) g-free)
  76         (loop
  77            for i from 0 below (mem-ref n-properties :uint)
  78            for param = (mem-aref params :pointer i)
  79            collect (parse-g-param-spec param))))))
  80
  81 (defun interface-properties (g-type)
  82   "@return{list of properties of GObject interface @code{g-type}. Each property is described by an object of type @class{g-class-property-definition}.}
  83 @arg[g-type]{an integer or a string specifying the GType}"
  84   (assert (g-type-is-a g-type +g-type-interface+))
  85   (with-unwind (g-iface (g-type-default-interface-ref g-type) g-type-default-interface-unref)
  86     (with-foreign-object (n-properties :uint)
  87       (with-unwind (params (g-object-interface-list-properties g-iface n-properties) g-free)
  88         (loop
  89            for i from 0 below (mem-ref n-properties :uint)
  90            for param = (mem-aref params :pointer i)
  91            collect (parse-g-param-spec param))))))
  92
  93 (defstruct enum-item
  94   "A structure describing a single enumeration item.
  95
  96 See accessor functions:
  97 @itemize{
  98 @item{@fun{enum-item-name}}
  99 @item{@fun{enum-item-value}}
 100 @item{@fun{enum-item-nick}}
 101 }"
 102   name value nick)
 103
 104 (setf (documentation 'enum-item-name 'function)
 105       "The C name of enum item, e.g. \"GTK_WINDOW_TOPLEVEL\".
 106 @return{a string}")
 107
 108 (setf (documentation 'enum-item-value 'function)
 109       "The numeric value of enum item.
 110 @return{an integer}")
 111
 112 (setf (documentation 'enum-item-nick 'function)
 113       "The \"nickname\" of enum item. Nickname is a short name of enum item. E.g., \"toplevel\".
 114 @return{a string}")
 115
 116 (defun get-enum-items (type)
 117   "Gets the list of enum items that belong to GEnum type @code{type}
 118 @arg[type]{a string or an integer specifying GEnum type}
 119 @return{a list of @class{enum-item} objects}"
 120   (assert (g-type-is-a type +g-type-enum+))
 121   (let ((g-class (g-type-class-ref type)))
 122     (unwind-protect
 123          (loop
 124             with n = (foreign-slot-value g-class 'g-enum-class :n-values)
 125             with values = (foreign-slot-value g-class 'g-enum-class :values)
 126             for i from 0 below n
 127             for enum-value = (mem-aref values 'g-enum-value i)
 128             collect (make-enum-item
 129                      :name (foreign-slot-value enum-value 'g-enum-value
 130                                                :name)
 131                      :value (foreign-slot-value enum-value 'g-enum-value
 132                                                 :value)
 133                      :nick (foreign-slot-value enum-value 'g-enum-value
 134                                                :nick)))
 135       (g-type-class-unref g-class))))
 136
 137 (defstruct flags-item
 138   "A structure describing a single flags item.
 139
 140 See accessor functions:
 141 @itemize{
 142 @item{@fun{flags-item-name}}
 143 @item{@fun{flags-item-value}}
 144 @item{@fun{flags-item-nick}}
 145 }"
 146   name value nick)
 147
 148 (setf (documentation 'flags-item-name 'function)
 149       "The C name of flags item, e.g. \"GDK_PROPERTY_CHANGE_MASK\".
 150 @return{a string}")
 151
 152 (setf (documentation 'flags-item-value 'function)
 153       "The numeric value of flags item.
 154 @return{an integer}")
 155
 156 (setf (documentation 'flags-item-nick 'function)
 157       "The \"nickname\" of flags item. Nickname is a short name of flags item. E.g., \"property-change-mask\".
 158 @return{a string}")
 159
 160 (defun get-flags-items (type)
 161   "Gets the list of flags items that belong to GFlags type @code{type}
 162 @arg[type]{a string or an integer specifying GFlags type}
 163 @return{a list of @class{flags-item} objects}"
 164   (assert (g-type-is-a type +g-type-flags+))
 165   (let ((g-class (g-type-class-ref type)))
 166     (unwind-protect
 167          (loop
 168             with n = (foreign-slot-value g-class 'g-flags-class :n-values)
 169             with values = (foreign-slot-value g-class 'g-flags-class :values)
 170             for i from 0 below n
 171             for flags-value = (mem-aref values 'g-flags-value i)
 172             collect (make-flags-item
 173                      :name (foreign-slot-value flags-value 'g-flags-value
 174                                                :name)
 175                      :value (foreign-slot-value flags-value 'g-flags-value
 176                                                 :value)
 177                      :nick (foreign-slot-value flags-value 'g-flags-value
 178                                                :nick)))
 179       (g-type-class-unref g-class))))