GNOME.org
 

Freeze break request: Some API additions

Aloha,

the Gtk2-Perl team would like to request permission to break the API
freeze for six separate, independent changes:

* gdk_pixbuf_get_option.patch: Wraps gdk_pixbuf_get_option() which we
simply missed in past releases.

* pango_parse_markup.patch: Wraps pango_parse_markup() which hasn't been
bound previously because there seemed to be no use for it.  We now
discovered that it can be fairly useful and sometimes even necessary.

* gtk_show_about_dialog.patch: Implements the handy convenience function
gtk_show_about_dialog().

* gtk_icon_view_selected_foreach.patch: Wraps
gtk_icon_view_selected_foreach().

* gtk_cell_renderer_stop_editing.patch: Binds the quite useful
gtk_cell_renderer_stop_editing() which we missed during the 2.6 series.

* g_signal_query.patch: Wraps g_signal_query() which we seem to have
missed previously.  We never noticed until someone came up with a use
for it that can't be achieved conveniently without this function.

Of course, all of the above will be tested as part of our test suites.

-- 
TIA,
-Torsten

Index: t/GdkPixbuf.t
===================================================================
RCS file: /cvsroot/gtk2-perl/gtk2-perl-xs/Gtk2/t/GdkPixbuf.t,v
retrieving revision 1.2
diff -u -r1.2 GdkPixbuf.t
--- t/GdkPixbuf.t	21 Mar 2004 04:38:32 -0000	1.2
+++ t/GdkPixbuf.t	6 Feb 2005 21:46:25 -0000
@@ -1,6 +1,6 @@
 use strict;
 use warnings;
-use Gtk2::TestHelper tests => 68, noinit => 1;
+use Gtk2::TestHelper tests => 73, noinit => 1;
 
 my $show = 0;
 
@@ -138,6 +138,25 @@
 unlink $filename;
 
 
+$filename = 'testsave.png';
+my $mtime = scalar localtime;
+my $desc = 'Something really cool';
+$pixbuf->save ($filename, 'png',
+	       'tEXt::Thumb::MTime' => $mtime,
+	       'tEXt::Description' => $desc);
+ok (1);
+
+$pixbuf = Gtk2::Gdk::Pixbuf->new_from_file ($filename);
+isa_ok ($pixbuf, 'Gtk2::Gdk::Pixbuf', 'new_from_file');
+
+is ($pixbuf->get_option ('tEXt::Description'), $desc, 'get_option works');
+is ($pixbuf->get_option ('tEXt::Thumb::MTime'), $mtime, 'get_option works');
+ok (! $pixbuf->get_option ('tEXt::noneXIStenTTag'),
+    'get_option returns undef if the key is not found');
+
+unlink $filename;
+
+
 # raw pixel values to make the xpm above, but with green for the
 # transparent pixels, so we can use add_alpha.
 $rawdata = pack 'C*',
Index: xs/GdkPixbuf.xs
===================================================================
RCS file: /cvsroot/gtk2-perl/gtk2-perl-xs/Gtk2/xs/GdkPixbuf.xs,v
retrieving revision 1.32
diff -u -r1.32 GdkPixbuf.xs
--- xs/GdkPixbuf.xs	19 Sep 2004 21:47:11 -0000	1.32
+++ xs/GdkPixbuf.xs	6 Feb 2005 21:46:26 -0000
@@ -240,6 +240,12 @@
 gdk_pixbuf_get_rowstride (pixbuf)
 	GdkPixbuf *pixbuf
 
+## G_CONST_RETURN gchar * gdk_pixbuf_get_option (GdkPixbuf *pixbuf, const gchar *key)
+const gchar_ornull *
+gdk_pixbuf_get_option (pixbuf, key)
+	GdkPixbuf * pixbuf
+	const gchar * key
+
 ##  GdkPixbuf *gdk_pixbuf_new (GdkColorspace colorspace, gboolean has_alpha, int bits_per_sample, int width, int height) 
 GdkPixbuf_noinc *
 gdk_pixbuf_new (class, colorspace, has_alpha, bits_per_sample, width, height)

Index: MANIFEST
===================================================================
RCS file: /cvsroot/gtk2-perl/gtk2-perl-xs/Gtk2/MANIFEST,v
retrieving revision 1.74
diff -u -r1.74 MANIFEST
--- MANIFEST	10 Jan 2005 14:06:34 -0000	1.74
+++ MANIFEST	7 Feb 2005 03:48:06 -0000
@@ -257,6 +257,7 @@
 t/GtkVSeparator.t
 t/GtkViewport.t
 t/GtkWidget.t
+t/PangoAttribute.t
 t/PangoContext.t
 t/PangoFont.t
 t/PangoFontMap.t
@@ -438,6 +439,7 @@
 xs/GtkViewport.xs
 xs/GtkWidget.xs
 xs/GtkWindow.xs
+xs/PangoAttributes.xs
 xs/PangoContext.xs
 xs/PangoFont.xs
 xs/PangoFontMap.xs
Index: xs_files-2.0
===================================================================
RCS file: /cvsroot/gtk2-perl/gtk2-perl-xs/Gtk2/xs_files-2.0,v
retrieving revision 1.10
diff -u -r1.10 xs_files-2.0
--- xs_files-2.0	20 Oct 2004 17:42:59 -0000	1.10
+++ xs_files-2.0	7 Feb 2005 03:48:06 -0000
@@ -142,6 +142,7 @@
 xs/GtkWindow.xs
 
 # Pango stuff
+xs/PangoAttributes.xs
 xs/PangoContext.xs
 xs/PangoFont.xs
 xs/PangoFontset.xs
Index: t/PangoAttributes.t
===================================================================
RCS file: t/PangoAttributes.t
diff -N t/PangoAttributes.t
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ t/PangoAttributes.t	7 Feb 2005 03:48:06 -0000
@@ -0,0 +1,40 @@
+#!/usr/bin/perl -w
+use strict;
+use Gtk2::TestHelper tests => 12;
+
+# $Header: $
+
+#
+# pango_parse_markup() 
+#
+
+my ($attr_list, $text, $accel_char) =
+	Gtk2::Pango->parse_markup
+		('<big>this text is <i>really</i> cool</big> (no lie)');
+isa_ok ($attr_list, 'Gtk2::Pango::AttrList');
+is ($text, 'this text is really cool (no lie)', 'text is stripped of tags');
+ok ((not defined $accel_char), 'no accel_char if no accel_marker');
+
+($attr_list, $text) = Gtk2::Pango->parse_markup ('no markup here');
+isa_ok ($attr_list, 'Gtk2::Pango::AttrList');
+is ($text, 'no markup here', 'no tags, nothing stripped');
+
+($attr_list, $text, $accel_char) =
+	Gtk2::Pango->parse_markup ('Text with _accel__chars', '_');
+isa_ok ($attr_list, 'Gtk2::Pango::AttrList');
+is ($text, 'Text with accel_chars');
+is ($accel_char, 'a');
+
+# invalid markup causes an exception...
+eval { Gtk2::Pango->parse_markup ('<bad>invalid markup') };
+isa_ok ($@, 'Glib::Error');
+isa_ok ($@, 'Glib::Markup::Error');
+is ($ ->domain, 'g-markup-error-quark');
+ok ($ ->matches ('Glib::Markup::Error', 'unknown-element'),
+    'invalid markup causes exceptions');
+
+
+__END__
+
+Copyright (C) 2005 by the gtk2-perl team (see the file AUTHORS for the
+full list).  See LICENSE for more information.
Index: xs/PangoAttributes.xs
===================================================================
RCS file: xs/PangoAttributes.xs
diff -N xs/PangoAttributes.xs
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ xs/PangoAttributes.xs	7 Feb 2005 03:48:07 -0000
@@ -0,0 +1,698 @@
+/*
+ * Copyright (c) 2005 by the gtk2-perl team (see the file AUTHORS)
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Library General Public
+ * License as published by the Free Software Foundation; either
+ * version 2.1 of the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Library General Public License for more details.
+ *
+ * You should have received a copy of the GNU Library General Public
+ * License along with this library; if not, write to the 
+ * Free Software Foundation, Inc., 59 Temple Place - Suite 330, 
+ * Boston, MA  02111-1307  USA.
+ *
+ * $Header: $
+ */
+#include "gtk2perl.h"
+
+MODULE = Gtk2::Pango::Attributes	PACKAGE = Gtk2::Pango	PREFIX = pango_
+
+# don't clobber the pod for Gtk2::Pango!
+=for object Gtk2::Pango::AttrList
+=cut
+
+##gboolean pango_parse_markup (const char                 *markup_text,
+##                             int                         length,
+##                             gunichar                    accel_marker,
+##                             PangoAttrList             **attr_list,
+##                             char                      **text,
+##                             gunichar                   *accel_char,
+##                             GError                    **error);
+##
+=for apidoc __gerror__
+=for signature ($attr_list, $text, $accel_char) = Gtk2::Pango->parse_markup ($markup_text, $accel_marker)
+Parses marked-up text to create a plaintext string and an attribute list.
+
+If I<$accel_marker> is supplied and nonzero, the given character will mark the
+character following it as an accelerator.  For example, the accel marker might
+be an ampersand or underscore.  All characters marked as an acclerator will
+receive a PANGO_UNDERLINE_LOW attribute, and the first character so marked will
+be returned in I<$accel_char>.  Two I<$accel_marker> characters following each
+other reduce to a single literal I<$accel_marker> character.
+=cut
+void
+pango_parse_markup (class, const gchar_length * markup_text, int length(markup_text), gunichar accel_marker=0)
+    PREINIT:
+	PangoAttrList * attr_list;
+	char * text;
+	gunichar accel_char;
+	GError * error = NULL;
+    PPCODE:
+	if (! pango_parse_markup (markup_text, XSauto_length_of_markup_text,
+				  accel_marker, &attr_list, &text,
+				  &accel_char, &error))
+		gperl_croak_gerror (NULL, error);
+	EXTEND (SP, 3);
+	PUSHs (sv_2mortal (newSVPangoAttrList (attr_list)));
+	PUSHs (sv_2mortal (newSVGChar (text)));
+	g_free (text);
+	if (accel_char) {
+		/* adapted from Glib/typemap */
+		gchar temp[6];
+		gint length = g_unichar_to_utf8 (accel_char, temp);
+		PUSHs (sv_2mortal (newSVpv (temp, length)));
+		SvUTF8_on (ST (2));
+	}
+

Index: t/GtkAboutDialog.t
===================================================================
RCS file: /cvsroot/gtk2-perl/gtk2-perl-xs/Gtk2/t/GtkAboutDialog.t,v
retrieving revision 1.6
diff -u -r1.6 GtkAboutDialog.t
--- t/GtkAboutDialog.t	29 Jan 2005 06:45:57 -0000	1.6
+++ t/GtkAboutDialog.t	7 Feb 2005 04:30:48 -0000
@@ -126,3 +126,10 @@
 my @artists = qw/Leonardo Donatello Raphael Michelangelo/;
 $dialog->set (artists => \ artists);
 ok (eq_array ($dialog->get ('artists'), \ artists), 'artists property');
+
+
+Gtk2->show_about_dialog (undef,
+			 name => 'Foo',
+			 version => '42',
+			 authors => [qw/me myself i/],
+			);
Index: xs/GtkAboutDialog.xs
===================================================================
RCS file: /cvsroot/gtk2-perl/gtk2-perl-xs/Gtk2/xs/GtkAboutDialog.xs,v
retrieving revision 1.7
diff -u -r1.7 GtkAboutDialog.xs
--- xs/GtkAboutDialog.xs	29 Jan 2005 06:45:58 -0000	1.7
+++ xs/GtkAboutDialog.xs	7 Feb 2005 04:30:48 -0000
@@ -26,15 +26,71 @@
 	gperl_callback_invoke ((GPerlCallback*)data, NULL, about, link);
 }
 
+MODULE = Gtk2::AboutDialog PACKAGE = Gtk2 PREFIX = gtk_
+
+=for object Gtk2::AboutDialog
+=cut
+
+=for apidoc
+=for arg first_property_name (string)
+=for arg ... the rest of a list of name=>property value pairs.
+This is a convenience function for showing an application's about box. The
+constructed dialog is associated with the parent window and reused for
+future invocations of this function.
+=cut
+void gtk_show_about_dialog (class, GtkWindow_ornull * parent, first_property_name, ...);
+    PREINIT:
+	static GtkWidget * global_about_dialog = NULL;
+	GtkWidget * dialog = NULL;
+    CODE:
+	if (parent)
+		dialog = g_object_get_data (G_OBJECT (parent), "gtk-about-dialog");
+	else
+		dialog = global_about_dialog;
+	if (!dialog) {
+		int i;
+
+		dialog = gtk_about_dialog_new ();
+
+		g_object_ref (dialog);
+		gtk_object_sink (GTK_OBJECT (dialog));
+
+		g_signal_connect (dialog, "delete_event",
+				  G_CALLBACK (gtk_widget_hide_on_delete), NULL);
+
+		for (i = 2; i < items ; i+=2) {
+			GParamSpec * pspec;
+			char * name = SvPV_nolen (ST (i));
+			SV * sv = ST (i + 1);
+
+			pspec = g_object_class_find_property
+					(G_OBJECT_GET_CLASS (dialog), name);
+			if (! pspec) {
+				const char * classname =
+					gperl_object_package_from_type
+						(G_OBJECT_TYPE (dialog));
+				croak ("type %s does not support property '%s'",
+				       classname, name);
+			} else {
+				GValue value = {0, };
+				g_value_init (&value,
+					      G_PARAM_SPEC_VALUE_TYPE (pspec));
+				gperl_value_from_sv (&value, sv);
+				g_object_set_property (G_OBJECT (dialog),
+						       name, &value);
+				g_value_unset (&value);
+			}
+		}
+	}
+	gtk_window_present (GTK_WINDOW (dialog));
+
+
 MODULE = Gtk2::AboutDialog PACKAGE = Gtk2::AboutDialog PREFIX = gtk_about_dialog_
 
 GtkWidget * gtk_about_dialog_new (class)
     C_ARGS:
 	/* void */
 
-## TODO/FIXME: 
-##void gtk_show_about_dialog (GtkWindow * parent, const gchar * first_property_name, ...);
-
 const gchar_ornull * gtk_about_dialog_get_name (GtkAboutDialog * about);
 
 void gtk_about_dialog_set_name (GtkAboutDialog * about, const gchar_ornull * name);

Index: t/GtkIconView.t
===================================================================
RCS file: /cvsroot/gtk2-perl/gtk2-perl-xs/Gtk2/t/GtkIconView.t,v
retrieving revision 1.5
diff -u -r1.5 GtkIconView.t
--- t/GtkIconView.t	30 Jan 2005 02:17:29 -0000	1.5
+++ t/GtkIconView.t	7 Feb 2005 04:53:47 -0000
@@ -12,7 +12,7 @@
 use strict;
 use warnings;
 
-use Gtk2::TestHelper tests => 25,
+use Gtk2::TestHelper tests => 30,
     at_least_version => [2, 6, 0, "GtkIconView is new in 2.6"],
     ;
 
@@ -95,6 +95,21 @@
 	$iview->unselect_all;
 	@sels = $iview->get_selected_items;
 	is (scalar (@sels), 0, '$iview->get_selected_items, count 0');
+
+	$iview->select_path ($path);
+	$iview->selected_foreach (sub {
+		my ($view, $path, $data) = @_;
+		isa_ok ($view, 'Gtk2::IconView');
+		isa_ok ($path, 'Gtk2::TreePath');
+		isa_ok ($data, 'HASH');
+		is ($data->{foo}, 'bar', 'callback data intact');
+	}, { foo => 'bar' });
+	$iview->select_all;
+	my $ncalls = 0;
+	$iview->selected_foreach (sub { $ncalls++ });
+	my @selected_items = $iview->get_selected_items;
+	is ($ncalls, scalar(@selected_items),
+	    'called once for each selected child');
 };
 
 sub create_store
Index: xs/GtkIconView.xs
===================================================================
RCS file: /cvsroot/gtk2-perl/gtk2-perl-xs/Gtk2/xs/GtkIconView.xs,v
retrieving revision 1.3
diff -u -r1.3 GtkIconView.xs
--- xs/GtkIconView.xs	30 Jan 2005 02:14:46 -0000	1.3
+++ xs/GtkIconView.xs	7 Feb 2005 04:53:47 -0000
@@ -1,5 +1,23 @@
 #include "gtk2perl.h"
 
+static GPerlCallback *
+gtk2perl_icon_view_foreach_func_create (SV * func, SV * data)
+{
+	GType param_types [2];
+	param_types[0] = GTK_TYPE_ICON_VIEW;
+	param_types[1] = GTK_TYPE_TREE_PATH;
+	return gperl_callback_new (func, data, G_N_ELEMENTS (param_types),
+				   param_types, G_TYPE_NONE);
+}
+static void
+gtk2perl_icon_view_foreach_func (GtkIconView      *icon_view,
+				 GtkTreePath      *path,
+				 gpointer          data)
+{
+	gperl_callback_invoke ((GPerlCallback*) data, NULL, icon_view, path);
+}
+
+
 MODULE = Gtk2::IconView PACKAGE = Gtk2::IconView PREFIX = gtk_icon_view_
 
 GtkWidget * gtk_icon_view_new (class)
@@ -33,8 +51,18 @@
 
 GtkTreePath_own * gtk_icon_view_get_path_at_pos (GtkIconView * icon_view, gint x, gint y);
 
-## TODO/FIXME: 
 ## void gtk_icon_view_selected_foreach (GtkIconView * icon_view, GtkIconViewForeachFunc func, gpointer data);
+void
+gtk_icon_view_selected_foreach (GtkIconView * icon_view, SV * func, SV * data=NULL);
+    PREINIT:
+	GPerlCallback * callback;
+    CODE:
+	callback = gtk2perl_icon_view_foreach_func_create (func, data);
+	gtk_icon_view_selected_foreach (icon_view,
+					gtk2perl_icon_view_foreach_func,
+					callback);
+	gperl_callback_destroy (callback);
+
 
 void gtk_icon_view_set_selection_mode (GtkIconView * icon_view, GtkSelectionMode mode);
 

Index: t/GtkCellRenderer.t
===================================================================
RCS file: /cvsroot/gtk2-perl/gtk2-perl-xs/Gtk2/t/GtkCellRenderer.t,v
retrieving revision 1.10
diff -u -r1.10 GtkCellRenderer.t
--- t/GtkCellRenderer.t	6 Jan 2005 04:23:17 -0000	1.10
+++ t/GtkCellRenderer.t	7 Feb 2005 05:02:19 -0000
@@ -136,6 +136,13 @@
 	$renderer->editing_canceled;
 }
 
+SKIP: {
+	skip "stop_editing is new in 2.6", 0
+		unless Gtk2->CHECK_VERSION (2, 6, 0);
+
+	$renderer->stop_editing (FALSE);
+}
+
 ##########################################################################
 
 run_main {
Index: xs/GtkCellRenderer.xs
===================================================================
RCS file: /cvsroot/gtk2-perl/gtk2-perl-xs/Gtk2/xs/GtkCellRenderer.xs,v
retrieving revision 1.28
diff -u -r1.28 GtkCellRenderer.xs
--- xs/GtkCellRenderer.xs	4 Sep 2004 23:50:35 -0000	1.28
+++ xs/GtkCellRenderer.xs	7 Feb 2005 05:02:20 -0000
@@ -558,6 +558,12 @@
 
 #endif
 
+#if GTK_CHECK_VERSION (2, 6, 0)
+
+void gtk_cell_renderer_stop_editing (GtkCellRenderer *cell, gboolean canceled)
+
+#endif
+
 ##
 ## Modify the underlying GObjectClass structure for the given package
 ## to call Perl methods as virtual overrides for the get_size, render, 

Index: GSignal.xs
===================================================================
RCS file: /cvsroot/gtk2-perl/gtk2-perl-xs/Glib/GSignal.xs,v
retrieving revision 1.24
diff -u -r1.24 GSignal.xs
--- GSignal.xs	21 Apr 2004 16:37:11 -0000	1.24
+++ GSignal.xs	7 Feb 2005 04:06:20 -0000
@@ -340,6 +340,51 @@
 }
 
 
+#define GET_NAME(name, gtype)				\
+	(name) = gperl_package_from_type (gtype);	\
+	if (!(name))					\
+		(name) = g_type_name (gtype);
+SV *
+_newSVGSignalQuery (GSignalQuery * query)
+{
+	HV * hv;
+	AV * av;
+	int j;
+	const char * pkgname;
+
+	if (!query)
+		return &PL_sv_undef;
+
+	hv = newHV ();
+	hv_store (hv, "signal_id", 9, newSViv (query->signal_id), 0);
+	hv_store (hv, "signal_name", 11,
+		  newSVpv (query->signal_name, 0), 0);
+	GET_NAME (pkgname, query->itype);
+	if (pkgname)
+		hv_store (hv, "itype", 5, newSVpv (pkgname, 0), 0);
+	hv_store (hv, "signal_flags", 12,
+		  newSVGSignalFlags (query->signal_flags), 0);
+	if (query->return_type != G_TYPE_NONE) {
+		GType t = query->return_type & ~G_SIGNAL_TYPE_STATIC_SCOPE;
+		GET_NAME (pkgname, t);
+		if (pkgname)
+			hv_store (hv, "return_type", 11,
+				  newSVpv (pkgname, 0), 0);
+	}
+	av = newAV ();
+	for (j = 0; j < query->n_params; j++) {
+		GType t = query->param_types[j] & ~G_SIGNAL_TYPE_STATIC_SCOPE;
+		GET_NAME (pkgname, t);
+		av_push (av, newSVpv (pkgname, 0));
+	}
+	hv_store (hv, "param_types", 11, newRV_noinc ((SV*)av), 0);
+	/* n_params is inferred by the length of the av in param_types */
+
+	return newRV_noinc ((SV*)hv);
+}
+#undef GET_NAME
+
+
 =back
 
 =cut
@@ -470,8 +515,55 @@
 ##guint                 g_signal_lookup       (const gchar        *name,
 ##					     GType               itype);
 ##G_CONST_RETURN gchar* g_signal_name         (guint               signal_id);
-##void                  g_signal_query        (guint               signal_id,
-##					     GSignalQuery       *query);
+
+##void g_signal_query (guint signal_id, GSignalQuery *query);
+=for apidoc
+Look up information about the signal I<$name> on the instance type
+I<$object_or_class_name>, which may be either a Glib::Object or a package
+name.
+
+See also C<Glib::Type::list_signals>, which returns the same kind of
+hash refs as this does.
+=cut
+SV *
+g_signal_query (SV * object_or_class_name, const char * name)
+    PREINIT:
+	GType itype;
+	guint signal_id;
+	GSignalQuery query;
+	GObjectClass * oclass = NULL;
+    CODE:
+	if (object_or_class_name &&
+	    SvOK (object_or_class_name) &&
+	    SvROK (object_or_class_name)) {
+		GObject * object = SvGObject (object_or_class_name);
+		if (!object)
+			croak ("bad object in signal_query");
+		itype = G_OBJECT_TYPE (object);
+	} else {
+		itype = gperl_object_type_from_package
+					(SvPV_nolen (object_or_class_name));
+		if (!itype)
+			croak ("package %s is not registered with GPerl",
+			       SvPV_nolen (object_or_class_name));
+	}
+	if (G_TYPE_IS_CLASSED (itype)) {
+		/* ref the class to ensure that the signals get created,
+		 * otherwise they may not exist at the time we query. */
+		oclass = g_type_class_ref (itype);
+		if (!oclass)
+			croak ("couldn't ref type %s", g_type_name (itype));
+	}
+	signal_id = g_signal_lookup (name, itype);
+	if (0 == signal_id)
+		XSRETURN_UNDEF;
+	g_signal_query (signal_id, &query);
+	RETVAL = _newSVGSignalQuery (&query);
+	if (oclass)
+		g_type_class_unref (oclass);
+    OUTPUT:
+	RETVAL
+
 ##guint*                g_signal_list_ids     (GType               itype,
 ##					     guint              *n_ids);
 ##gboolean	      g_signal_parse_name   (const gchar	*detailed_signal,
Index: GType.xs
===================================================================
RCS file: /cvsroot/gtk2-perl/gtk2-perl-xs/Glib/GType.xs,v
retrieving revision 1.65
diff -u -r1.65 GType.xs
--- GType.xs	19 Sep 2004 21:34:55 -0000	1.65
+++ GType.xs	7 Feb 2005 04:06:20 -0000
@@ -2323,11 +2323,6 @@
 	HV           * hv;
 	AV           * av;
     PPCODE:
-#define GET_NAME(name, gtype)				\
-	(name) = gperl_package_from_type (gtype);	\
-	if (!(name))					\
-		(name) = g_type_name (gtype);		\
-
 	package_type = gperl_type_from_package (package);
 	if (!package_type)
 		croak ("%s is not registered with either GPerl or GLib",
@@ -2348,36 +2343,13 @@
 	EXTEND(SP, num);
 	for (i = 0; i < num; i++)
 	{
+		/* XXX externs are bad, you shouldn't use externs, m'kay? */
+		extern SV * _newSVGSignalQuery (GSignalQuery *);
 		g_signal_query (sigids[i], &siginfo);
-		hv = newHV ();
-		hv_store (hv, "signal_id", 9, newSViv (siginfo.signal_id), 0);
-		hv_store (hv, "signal_name", 11,
-				newSVpv (siginfo.signal_name, 0), 0);
-		GET_NAME (pkgname, siginfo.itype);
-		if (pkgname)
-			hv_store (hv, "itype", 5, newSVpv (pkgname, 0), 0);
-		hv_store (hv, "signal_flags", 12,
-			newSVGSignalFlags (siginfo.signal_flags), 0);
-		if (siginfo.return_type != G_TYPE_NONE)
-		{
-			GET_NAME (pkgname, siginfo.return_type);
-			if (pkgname)
-				hv_store (hv, "return_type", 11,
-					newSVpv (pkgname, 0), 0);
-		}
-		av = newAV ();
-		for (j = 0; j < siginfo.n_params; j++)
-		{
-			GET_NAME (pkgname, siginfo.param_types[j]
-					& ~G_SIGNAL_TYPE_STATIC_SCOPE);
-			av_push (av, newSVpv (pkgname, 0));
-		}
-		hv_store (hv, "param_types", 11, newRV_noinc ((SV*)av), 0);
-		PUSHs (sv_2mortal (newRV_noinc ((SV*)hv)));
+		PUSHs (sv_2mortal (_newSVGSignalQuery (&siginfo)));
 	}
 	if (oclass)
 		g_type_class_unref (oclass);
-#undef GET_NAME
 
 
 =for apidoc
[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]