glib/gobject.type-info.object.lisp

   1 (in-package :gobject)
   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 (defmethod print-object ((instance g-class-property-definition) stream)
  26   (if *print-readably*
  27       (call-next-method)
  28       (print-unreadable-object (instance stream)
  29         (format stream
  30                 "PROPERTY ~A ~A.~A (flags:~@[~* readable~]~@[~* writable~]~@[~* constructor~]~@[~* constructor-only~])"
  31                 (g-class-property-definition-type instance)
  32                 (g-class-property-definition-owner-type instance)
  33                 (g-class-property-definition-name instance)
  34                 (g-class-property-definition-readable instance)
  35                 (g-class-property-definition-writable instance)
  36                 (g-class-property-definition-constructor instance)
  37                 (g-class-property-definition-constructor-only instance)))))
  38
  39 (setf (documentation 'g-class-property-definition-name 'function)
  40       "Name of GObject class property. See @class{g-class-property-definition}.
  41 @return{a string}")
  42
  43 (setf (documentation 'g-class-property-definition-type 'function)
  44       "Type of GObject class property. See @class{g-class-property-definition}.
  45 @return{a GType (integer)}")
  46
  47 (setf (documentation 'g-class-property-definition-readable 'function)
  48       "Whether the GObject class property is readable. See @class{g-class-property-definition}.
  49 @return{a boolean}")
  50
  51 (setf (documentation 'g-class-property-definition-writable 'function)
  52       "Whether the GObject class property is writable. See @class{g-class-property-definition}.
  53 @return{a boolean}")
  54
  55 (setf (documentation 'g-class-property-definition-constructor 'function)
  56       "Whether the GObject class property can be set at object construction time. See @class{g-class-property-definition}.
  57 @return{a boolean}")
  58
  59 (setf (documentation 'g-class-property-definition-constructor-only 'function)
  60       "Whether the GObject class property can only be set at object construction time. See @class{g-class-property-definition}.
  61 @return{a boolean}")
  62
  63 (setf (documentation 'g-class-property-definition-owner-type 'function)
  64       "The GType on which this GObject class property was defined. See @class{g-class-property-definition}.
  65 @return{a GType (integer)}")
  66
  67 (defun parse-g-param-spec (param)
  68   (let ((flags (foreign-slot-value param 'g-param-spec :flags)))
  69     (make-g-class-property-definition
  70      :name (foreign-slot-value param 'g-param-spec :name)
  71      :type (foreign-slot-value param 'g-param-spec :value-type)
  72      :readable (not (null (member :readable flags)))
  73      :writable (not (null (member :writable flags)))
  74      :constructor (not (null (member :construct flags)))
  75      :constructor-only (not (null (member :construct-only flags)))
  76      :owner-type (foreign-slot-value param 'g-param-spec :owner-type))))
  77
  78 (defmacro with-unwind ((var expr unwind-function) &body body)
  79   `(let ((,var ,expr))
  80      (unwind-protect (progn ,@body)
  81        (,unwind-function ,var))))
  82
  83 (defun class-properties (g-type)
  84   "@return{list of properties of GObject class @code{g-type}. Each property is described by an object of type @class{g-class-property-definition}.}
  85 @arg[g-type]{an integer or a string specifying the GType}"
  86   (assert (g-type-is-a g-type +g-type-object+))
  87   (with-unwind (g-class (g-type-class-ref g-type) g-type-class-unref)
  88     (with-foreign-object (n-properties :uint)
  89       (with-unwind (params (g-object-class-list-properties g-class n-properties) g-free)
  90         (loop
  91            for i from 0 below (mem-ref n-properties :uint)
  92            for param = (mem-aref params :pointer i)
  93            collect (parse-g-param-spec param))))))
  94
  95 (defun class-property-info (g-type property-name)
  96   (with-unwind (g-class (g-type-class-ref g-type) g-type-class-unref)
  97     (let* ((param-spec (g-object-class-find-property g-class property-name)))
  98       (when param-spec (parse-g-param-spec param-spec)))))
  99
 100 (defun interface-properties (g-type)
 101   "@return{list of properties of GObject interface @code{g-type}. Each property is described by an object of type @class{g-class-property-definition}.}
 102 @arg[g-type]{an integer or a string specifying the GType}"
 103   (assert (g-type-is-a g-type +g-type-interface+))
 104   (with-unwind (g-iface (g-type-default-interface-ref g-type) g-type-default-interface-unref)
 105     (with-foreign-object (n-properties :uint)
 106       (with-unwind (params (g-object-interface-list-properties g-iface n-properties) g-free)
 107         (loop
 108            for i from 0 below (mem-ref n-properties :uint)
 109            for param = (mem-aref params :pointer i)
 110            collect (parse-g-param-spec param))))))