[perl-Gtk3] Add overrides for Gtk3::ActionGroup

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

commit 237d426447f334437c345db61b3026b5817f0c06
Author: Dave M <dave nerd gmail com>
Date:   Tue Jun 26 21:58:08 2012 +0200

    Add overrides for Gtk3::ActionGroup
    
    Namely, make list_actions() flatten its output list, and provide
    reimplementations of add_actions(), add_toggle_actions() and
    add_radio_actions().

 lib/Gtk3.pm           |  174 +++++++++++++++++++++++++++++++++++++++++++++++++
 t/zz-GtkActionGroup.t |  124 +++++++++++++++++++++++++++++++++++
 2 files changed, 298 insertions(+), 0 deletions(-)
---
diff --git a/lib/Gtk3.pm b/lib/Gtk3.pm
index 170bd6e..c6bf3b0 100644
--- a/lib/Gtk3.pm
+++ b/lib/Gtk3.pm
@@ -33,6 +33,7 @@ my %_GTK_NAME_CORRECTIONS = (
   'Gtk3::stock_set_translate_func' => 'Gtk3::Stock::set_translate_func',
 );
 my @_GTK_FLATTEN_ARRAY_REF_RETURN_FOR = qw/
+  Gtk3::ActionGroup::list_actions
   Gtk3::Builder::get_objects
   Gtk3::CellLayout::get_cells
   Gtk3::Stock::list_ids
@@ -178,6 +179,179 @@ sub Gtk3::main_quit {
   }
 }
 
+sub Gtk3::ActionGroup::add_actions {
+  my ($self, $entries, $user_data) = @_;
+
+  croak 'actions must be a reference to an array of action entries'
+    unless (ref($entries) eq 'ARRAY');
+
+  croak 'action array is empty'
+    unless (@$entries);
+
+  my $process = sub {
+    my ($p) = @_;
+    my ($name, $stock_id, $label, $accelerator, $tooltip, $callback);
+
+    if (ref($p) eq 'ARRAY') {
+      $name        = $p->[0];
+      $stock_id    = $p->[1];
+      $label       = $p->[2];
+      $accelerator = $p->[3];
+      $tooltip     = $p->[4];
+      $callback    = $p->[5];
+    } elsif (ref($p) eq 'HASH') {
+      $name        = $p->{name};
+      $stock_id    = $p->{stock_id};
+      $label       = $p->{label};
+      $accelerator = $p->{accelerator};
+      $tooltip     = $p->{tooltip};
+      $callback    = $p->{callback};
+    } else {
+      croak 'action entry must be a reference to a hash or an array';
+    }
+
+    if (defined($label)) {
+      $label   = $self->translate_string($label);
+    }
+    if (defined($tooltip)) {
+      $tooltip = $self->translate_string($tooltip);
+    }
+
+    my $action = Gtk3::Action->new ($name, $label, $tooltip, $stock_id);
+
+    if ($callback) {
+      $action->signal_connect ('activate', $callback, $user_data);
+    }
+    $self->add_action_with_accel ($action, $accelerator);
+  };
+
+  for my $e (@$entries) {
+    $process->($e);
+  }
+}
+
+sub Gtk3::ActionGroup::add_toggle_actions {
+  my ($self, $entries, $user_data) = @_;
+
+  croak 'entries must be a reference to an array of toggle action entries'
+    unless (ref($entries) eq 'ARRAY');
+
+  croak 'toggle action array is empty'
+    unless (@$entries);
+
+  my $process = sub {
+    my ($p) = @_;
+    my ($name, $stock_id, $label, $accelerator, $tooltip,
+      $callback, $is_active);
+
+    if (ref($p) eq 'ARRAY') {
+      $name        = $p->[0];
+      $stock_id    = $p->[1];
+      $label       = $p->[2];
+      $accelerator = $p->[3];
+      $tooltip     = $p->[4];
+      $callback    = $p->[5];
+      $is_active   = $p->[6];
+    } elsif (ref($p) eq 'HASH') {
+      $name        = $p->{name};
+      $stock_id    = $p->{stock_id};
+      $label       = $p->{label};
+      $accelerator = $p->{accelerator};
+      $tooltip     = $p->{tooltip};
+      $callback    = $p->{callback};
+      $is_active   = $p->{is_active};
+    } else {
+      croak 'action entry must be a hash or an array';
+    }
+
+    if (defined($label)) {
+      $label   = $self->translate_string($label);
+    }
+    if (defined($tooltip)) {
+      $tooltip = $self->translate_string($tooltip);
+    }
+
+    my $action = Gtk3::ToggleAction->new (
+      $name, $label, $tooltip, $stock_id);
+    $action->set_active ($is_active);
+
+    if ($callback) {
+      $action->signal_connect ('activate', $callback, $user_data);
+    }
+
+    $self->add_action_with_accel ($action, $accelerator);
+  };
+
+  for my $e (@$entries) {
+    $process->($e);
+  }
+}
+
+sub Gtk3::ActionGroup::add_radio_actions {
+  my ($self, $entries, $value, $on_change, $user_data) = @_;
+
+  croak 'radio_action_entries must be a reference to '
+    . 'an array of action entries'
+    unless (ref($entries) eq 'ARRAY');
+
+  croak 'radio action array is empty'
+    unless (@$entries);
+
+  my $first_action = undef;
+
+  my $process = sub {
+    my ($group, $p) = @_;
+    my ($name, $stock_id, $label, $accelerator, $tooltip, $entry_value);
+
+    if (ref($p) eq 'ARRAY') {
+      $name        = $p->[0];
+      $stock_id    = $p->[1];
+      $label       = $p->[2];
+      $accelerator = $p->[3];
+      $tooltip     = $p->[4];
+      $entry_value = $p->[5];
+    } elsif (ref($p) eq 'HASH') {
+      $name        = $p->{name};
+      $stock_id    = $p->{stock_id};
+      $label       = $p->{label};
+      $accelerator = $p->{accelerator};
+      $tooltip     = $p->{tooltip};
+      $entry_value = $p->{value};
+    } else {
+      croak 'radio action entries neither hash nor array';
+    }
+
+    if (defined($label)) {
+      $label   = $self->translate_string($label);
+    }
+    if (defined($tooltip)) {
+      $tooltip = $self->translate_string($tooltip);
+    }
+
+    my $action = Gtk3::RadioAction->new (
+      $name, $label, $tooltip, $stock_id, $entry_value);
+
+    $action->join_group($group);
+
+    if ($value == $entry_value) {
+      $action->set_active(Glib::TRUE);
+    }
+    $self->add_action_with_accel($action, $accelerator);
+    return $action;
+  };
+
+  for my $e (@$entries) {
+    my $group = $process->($first_action, $e);
+    if (!$first_action) {
+      $first_action = $group;
+    }
+  }
+
+  if ($first_action && $on_change) {
+    $first_action->signal_connect ('changed', $on_change, $user_data);
+  }
+}
+
 sub Gtk3::Builder::add_objects_from_file {
   my ($builder, $filename, @rest) = @_;
   my $ref = _rest_to_ref (\ rest);
diff --git a/t/zz-GtkActionGroup.t b/t/zz-GtkActionGroup.t
new file mode 100644
index 0000000..16a74f7
--- /dev/null
+++ b/t/zz-GtkActionGroup.t
@@ -0,0 +1,124 @@
+#!/usr/bin/perl
+
+# Copied from Gtk2/t/GtkActionGroup.t
+
+BEGIN { require './t/inc/setup.pl' }
+
+use strict;
+use warnings;
+
+plan tests => 28;
+
+use Glib 'TRUE', 'FALSE';
+
+my $action_group = Gtk3::ActionGroup->new ('Fred');
+
+isa_ok ($action_group, 'Gtk3::ActionGroup');
+is ($action_group->get_name, 'Fred');
+
+$action_group->set_sensitive (1);
+is ($action_group->get_sensitive, 1);
+
+$action_group->set_visible (1);
+is ($action_group->get_visible, 1);
+
+my $action = Gtk3::Action->new ('Barney');
+
+$action_group->add_action ($action);
+
+my @list = $action_group->list_actions;
+is (@list, 1);
+is ($list[0], $action);
+is ($action_group->get_action ('Barney'), $action);
+$action_group->remove_action ($action);
+ list = $action_group->list_actions;
+is (@list, 0);
+
+$action_group->add_action_with_accel ($action, undef);
+$action_group->remove_action ($action);
+
+$action_group->add_action_with_accel ($action, "<shift>a");
+$action_group->remove_action ($action);
+
+my @action_entries = (
+  {
+    name        => 'open',
+    stock_id    => 'gtk-open',
+    label       => 'Open',
+    accelerator => '<control>o',
+    tooltip     => 'Open something',
+    callback    => sub { ok (TRUE) },
+  },
+  {
+    name        => 'new',
+    stock_id    => 'gtk-new',
+  },
+  {
+    name        => 'old',
+    label       => 'Old',
+  },
+  [ 'close', 'gtk-close', 'Close', '<control>w', 'Close something', sub { ok (TRUE) } ],
+  [ 'quit', 'gtk-quit', undef, '<control>q', ],
+  [ 'sep',  undef, 'blank', ],
+);
+
+my @toggle_entries = (
+  [ "Bold", 'gtk-bold', "_Bold",               # name, stock id, label
+     "<control>B", "Bold",                     # accelerator, tooltip
+    \&activate_action, TRUE ],                 # is_active
+);
+
+use constant COLOR_RED   => 0;
+use constant COLOR_GREEN => 1;
+use constant COLOR_BLUE  => 2;
+
+my @color_entries = (
+  # name,    stock id, label,    accelerator,  tooltip, value
+  [ "Red",   undef,    "_Red",   "<control>R", "Blood", COLOR_RED   ],
+  [ "Green", undef,    "_Green", "<control>G", "Grass", COLOR_GREEN ],
+  [ "Blue",  undef,    "_Blue",  "<control>B", "Sky",   COLOR_BLUE  ],
+);
+
+#$action_group->add_actions (\ action_entries, 42)
+$action_group->add_actions (\ action_entries);
+ list = $action_group->list_actions;
+is (@list, 6);
+
+$action_group->add_toggle_actions (\ toggle_entries, 42);
+#$action_group->add_toggle_actions (\ toggle_entries);
+ list = $action_group->list_actions;
+is (@list, 7);
+
+
+#$action_group->add_radio_actions (\ color_entries, COLOR_BLUE, \&on_change, 42);
+$action_group->add_radio_actions (\ color_entries, COLOR_GREEN, \&on_change);
+ list = $action_group->list_actions;
+is (@list, 10);
+
+$action_group->set_translation_domain("de_DE");
+
+$action_group = Gtk3::ActionGroup->new ("Fred");
+
+$action_group->set_translate_func(sub {
+  my ($string, $data) = @_;
+
+  is($string, "Urgs");
+  is($data, "bla");
+
+  return "Sgru";
+}, "bla");
+
+is($action_group->translate_string("Urgs"), "Sgru");
+
+# as of 2.6.0 we have the ability to call the translation function
+# from add_*_actions like we're supposed to, so let's test that.
+# the following should result in 14 oks.
+$action_group->set_translate_func (sub { ok(TRUE, 'xlate'); reverse $_[0]; });
+$action_group->add_actions (\ action_entries);
+$action_group->add_toggle_actions (\ toggle_entries, 42);
+$action_group->add_radio_actions (\ color_entries, COLOR_GREEN, \&on_change);
+
+__END__
+
+Copyright (C) 2003-2005 by the gtk2-perl team (see the file AUTHORS for the
+full list).  See LICENSE for more information.