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