X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=gtk%2Fgtk.widget.lisp;h=a70ec15e704c0547a18577a82b28ad962ea07961;hb=274541ffed73f815303a78a8570021f2b93af78a;hp=15336ffbe72aa8d857a2b1f8830d5b262c47d726;hpb=5c7296a0dc78174654aa243805fdc0862b267c92;p=cl-gtk2.git

diff --git a/gtk/gtk.widget.lisp b/gtk/gtk.widget.lisp
index 15336ff..a70ec15 100644
--- a/gtk/gtk.widget.lisp
+++ b/gtk/gtk.widget.lisp
@@ -13,33 +13,33 @@
 (export 'widget-flags)
 
 (defcstruct %gtk-requisition
-  (width :int)
-  (height :int))
+  (:width :int)
+  (:height :int))
 
 (defcstruct %gtk-allocation
-  (x :int)
-  (y :int)
-  (width :int)
-  (height :int))
+  (:x :int)
+  (:y :int)
+  (:width :int)
+  (:height :int))
 
 (defcstruct %gtk-widget
-  (object %gtk-object)
-  (private-flags :uint16)
-  (state state-type)
-  (saved-state state-type)
-  (name (:pointer :char))
-  (style :pointer)
-  (requisition %gtk-requisition)
-  (allocation %gtk-allocation)
-  (window :pointer)
-  (parent :pointer))
+  (:object %gtk-object)
+  (:private-flags :uint16)
+  (:state state-type)
+  (:saved-state state-type)
+  (:name (:pointer :char))
+  (:style :pointer)
+  (:requisition %gtk-requisition)
+  (:allocation %gtk-allocation)
+  (:window :pointer)
+  (:parent :pointer))
 
 (defun widget-state (widget)
-  (foreign-slot-value (pointer widget) '%gtk-widget 'state))
+  (foreign-slot-value (pointer widget) '%gtk-widget :state))
 
 (export 'widget-state)
 (defun widget-saved-state (widget)
-  (foreign-slot-value (pointer widget) '%gtk-widget 'saved-state))
+  (foreign-slot-value (pointer widget) '%gtk-widget :saved-state))
 
 (export 'widget-saved-state)
 
@@ -147,7 +147,7 @@
   (accel-signal :string)
   (accel-group g-object)
   (accel-key :uint)
-  (accel-mods gdk-modifier-type)
+  (accel-mods modifier-type)
   (accel-flags accel-flags))
 
 (export 'widget-add-accelerator)
@@ -156,7 +156,7 @@
   (widget g-object)
   (accel-group g-object)
   (accel-key :uint)
-  (accel-mods gdk-modifier-type))
+  (accel-mods modifier-type))
 
 (export 'widget-remove-accelerator)
 
@@ -194,8 +194,8 @@
 
 (defcfun gtk-widget-intersect :boolean
   (widget g-object)
-  (area (g-boxed-ptr rectangle))
-  (intersection (g-boxed-ptr rectangle :in-out)))
+  (area (g-boxed-foreign rectangle))
+  (intersection (g-boxed-foreign rectangle :in-out)))
 
 (defun widget-intersect (widget rectangle)
   (let ((result (make-rectangle :x 0 :y 0 :width 0 :height 0)))
@@ -357,7 +357,7 @@
 
 (export 'widget-get-pango-context)
 
-(defcfun (widget-create-pango-layout "gtk_widget_create_pango_layout") (g-object gdk::pango-layout)
+(defcfun (widget-create-pango-layout "gtk_widget_create_pango_layout") (g-object gdk::pango-layout :already-referenced)
   (widget (g-object widget))
   (text :string))
 
@@ -386,9 +386,9 @@
   (x :int)
   (y :int)
   (width :int)
-  (height :int)
+  (height :int))
 
-(export 'widget-queue-draw-area))
+(export 'widget-queue-draw-area)
 
 (defcfun (widget-reset-shapes "gtk_widget_reset_shapes") :void
   (widget g-object))
@@ -406,15 +406,61 @@
 
 ; TOOD: gtk_widget_class_install_style_property_parser
 
-; TODO: gtk_widget_class_find_style_property
-
 ; TODO: gtk_widget_class_list_style_properties
 
 ; TODO: gtk_widget_region_intersect
 
 ; TODO: gtk_widget_send_expose
 
-; TODO: gtk_widget_style_get_property
+(defcfun gtk-widget-style-get-property :void
+  (widget g-object)
+  (property-name :string)
+  (value (:pointer g-value)))
+
+(defcfun gtk-widget-class-find-style-property (:pointer g-param-spec)
+  (class :pointer)
+  (property-name :string))
+
+(defcfun gtk-widget-class-list-style-properties (:pointer (:pointer g-param-spec))
+  (class :pointer)
+  (n-properties (:pointer :int)))
+
+(defun widget-class-get-style-properties (type)
+  (setf type (ensure-g-type type))
+  (let ((class (g-type-class-ref type)))
+    (unwind-protect
+         (with-foreign-object (np :int)
+           (let ((specs (gtk-widget-class-list-style-properties class np)))
+             (unwind-protect
+                  (loop
+                     repeat (mem-ref np :int)
+                     for i from 0
+                     for spec = (mem-aref specs :pointer i)
+                     collect (parse-g-param-spec spec))
+               (g-free specs))))
+      (g-type-class-unref class))))
+
+(export 'widget-class-get-style-properties)
+
+(defun widget-child-property-type (widget property-name)
+  (let* ((type (g-type-from-object widget))
+         (class (g-type-class-ref type)))
+    (unwind-protect
+         (let ((g-param-spec (gtk-widget-class-find-style-property class property-name)))
+           (when (null-pointer-p g-param-spec) (error "Widget ~A has no style-property named '~A'" widget property-name))
+           (foreign-slot-value g-param-spec 'gobject:g-param-spec :value-type))
+      (g-type-class-unref class))))
+
+(defun widget-child-property-value (widget property-name &optional property-type)
+  (unless property-type (setf property-type (widget-child-property-type widget property-name)))
+  (setf property-type (ensure-g-type property-type))
+  (with-foreign-object (gvalue 'g-value)
+    (g-value-zero gvalue)
+    (g-value-init gvalue property-type)
+    (prog1 (gtk-widget-style-get-property widget property-name gvalue)
+      (g-value-unset gvalue))))
+
+(export 'widget-child-property-value)
 
 (defcfun (widget-child-focus "gtk_widget_child_focus") :boolean
   (widget g-object)
@@ -495,8 +541,11 @@
 
 (export 'widget-trigger-tooltip-query)
 
-(defcfun (widget-snapshot "gtk_widget_get_snapshot") g-object
+(defcfun gtk-widget-get-snapshot g-object
   (widget g-object)
-  (clip-rectangle (g-boxed-ptr rectangle)))
+  (clip-rectangle (g-boxed-foreign rectangle)))
+
+(defun widget-snapshot (widget &optional clip-rectangle)
+  (gtk-widget-get-snapshot widget clip-rectangle))
 
 (export 'widget-snapshot)
\ No newline at end of file