glib/gobject.gobject-query.lisp

   1 (in-package :gobject)
   2
   3 (defstruct g-class-property-definition
   4   name
   5   type
   6   readable
   7   writable
   8   constructor
   9   constructor-only
  10   owner-type)
  11
  12 (defun parse-g-param-spec (param)
  13   (let ((flags (foreign-slot-value param 'g-param-spec 'flags)))
  14     (make-g-class-property-definition
  15      :name (foreign-slot-value param 'g-param-spec
  16                                'name)
  17      :type (foreign-slot-value param 'g-param-spec
  18                                'value-type)
  19      :readable (not (null (member :readable flags)))
  20      :writable (not (null (member :writable flags)))
  21      :constructor (not (null (member :construct flags)))
  22      :constructor-only (not (null (member :construct-only flags)))
  23      :owner-type (foreign-slot-value param 'g-param-spec
  24                                      'owner-type))))
  25
  26 (defun class-properties (g-type)
  27   (setf g-type (ensure-g-type g-type))
  28   (let ((g-class (g-type-class-ref g-type)))
  29     (unwind-protect
  30          (with-foreign-object (n-properties :uint)
  31            (let ((params (g-object-class-list-properties g-class n-properties)))
  32              (unwind-protect
  33                   (loop
  34                      for i from 0 below (mem-ref n-properties :uint)
  35                      for param = (mem-aref params :pointer i)
  36                      collect (parse-g-param-spec param))
  37                (g-free params))))
  38       (g-type-class-unref g-class))))
  39
  40 (defun class-parent (type)
  41   (g-type-parent (ensure-g-type type)))
  42
  43 (defun interface-properties (g-type)
  44   (setf g-type (ensure-g-type g-type))
  45   (let ((g-iface (g-type-default-interface-ref g-type)))
  46     (unwind-protect
  47          (with-foreign-object (n-properties :uint)
  48            (let ((params (g-object-interface-list-properties g-iface n-properties)))
  49              (unwind-protect
  50                   (loop
  51                      for i from 0 below (mem-ref n-properties :uint)
  52                      for param = (mem-aref params :pointer i)
  53                      for flags = (foreign-slot-value param 'g-param-spec 'flags)
  54                      collect (make-g-class-property-definition
  55                               :name (foreign-slot-value param 'g-param-spec
  56                                                         'name)
  57                               :type (foreign-slot-value param 'g-param-spec
  58                                                         'value-type)
  59                               :readable (not (null (member :readable flags)))
  60                               :writable (not (null (member :writable flags)))
  61                               :constructor (not (null (member :construct flags)))
  62                               :constructor-only (not (null (member :construct-only flags)))
  63                               :owner-type (foreign-slot-value param 'g-param-spec
  64                                                               'owner-type)))
  65                (g-free params))))
  66       (g-type-default-interface-unref g-iface))))
  67
  68 (defstruct enum-item
  69   name value nick)
  70
  71 (defun get-enum-items (type)
  72   (let ((g-class (g-type-class-ref (ensure-g-type type))))
  73     (unwind-protect
  74          (loop
  75             with n = (foreign-slot-value g-class 'g-enum-class 'n-values)
  76             with values = (foreign-slot-value g-class 'g-enum-class 'values)
  77             for i from 0 below n
  78             for enum-value = (mem-aref values 'g-enum-value i)
  79             collect (make-enum-item
  80                      :name (foreign-slot-value enum-value 'g-enum-value
  81                                                'name)
  82                      :value (foreign-slot-value enum-value 'g-enum-value
  83                                                 'value)
  84                      :nick (foreign-slot-value enum-value 'g-enum-value
  85                                                'nick)))
  86       (g-type-class-unref g-class))))
  87
  88 (defstruct flags-item
  89   name value nick)
  90
  91 (defun get-flags-items (type)
  92   (let ((g-class (g-type-class-ref (ensure-g-type type))))
  93     (unwind-protect
  94          (loop
  95             with n = (foreign-slot-value g-class 'g-flags-class 'n-values)
  96             with values = (foreign-slot-value g-class 'g-flags-class 'values)
  97             for i from 0 below n
  98             for flags-value = (mem-aref values 'g-flags-value i)
  99             collect (make-flags-item
 100                      :name (foreign-slot-value flags-value 'g-flags-value
 101                                                'name)
 102                      :value (foreign-slot-value flags-value 'g-flags-value
 103                                                 'value)
 104                      :nick (foreign-slot-value flags-value 'g-flags-value
 105                                                'nick)))
 106       (g-type-class-unref g-class))))