(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)
(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)
(widget g-object)
(accel-group g-object)
(accel-key :uint)
- (accel-mods gdk-modifier-type))
+ (accel-mods modifier-type))
(export 'widget-remove-accelerator)
(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)))
(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))
(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))
; 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)
(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