[perl-Gtk3] Add overrides for GtkRadio*

[Torsten Schönfeld <tsch src gnome org>]

commit fb09b3a06afd9f922d8153d0b8a672e3aac110e6
Author: Torsten Schönfeld <kaffeetisch gmx de>
Date:   Thu Dec 5 23:04:39 2013 +0100

    Add overrides for GtkRadio*

 NEWS                      |    2 +
 lib/Gtk3.pm               |   92 +++++++++++++++++++++++++++++++++++++++-----
 t/zz-GtkRadioAction.t     |   46 ++++++++++++++++++++++
 t/zz-GtkRadioButton.t     |   59 +++++++++++++++++++++++++++++
 t/zz-GtkRadioMenuItem.t   |   21 +++-------
 t/zz-GtkRadioToolButton.t |   51 +++++++++++++++++++++++++
 6 files changed, 246 insertions(+), 25 deletions(-)
---
diff --git a/NEWS b/NEWS
index 6931fe1..bbb25d8 100644
--- a/NEWS
+++ b/NEWS
@@ -1,5 +1,7 @@
 {{$NEXT}}
 
+* Add overrides for Gtk3::RadioAction, Gtk3::RadioButton, Gtk3::RadioMenuItem
+  and Gtk3::RadioToolButton.
 * Require Test::Simple >= 0.96.
 
 Overview of changes in Gtk3 0.014 [2013-10-18]
diff --git a/lib/Gtk3.pm b/lib/Gtk3.pm
index 5a06c28..4d0bb09 100644
--- a/lib/Gtk3.pm
+++ b/lib/Gtk3.pm
@@ -970,22 +970,90 @@ sub Gtk3::MessageDialog::new {
   return $dialog;
 }
 
-# Gtk3::RadioMenuItem constructors.
+# Gtk3::RadioAction, Gtk3::RadioButton, Gtk3::RadioMenuItem and
+# Gtk3::RadioToolButton constructors.
 {
   no strict qw(refs);
-  foreach my $ctor (qw/new new_with_label new_with_mnemonic/) {
-    *{'Gtk3::RadioMenuItem::' . $ctor} = sub {
-      my ($class, $group_or_member, @rest) = @_;
-      my $real_ctor = $ctor;
-      {
-        local $@;
-        if (eval { $group_or_member->isa ('Gtk3::RadioMenuItem') }) {
+
+  my $group_converter = sub {
+    my ($ctor, $group_or_member, $package) = @_;
+    local $@;
+    # undef => []
+    if (!defined $group_or_member) {
+      return ($ctor, []);
+    }
+    # [] => []
+    elsif (eval { $#$group_or_member == -1 }) {
+      return ($ctor, []);
+    }
+    # [member1, ...] => member1
+    elsif (eval { $#$group_or_member >= 0}) {
+      return ($ctor . '_from_widget', $group_or_member->[0]);
+    }
+    # member => member
+    elsif (eval { $group_or_member->isa ('Gtk3::' . $package) }) {
+      return ($ctor . '_from_widget', $group_or_member);
+    }
+    else {
+      croak ('Unhandled group or member argument encountered');
+    }
+  };
+
+  # Gtk3::RadioAction/Gtk3::RadioButton/Gtk3::RadioMenuItem/Gtk3::RadioToolButton
+  foreach my $package (qw/RadioAction RadioButton RadioMenuItem RadioToolButton/) {
+    *{'Gtk3::' . $package . '::set_group'} = sub {
+      my ($button, $group) = @_;
+      my $real_group = $group;
+      if (eval { $#$group >= 0 }) {
+        $real_group = $group->[0];
+      }
+      $button->set (group => $real_group);
+    };
+  }
+
+  # Gtk3::RadioButton/Gtk3::RadioMenuItem
+  foreach my $package (qw/RadioButton RadioMenuItem/) {
+    foreach my $ctor (qw/new new_with_label new_with_mnemonic/) {
+      # Avoid using the list-based API, as G:O:I does not support the memory
+      # ownership semantics.  Use the item-based API instead.
+      *{'Gtk3::' . $package . '::' . $ctor} = sub {
+        my ($class, $group_or_member, @rest) = @_;
+        my ($real_ctor, $real_group_or_member) =
+          $group_converter->($ctor, $group_or_member, $package);
+        return Glib::Object::Introspection->invoke (
+          $_GTK_BASENAME, $package, $real_ctor,
+          $class, $real_group_or_member, @rest);
+      };
+
+      # Work around <https://bugzilla.gnome.org/show_bug.cgi?id=679563>.
+      *{'Gtk3::' . $package . '::' . $ctor . '_from_widget'} = sub {
+        my ($class, $member, @rest) = @_;
+        my $real_ctor = $ctor;
+        my $real_group_or_member = $member;
+        if (!defined $member) {
+          $real_group_or_member = [];
+        } else {
           $real_ctor .= '_from_widget';
         }
-      }
+        return Glib::Object::Introspection->invoke (
+          $_GTK_BASENAME, $package, $real_ctor,
+          $class, $real_group_or_member, @rest);
+      };
+    }
+  }
+
+  # GtkRadioToolButton
+  foreach my $ctor (qw/new new_from_stock/) {
+    # Avoid using the list-based API, as G:O:I does not support the memory
+    # ownership semantics.  Use the item-based API instead.
+    *{'Gtk3::RadioToolButton::' . $ctor} = sub {
+      my ($class, $group_or_member, @rest) = @_;
+      my ($real_ctor, $real_group_or_member) =
+        $group_converter->($ctor, $group_or_member, 'RadioToolButton');
+      $real_ctor =~ s/_from_stock_from_/_with_stock_from_/; # you gotta be kidding me...
       return Glib::Object::Introspection->invoke (
-        $_GTK_BASENAME, 'RadioMenuItem', $real_ctor,
-        $class, $group_or_member, @rest);
+        $_GTK_BASENAME, 'RadioToolButton', $real_ctor,
+        $class, $real_group_or_member, @rest);
     };
   }
 }
@@ -1535,6 +1603,8 @@ and must be returned.
 =item * Gtk3::Menu: The position callback passed to popup() does not receive x
 and y parameters anymore.
 
+=item * Gtk3::RadioAction: The constructor now follows the C API.
+
 =item * Gtk3::TreeModel: iter_next() is now a method that is modifying the iter
 directly, instead of returning a new one.  rows_reordered() and the
 "rows-reordered" signal are currently unusable.
diff --git a/t/zz-GtkRadioAction.t b/t/zz-GtkRadioAction.t
new file mode 100644
index 0000000..b80962d
--- /dev/null
+++ b/t/zz-GtkRadioAction.t
@@ -0,0 +1,46 @@
+#!/usr/bin/perl
+
+# Based on Gtk2/t/GtkRadioAction.t
+
+BEGIN { require './t/inc/setup.pl' }
+
+use strict;
+use warnings;
+
+plan tests => 14;
+
+my @actions = (Gtk3::RadioAction->new ('one', undef, undef, undef, 0));
+isa_ok ($actions[$#actions], 'Gtk3::RadioAction');
+my $i = 1;
+foreach (qw(two three four five)) {
+       push @actions, Gtk3::RadioAction->new ($_, undef, undef, undef, $i++);
+        $actions[$#actions]->set (group => $actions[$#actions-1]);
+       isa_ok ($actions[$#actions], 'Gtk3::RadioAction');
+}
+my $group = $actions[0]->get_group;
+push @actions, Gtk3::RadioAction->new ('six', undef, undef, undef, 5);
+isa_ok ($actions[$#actions], 'Gtk3::RadioAction');
+$actions[$#actions]->set_group ($group);
+{
+  # get_group() no memory leaks in arrayref return and array items
+  my $x = Gtk3::RadioAction->new ('x', undef, undef, undef, 0);
+  my $y = Gtk3::RadioAction->new ('y', undef, undef, undef, 0);
+  $y->set_group($x);
+  my $aref = $x->get_group;
+  is_deeply($aref, [$x,$y]);
+  require Scalar::Util;
+  Scalar::Util::weaken ($aref);
+  is ($aref, undef, 'get_group() array destroyed by weakening');
+  Scalar::Util::weaken ($x);
+  is ($x, undef, 'get_group() item x destroyed by weakening');
+  Scalar::Util::weaken ($y);
+  is ($y, undef, 'get_group() item y destroyed by weakening');
+}
+
+is ($actions[0]->get_current_value, 0);
+$actions[0]->set_current_value (3);
+is ($actions[0]->get_current_value, 3);
+
+$actions[3]->set_active (Glib::TRUE);
+ok (!$actions[0]->get_active);
+ok ($actions[3]->get_active);
diff --git a/t/zz-GtkRadioButton.t b/t/zz-GtkRadioButton.t
new file mode 100644
index 0000000..4747a76
--- /dev/null
+++ b/t/zz-GtkRadioButton.t
@@ -0,0 +1,59 @@
+#!/usr/bin/perl
+
+BEGIN { require './t/inc/setup.pl' }
+
+use strict;
+use warnings;
+
+plan tests => 11;
+
+{
+  my $item_one = Gtk3::RadioButton -> new();
+  isa_ok($item_one, "Gtk3::RadioButton");
+
+  my $item_two = Gtk3::RadioButton -> new($item_one -> get_group());
+  isa_ok($item_two, "Gtk3::RadioButton");
+
+  my $item_three = Gtk3::RadioButton -> new_with_label([], "Bla");
+  isa_ok($item_three, "Gtk3::RadioButton");
+
+  my $item_four = Gtk3::RadioButton -> new_with_mnemonic([$item_one, $item_two], "_Bla");
+  isa_ok($item_four, "Gtk3::RadioButton");
+
+  $item_three -> set_group($item_one -> get_group());
+  is_deeply($item_one -> get_group(),
+            [$item_one, $item_two, $item_three, $item_four]);
+
+  my $item_five = Gtk3::RadioButton -> new_from_widget($item_one);
+  isa_ok($item_five, "Gtk3::RadioButton");
+
+  my $item_six = Gtk3::RadioButton -> new_with_label_from_widget($item_two, "Bla");
+  isa_ok($item_six, "Gtk3::RadioButton");
+
+  my $item_seven = Gtk3::RadioButton -> new_with_mnemonic_from_widget($item_three, "_Bla");
+  isa_ok($item_seven, "Gtk3::RadioButton");
+
+  is_deeply($item_one -> get_group(),
+            [$item_one, $item_two, $item_three, $item_four,
+             $item_five, $item_six, $item_seven]);
+}
+
+{
+  my $item_one = Gtk3::RadioButton -> new_from_widget(undef);
+  my $item_two = Gtk3::RadioButton -> new($item_one);
+  my $item_three = Gtk3::RadioButton -> new_with_label($item_one, "Bla");
+  my $item_four = Gtk3::RadioButton -> new_with_mnemonic($item_one, "_Bla");
+  is_deeply($item_one -> get_group(), [$item_one, $item_two, $item_three, $item_four]);
+
+  my $item_five = Gtk3::RadioButton -> new_from_widget($item_one);
+  my $item_six = Gtk3::RadioButton -> new_with_label_from_widget($item_two, "Bla");
+  my $item_seven = Gtk3::RadioButton -> new_with_mnemonic_from_widget($item_three, "_Bla");
+  is_deeply($item_seven -> get_group(),
+            [$item_one, $item_two, $item_three, $item_four,
+             $item_five, $item_six, $item_seven]);
+}
+
+__END__
+
+Copyright (C) 2003-2012 by the gtk2-perl team (see the file AUTHORS for the
+full list).  See LICENSE for more information.
diff --git a/t/zz-GtkRadioMenuItem.t b/t/zz-GtkRadioMenuItem.t
index 834b8c3..7d3819c 100644
--- a/t/zz-GtkRadioMenuItem.t
+++ b/t/zz-GtkRadioMenuItem.t
@@ -7,12 +7,9 @@ BEGIN { require './t/inc/setup.pl' }
 use strict;
 use warnings;
 
-plan tests => 11;
-
-SKIP: {
-  skip 'list-based API; it is broken currently', 9
-    unless 0; # FIXME: <https://bugzilla.gnome.org/show_bug.cgi?id=679563>
+plan tests => 12;
 
+{
   my $item_one = Gtk3::RadioMenuItem -> new();
   isa_ok($item_one, "Gtk3::RadioMenuItem");
 
@@ -25,6 +22,9 @@ SKIP: {
   my $item_four = Gtk3::RadioMenuItem -> new_with_mnemonic([$item_one, $item_two], "_Bla");
   isa_ok($item_four, "Gtk3::RadioMenuItem");
 
+  is_deeply($item_one -> get_group(),
+            [$item_one, $item_two, $item_four]);
+
   $item_three -> set_group($item_one -> get_group());
   is_deeply($item_one -> get_group(),
             [$item_one, $item_two, $item_three, $item_four]);
@@ -43,15 +43,8 @@ SKIP: {
              $item_five, $item_six, $item_seven]);
 }
 
-SKIP: {
-  skip 'item-based API; missing annotations', 2
-    unless Gtk3::CHECK_VERSION (3, 6, 0);
-
-  # FIXME: The item-based API is not bootstrap-able on its own yet, see
-  # <https://bugzilla.gnome.org/show_bug.cgi?id=679563>.
-  # my $item_one = Gtk3::RadioMenuItem -> new_from_widget(undef);
-
-  my $item_one = Gtk3::RadioMenuItem -> new([]);
+{
+  my $item_one = Gtk3::RadioMenuItem -> new_from_widget(undef);
   my $item_two = Gtk3::RadioMenuItem -> new($item_one);
   my $item_three = Gtk3::RadioMenuItem -> new_with_label($item_one, "Bla");
   my $item_four = Gtk3::RadioMenuItem -> new_with_mnemonic($item_one, "_Bla");
diff --git a/t/zz-GtkRadioToolButton.t b/t/zz-GtkRadioToolButton.t
new file mode 100644
index 0000000..29206b2
--- /dev/null
+++ b/t/zz-GtkRadioToolButton.t
@@ -0,0 +1,51 @@
+#!/usr/bin/perl
+
+# Based on Gtk2/t/GtkRadioToolButton.t
+
+BEGIN { require './t/inc/setup.pl' }
+
+use strict;
+use warnings;
+
+plan tests => 12;
+
+my $item = Gtk3::RadioToolButton -> new();
+isa_ok($item, "Gtk3::RadioToolButton");
+
+my $item_two = Gtk3::RadioToolButton -> new(undef);
+isa_ok($item_two, "Gtk3::RadioToolButton");
+
+my $item_three = Gtk3::RadioToolButton -> new([$item, $item_two]);
+isa_ok($item_three, "Gtk3::RadioToolButton");
+
+$item_two = Gtk3::RadioToolButton -> new_from_stock(undef, "gtk-quit");
+isa_ok($item_two, "Gtk3::RadioToolButton");
+
+$item_three = Gtk3::RadioToolButton -> new_from_stock([$item, $item_two], "gtk-quit");
+isa_ok($item_three, "Gtk3::RadioToolButton");
+
+$item = Gtk3::RadioToolButton -> new_from_widget($item_two);
+isa_ok($item, "Gtk3::RadioToolButton");
+
+$item = Gtk3::RadioToolButton -> new_with_stock_from_widget($item_two, "gtk-quit");
+isa_ok($item, "Gtk3::RadioToolButton");
+
+$item = Gtk3::RadioToolButton -> new();
+$item -> set_group([$item_two, $item_three]);
+is_deeply($item -> get_group(), [$item_two, $item_three]);
+
+{
+  # get_group() no memory leaks in arrayref return and array items
+  my $x = Gtk3::RadioToolButton->new;
+  my $y = Gtk3::RadioToolButton->new;
+  $y->set_group ($x);
+  my $aref = $x->get_group;
+  is_deeply ($aref, [$x,$y]);
+  require Scalar::Util;
+  Scalar::Util::weaken ($aref);
+  is ($aref, undef, 'get_group() array destroyed by weakening');
+  Scalar::Util::weaken ($x);
+  is ($x, undef, 'get_group() item x destroyed by weakening');
+  Scalar::Util::weaken ($y);
+  is ($y, undef, 'get_group() item y destroyed by weakening');
+}