1#!/usr/bin/perl
2#
3# $Id$
4#
5
6use Gtk2::TestHelper
7	at_least_version => [2, 4, 0, "Action-based menus are new in 2.4"],
8	tests => 31, noinit => 0;
9
10my $action = Gtk2::Action->new (name => 'Open',
11                                label => '_Open',
12                                tooltip => 'Open Something',
13                                stock_id => 'gtk-open');
14
15is ($action->is_sensitive, 1);
16is ($action->get_sensitive, 1);
17
18is ($action->is_visible, 1);
19is ($action->get_visible, 1);
20
21isa_ok ($action, 'Gtk2::Action');
22is ($action->get_name, 'Open');
23
24$action->signal_connect (activate => sub { ok (TRUE) });
25$action->activate;
26
27# most of these are for action implementations
28my $icon_widget = $action->create_icon ('large-toolbar');
29isa_ok ($icon_widget, 'Gtk2::Image');
30
31my $group = Gtk2::ActionGroup->new ('dummy');
32$group->add_action ($action);
33
34my $widget = $action->create_menu_item;
35isa_ok ($widget, 'Gtk2::MenuItem');
36
37$widget = $action->create_tool_item;
38isa_ok ($widget, 'Gtk2::ToolItem');
39
40my $proxy = Gtk2::Button->new;
41$action->connect_proxy ($proxy);
42my @proxies = $action->get_proxies;
43ok (grep {$_ == $proxy} @proxies);
44$action->disconnect_proxy ($proxy);
45
46$action->connect_accelerator;
47$action->disconnect_accelerator;
48## /* protected ... for use by child actions */
49$action->block_activate_from ($proxy);
50$action->unblock_activate_from ($proxy);
51## /* protected ... for use by action groups */
52$action->set_accel_path ('<Action>/');
53$action->set_accel_group (undef);
54$action->set_accel_group (Gtk2::AccelGroup->new);
55
56# call $action->get_proxies within an ActionGroup connect_proxy signal, to
57# check the ref-counting/sinking/not-sinking on that get_proxies is ok there.
58{
59  my $actions = Gtk2::ActionGroup->new ("Actions");
60  $actions->add_actions
61    ([ [ 'FileMenu', undef, '_File' ] ]);
62  $actions->signal_connect (connect_proxy => \&connect_get_proxies);
63  my $proxies_called = 0;
64  sub connect_get_proxies {
65    my ($actions, $action, $widget) = @_;
66    $action->get_proxies;
67    $proxies_called++;
68  }
69  my $ui = Gtk2::UIManager->new;
70  $ui->insert_action_group ($actions, 0);
71  $ui->add_ui_from_string (<<'HERE');
72<ui>
73  <menubar name='MenuBar'>
74    <menu action='FileMenu'>
75    </menu>
76  </menubar>
77</ui>
78HERE
79  # dodgy refs result in g_critical logs
80  my $old_fatal = Glib::Log->set_always_fatal (['critical', 'fatal-mask']);
81  $ui->get_widget('/MenuBar');
82  Glib::Log->set_always_fatal ($old_fatal);
83  is ($proxies_called, 1,
84      '$action->get_proxies ok under a connect_proxy signal');
85}
86
87SKIP: {
88	skip "new 2.6 stuff", 3
89		unless Gtk2->CHECK_VERSION (2, 6, 0);
90
91	$action->set_sensitive(FALSE);
92	is ($action->is_sensitive, FALSE);
93
94	$action->set_visible(FALSE);
95	is ($action->is_visible, FALSE);
96
97	ok (defined $action->get_accel_path);
98}
99
100SKIP: {
101	skip "new 2.10 stuff", 1
102		unless Gtk2->CHECK_VERSION (2, 10, 0);
103
104	isa_ok ($widget->get_action, 'Gtk2::Action');
105}
106
107SKIP: {
108	skip "new 2.12 stuff", 1
109		unless Gtk2->CHECK_VERSION (2, 12, 0);
110
111	is ($action->create_menu, undef);
112}
113
114SKIP: {
115	skip "new 2.16 stuff", 13
116		unless Gtk2->CHECK_VERSION (2, 16, 0);
117
118	$action->set_label('new label');
119	is ($action->get_label, 'new label', '[gs]et_label');
120
121	$action->set_short_label('new short label');
122	is ($action->get_short_label, 'new short label', '[gs]et_short_label');
123
124	# it seems resetting label and short_label to undef is not possible,
125	# so use a new gtkaction with no label/short_label to test the getters
126	my $a_undef = Gtk2::Action->new (name => 'Open');
127	is ($a_undef->get_label, undef, 'get_label with undef');
128	is ($a_undef->get_short_label, undef, 'get_short_label with undef');
129
130	$action->set_tooltip('new tooltip');
131	is ($action->get_tooltip, 'new tooltip', '[gs]et_tooltip');
132	$action->set_tooltip(undef);
133	is ($action->get_tooltip, undef, '[gs]et_tooltip with undef');
134
135	$action->set_stock_id('gtk-ok');
136	is ($action->get_stock_id, 'gtk-ok', '[gs]et_stock_id');
137	$action->set_stock_id(undef);
138	is ($action->get_stock_id, undef, '[gs]et_stock_id with undef');
139
140	$action->set_icon_name('my-icon-name');
141	is ($action->get_icon_name, 'my-icon-name', '[gs]et_icon_name');
142	$action->set_icon_name(undef);
143	is ($action->get_icon_name, undef, '[gs]et_icon_name with undef');
144
145	$action->set_visible_horizontal(FALSE);
146	is ($action->get_visible_horizontal, FALSE, '[gs]et_visible_horizontal');
147
148	$action->set_visible_vertical(FALSE);
149	is ($action->get_visible_vertical, FALSE, '[gs]et_visible_vertical');
150
151	$action->set_is_important(TRUE);
152	is ($action->get_is_important, TRUE, '[gs]et_is_important');
153
154	$action->block_activate;
155	$action->unblock_activate;
156}
157
158SKIP: {
159	skip 'new 2.20 stuff', 1
160		unless Gtk2->CHECK_VERSION(2, 20, 0);
161
162	$action->set_always_show_image (TRUE);
163	ok ($action->get_always_show_image);
164}
165
166__END__
167
168Copyright (C) 2003-2006 by the gtk2-perl team (see the file AUTHORS for the
169full list).  See LICENSE for more information.
170