Re: Gtk2->show_about_dialog() bug

[Torsten Schoenfeld <kaffeetisch gmx de>]

On Sat, 2006-11-18 at 10:23 -0500, muppet wrote:

> > Any suggestions for improvements?
> 
> I don't know if this would be an improvement, but we could move the  
> implementation to perl to emphasize the fact that it's just a  
> convenience function.
> 
> Provided that the license and credits dialogs are made transient to  
> their About parent, you should be able to do something like this:

OK, here's a patch that moves the implementation over to Perl and uses
muppet's approach.  It seemed to work in my limited testing.  Please try
it.

If it works it might make it into tomorrow's unstable release.

-- 
Bye,
-Torsten

Index: Gtk2.pm
===================================================================
RCS file: /cvsroot/gtk2-perl/gtk2-perl-xs/Gtk2/Gtk2.pm,v
retrieving revision 1.100
diff -u -d -p -r1.100 Gtk2.pm
--- Gtk2.pm	4 Sep 2006 18:37:04 -0000	1.100
+++ Gtk2.pm	3 Dec 2006 21:46:27 -0000
@@ -27,7 +27,7 @@ use 5.008;
 use strict;
 use warnings;
 
-use Glib;
+use Glib qw(TRUE FALSE);
 
 # if the gtk+ we've been compiled against is at least as new as 2.8.0, we need
 # to import the Cairo module for the cairo glue in gtk+ and pango.
@@ -63,6 +63,60 @@ sub import {
 	Gtk2->init if ($init);
 }
 
+{
+	my $global_about_dialog = undef;
+	my $parent_key = '_gtk2perl_about_dialog';
+
+	# this is implemented here rather than in xs because it's easier to
+	# pull off in Perl.
+	sub show_about_dialog {
+		my ($class, $parent, %props) = @_;
+
+		my $dialog = defined $parent
+			? $parent->{$parent_key} :
+			$global_about_dialog;
+
+		if (!$dialog) {
+			$dialog = Gtk2::AboutDialog->new;
+
+			$dialog->signal_connect(delete_event => sub {
+				my ($dialog) = @_;
+				return $dialog->hide_on_delete;
+			});
+
+			$dialog->signal_connect(response => sub {
+				my ($dialog) = @_;
+
+				# we need to destroy the credits and license
+				# dialogs, but have no way to access them
+				# directly.  so destroy all windows transient
+				# to this one.
+				foreach my $window (Gtk2::Window->list_toplevels) {
+					next if $window == $dialog;
+					my $parent = $window->get_transient_for;
+					$window->destroy if $parent && $parent == $dialog;
+				}
+
+				$dialog->hide;
+			});
+
+			foreach my $name (keys %props) {
+				$dialog->set ($name, $props{$name});
+			}
+
+			if ($parent) {
+				$dialog->set_transient_for ($parent);
+				$dialog->set_destroy_with_parent (TRUE);
+				$parent->{$parent_key} = $dialog;
+			}
+		} else {
+			$global_about_dialog = $dialog;
+		}
+
+		$dialog->present;
+	}
+}
+
 # this is critical -- tell dynaloader to load the module so that its
 # symbols are available to all other modules.  without this, nobody
 # else can use important functions like gtk2perl_new_object!
Index: t/GtkAboutDialog.t
===================================================================
RCS file: /cvsroot/gtk2-perl/gtk2-perl-xs/Gtk2/t/GtkAboutDialog.t,v
retrieving revision 1.8
diff -u -d -p -r1.8 GtkAboutDialog.t
--- t/GtkAboutDialog.t	29 Sep 2005 22:49:35 -0000	1.8
+++ t/GtkAboutDialog.t	3 Dec 2006 21:46:27 -0000
@@ -140,4 +140,6 @@ Gtk2->show_about_dialog (undef,
 			 name => 'Foo',
 			 version => '42',
 			 authors => [qw/me myself i/],
+			 license => qq/Bla bla bla!/,
 			);
+Gtk2->show_about_dialog ($dialog);
Index: xs/GtkAboutDialog.xs
===================================================================
RCS file: /cvsroot/gtk2-perl/gtk2-perl-xs/Gtk2/xs/GtkAboutDialog.xs,v
retrieving revision 1.10
diff -u -d -p -r1.10 GtkAboutDialog.xs
--- xs/GtkAboutDialog.xs	29 Sep 2005 22:49:35 -0000	1.10
+++ xs/GtkAboutDialog.xs	3 Dec 2006 21:46:27 -0000
@@ -26,71 +26,6 @@ gtk2perl_about_dialog_activate_link_func
 	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);
-			}
-		}
-		if (parent)
-			g_object_set_data_full (G_OBJECT (parent),
-					       	"gtk-about-dialog",
-						dialog, g_object_unref);
-		else
-			global_about_dialog = dialog;
-	}
-	gtk_window_present (GTK_WINDOW (dialog));
-
-
 MODULE = Gtk2::AboutDialog PACKAGE = Gtk2::AboutDialog PREFIX = gtk_about_dialog_
 
 GtkWidget * gtk_about_dialog_new (class)
@@ -265,3 +200,13 @@ gtk_about_dialog_set_url_hook (class, fu
 		  gtk2perl_about_dialog_activate_link_func,
 		callback,
 		(GDestroyNotify) gperl_callback_destroy);
+
+# Gtk2::show_about_dialog is implemented in Gtk2.pm.
+=for apidoc Gtk2::show_about_dialog
+=for signature Gtk2->show_about_dialog ($parent, $first_property_name, ...)
+=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