Index: xs/GtkStyle.xs =================================================================== --- xs/GtkStyle.xs (revision 2116) +++ xs/GtkStyle.xs (working copy) @@ -21,6 +21,7 @@ #include "gtk2perl.h" + MODULE = Gtk2::Style PACKAGE = Gtk2::Style PREFIX = gtk_style_ BOOT: @@ -572,3 +573,72 @@ RETVAL #endif + +#if GTK_CHECK_VERSION (2, 15, 0) /* FIXME 2.16.0 */ + +=for apidoc Gtk2::Style::get +=for signature $style->get (widget_package, ...) +=for arg widget_package (string) widget package name (ex: 'Gtk2::TreeView') +=for arg ... (list) list of property names + +Fetch and return the values for the style properties named in I<...> for a +widget of type I. + +=cut + +=for apidoc Gtk2::Style::get_property +=for arg widget_package (__hide__) +=for arg ... (__hide__) + +Alias for C. + +=cut + +void +gtk_style_get (style, widget_package, ...) + GtkStyle *style + const char *widget_package + ALIAS: + Gtk2::Style::get = 0 + Gtk2::Style::get_property = 1 + PREINIT: + int i; + GType widget_type; + gpointer class_peek; + GValue value = {0,}; + + CODE: + /* Use CODE: instead of PPCODE: so we can handle the stack ourselves in + * order to avoid that xsubs called by g_object_get_property overwrite + * what we put on the stack. */ + PERL_UNUSED_VAR (ix); + + widget_type = gperl_type_from_package(widget_package); + if (widget_type == 0) { + croak("package %s is not registered with GPerl", widget_package); + } + if (! g_type_is_a (widget_type, GTK_TYPE_WIDGET)) { + croak("%s is not a subclass of Gtk2::Widget", widget_package); + } + + class_peek = g_type_class_peek(widget_type); + + + for (i = 2 ; i < items ; i++) { + GValue value = {0, }; + gchar * name = SvGChar(ST(i)); + GParamSpec * pspec; + pspec = gtk_widget_class_find_style_property(class_peek, name); + if (pspec) { + g_value_init(&value, G_PARAM_SPEC_VALUE_TYPE(pspec)); + gtk_style_get_property(style, widget_type, name, &value); + ST (i - 2) = sv_2mortal (gperl_sv_from_value(&value)); + g_value_unset(&value); + } + else { + warn ("Invalid property `%s' used", name); + } + } + XSRETURN (items - 2); + +#endif Index: t/GtkStyle.t =================================================================== --- t/GtkStyle.t (revision 2116) +++ t/GtkStyle.t (working copy) @@ -1,7 +1,7 @@ #!/usr/bin/perl -w # vim: set ft=perl expandtab shiftwidth=2 softtabstop=2 : use strict; -use Gtk2::TestHelper tests => 113; +use Gtk2::TestHelper tests => 118; # $Id$ @@ -133,6 +133,56 @@ ok (1); } +SKIP: { + skip("get_property is new in 2.16", 5) + unless (Gtk2->CHECK_VERSION(2, 15, 0)); # FIXME 2.16 + + # Test different properties (gint, gboolean, gchar* and GObject) + my $property = $style -> get_property('Gtk2::TreeView', 'expander-size'); + my $treeview = Gtk2::TreeView -> new(); + + # get gboolean + is ( + $style -> get_property('Gtk2::TreeView', 'allow-rules'), + $treeview -> style_get_property('allow-rules'), + "get_property gboolean" + ); + + # get gint + is ( + $style -> get_property('Gtk2::TreeView', 'expander-size'), + $treeview -> style_get_property('expander-size'), + "get_property gint" + ); + + # get gchar* + is ( + $style -> get_property('Gtk2::TreeView', 'grid_line-pattern'), + $treeview -> style_get_property('grid_line-pattern'), + "get_property gchar*" + ); + + # get GObject (a color) + is ( + $style -> get_property('Gtk2::TreeView', 'even-row-color'), + $treeview -> style_get_property('even-row-color'), + "get_property GObject*" + ); + + + # Get multiple properties simultaneously + my @properties = $style -> get('Gtk2::TreeView', 'expander-size', 'even-row-color', 'grid_line-pattern'); + is_deeply ( + \ properties, + [ + $treeview -> style_get_property('expander-size'), + $treeview -> style_get_property('even-row-color'), + $treeview -> style_get_property('grid_line-pattern'), + ], + 'get multiple properties', + ); +} + __END__ Copyright (C) 2003-2006 by the gtk2-perl team (see the file AUTHORS for the