X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=glib%2Fgobject.type-info.object.lisp;h=27b7db06ab79370b3ed05085733c768de0433f16;hb=47427d9e824cf990bf88b4db8fdb205565062cd2;hp=c76600f71df0a8c8349a850fe5c104533b6410d2;hpb=83211c074addf8951dab479ef7f319a85136bf88;p=cl-gtk2.git

diff --git a/glib/gobject.type-info.object.lisp b/glib/gobject.type-info.object.lisp
index c76600f..27b7db0 100644
--- a/glib/gobject.type-info.object.lisp
+++ b/glib/gobject.type-info.object.lisp
@@ -1,4 +1,4 @@
-(in-package :gobject.type-info)
+(in-package :gobject)
 
 (defstruct g-class-property-definition
   "Structure describing property of a GObject class.
@@ -22,6 +22,20 @@ See accessor functions:
   constructor-only
   owner-type)
 
+(defmethod print-object ((instance g-class-property-definition) stream)
+  (if *print-readably*
+      (call-next-method)
+      (print-unreadable-object (instance stream)
+        (format stream
+                "PROPERTY ~A ~A.~A (flags:~@[~* readable~]~@[~* writable~]~@[~* constructor~]~@[~* constructor-only~])"
+                (g-class-property-definition-type instance)
+                (g-class-property-definition-owner-type instance)
+                (g-class-property-definition-name instance)
+                (g-class-property-definition-readable instance)
+                (g-class-property-definition-writable instance)
+                (g-class-property-definition-constructor instance)
+                (g-class-property-definition-constructor-only instance)))))
+
 (setf (documentation 'g-class-property-definition-name 'function)
       "Name of GObject class property. See @class{g-class-property-definition}.
 @return{a string}")
@@ -78,6 +92,11 @@ See accessor functions:
            for param = (mem-aref params :pointer i)
            collect (parse-g-param-spec param))))))
 
+(defun class-property-info (g-type property-name)
+  (with-unwind (g-class (g-type-class-ref g-type) g-type-class-unref)
+    (let* ((param-spec (g-object-class-find-property g-class property-name)))
+      (when param-spec (parse-g-param-spec param-spec)))))
+
 (defun interface-properties (g-type)
   "@return{list of properties of GObject interface @code{g-type}. Each property is described by an object of type @class{g-class-property-definition}.}
 @arg[g-type]{an integer or a string specifying the GType}"
@@ -89,91 +108,3 @@ See accessor functions:
            for i from 0 below (mem-ref n-properties :uint)
            for param = (mem-aref params :pointer i)
            collect (parse-g-param-spec param))))))
-
-(defstruct enum-item
-  "A structure describing a single enumeration item.
-
-See accessor functions:
-@itemize{
-@item{@fun{enum-item-name}}
-@item{@fun{enum-item-value}}
-@item{@fun{enum-item-nick}}
-}"
-  name value nick)
-
-(setf (documentation 'enum-item-name 'function)
-      "The C name of enum item, e.g. \"GTK_WINDOW_TOPLEVEL\".
-@return{a string}")
-
-(setf (documentation 'enum-item-value 'function)
-      "The numeric value of enum item.
-@return{an integer}")
-
-(setf (documentation 'enum-item-nick 'function)
-      "The \"nickname\" of enum item. Nickname is a short name of enum item. E.g., \"toplevel\".
-@return{a string}")
-
-(defun get-enum-items (type)
-  "Gets the list of enum items that belong to GEnum type @code{type}
-@arg[type]{a string or an integer specifying GEnum type}
-@return{a list of @class{enum-item} objects}"
-  (assert (g-type-is-a type +g-type-enum+))
-  (let ((g-class (g-type-class-ref type)))
-    (unwind-protect
-         (loop
-            with n = (foreign-slot-value g-class 'g-enum-class :n-values)
-            with values = (foreign-slot-value g-class 'g-enum-class :values)
-            for i from 0 below n
-            for enum-value = (mem-aref values 'g-enum-value i)
-            collect (make-enum-item
-                     :name (foreign-slot-value enum-value 'g-enum-value
-                                               :name)
-                     :value (foreign-slot-value enum-value 'g-enum-value
-                                                :value)
-                     :nick (foreign-slot-value enum-value 'g-enum-value
-                                               :nick)))
-      (g-type-class-unref g-class))))
-
-(defstruct flags-item
-  "A structure describing a single flags item.
-
-See accessor functions:
-@itemize{
-@item{@fun{flags-item-name}}
-@item{@fun{flags-item-value}}
-@item{@fun{flags-item-nick}}
-}"
-  name value nick)
-
-(setf (documentation 'flags-item-name 'function)
-      "The C name of flags item, e.g. \"GDK_PROPERTY_CHANGE_MASK\".
-@return{a string}")
-
-(setf (documentation 'flags-item-value 'function)
-      "The numeric value of flags item.
-@return{an integer}")
-
-(setf (documentation 'flags-item-nick 'function)
-      "The \"nickname\" of flags item. Nickname is a short name of flags item. E.g., \"property-change-mask\".
-@return{a string}")
-
-(defun get-flags-items (type)
-  "Gets the list of flags items that belong to GFlags type @code{type}
-@arg[type]{a string or an integer specifying GFlags type}
-@return{a list of @class{flags-item} objects}"
-  (assert (g-type-is-a type +g-type-flags+))
-  (let ((g-class (g-type-class-ref type)))
-    (unwind-protect
-         (loop
-            with n = (foreign-slot-value g-class 'g-flags-class :n-values)
-            with values = (foreign-slot-value g-class 'g-flags-class :values)
-            for i from 0 below n
-            for flags-value = (mem-aref values 'g-flags-value i)
-            collect (make-flags-item
-                     :name (foreign-slot-value flags-value 'g-flags-value
-                                               :name)
-                     :value (foreign-slot-value flags-value 'g-flags-value
-                                                :value)
-                     :nick (foreign-slot-value flags-value 'g-flags-value
-                                               :nick)))
-      (g-type-class-unref g-class))))