#!/usr/bin/perl -w
use strict;
use Gtk2::TestHelper tests => 19;
# $Id$
use Gtk2::Gdk::Keysyms;
my $group = Gtk2::AccelGroup -> new();
isa_ok($group, "Gtk2::AccelGroup");
my $window = Gtk2::Window -> new();
$window -> add_accel_group($group);
my $key = $Gtk2::Gdk::Keysyms{ KP_Enter };
my $mask = qw(shift-mask);
my $closure = sub {
is($_[0], $group);
is($_[1], $window);
is($_[2], $key);
is_deeply(\@{ $_[3] }, [$mask]);
};
$group -> connect($key, $mask, qw(visible), $closure);
$group -> connect_by_path("<gtk2-perl-tests>/Bla/Blub", $closure);
$group -> lock();
$group -> unlock();
like(Gtk2::AccelGroups -> activate($window, $key, $mask), qr/^(?:|1)$/);
is(Gtk2::AccelGroups -> from_object($window), $group);
is(Gtk2::Accelerator -> valid($key, $mask), 1);
my @test = Gtk2::Accelerator -> parse("<Shift>KP_Enter");
is($test[0], $key);
is_deeply(\@{ $test[1] }, [$mask]);
is(Gtk2::Accelerator -> name($key, $mask), "<Shift>KP_Enter");
Gtk2::Accelerator -> set_default_mod_mask([qw(shift-mask control-mask mod1-mask mod2-mask lock-mask)]);
ok(Gtk2::Accelerator -> get_default_mod_mask() == [qw(shift-mask control-mask mod1-mask mod2-mask lock-mask)]);
is($group -> disconnect_key($key, $mask), 1);
SKIP: {
skip 'disconnect_key from empty group, bug in gtk+', 1
unless Gtk2->CHECK_VERSION (2, 4, 0);
ok (not ($group->disconnect_key (42, qw/shift-mask/)),
'second disconnect_key shift-mask should fail');
}
SKIP: {
skip 'get_label is new in 2.6', 1
unless Gtk2->CHECK_VERSION (2, 6, 0);
ok(defined Gtk2::Accelerator -> get_label($key, $mask));
}
is($group -> disconnect($closure), 1);
ok(not $group -> disconnect($closure));
SKIP: {
skip 'new 2.14 stuff', 2
unless Gtk2->CHECK_VERSION (2, 14, 0);
is ($group->get_is_locked, FALSE);
ok (defined $group->get_modifier_mask);
}
__END__
Copyright (C) 2003-2005 by the gtk2-perl team (see the file AUTHORS for
the full list). See LICENSE for more information.