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