#!/usr/bin/perl

# Copyright 2009 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, see <http://www.gnu.org/licenses/>.

package My::Object;
use strict;
use warnings;
use Gtk2;
use Glib::Object::Subclass
  'Gtk2::Object',
  signals => { mysig => { parameter_types => [],
                          return_type => undef,
                          flags => ['run-last','action'],
                          class_closure => \&do_mysig },
             };
my $mysig_seen;
sub do_mysig {
  Test::More::diag ("mysig runs");
  $mysig_seen = 1;
}

package My::Widget;
use strict;
use warnings;
use Gtk2;
use Glib::Object::Subclass
  'Gtk2::Widget',
  signals => { mywidgetsig => { parameter_types => [],
                          return_type => undef,
                          flags => ['run-last','action'],
                          class_closure => \&do_mywidgetsig },
             };
my $mywidgetsig_seen;
sub do_mywidgetsig {
  Test::More::diag ("mywidgetsig runs");
  $mywidgetsig_seen = 1;
}

package main;
use strict;
use warnings;
use Gtk2::TestHelper tests => 11,
  noinit => 1;  # don't think a display is needed ...
use Gtk2 '-init';

#-----------------------------------------------------------------------------
# new()

my $mybindings = Gtk2::BindingSet->new('mybindings');
ok ($mybindings, 'new()');

#-----------------------------------------------------------------------------
# name() field accessor

is ($mybindings->name, 'mybindings',
    'name() of mybindings');

#-----------------------------------------------------------------------------
# find()

ok (Gtk2::BindingSet->find('mybindings'),
    'find() mybindings');
is (Gtk2::BindingSet->find('nosuchbindingset'), undef,
    'find() not found');

#-----------------------------------------------------------------------------
# by_class()

ok (Gtk2::BindingSet->by_class('Gtk2::Entry'),
    'by_class() Gtk2::Entry');

#-----------------------------------------------------------------------------
# activate()

# The rc mechanism doesn't actually parse anything or create any
# GtkBindingSet's until one or more GtkSettings objects exist and are
# interested in the rc values.  Create a dummy label widget to force that to
# happen and thus ensure creation of the "some_bindings" set.
#
my $dummy_label = Gtk2::Label->new;

Gtk2::Rc->parse_string (<<'HERE');
binding "some_bindings" {
  bind "Return" { "mysig" () }
}
HERE

{
  my $some_bindings = Gtk2::BindingSet->find('some_bindings');
  ok ($some_bindings, 'find() of RC parsed bindings');

  my $myobj = My::Object->new;
  $mysig_seen = 0;
  ok ($some_bindings->activate (Gtk2::Gdk->keyval_from_name('Return'),
                                [],$myobj),
      'activate() return true on myobj');
  is ($mysig_seen, 1, 'activate() runs mysig on myobj');
}

#-----------------------------------------------------------------------------
# add_path() and bindings_activate()

Gtk2::Rc->parse_string (<<'HERE');
binding "my_widget_bindings" {
  bind "Return" { "mywidgetsig" () }
}
HERE

# As of Gtk 2.12 $gtkobj->bindings_activate() only actually works on a
# Gtk2::Widget, not a Gtk2::Object, hence My::Widget to exercise add_path()
# instead of My::Object.
{
  my $my_widget_bindings = Gtk2::BindingSet->find('my_widget_bindings');
  ok ($my_widget_bindings, 'find() of RC parsed bindings');

  $my_widget_bindings->add_path ('widget-class', 'My__Widget', 'application');

  my $mywidget = My::Widget->new;
  $mywidgetsig_seen = 0;
  ok ($mywidget->bindings_activate (Gtk2::Gdk->keyval_from_name('Return'),[]),
      'bindings_activate() return true on mywidget');
  is ($mywidgetsig_seen, 1,
      'bindings_activate() runs mywidgetsig on mywidget');
}

exit 0;