perl-Gtk2 r2146 - in trunk: . t xs

[tsch svn gnome org]

Author: tsch
Date: Sat Feb 21 22:29:42 2009
New Revision: 2146
URL: http://svn.gnome.org/viewvc/perl-Gtk2?rev=2146&view=rev

Log:
Wrap the gtk_style_get() family of methods as Gtk2::Style::get(), and make
Gtk2::Style::get_property() an alias for get().  Patch by Emmanuel Rodriguez.


Modified:
   trunk/ChangeLog
   trunk/t/GtkStyle.t
   trunk/xs/GtkStyle.xs

Modified: trunk/t/GtkStyle.t
==============================================================================
--- trunk/t/GtkStyle.t	(original)
+++ trunk/t/GtkStyle.t	Sat Feb 21 22:29:42 2009
@@ -1,7 +1,8 @@
 #!/usr/bin/perl -w
 # vim: set ft=perl expandtab shiftwidth=2 softtabstop=2 :
 use strict;
-use Gtk2::TestHelper tests => 113;
+use Gtk2::TestHelper tests => 125;
+use Carp;
 
 # $Id$
 
@@ -133,6 +134,129 @@
   ok (1);
 }
 
+SKIP: {
+  skip("get_property is new in 2.16", 12)
+    unless (Gtk2->CHECK_VERSION(2, 15, 0)); # FIXME 2.16
+
+  # Test different properties (gint, gboolean, gchar* and GObject)
+  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',
+  );
+
+
+
+  # Make sure that Glib::GObject::get() and Gtk2::Style::get() can coexist.
+  my $custom_style = Custom::Style -> new();
+  is ($custom_style -> Glib::Object::get('perl-string'), 'empty');
+  is ($custom_style -> Glib::Object::get_property('perl-string'), 'empty');
+  is ($style -> get('Gtk2::Button', 'image-spacing'), 2);
+  is ($style -> get_property('Gtk2::Button', 'image-spacing'), 2);
+
+
+
+  # Test for bad usage
+  # Bad class
+  test_die(
+    sub { $style -> get('wrong::class', 'border'); },
+    qr/^package wrong::class is not registered with GPerl/
+  );
+
+  # Non existing property
+  test_die(
+    sub { $style -> get('Gtk2::Button', 'image-spacing', 'perl-var', 'default-border'); },
+    qr/^type Gtk2::Button does not support style property 'perl-var'/
+  );
+
+  # Not a Gtk2::Widget
+  test_die(
+    sub { $style -> get('Glib::Object', 'prop'); },
+    qr/^Glib::Object is not a subclass of Gtk2::Widget/
+  );
+}
+
+
+# Test that an error is thrown
+sub test_die {
+  my ($code, $regexp) = @_;
+  croak "usage(code, regexp)" unless ref $code eq 'CODE';
+
+  my $passed = FALSE;
+  eval {
+    $code->();
+  };
+  if (my $error = $@) {
+    if ($error =~ /$regexp/) {
+      $passed = TRUE;
+    }
+    else {
+      diag("Expected $regexp but got $error");
+    }
+  }
+
+  return Test::More->builder->ok($passed);
+}
+
+
+#
+# Used to test if Gtk2::Style::get() conflicts with Glib::GObject::get(). A new
+# package is needed because as of gtk+ 2.16, Gtk2::Style defines no properties.
+#
+package Custom::Style;
+
+use Glib::Object::Subclass 'Gtk2::Style' =>
+
+	properties => [
+		Glib::ParamSpec->string(
+			'perl-string',
+			'Test string',
+			'A test string.',
+			'empty',
+			['readable', 'writable'],
+		),
+	],
+;
+
+
 __END__
 
 Copyright (C) 2003-2006 by the gtk2-perl team (see the file AUTHORS for the

Modified: trunk/xs/GtkStyle.xs
==============================================================================
--- trunk/xs/GtkStyle.xs	(original)
+++ trunk/xs/GtkStyle.xs	Sat Feb 21 22:29:42 2009
@@ -572,3 +572,84 @@
         RETVAL
 
 #endif
+
+#if GTK_CHECK_VERSION (2, 15, 0) /* FIXME 2.16 */
+
+=for apidoc Gtk2::Style::get
+=for signature $style->get (widget_package, ...)
+=for signature $style->get_property (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<widget_package>.
+
+I<get_property> is an alias for I<get>.
+
+B<Note>: These methods shadow I<Glib::Object::get> and
+I<Glib::Object::get_property>. This shouldn't be a problem since I<Gtk2::Style>
+defines no properties (as of gtk+ 2.16).  If you have a class that's derived
+from Gtk2::Style and adds a property or if a new version of gtk+ adds a
+property to I<Gtk2::Style>, the property can be accessed by fully qualifying
+the method name:
+
+	my $value = $style->Glib::Object::get('property');
+
+=cut
+
+=for apidoc Gtk2::Style::get_property __hide__
+=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;
+    CODE:
+	/* Use CODE: instead of PPCODE: so we can handle the stack ourselves in
+	 * order to avoid that xsubs called by gtk_style_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 = g_type_class_ref (widget_type);
+	if (class == NULL)
+		croak ("can't find type class for type %s", widget_package);
+
+	for (i = 2 ; i < items ; i++) {
+		GValue value = {0, };
+		gchar *name = SvGChar (ST (i));
+		GParamSpec *pspec =
+			gtk_widget_class_find_style_property (class, 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 {
+			g_type_class_unref (class);
+			croak ("type %s does not support style property '%s'",
+			       widget_package, name);
+		}
+	}
+
+	g_type_class_unref (class);
+
+	XSRETURN (items - 2);
+
+#endif