| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Gtk3; | 
| 2 |  |  |  |  |  |  | $Gtk3::VERSION = '0.032'; | 
| 3 |  |  |  |  |  |  | =encoding utf8 | 
| 4 |  |  |  |  |  |  |  | 
| 5 |  |  |  |  |  |  | =head1 NAME | 
| 6 |  |  |  |  |  |  |  | 
| 7 |  |  |  |  |  |  | Gtk3 - Perl interface to the 3.x series of the gtk+ toolkit | 
| 8 |  |  |  |  |  |  |  | 
| 9 |  |  |  |  |  |  | =head1 SYNOPSIS | 
| 10 |  |  |  |  |  |  |  | 
| 11 |  |  |  |  |  |  | use Gtk3 -init; | 
| 12 |  |  |  |  |  |  | my $window = Gtk3::Window->new ('toplevel'); | 
| 13 |  |  |  |  |  |  | my $button = Gtk3::Button->new ('Quit'); | 
| 14 |  |  |  |  |  |  | $button->signal_connect (clicked => sub { Gtk3::main_quit }); | 
| 15 |  |  |  |  |  |  | $window->add ($button); | 
| 16 |  |  |  |  |  |  | $window->show_all; | 
| 17 |  |  |  |  |  |  | Gtk3::main; | 
| 18 |  |  |  |  |  |  |  | 
| 19 |  |  |  |  |  |  | =head1 ABSTRACT | 
| 20 |  |  |  |  |  |  |  | 
| 21 |  |  |  |  |  |  | Perl bindings to the 3.x series of the gtk+ toolkit.  This module allows you to | 
| 22 |  |  |  |  |  |  | write graphical user interfaces in a Perlish and object-oriented way, freeing | 
| 23 |  |  |  |  |  |  | you from the casting and memory management in C, yet remaining very close in | 
| 24 |  |  |  |  |  |  | spirit to original API. | 
| 25 |  |  |  |  |  |  |  | 
| 26 |  |  |  |  |  |  | =head1 DESCRIPTION | 
| 27 |  |  |  |  |  |  |  | 
| 28 |  |  |  |  |  |  | The C module allows a Perl developer to use the gtk+ graphical user | 
| 29 |  |  |  |  |  |  | interface library.  Find out more about gtk+ at L. | 
| 30 |  |  |  |  |  |  |  | 
| 31 |  |  |  |  |  |  | The gtk+ reference manual is also a handy companion when writing C | 
| 32 |  |  |  |  |  |  | programs in Perl: L.  The Perl | 
| 33 |  |  |  |  |  |  | bindings follow the C API very closely, and the C reference documentation | 
| 34 |  |  |  |  |  |  | should be considered the canonical source.  The principles underlying the | 
| 35 |  |  |  |  |  |  | mapping from C to Perl are explained in the documentation of | 
| 36 |  |  |  |  |  |  | L, on which C is based. | 
| 37 |  |  |  |  |  |  |  | 
| 38 |  |  |  |  |  |  | L also comes with the C program which | 
| 39 |  |  |  |  |  |  | displays the API reference documentation of all installed libraries organized | 
| 40 |  |  |  |  |  |  | in accordance with these principles. | 
| 41 |  |  |  |  |  |  |  | 
| 42 |  |  |  |  |  |  | =cut | 
| 43 |  |  |  |  |  |  |  | 
| 44 | 22 |  |  | 22 |  | 312267 | use strict; | 
|  | 22 |  |  |  |  | 50 |  | 
|  | 22 |  |  |  |  | 634 |  | 
| 45 | 22 |  |  | 22 |  | 105 | use warnings; | 
|  | 22 |  |  |  |  | 48 |  | 
|  | 22 |  |  |  |  | 666 |  | 
| 46 | 22 |  |  | 22 |  | 128 | use Carp qw/croak/; | 
|  | 22 |  |  |  |  | 49 |  | 
|  | 22 |  |  |  |  | 1274 |  | 
| 47 | 22 |  |  | 22 |  | 18095 | use Cairo::GObject; | 
|  | 0 |  |  |  |  |  |  | 
|  | 0 |  |  |  |  |  |  | 
| 48 |  |  |  |  |  |  | use Glib::Object::Introspection; | 
| 49 |  |  |  |  |  |  | use Exporter; | 
| 50 |  |  |  |  |  |  |  | 
| 51 |  |  |  |  |  |  | our @ISA = qw(Exporter); | 
| 52 |  |  |  |  |  |  |  | 
| 53 |  |  |  |  |  |  | =head2 Wrapped libraries | 
| 54 |  |  |  |  |  |  |  | 
| 55 |  |  |  |  |  |  | C automatically sets up the following correspondence between C libraries | 
| 56 |  |  |  |  |  |  | and Perl packages: | 
| 57 |  |  |  |  |  |  |  | 
| 58 |  |  |  |  |  |  | Library       | Package | 
| 59 |  |  |  |  |  |  | --------------+---------- | 
| 60 |  |  |  |  |  |  | Gtk-3.0       | Gtk3 | 
| 61 |  |  |  |  |  |  | Gdk-3.0       | Gtk3::Gdk | 
| 62 |  |  |  |  |  |  | GdkPixbuf-2.0 | Gtk3::Gdk | 
| 63 |  |  |  |  |  |  | Pango-1.0     | Pango | 
| 64 |  |  |  |  |  |  |  | 
| 65 |  |  |  |  |  |  | =cut | 
| 66 |  |  |  |  |  |  |  | 
| 67 |  |  |  |  |  |  | =head2 Import arguments | 
| 68 |  |  |  |  |  |  |  | 
| 69 |  |  |  |  |  |  | When importing C, you can pass C<-init> as in C<< use Gtk3 -init; >> to | 
| 70 |  |  |  |  |  |  | have C automatically called.  You can also pass a version number to | 
| 71 |  |  |  |  |  |  | require a certain version of C. | 
| 72 |  |  |  |  |  |  |  | 
| 73 |  |  |  |  |  |  | =cut | 
| 74 |  |  |  |  |  |  |  | 
| 75 |  |  |  |  |  |  | my $_GTK_BASENAME = 'Gtk'; | 
| 76 |  |  |  |  |  |  | my $_GTK_VERSION = '3.0'; | 
| 77 |  |  |  |  |  |  | my $_GTK_PACKAGE = 'Gtk3'; | 
| 78 |  |  |  |  |  |  |  | 
| 79 |  |  |  |  |  |  | my $_GDK_BASENAME = 'Gdk'; | 
| 80 |  |  |  |  |  |  | my $_GDK_VERSION = '3.0'; | 
| 81 |  |  |  |  |  |  | my $_GDK_PACKAGE = 'Gtk3::Gdk'; | 
| 82 |  |  |  |  |  |  |  | 
| 83 |  |  |  |  |  |  | my $_GDK_PIXBUF_BASENAME = 'GdkPixbuf'; | 
| 84 |  |  |  |  |  |  | my $_GDK_PIXBUF_VERSION = '2.0'; | 
| 85 |  |  |  |  |  |  | my $_GDK_PIXBUF_PACKAGE = 'Gtk3::Gdk'; | 
| 86 |  |  |  |  |  |  |  | 
| 87 |  |  |  |  |  |  | my $_PANGO_BASENAME = 'Pango'; | 
| 88 |  |  |  |  |  |  | my $_PANGO_VERSION = '1.0'; | 
| 89 |  |  |  |  |  |  | my $_PANGO_PACKAGE = 'Pango'; | 
| 90 |  |  |  |  |  |  |  | 
| 91 |  |  |  |  |  |  | =head2 Customizations and overrides | 
| 92 |  |  |  |  |  |  |  | 
| 93 |  |  |  |  |  |  | In order to make things more Perlish or to make porting from C to C | 
| 94 |  |  |  |  |  |  | easier, C customizes the API generated by L | 
| 95 |  |  |  |  |  |  | in a few spots: | 
| 96 |  |  |  |  |  |  |  | 
| 97 |  |  |  |  |  |  | =over | 
| 98 |  |  |  |  |  |  |  | 
| 99 |  |  |  |  |  |  | =cut | 
| 100 |  |  |  |  |  |  |  | 
| 101 |  |  |  |  |  |  | # - Customizations ---------------------------------------------------------- # | 
| 102 |  |  |  |  |  |  |  | 
| 103 |  |  |  |  |  |  | =item * The array ref normally returned by the following functions is flattened | 
| 104 |  |  |  |  |  |  | into a list: | 
| 105 |  |  |  |  |  |  |  | 
| 106 |  |  |  |  |  |  | =over | 
| 107 |  |  |  |  |  |  |  | 
| 108 |  |  |  |  |  |  | =item Gtk3::ActionGroup::list_actions | 
| 109 |  |  |  |  |  |  |  | 
| 110 |  |  |  |  |  |  | =item Gtk3::Builder::get_objects | 
| 111 |  |  |  |  |  |  |  | 
| 112 |  |  |  |  |  |  | =item Gtk3::CellLayout::get_cells | 
| 113 |  |  |  |  |  |  |  | 
| 114 |  |  |  |  |  |  | =item Gtk3::Container::get_children | 
| 115 |  |  |  |  |  |  |  | 
| 116 |  |  |  |  |  |  | =item Gtk3::SizeGroup::get_widgets | 
| 117 |  |  |  |  |  |  |  | 
| 118 |  |  |  |  |  |  | =item Gtk3::TreePath::get_indices | 
| 119 |  |  |  |  |  |  |  | 
| 120 |  |  |  |  |  |  | =item Gtk3::TreeView::get_columns | 
| 121 |  |  |  |  |  |  |  | 
| 122 |  |  |  |  |  |  | =item Gtk3::UIManager::get_action_groups | 
| 123 |  |  |  |  |  |  |  | 
| 124 |  |  |  |  |  |  | =item Gtk3::UIManager::get_toplevels | 
| 125 |  |  |  |  |  |  |  | 
| 126 |  |  |  |  |  |  | =item Gtk3::Window::list_toplevels | 
| 127 |  |  |  |  |  |  |  | 
| 128 |  |  |  |  |  |  | =item Gtk3::stock_list_ids | 
| 129 |  |  |  |  |  |  |  | 
| 130 |  |  |  |  |  |  | =item Gtk3::Gdk::Pixbuf::get_formats | 
| 131 |  |  |  |  |  |  |  | 
| 132 |  |  |  |  |  |  | =back | 
| 133 |  |  |  |  |  |  |  | 
| 134 |  |  |  |  |  |  | =cut | 
| 135 |  |  |  |  |  |  |  | 
| 136 |  |  |  |  |  |  | my @_GTK_FLATTEN_ARRAY_REF_RETURN_FOR = qw/ | 
| 137 |  |  |  |  |  |  | Gtk3::ActionGroup::list_actions | 
| 138 |  |  |  |  |  |  | Gtk3::Builder::get_objects | 
| 139 |  |  |  |  |  |  | Gtk3::CellLayout::get_cells | 
| 140 |  |  |  |  |  |  | Gtk3::Container::get_children | 
| 141 |  |  |  |  |  |  | Gtk3::SizeGroup::get_widgets | 
| 142 |  |  |  |  |  |  | Gtk3::TreePath::get_indices | 
| 143 |  |  |  |  |  |  | Gtk3::TreeView::get_columns | 
| 144 |  |  |  |  |  |  | Gtk3::UIManager::get_action_groups | 
| 145 |  |  |  |  |  |  | Gtk3::UIManager::get_toplevels | 
| 146 |  |  |  |  |  |  | Gtk3::Window::list_toplevels | 
| 147 |  |  |  |  |  |  | Gtk3::stock_list_ids | 
| 148 |  |  |  |  |  |  | /; | 
| 149 |  |  |  |  |  |  |  | 
| 150 |  |  |  |  |  |  | my @_GDK_PIXBUF_FLATTEN_ARRAY_REF_RETURN_FOR = qw/ | 
| 151 |  |  |  |  |  |  | Gtk3::Gdk::Pixbuf::get_formats | 
| 152 |  |  |  |  |  |  | /; | 
| 153 |  |  |  |  |  |  |  | 
| 154 |  |  |  |  |  |  | =item * The following functions normally return a boolean and additional out | 
| 155 |  |  |  |  |  |  | arguments, where the boolean indicates whether the out arguments are valid. | 
| 156 |  |  |  |  |  |  | They are altered such that when the boolean is true, only the additional out | 
| 157 |  |  |  |  |  |  | arguments are returned, and when the boolean is false, an empty list is | 
| 158 |  |  |  |  |  |  | returned. | 
| 159 |  |  |  |  |  |  |  | 
| 160 |  |  |  |  |  |  | =over | 
| 161 |  |  |  |  |  |  |  | 
| 162 |  |  |  |  |  |  | =item Gtk3::TextBuffer::get_selection_bounds | 
| 163 |  |  |  |  |  |  |  | 
| 164 |  |  |  |  |  |  | =item Gtk3::TreeModel::get_iter | 
| 165 |  |  |  |  |  |  |  | 
| 166 |  |  |  |  |  |  | =item Gtk3::TreeModel::get_iter_first | 
| 167 |  |  |  |  |  |  |  | 
| 168 |  |  |  |  |  |  | =item Gtk3::TreeModel::get_iter_from_string | 
| 169 |  |  |  |  |  |  |  | 
| 170 |  |  |  |  |  |  | =item Gtk3::TreeModel::iter_children | 
| 171 |  |  |  |  |  |  |  | 
| 172 |  |  |  |  |  |  | =item Gtk3::TreeModel::iter_nth_child | 
| 173 |  |  |  |  |  |  |  | 
| 174 |  |  |  |  |  |  | =item Gtk3::TreeModel::iter_parent | 
| 175 |  |  |  |  |  |  |  | 
| 176 |  |  |  |  |  |  | =item Gtk3::TreeModelFilter::convert_child_iter_to_iter | 
| 177 |  |  |  |  |  |  |  | 
| 178 |  |  |  |  |  |  | =item Gtk3::TreeModelSort::convert_child_iter_to_iter | 
| 179 |  |  |  |  |  |  |  | 
| 180 |  |  |  |  |  |  | =item Gtk3::TreeSelection::get_selected | 
| 181 |  |  |  |  |  |  |  | 
| 182 |  |  |  |  |  |  | =item Gtk3::TreeView::get_dest_row_at_pos | 
| 183 |  |  |  |  |  |  |  | 
| 184 |  |  |  |  |  |  | =item Gtk3::TreeView::get_path_at_pos | 
| 185 |  |  |  |  |  |  |  | 
| 186 |  |  |  |  |  |  | =item Gtk3::TreeView::get_tooltip_context | 
| 187 |  |  |  |  |  |  |  | 
| 188 |  |  |  |  |  |  | =item Gtk3::TreeView::get_visible_range | 
| 189 |  |  |  |  |  |  |  | 
| 190 |  |  |  |  |  |  | =item Gtk3::TreeViewColumn::cell_get_position | 
| 191 |  |  |  |  |  |  |  | 
| 192 |  |  |  |  |  |  | =item Gtk3::stock_lookup | 
| 193 |  |  |  |  |  |  |  | 
| 194 |  |  |  |  |  |  | =item Gtk3::Gdk::Event::get_axis | 
| 195 |  |  |  |  |  |  |  | 
| 196 |  |  |  |  |  |  | =item Gtk3::Gdk::Event::get_button | 
| 197 |  |  |  |  |  |  |  | 
| 198 |  |  |  |  |  |  | =item Gtk3::Gdk::Event::get_click_count | 
| 199 |  |  |  |  |  |  |  | 
| 200 |  |  |  |  |  |  | =item Gtk3::Gdk::Event::get_coords | 
| 201 |  |  |  |  |  |  |  | 
| 202 |  |  |  |  |  |  | =item Gtk3::Gdk::Event::get_keycode | 
| 203 |  |  |  |  |  |  |  | 
| 204 |  |  |  |  |  |  | =item Gtk3::Gdk::Event::get_keyval | 
| 205 |  |  |  |  |  |  |  | 
| 206 |  |  |  |  |  |  | =item Gtk3::Gdk::Event::get_scroll_direction | 
| 207 |  |  |  |  |  |  |  | 
| 208 |  |  |  |  |  |  | =item Gtk3::Gdk::Event::get_scroll_deltas | 
| 209 |  |  |  |  |  |  |  | 
| 210 |  |  |  |  |  |  | =item Gtk3::Gdk::Event::get_state | 
| 211 |  |  |  |  |  |  |  | 
| 212 |  |  |  |  |  |  | =item Gtk3::Gdk::Event::get_root_coords | 
| 213 |  |  |  |  |  |  |  | 
| 214 |  |  |  |  |  |  | =item Gtk3::Gdk::Window::get_origin | 
| 215 |  |  |  |  |  |  |  | 
| 216 |  |  |  |  |  |  | =back | 
| 217 |  |  |  |  |  |  |  | 
| 218 |  |  |  |  |  |  | =cut | 
| 219 |  |  |  |  |  |  |  | 
| 220 |  |  |  |  |  |  | my @_GTK_HANDLE_SENTINEL_BOOLEAN_FOR = qw/ | 
| 221 |  |  |  |  |  |  | Gtk3::TextBuffer::get_selection_bounds | 
| 222 |  |  |  |  |  |  | Gtk3::TreeModel::get_iter | 
| 223 |  |  |  |  |  |  | Gtk3::TreeModel::get_iter_first | 
| 224 |  |  |  |  |  |  | Gtk3::TreeModel::get_iter_from_string | 
| 225 |  |  |  |  |  |  | Gtk3::TreeModel::iter_children | 
| 226 |  |  |  |  |  |  | Gtk3::TreeModel::iter_nth_child | 
| 227 |  |  |  |  |  |  | Gtk3::TreeModel::iter_parent | 
| 228 |  |  |  |  |  |  | Gtk3::TreeModelFilter::convert_child_iter_to_iter | 
| 229 |  |  |  |  |  |  | Gtk3::TreeModelSort::convert_child_iter_to_iter | 
| 230 |  |  |  |  |  |  | Gtk3::TreeSelection::get_selected | 
| 231 |  |  |  |  |  |  | Gtk3::TreeView::get_dest_row_at_pos | 
| 232 |  |  |  |  |  |  | Gtk3::TreeView::get_path_at_pos | 
| 233 |  |  |  |  |  |  | Gtk3::TreeView::get_tooltip_context | 
| 234 |  |  |  |  |  |  | Gtk3::TreeView::get_visible_range | 
| 235 |  |  |  |  |  |  | Gtk3::TreeViewColumn::cell_get_position | 
| 236 |  |  |  |  |  |  | Gtk3::stock_lookup | 
| 237 |  |  |  |  |  |  | /; | 
| 238 |  |  |  |  |  |  |  | 
| 239 |  |  |  |  |  |  | my @_GDK_HANDLE_SENTINEL_BOOLEAN_FOR = qw/ | 
| 240 |  |  |  |  |  |  | Gtk3::Gdk::Event::get_axis | 
| 241 |  |  |  |  |  |  | Gtk3::Gdk::Event::get_button | 
| 242 |  |  |  |  |  |  | Gtk3::Gdk::Event::get_click_count | 
| 243 |  |  |  |  |  |  | Gtk3::Gdk::Event::get_coords | 
| 244 |  |  |  |  |  |  | Gtk3::Gdk::Event::get_keycode | 
| 245 |  |  |  |  |  |  | Gtk3::Gdk::Event::get_keyval | 
| 246 |  |  |  |  |  |  | Gtk3::Gdk::Event::get_scroll_direction | 
| 247 |  |  |  |  |  |  | Gtk3::Gdk::Event::get_scroll_deltas | 
| 248 |  |  |  |  |  |  | Gtk3::Gdk::Event::get_state | 
| 249 |  |  |  |  |  |  | Gtk3::Gdk::Event::get_root_coords | 
| 250 |  |  |  |  |  |  | Gtk3::Gdk::Window::get_origin | 
| 251 |  |  |  |  |  |  | /; | 
| 252 |  |  |  |  |  |  |  | 
| 253 |  |  |  |  |  |  | my @_GTK_USE_GENERIC_SIGNAL_MARSHALLER_FOR = ( | 
| 254 |  |  |  |  |  |  | ['Gtk3::Editable', 'insert-text'], | 
| 255 |  |  |  |  |  |  | ['Gtk3::Dialog',   'response',    \&Gtk3::Dialog::_gtk3_perl_response_converter], | 
| 256 |  |  |  |  |  |  | ['Gtk3::InfoBar',  'response',    \&Gtk3::Dialog::_gtk3_perl_response_converter], | 
| 257 |  |  |  |  |  |  | ); | 
| 258 |  |  |  |  |  |  |  | 
| 259 |  |  |  |  |  |  | =item * Values of type Gtk3::ResponseType are converted to and from nick names | 
| 260 |  |  |  |  |  |  | if possible, while still allowing raw IDs, in the following places: | 
| 261 |  |  |  |  |  |  |  | 
| 262 |  |  |  |  |  |  | =over | 
| 263 |  |  |  |  |  |  |  | 
| 264 |  |  |  |  |  |  | =item - For Gtk3::Dialog and Gtk3::InfoBar: the signal C as well as | 
| 265 |  |  |  |  |  |  | the methods C, C, C, C, | 
| 266 |  |  |  |  |  |  | C and C. | 
| 267 |  |  |  |  |  |  |  | 
| 268 |  |  |  |  |  |  | =item - For Gtk3::Dialog: the methods C, | 
| 269 |  |  |  |  |  |  | C, C and C. | 
| 270 |  |  |  |  |  |  |  | 
| 271 |  |  |  |  |  |  | =back | 
| 272 |  |  |  |  |  |  |  | 
| 273 |  |  |  |  |  |  | =cut | 
| 274 |  |  |  |  |  |  |  | 
| 275 |  |  |  |  |  |  | # GtkResponseType: id <-> nick | 
| 276 |  |  |  |  |  |  | my $_GTK_RESPONSE_ID_TO_NICK = sub { | 
| 277 |  |  |  |  |  |  | my ($id) = @_; | 
| 278 |  |  |  |  |  |  | { | 
| 279 |  |  |  |  |  |  | local $@; | 
| 280 |  |  |  |  |  |  | my $nick = eval { Glib::Object::Introspection->convert_enum_to_sv ( | 
| 281 |  |  |  |  |  |  | 'Gtk3::ResponseType', $id) }; | 
| 282 |  |  |  |  |  |  | return $nick if defined $nick; | 
| 283 |  |  |  |  |  |  | } | 
| 284 |  |  |  |  |  |  | return $id; | 
| 285 |  |  |  |  |  |  | }; | 
| 286 |  |  |  |  |  |  | my $_GTK_RESPONSE_NICK_TO_ID = sub { | 
| 287 |  |  |  |  |  |  | my ($nick) = @_; | 
| 288 |  |  |  |  |  |  | { | 
| 289 |  |  |  |  |  |  | local $@; | 
| 290 |  |  |  |  |  |  | my $id = eval { Glib::Object::Introspection->convert_sv_to_enum ( | 
| 291 |  |  |  |  |  |  | 'Gtk3::ResponseType', $nick) }; | 
| 292 |  |  |  |  |  |  | return $id if defined $id; | 
| 293 |  |  |  |  |  |  | } | 
| 294 |  |  |  |  |  |  | return $nick; | 
| 295 |  |  |  |  |  |  | }; | 
| 296 |  |  |  |  |  |  |  | 
| 297 |  |  |  |  |  |  | # Converter for GtkDialog's "response" signal. | 
| 298 |  |  |  |  |  |  | sub Gtk3::Dialog::_gtk3_perl_response_converter { | 
| 299 |  |  |  |  |  |  | my ($dialog, $id, $data) = @_; | 
| 300 |  |  |  |  |  |  | return ($dialog, $_GTK_RESPONSE_ID_TO_NICK->($id), $data); | 
| 301 |  |  |  |  |  |  | } | 
| 302 |  |  |  |  |  |  |  | 
| 303 |  |  |  |  |  |  | =item * Values of type Gtk3::IconSize are converted to and from nick names if | 
| 304 |  |  |  |  |  |  | possible, while still allowing raw IDs, in the following places: | 
| 305 |  |  |  |  |  |  |  | 
| 306 |  |  |  |  |  |  | =over | 
| 307 |  |  |  |  |  |  |  | 
| 308 |  |  |  |  |  |  | =item - Gtk3::Image: the constructors new_from_stock, new_from_icon_set, | 
| 309 |  |  |  |  |  |  | new_from_icon_name and new_from_gicon, the getters get_stock, get_icon_set, | 
| 310 |  |  |  |  |  |  | get_icon_name and get_gicon and the setters set_from_stock, set_from_icon_set, | 
| 311 |  |  |  |  |  |  | set_from_icon_name, set_from_gicon. | 
| 312 |  |  |  |  |  |  |  | 
| 313 |  |  |  |  |  |  | =item - Gtk3::Widget: the method render_icon. | 
| 314 |  |  |  |  |  |  |  | 
| 315 |  |  |  |  |  |  | =back | 
| 316 |  |  |  |  |  |  |  | 
| 317 |  |  |  |  |  |  | =cut | 
| 318 |  |  |  |  |  |  |  | 
| 319 |  |  |  |  |  |  | # GtkIconSize: id <-> nick | 
| 320 |  |  |  |  |  |  | my $_GTK_ICON_SIZE_ID_TO_NICK = sub { | 
| 321 |  |  |  |  |  |  | my ($id) = @_; | 
| 322 |  |  |  |  |  |  | { | 
| 323 |  |  |  |  |  |  | local $@; | 
| 324 |  |  |  |  |  |  | my $nick = eval { Glib::Object::Introspection->convert_enum_to_sv ( | 
| 325 |  |  |  |  |  |  | 'Gtk3::IconSize', $id) }; | 
| 326 |  |  |  |  |  |  | return $nick if defined $nick; | 
| 327 |  |  |  |  |  |  | } | 
| 328 |  |  |  |  |  |  | { | 
| 329 |  |  |  |  |  |  | my $nick = Gtk3::IconSize::get_name ($id); | 
| 330 |  |  |  |  |  |  | return $nick if defined $nick; | 
| 331 |  |  |  |  |  |  | } | 
| 332 |  |  |  |  |  |  | return $id; | 
| 333 |  |  |  |  |  |  | }; | 
| 334 |  |  |  |  |  |  | my $_GTK_ICON_SIZE_NICK_TO_ID = sub { | 
| 335 |  |  |  |  |  |  | my ($nick) = @_; | 
| 336 |  |  |  |  |  |  | { | 
| 337 |  |  |  |  |  |  | local $@; | 
| 338 |  |  |  |  |  |  | my $id = eval { Glib::Object::Introspection->convert_sv_to_enum ( | 
| 339 |  |  |  |  |  |  | 'Gtk3::IconSize', $nick) }; | 
| 340 |  |  |  |  |  |  | return $id if defined $id; | 
| 341 |  |  |  |  |  |  | } | 
| 342 |  |  |  |  |  |  | { | 
| 343 |  |  |  |  |  |  | my $id = Gtk3::IconSize::from_name ($nick); | 
| 344 |  |  |  |  |  |  | return $id if $id;# if it's not zero | 
| 345 |  |  |  |  |  |  | } | 
| 346 |  |  |  |  |  |  | return $nick; | 
| 347 |  |  |  |  |  |  | }; | 
| 348 |  |  |  |  |  |  |  | 
| 349 |  |  |  |  |  |  | =item * The constants C and C can be | 
| 350 |  |  |  |  |  |  | used in handlers for event signals like C to indicate whether | 
| 351 |  |  |  |  |  |  | or not the event should continue propagating through the widget hierarchy. | 
| 352 |  |  |  |  |  |  |  | 
| 353 |  |  |  |  |  |  | =cut | 
| 354 |  |  |  |  |  |  |  | 
| 355 |  |  |  |  |  |  | # Names "STOP" and "PROPAGATE" here are per the GtkWidget event signal | 
| 356 |  |  |  |  |  |  | # descriptions.  In some other flavours of signals the jargon is "handled" | 
| 357 |  |  |  |  |  |  | # instead of "stop".  "Handled" matches g_signal_accumulator_true_handled(), | 
| 358 |  |  |  |  |  |  | # though that function doesn't rate a mention in the Gtk docs.  There's | 
| 359 |  |  |  |  |  |  | # nothing fixed in the idea of "true means cease emission" (whether it's | 
| 360 |  |  |  |  |  |  | # called "stop" or "handled").  You can just as easily have false for cease | 
| 361 |  |  |  |  |  |  | # (the way the underlying GSignalAccumulator func in fact operates).  The | 
| 362 |  |  |  |  |  |  | # upshot being don't want to attempt to be too universal with the names | 
| 363 |  |  |  |  |  |  | # here; "EVENT" is meant to hint at the context or signal flavour they're | 
| 364 |  |  |  |  |  |  | # for use with. | 
| 365 |  |  |  |  |  |  | sub Gtk3::EVENT_PROPAGATE() { !1 }; | 
| 366 |  |  |  |  |  |  | sub Gtk3::EVENT_STOP() { 1 }; | 
| 367 |  |  |  |  |  |  |  | 
| 368 |  |  |  |  |  |  | =item * The records corresponding to the various Gtk3::Gdk::Event types, like | 
| 369 |  |  |  |  |  |  | C or C, are represented as objects blessed into specific | 
| 370 |  |  |  |  |  |  | Perl packages, like C or C, that | 
| 371 |  |  |  |  |  |  | all inherit from C.  This allows you to seemlessly access | 
| 372 |  |  |  |  |  |  | type-specific fields as well as common fields, as in C<< $event->window >> or | 
| 373 |  |  |  |  |  |  | C<< $event->keyval >>. | 
| 374 |  |  |  |  |  |  |  | 
| 375 |  |  |  |  |  |  | =cut | 
| 376 |  |  |  |  |  |  |  | 
| 377 |  |  |  |  |  |  | my %_GDK_REBLESSERS = ( | 
| 378 |  |  |  |  |  |  | 'Gtk3::Gdk::Event' => \&Gtk3::Gdk::Event::_rebless, | 
| 379 |  |  |  |  |  |  | ); | 
| 380 |  |  |  |  |  |  |  | 
| 381 |  |  |  |  |  |  | my %_GDK_EVENT_TYPE_TO_PACKAGE = ( | 
| 382 |  |  |  |  |  |  | 'expose' => 'Expose', | 
| 383 |  |  |  |  |  |  | 'motion-notify' => 'Motion', | 
| 384 |  |  |  |  |  |  | 'button-press' => 'Button', | 
| 385 |  |  |  |  |  |  | '2button-press' => 'Button', | 
| 386 |  |  |  |  |  |  | '3button-press' => 'Button', | 
| 387 |  |  |  |  |  |  | 'button-release' => 'Button', | 
| 388 |  |  |  |  |  |  | 'key-press' => 'Key', | 
| 389 |  |  |  |  |  |  | 'key-release' => 'Key', | 
| 390 |  |  |  |  |  |  | 'enter-notify' => 'Crossing', | 
| 391 |  |  |  |  |  |  | 'leave-notify' => 'Crossing', | 
| 392 |  |  |  |  |  |  | 'focus-change' => 'Focus', | 
| 393 |  |  |  |  |  |  | 'configure' => 'Configure', | 
| 394 |  |  |  |  |  |  | 'property-notify' => 'Property', | 
| 395 |  |  |  |  |  |  | 'selection-clear' => 'Selection', | 
| 396 |  |  |  |  |  |  | 'selection-request' => 'Selection', | 
| 397 |  |  |  |  |  |  | 'selection-notify' => 'Selection', | 
| 398 |  |  |  |  |  |  | 'proximity-in' => 'Proximity', | 
| 399 |  |  |  |  |  |  | 'proximity-out' => 'Proximity', | 
| 400 |  |  |  |  |  |  | 'drag-enter' => 'DND', | 
| 401 |  |  |  |  |  |  | 'drag-leave' => 'DND', | 
| 402 |  |  |  |  |  |  | 'drag-motion' => 'DND', | 
| 403 |  |  |  |  |  |  | 'drag-status' => 'DND', | 
| 404 |  |  |  |  |  |  | 'drop-start' => 'DND', | 
| 405 |  |  |  |  |  |  | 'drop-finished' => 'DND', | 
| 406 |  |  |  |  |  |  | 'client-event' => 'Client', | 
| 407 |  |  |  |  |  |  | 'visibility-notify' => 'Visibility', | 
| 408 |  |  |  |  |  |  | 'no-expose' => 'NoExpose', | 
| 409 |  |  |  |  |  |  | 'scroll' => 'Scroll', | 
| 410 |  |  |  |  |  |  | 'window-state' => 'WindowState', | 
| 411 |  |  |  |  |  |  | 'setting' => 'Setting', | 
| 412 |  |  |  |  |  |  | 'owner-change' => 'OwnerChange', | 
| 413 |  |  |  |  |  |  | 'grab-broken' => 'GrabBroken', | 
| 414 |  |  |  |  |  |  | 'damage' => 'Expose', | 
| 415 |  |  |  |  |  |  | # added in 3.4: | 
| 416 |  |  |  |  |  |  | 'touch-begin' => 'Touch', | 
| 417 |  |  |  |  |  |  | 'touch-update' => 'Touch', | 
| 418 |  |  |  |  |  |  | 'touch-end' => 'Touch', | 
| 419 |  |  |  |  |  |  | 'touch-cancel' => 'Touch', | 
| 420 |  |  |  |  |  |  | # added in 3.6: | 
| 421 |  |  |  |  |  |  | 'double-button-press' => 'Button', | 
| 422 |  |  |  |  |  |  | 'triple-button-press' => 'Button', | 
| 423 |  |  |  |  |  |  | ); | 
| 424 |  |  |  |  |  |  |  | 
| 425 |  |  |  |  |  |  | # Make all of the above sub-types inherit from Gtk3::Gdk::Event. | 
| 426 |  |  |  |  |  |  | { | 
| 427 |  |  |  |  |  |  | no strict qw(refs); | 
| 428 |  |  |  |  |  |  | my %seen; | 
| 429 |  |  |  |  |  |  | foreach (grep { !$seen{$_}++ } values %_GDK_EVENT_TYPE_TO_PACKAGE) { | 
| 430 |  |  |  |  |  |  | push @{'Gtk3::Gdk::Event' . $_ . '::ISA'}, 'Gtk3::Gdk::Event'; | 
| 431 |  |  |  |  |  |  | } | 
| 432 |  |  |  |  |  |  | } | 
| 433 |  |  |  |  |  |  |  | 
| 434 |  |  |  |  |  |  | sub Gtk3::Gdk::Event::_rebless { | 
| 435 |  |  |  |  |  |  | my ($event) = @_; | 
| 436 |  |  |  |  |  |  | my $package = 'Gtk3::Gdk::Event'; | 
| 437 |  |  |  |  |  |  | if (exists $_GDK_EVENT_TYPE_TO_PACKAGE{$event->type}) { | 
| 438 |  |  |  |  |  |  | $package .= $_GDK_EVENT_TYPE_TO_PACKAGE{$event->type}; | 
| 439 |  |  |  |  |  |  | } | 
| 440 |  |  |  |  |  |  | return bless $event, $package; | 
| 441 |  |  |  |  |  |  | } | 
| 442 |  |  |  |  |  |  |  | 
| 443 |  |  |  |  |  |  | # - Wiring ------------------------------------------------------------------ # | 
| 444 |  |  |  |  |  |  |  | 
| 445 |  |  |  |  |  |  | =item * Gtk3::Gdk::Atom has overloads for the C<==> and C operators that | 
| 446 |  |  |  |  |  |  | check for equality of the underlying atoms. | 
| 447 |  |  |  |  |  |  |  | 
| 448 |  |  |  |  |  |  | =cut | 
| 449 |  |  |  |  |  |  |  | 
| 450 |  |  |  |  |  |  | sub import { | 
| 451 |  |  |  |  |  |  | my $class = shift; | 
| 452 |  |  |  |  |  |  |  | 
| 453 |  |  |  |  |  |  | Glib::Object::Introspection->setup ( | 
| 454 |  |  |  |  |  |  | basename => $_GTK_BASENAME, | 
| 455 |  |  |  |  |  |  | version => $_GTK_VERSION, | 
| 456 |  |  |  |  |  |  | package => $_GTK_PACKAGE, | 
| 457 |  |  |  |  |  |  | flatten_array_ref_return_for => \@_GTK_FLATTEN_ARRAY_REF_RETURN_FOR, | 
| 458 |  |  |  |  |  |  | handle_sentinel_boolean_for => \@_GTK_HANDLE_SENTINEL_BOOLEAN_FOR, | 
| 459 |  |  |  |  |  |  | use_generic_signal_marshaller_for => \@_GTK_USE_GENERIC_SIGNAL_MARSHALLER_FOR); | 
| 460 |  |  |  |  |  |  |  | 
| 461 |  |  |  |  |  |  | Glib::Object::Introspection->setup ( | 
| 462 |  |  |  |  |  |  | basename => $_GDK_BASENAME, | 
| 463 |  |  |  |  |  |  | version => $_GDK_VERSION, | 
| 464 |  |  |  |  |  |  | package => $_GDK_PACKAGE, | 
| 465 |  |  |  |  |  |  | handle_sentinel_boolean_for => \@_GDK_HANDLE_SENTINEL_BOOLEAN_FOR, | 
| 466 |  |  |  |  |  |  | reblessers => \%_GDK_REBLESSERS); | 
| 467 |  |  |  |  |  |  |  | 
| 468 |  |  |  |  |  |  | Glib::Object::Introspection->setup ( | 
| 469 |  |  |  |  |  |  | basename => $_GDK_PIXBUF_BASENAME, | 
| 470 |  |  |  |  |  |  | version => $_GDK_PIXBUF_VERSION, | 
| 471 |  |  |  |  |  |  | package => $_GDK_PIXBUF_PACKAGE, | 
| 472 |  |  |  |  |  |  | flatten_array_ref_return_for => \@_GDK_PIXBUF_FLATTEN_ARRAY_REF_RETURN_FOR); | 
| 473 |  |  |  |  |  |  |  | 
| 474 |  |  |  |  |  |  | Glib::Object::Introspection->setup ( | 
| 475 |  |  |  |  |  |  | basename => $_PANGO_BASENAME, | 
| 476 |  |  |  |  |  |  | version => $_PANGO_VERSION, | 
| 477 |  |  |  |  |  |  | package => $_PANGO_PACKAGE); | 
| 478 |  |  |  |  |  |  |  | 
| 479 |  |  |  |  |  |  | Glib::Object::Introspection->_register_boxed_synonym ( | 
| 480 |  |  |  |  |  |  | "cairo", "RectangleInt", "gdk_rectangle_get_type"); | 
| 481 |  |  |  |  |  |  |  | 
| 482 |  |  |  |  |  |  | # FIXME: This uses an undocumented interface for overloading to avoid the | 
| 483 |  |  |  |  |  |  | # need for a package declaration. | 
| 484 |  |  |  |  |  |  | Gtk3::Gdk::Atom->overload::OVERLOAD ( | 
| 485 |  |  |  |  |  |  | '==' => sub { ${$_[0]} == ${$_[1]} }, | 
| 486 |  |  |  |  |  |  | '!=' => sub { ${$_[0]} != ${$_[1]} }, | 
| 487 |  |  |  |  |  |  | fallback => 1); | 
| 488 |  |  |  |  |  |  |  | 
| 489 |  |  |  |  |  |  | my $init = 0; | 
| 490 |  |  |  |  |  |  | my @unknown_args = ($class); | 
| 491 |  |  |  |  |  |  | foreach (@_) { | 
| 492 |  |  |  |  |  |  | if (/^-?init$/) { | 
| 493 |  |  |  |  |  |  | $init = 1; | 
| 494 |  |  |  |  |  |  | } else { | 
| 495 |  |  |  |  |  |  | push @unknown_args, $_; | 
| 496 |  |  |  |  |  |  | } | 
| 497 |  |  |  |  |  |  | } | 
| 498 |  |  |  |  |  |  |  | 
| 499 |  |  |  |  |  |  | if ($init) { | 
| 500 |  |  |  |  |  |  | Gtk3::init (); | 
| 501 |  |  |  |  |  |  | } | 
| 502 |  |  |  |  |  |  |  | 
| 503 |  |  |  |  |  |  | # call into Exporter for the unrecognized arguments; handles exporting and | 
| 504 |  |  |  |  |  |  | # version checking | 
| 505 |  |  |  |  |  |  | Gtk3->export_to_level (1, @unknown_args); | 
| 506 |  |  |  |  |  |  | } | 
| 507 |  |  |  |  |  |  |  | 
| 508 |  |  |  |  |  |  | # - Overrides --------------------------------------------------------------- # | 
| 509 |  |  |  |  |  |  |  | 
| 510 |  |  |  |  |  |  | =item * For backwards compatibility, C, | 
| 511 |  |  |  |  |  |  | C, C, C, C, | 
| 512 |  |  |  |  |  |  | C and C can be called as class-static or as | 
| 513 |  |  |  |  |  |  | normal functions: for example, C<< Gtk3->main_quit >> and C<< Gtk3::main_quit | 
| 514 |  |  |  |  |  |  | >> are both supported.  Additionally, C and C | 
| 515 |  |  |  |  |  |  | automatically handle passing and updating C<@ARGV> as appropriate. | 
| 516 |  |  |  |  |  |  |  | 
| 517 |  |  |  |  |  |  | =cut | 
| 518 |  |  |  |  |  |  |  | 
| 519 |  |  |  |  |  |  | sub Gtk3::CHECK_VERSION { | 
| 520 |  |  |  |  |  |  | return not defined Gtk3::check_version(@_ == 4 ? @_[1..3] : @_); | 
| 521 |  |  |  |  |  |  | } | 
| 522 |  |  |  |  |  |  |  | 
| 523 |  |  |  |  |  |  | sub Gtk3::check_version { | 
| 524 |  |  |  |  |  |  | Glib::Object::Introspection->invoke ($_GTK_BASENAME, undef, 'check_version', | 
| 525 |  |  |  |  |  |  | @_ == 4 ? @_[1..3] : @_); | 
| 526 |  |  |  |  |  |  | } | 
| 527 |  |  |  |  |  |  |  | 
| 528 |  |  |  |  |  |  | sub Gtk3::init { | 
| 529 |  |  |  |  |  |  | my $rest = Glib::Object::Introspection->invoke ( | 
| 530 |  |  |  |  |  |  | $_GTK_BASENAME, undef, 'init', | 
| 531 |  |  |  |  |  |  | [$0, @ARGV]); | 
| 532 |  |  |  |  |  |  | @ARGV = @{$rest}[1 .. $#$rest]; # remove $0 | 
| 533 |  |  |  |  |  |  | return; | 
| 534 |  |  |  |  |  |  | } | 
| 535 |  |  |  |  |  |  |  | 
| 536 |  |  |  |  |  |  | sub Gtk3::init_check { | 
| 537 |  |  |  |  |  |  | my ($success, $rest) = Glib::Object::Introspection->invoke ( | 
| 538 |  |  |  |  |  |  | $_GTK_BASENAME, undef, 'init_check', | 
| 539 |  |  |  |  |  |  | [$0, @ARGV]); | 
| 540 |  |  |  |  |  |  | @ARGV = @{$rest}[1 .. $#$rest]; # remove $0 | 
| 541 |  |  |  |  |  |  | return $success; | 
| 542 |  |  |  |  |  |  | } | 
| 543 |  |  |  |  |  |  |  | 
| 544 |  |  |  |  |  |  | sub Gtk3::main { | 
| 545 |  |  |  |  |  |  | # Ignore any arguments passed in. | 
| 546 |  |  |  |  |  |  | Glib::Object::Introspection->invoke ($_GTK_BASENAME, undef, 'main'); | 
| 547 |  |  |  |  |  |  | } | 
| 548 |  |  |  |  |  |  |  | 
| 549 |  |  |  |  |  |  | sub Gtk3::main_level { | 
| 550 |  |  |  |  |  |  | # Ignore any arguments passed in. | 
| 551 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ($_GTK_BASENAME, undef, 'main_level'); | 
| 552 |  |  |  |  |  |  | } | 
| 553 |  |  |  |  |  |  |  | 
| 554 |  |  |  |  |  |  | sub Gtk3::main_quit { | 
| 555 |  |  |  |  |  |  | # Ignore any arguments passed in. | 
| 556 |  |  |  |  |  |  | Glib::Object::Introspection->invoke ($_GTK_BASENAME, undef, 'main_quit'); | 
| 557 |  |  |  |  |  |  | } | 
| 558 |  |  |  |  |  |  |  | 
| 559 |  |  |  |  |  |  | =item * A Perl reimplementation of C is provided. | 
| 560 |  |  |  |  |  |  |  | 
| 561 |  |  |  |  |  |  | =cut | 
| 562 |  |  |  |  |  |  |  | 
| 563 |  |  |  |  |  |  | { | 
| 564 |  |  |  |  |  |  | my $global_about_dialog = undef; | 
| 565 |  |  |  |  |  |  | my $about_dialog_key = '__gtk3_about_dialog'; | 
| 566 |  |  |  |  |  |  |  | 
| 567 |  |  |  |  |  |  | sub Gtk3::show_about_dialog { | 
| 568 |  |  |  |  |  |  | # For backwards-compatibility, optionally accept and discard a class | 
| 569 |  |  |  |  |  |  | # argument. | 
| 570 |  |  |  |  |  |  | my $parent_or_class = shift; | 
| 571 |  |  |  |  |  |  | my $parent = defined $parent_or_class && $parent_or_class eq 'Gtk3' | 
| 572 |  |  |  |  |  |  | ? shift | 
| 573 |  |  |  |  |  |  | : $parent_or_class; | 
| 574 |  |  |  |  |  |  | my %props = @_; | 
| 575 |  |  |  |  |  |  | my $dialog = defined $parent | 
| 576 |  |  |  |  |  |  | ? $parent->{$about_dialog_key} | 
| 577 |  |  |  |  |  |  | : $global_about_dialog; | 
| 578 |  |  |  |  |  |  |  | 
| 579 |  |  |  |  |  |  | if (!$dialog) { | 
| 580 |  |  |  |  |  |  | $dialog = Gtk3::AboutDialog->new; | 
| 581 |  |  |  |  |  |  | $dialog->signal_connect (delete_event => sub { $dialog->hide_on_delete }); | 
| 582 |  |  |  |  |  |  | $dialog->signal_connect (response => sub { $dialog->hide }); | 
| 583 |  |  |  |  |  |  | foreach my $prop (keys %props) { | 
| 584 |  |  |  |  |  |  | $dialog->set ($prop => $props{$prop}); | 
| 585 |  |  |  |  |  |  | } | 
| 586 |  |  |  |  |  |  | if ($parent) { | 
| 587 |  |  |  |  |  |  | $dialog->set_modal (Glib::TRUE); | 
| 588 |  |  |  |  |  |  | $dialog->set_transient_for ($parent); | 
| 589 |  |  |  |  |  |  | $dialog->set_destroy_with_parent (Glib::TRUE); | 
| 590 |  |  |  |  |  |  | $parent->{$about_dialog_key} = $dialog; | 
| 591 |  |  |  |  |  |  | } else { | 
| 592 |  |  |  |  |  |  | $global_about_dialog = $dialog; | 
| 593 |  |  |  |  |  |  | } | 
| 594 |  |  |  |  |  |  | } | 
| 595 |  |  |  |  |  |  |  | 
| 596 |  |  |  |  |  |  | $dialog->present; | 
| 597 |  |  |  |  |  |  | } | 
| 598 |  |  |  |  |  |  | } | 
| 599 |  |  |  |  |  |  |  | 
| 600 |  |  |  |  |  |  | =item * Perl reimplementations of C, | 
| 601 |  |  |  |  |  |  | C and C are provided. | 
| 602 |  |  |  |  |  |  |  | 
| 603 |  |  |  |  |  |  | =cut | 
| 604 |  |  |  |  |  |  |  | 
| 605 |  |  |  |  |  |  | sub Gtk3::ActionGroup::add_actions { | 
| 606 |  |  |  |  |  |  | my ($self, $entries, $user_data) = @_; | 
| 607 |  |  |  |  |  |  |  | 
| 608 |  |  |  |  |  |  | croak 'actions must be a reference to an array of action entries' | 
| 609 |  |  |  |  |  |  | unless (ref($entries) eq 'ARRAY'); | 
| 610 |  |  |  |  |  |  |  | 
| 611 |  |  |  |  |  |  | croak 'action array is empty' | 
| 612 |  |  |  |  |  |  | unless (@$entries); | 
| 613 |  |  |  |  |  |  |  | 
| 614 |  |  |  |  |  |  | my $process = sub { | 
| 615 |  |  |  |  |  |  | my ($p) = @_; | 
| 616 |  |  |  |  |  |  | my ($name, $stock_id, $label, $accelerator, $tooltip, $callback); | 
| 617 |  |  |  |  |  |  |  | 
| 618 |  |  |  |  |  |  | if (ref($p) eq 'ARRAY') { | 
| 619 |  |  |  |  |  |  | $name        = $p->[0]; | 
| 620 |  |  |  |  |  |  | $stock_id    = $p->[1]; | 
| 621 |  |  |  |  |  |  | $label       = $p->[2]; | 
| 622 |  |  |  |  |  |  | $accelerator = $p->[3]; | 
| 623 |  |  |  |  |  |  | $tooltip     = $p->[4]; | 
| 624 |  |  |  |  |  |  | $callback    = $p->[5]; | 
| 625 |  |  |  |  |  |  | } elsif (ref($p) eq 'HASH') { | 
| 626 |  |  |  |  |  |  | $name        = $p->{name}; | 
| 627 |  |  |  |  |  |  | $stock_id    = $p->{stock_id}; | 
| 628 |  |  |  |  |  |  | $label       = $p->{label}; | 
| 629 |  |  |  |  |  |  | $accelerator = $p->{accelerator}; | 
| 630 |  |  |  |  |  |  | $tooltip     = $p->{tooltip}; | 
| 631 |  |  |  |  |  |  | $callback    = $p->{callback}; | 
| 632 |  |  |  |  |  |  | } else { | 
| 633 |  |  |  |  |  |  | croak 'action entry must be a reference to a hash or an array'; | 
| 634 |  |  |  |  |  |  | } | 
| 635 |  |  |  |  |  |  |  | 
| 636 |  |  |  |  |  |  | if (defined($label)) { | 
| 637 |  |  |  |  |  |  | $label   = $self->translate_string($label); | 
| 638 |  |  |  |  |  |  | } | 
| 639 |  |  |  |  |  |  | if (defined($tooltip)) { | 
| 640 |  |  |  |  |  |  | $tooltip = $self->translate_string($tooltip); | 
| 641 |  |  |  |  |  |  | } | 
| 642 |  |  |  |  |  |  |  | 
| 643 |  |  |  |  |  |  | my $action = Gtk3::Action->new ($name, $label, $tooltip, $stock_id); | 
| 644 |  |  |  |  |  |  |  | 
| 645 |  |  |  |  |  |  | if ($callback) { | 
| 646 |  |  |  |  |  |  | $action->signal_connect ('activate', $callback, $user_data); | 
| 647 |  |  |  |  |  |  | } | 
| 648 |  |  |  |  |  |  | $self->add_action_with_accel ($action, $accelerator); | 
| 649 |  |  |  |  |  |  | }; | 
| 650 |  |  |  |  |  |  |  | 
| 651 |  |  |  |  |  |  | for my $e (@$entries) { | 
| 652 |  |  |  |  |  |  | $process->($e); | 
| 653 |  |  |  |  |  |  | } | 
| 654 |  |  |  |  |  |  | } | 
| 655 |  |  |  |  |  |  |  | 
| 656 |  |  |  |  |  |  | sub Gtk3::ActionGroup::add_toggle_actions { | 
| 657 |  |  |  |  |  |  | my ($self, $entries, $user_data) = @_; | 
| 658 |  |  |  |  |  |  |  | 
| 659 |  |  |  |  |  |  | croak 'entries must be a reference to an array of toggle action entries' | 
| 660 |  |  |  |  |  |  | unless (ref($entries) eq 'ARRAY'); | 
| 661 |  |  |  |  |  |  |  | 
| 662 |  |  |  |  |  |  | croak 'toggle action array is empty' | 
| 663 |  |  |  |  |  |  | unless (@$entries); | 
| 664 |  |  |  |  |  |  |  | 
| 665 |  |  |  |  |  |  | my $process = sub { | 
| 666 |  |  |  |  |  |  | my ($p) = @_; | 
| 667 |  |  |  |  |  |  | my ($name, $stock_id, $label, $accelerator, $tooltip, | 
| 668 |  |  |  |  |  |  | $callback, $is_active); | 
| 669 |  |  |  |  |  |  |  | 
| 670 |  |  |  |  |  |  | if (ref($p) eq 'ARRAY') { | 
| 671 |  |  |  |  |  |  | $name        = $p->[0]; | 
| 672 |  |  |  |  |  |  | $stock_id    = $p->[1]; | 
| 673 |  |  |  |  |  |  | $label       = $p->[2]; | 
| 674 |  |  |  |  |  |  | $accelerator = $p->[3]; | 
| 675 |  |  |  |  |  |  | $tooltip     = $p->[4]; | 
| 676 |  |  |  |  |  |  | $callback    = $p->[5]; | 
| 677 |  |  |  |  |  |  | $is_active   = $p->[6]; | 
| 678 |  |  |  |  |  |  | } elsif (ref($p) eq 'HASH') { | 
| 679 |  |  |  |  |  |  | $name        = $p->{name}; | 
| 680 |  |  |  |  |  |  | $stock_id    = $p->{stock_id}; | 
| 681 |  |  |  |  |  |  | $label       = $p->{label}; | 
| 682 |  |  |  |  |  |  | $accelerator = $p->{accelerator}; | 
| 683 |  |  |  |  |  |  | $tooltip     = $p->{tooltip}; | 
| 684 |  |  |  |  |  |  | $callback    = $p->{callback}; | 
| 685 |  |  |  |  |  |  | $is_active   = $p->{is_active}; | 
| 686 |  |  |  |  |  |  | } else { | 
| 687 |  |  |  |  |  |  | croak 'action entry must be a hash or an array'; | 
| 688 |  |  |  |  |  |  | } | 
| 689 |  |  |  |  |  |  |  | 
| 690 |  |  |  |  |  |  | if (defined($label)) { | 
| 691 |  |  |  |  |  |  | $label   = $self->translate_string($label); | 
| 692 |  |  |  |  |  |  | } | 
| 693 |  |  |  |  |  |  | if (defined($tooltip)) { | 
| 694 |  |  |  |  |  |  | $tooltip = $self->translate_string($tooltip); | 
| 695 |  |  |  |  |  |  | } | 
| 696 |  |  |  |  |  |  |  | 
| 697 |  |  |  |  |  |  | my $action = Gtk3::ToggleAction->new ( | 
| 698 |  |  |  |  |  |  | $name, $label, $tooltip, $stock_id); | 
| 699 |  |  |  |  |  |  | $action->set_active ($is_active) if defined $is_active; | 
| 700 |  |  |  |  |  |  |  | 
| 701 |  |  |  |  |  |  | if ($callback) { | 
| 702 |  |  |  |  |  |  | $action->signal_connect ('activate', $callback, $user_data); | 
| 703 |  |  |  |  |  |  | } | 
| 704 |  |  |  |  |  |  |  | 
| 705 |  |  |  |  |  |  | $self->add_action_with_accel ($action, $accelerator); | 
| 706 |  |  |  |  |  |  | }; | 
| 707 |  |  |  |  |  |  |  | 
| 708 |  |  |  |  |  |  | for my $e (@$entries) { | 
| 709 |  |  |  |  |  |  | $process->($e); | 
| 710 |  |  |  |  |  |  | } | 
| 711 |  |  |  |  |  |  | } | 
| 712 |  |  |  |  |  |  |  | 
| 713 |  |  |  |  |  |  | sub Gtk3::ActionGroup::add_radio_actions { | 
| 714 |  |  |  |  |  |  | my ($self, $entries, $value, $on_change, $user_data) = @_; | 
| 715 |  |  |  |  |  |  |  | 
| 716 |  |  |  |  |  |  | croak 'radio_action_entries must be a reference to ' | 
| 717 |  |  |  |  |  |  | . 'an array of action entries' | 
| 718 |  |  |  |  |  |  | unless (ref($entries) eq 'ARRAY'); | 
| 719 |  |  |  |  |  |  |  | 
| 720 |  |  |  |  |  |  | croak 'radio action array is empty' | 
| 721 |  |  |  |  |  |  | unless (@$entries); | 
| 722 |  |  |  |  |  |  |  | 
| 723 |  |  |  |  |  |  | my $first_action = undef; | 
| 724 |  |  |  |  |  |  |  | 
| 725 |  |  |  |  |  |  | my $process = sub { | 
| 726 |  |  |  |  |  |  | my ($group, $p) = @_; | 
| 727 |  |  |  |  |  |  | my ($name, $stock_id, $label, $accelerator, $tooltip, $entry_value); | 
| 728 |  |  |  |  |  |  |  | 
| 729 |  |  |  |  |  |  | if (ref($p) eq 'ARRAY') { | 
| 730 |  |  |  |  |  |  | $name        = $p->[0]; | 
| 731 |  |  |  |  |  |  | $stock_id    = $p->[1]; | 
| 732 |  |  |  |  |  |  | $label       = $p->[2]; | 
| 733 |  |  |  |  |  |  | $accelerator = $p->[3]; | 
| 734 |  |  |  |  |  |  | $tooltip     = $p->[4]; | 
| 735 |  |  |  |  |  |  | $entry_value = $p->[5]; | 
| 736 |  |  |  |  |  |  | } elsif (ref($p) eq 'HASH') { | 
| 737 |  |  |  |  |  |  | $name        = $p->{name}; | 
| 738 |  |  |  |  |  |  | $stock_id    = $p->{stock_id}; | 
| 739 |  |  |  |  |  |  | $label       = $p->{label}; | 
| 740 |  |  |  |  |  |  | $accelerator = $p->{accelerator}; | 
| 741 |  |  |  |  |  |  | $tooltip     = $p->{tooltip}; | 
| 742 |  |  |  |  |  |  | $entry_value = $p->{value}; | 
| 743 |  |  |  |  |  |  | } else { | 
| 744 |  |  |  |  |  |  | croak 'radio action entries neither hash nor array'; | 
| 745 |  |  |  |  |  |  | } | 
| 746 |  |  |  |  |  |  |  | 
| 747 |  |  |  |  |  |  | if (defined($label)) { | 
| 748 |  |  |  |  |  |  | $label   = $self->translate_string($label); | 
| 749 |  |  |  |  |  |  | } | 
| 750 |  |  |  |  |  |  | if (defined($tooltip)) { | 
| 751 |  |  |  |  |  |  | $tooltip = $self->translate_string($tooltip); | 
| 752 |  |  |  |  |  |  | } | 
| 753 |  |  |  |  |  |  |  | 
| 754 |  |  |  |  |  |  | my $action = Gtk3::RadioAction->new ( | 
| 755 |  |  |  |  |  |  | $name, $label, $tooltip, $stock_id, $entry_value); | 
| 756 |  |  |  |  |  |  |  | 
| 757 |  |  |  |  |  |  | $action->join_group($group); | 
| 758 |  |  |  |  |  |  |  | 
| 759 |  |  |  |  |  |  | if ($value == $entry_value) { | 
| 760 |  |  |  |  |  |  | $action->set_active(Glib::TRUE); | 
| 761 |  |  |  |  |  |  | } | 
| 762 |  |  |  |  |  |  | $self->add_action_with_accel($action, $accelerator); | 
| 763 |  |  |  |  |  |  | return $action; | 
| 764 |  |  |  |  |  |  | }; | 
| 765 |  |  |  |  |  |  |  | 
| 766 |  |  |  |  |  |  | for my $e (@$entries) { | 
| 767 |  |  |  |  |  |  | my $group = $process->($first_action, $e); | 
| 768 |  |  |  |  |  |  | if (!$first_action) { | 
| 769 |  |  |  |  |  |  | $first_action = $group; | 
| 770 |  |  |  |  |  |  | } | 
| 771 |  |  |  |  |  |  | } | 
| 772 |  |  |  |  |  |  |  | 
| 773 |  |  |  |  |  |  | if ($first_action && $on_change) { | 
| 774 |  |  |  |  |  |  | $first_action->signal_connect ('changed', $on_change, $user_data); | 
| 775 |  |  |  |  |  |  | } | 
| 776 |  |  |  |  |  |  | } | 
| 777 |  |  |  |  |  |  |  | 
| 778 |  |  |  |  |  |  | =item * C and C | 
| 779 |  |  |  |  |  |  | also accept a list of objects instead of an array ref. | 
| 780 |  |  |  |  |  |  |  | 
| 781 |  |  |  |  |  |  | =item * C and C don't | 
| 782 |  |  |  |  |  |  | take length arguments, as they are computed automatically. | 
| 783 |  |  |  |  |  |  |  | 
| 784 |  |  |  |  |  |  | =cut | 
| 785 |  |  |  |  |  |  |  | 
| 786 |  |  |  |  |  |  | sub Gtk3::Builder::add_objects_from_file { | 
| 787 |  |  |  |  |  |  | my ($builder, $filename, @rest) = @_; | 
| 788 |  |  |  |  |  |  | my $ref = _rest_to_ref (\@rest); | 
| 789 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 790 |  |  |  |  |  |  | $_GTK_BASENAME, 'Builder', 'add_objects_from_file', | 
| 791 |  |  |  |  |  |  | $builder, $filename, $ref); | 
| 792 |  |  |  |  |  |  | } | 
| 793 |  |  |  |  |  |  |  | 
| 794 |  |  |  |  |  |  | sub Gtk3::Builder::add_objects_from_string { | 
| 795 |  |  |  |  |  |  | my ($builder, $string, @rest) = @_; | 
| 796 |  |  |  |  |  |  | my $ref = _rest_to_ref (\@rest); | 
| 797 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 798 |  |  |  |  |  |  | $_GTK_BASENAME, 'Builder', 'add_objects_from_string', | 
| 799 |  |  |  |  |  |  | $builder, $string, -1, $ref); # wants length in bytes | 
| 800 |  |  |  |  |  |  | } | 
| 801 |  |  |  |  |  |  |  | 
| 802 |  |  |  |  |  |  | sub Gtk3::Builder::add_from_string { | 
| 803 |  |  |  |  |  |  | my ($builder, $string) = @_; | 
| 804 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 805 |  |  |  |  |  |  | $_GTK_BASENAME, 'Builder', 'add_from_string', | 
| 806 |  |  |  |  |  |  | $builder, $string, -1); # wants length in bytes | 
| 807 |  |  |  |  |  |  | } | 
| 808 |  |  |  |  |  |  |  | 
| 809 |  |  |  |  |  |  | =item * A Perl reimplementation of C is | 
| 810 |  |  |  |  |  |  | provided. | 
| 811 |  |  |  |  |  |  |  | 
| 812 |  |  |  |  |  |  | =cut | 
| 813 |  |  |  |  |  |  |  | 
| 814 |  |  |  |  |  |  | # Copied from Gtk2.pm | 
| 815 |  |  |  |  |  |  | sub Gtk3::Builder::connect_signals { | 
| 816 |  |  |  |  |  |  | my $builder = shift; | 
| 817 |  |  |  |  |  |  | my $user_data = shift; | 
| 818 |  |  |  |  |  |  |  | 
| 819 |  |  |  |  |  |  | my $do_connect = sub { | 
| 820 |  |  |  |  |  |  | my ($object, | 
| 821 |  |  |  |  |  |  | $signal_name, | 
| 822 |  |  |  |  |  |  | $user_data, | 
| 823 |  |  |  |  |  |  | $connect_object, | 
| 824 |  |  |  |  |  |  | $flags, | 
| 825 |  |  |  |  |  |  | $handler) = @_; | 
| 826 |  |  |  |  |  |  | my $func = ($flags & 'after') ? 'signal_connect_after' : 'signal_connect'; | 
| 827 |  |  |  |  |  |  | # we get connect_object when we're supposed to call | 
| 828 |  |  |  |  |  |  | # signal_connect_object, which ensures that the data (an object) | 
| 829 |  |  |  |  |  |  | # lives as long as the signal is connected.  the bindings take | 
| 830 |  |  |  |  |  |  | # care of that for us in all cases, so we only have signal_connect. | 
| 831 |  |  |  |  |  |  | # if we get a connect_object, just use that instead of user_data. | 
| 832 |  |  |  |  |  |  | $object->$func($signal_name => $handler, | 
| 833 |  |  |  |  |  |  | $connect_object || $user_data); | 
| 834 |  |  |  |  |  |  | }; | 
| 835 |  |  |  |  |  |  |  | 
| 836 |  |  |  |  |  |  | # $builder->connect_signals ($user_data) | 
| 837 |  |  |  |  |  |  | # $builder->connect_signals ($user_data, $package) | 
| 838 |  |  |  |  |  |  | if ($#_ <= 0) { | 
| 839 |  |  |  |  |  |  | my $package = shift; | 
| 840 |  |  |  |  |  |  | $package = caller unless defined $package; | 
| 841 |  |  |  |  |  |  |  | 
| 842 |  |  |  |  |  |  | $builder->connect_signals_full(sub { | 
| 843 |  |  |  |  |  |  | my ($builder, | 
| 844 |  |  |  |  |  |  | $object, | 
| 845 |  |  |  |  |  |  | $signal_name, | 
| 846 |  |  |  |  |  |  | $handler_name, | 
| 847 |  |  |  |  |  |  | $connect_object, | 
| 848 |  |  |  |  |  |  | $flags) = @_; | 
| 849 |  |  |  |  |  |  |  | 
| 850 |  |  |  |  |  |  | no strict qw/refs/; | 
| 851 |  |  |  |  |  |  |  | 
| 852 |  |  |  |  |  |  | my $handler = $handler_name; | 
| 853 |  |  |  |  |  |  | if (ref $package) { | 
| 854 |  |  |  |  |  |  | $handler = sub { $package->$handler_name(@_) }; | 
| 855 |  |  |  |  |  |  | } else { | 
| 856 |  |  |  |  |  |  | if ($package && $handler !~ /::/) { | 
| 857 |  |  |  |  |  |  | $handler = $package.'::'.$handler_name; | 
| 858 |  |  |  |  |  |  | } | 
| 859 |  |  |  |  |  |  | } | 
| 860 |  |  |  |  |  |  |  | 
| 861 |  |  |  |  |  |  | $do_connect->($object, $signal_name, $user_data, $connect_object, | 
| 862 |  |  |  |  |  |  | $flags, $handler); | 
| 863 |  |  |  |  |  |  | }); | 
| 864 |  |  |  |  |  |  | } | 
| 865 |  |  |  |  |  |  |  | 
| 866 |  |  |  |  |  |  | # $builder->connect_signals ($user_data, %handlers) | 
| 867 |  |  |  |  |  |  | else { | 
| 868 |  |  |  |  |  |  | my %handlers = @_; | 
| 869 |  |  |  |  |  |  |  | 
| 870 |  |  |  |  |  |  | $builder->connect_signals_full(sub { | 
| 871 |  |  |  |  |  |  | my ($builder, | 
| 872 |  |  |  |  |  |  | $object, | 
| 873 |  |  |  |  |  |  | $signal_name, | 
| 874 |  |  |  |  |  |  | $handler_name, | 
| 875 |  |  |  |  |  |  | $connect_object, | 
| 876 |  |  |  |  |  |  | $flags) = @_; | 
| 877 |  |  |  |  |  |  |  | 
| 878 |  |  |  |  |  |  | return unless exists $handlers{$handler_name}; | 
| 879 |  |  |  |  |  |  |  | 
| 880 |  |  |  |  |  |  | $do_connect->($object, $signal_name, $user_data, $connect_object, | 
| 881 |  |  |  |  |  |  | $flags, $handlers{$handler_name}); | 
| 882 |  |  |  |  |  |  | }); | 
| 883 |  |  |  |  |  |  | } | 
| 884 |  |  |  |  |  |  | } | 
| 885 |  |  |  |  |  |  |  | 
| 886 |  |  |  |  |  |  | =item * The default C constructors of Gtk3::Button, Gtk3::CheckButton, | 
| 887 |  |  |  |  |  |  | Gtk3::ColorButton, Gtk3::FontButton and Gtk3::ToggleButton reroute to | 
| 888 |  |  |  |  |  |  | C if given an extra argument. | 
| 889 |  |  |  |  |  |  |  | 
| 890 |  |  |  |  |  |  | =cut | 
| 891 |  |  |  |  |  |  |  | 
| 892 |  |  |  |  |  |  | { | 
| 893 |  |  |  |  |  |  | no strict 'refs'; | 
| 894 |  |  |  |  |  |  | my @button_classes = ([Button => 'new_with_mnemonic'], | 
| 895 |  |  |  |  |  |  | [CheckButton => 'new_with_mnemonic'], | 
| 896 |  |  |  |  |  |  | [ColorButton => 'new_with_color'], | 
| 897 |  |  |  |  |  |  | [FontButton => 'new_with_font'], | 
| 898 |  |  |  |  |  |  | [ToggleButton => 'new_with_mnemonic']); | 
| 899 |  |  |  |  |  |  | foreach my $button_pair (@button_classes) { | 
| 900 |  |  |  |  |  |  | my ($button_class, $button_ctor) = @$button_pair; | 
| 901 |  |  |  |  |  |  | *{'Gtk3::' . $button_class . '::new'} = sub { | 
| 902 |  |  |  |  |  |  | my ($class, $thing) = @_; | 
| 903 |  |  |  |  |  |  | if (defined $thing) { | 
| 904 |  |  |  |  |  |  | return $class->$button_ctor ($thing); | 
| 905 |  |  |  |  |  |  | } else { | 
| 906 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 907 |  |  |  |  |  |  | $_GTK_BASENAME, $button_class, 'new', @_); | 
| 908 |  |  |  |  |  |  | } | 
| 909 |  |  |  |  |  |  | } | 
| 910 |  |  |  |  |  |  | } | 
| 911 |  |  |  |  |  |  | } | 
| 912 |  |  |  |  |  |  |  | 
| 913 |  |  |  |  |  |  | =item * The default C constructor of Gtk3::CheckMenuItem reroutes to | 
| 914 |  |  |  |  |  |  | C if given an extra argument. | 
| 915 |  |  |  |  |  |  |  | 
| 916 |  |  |  |  |  |  | =cut | 
| 917 |  |  |  |  |  |  |  | 
| 918 |  |  |  |  |  |  | sub Gtk3::CheckMenuItem::new { | 
| 919 |  |  |  |  |  |  | my ($class, $mnemonic) = @_; | 
| 920 |  |  |  |  |  |  | if (defined $mnemonic) { | 
| 921 |  |  |  |  |  |  | return $class->new_with_mnemonic ($mnemonic); | 
| 922 |  |  |  |  |  |  | } | 
| 923 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 924 |  |  |  |  |  |  | $_GTK_BASENAME, 'CheckMenuItem', 'new', @_); | 
| 925 |  |  |  |  |  |  | } | 
| 926 |  |  |  |  |  |  |  | 
| 927 |  |  |  |  |  |  | =item * The C argument of C is optional. | 
| 928 |  |  |  |  |  |  |  | 
| 929 |  |  |  |  |  |  | =cut | 
| 930 |  |  |  |  |  |  |  | 
| 931 |  |  |  |  |  |  | sub Gtk3::Clipboard::set_text { | 
| 932 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 933 |  |  |  |  |  |  | $_GTK_BASENAME, 'Clipboard', 'set_text', | 
| 934 |  |  |  |  |  |  | @_ == 3 ? @_ : (@_[0,1], -1)); # wants length in bytes | 
| 935 |  |  |  |  |  |  | } | 
| 936 |  |  |  |  |  |  |  | 
| 937 |  |  |  |  |  |  | =item * Perl reimplementations of C, | 
| 938 |  |  |  |  |  |  | C and C are provided. | 
| 939 |  |  |  |  |  |  |  | 
| 940 |  |  |  |  |  |  | =cut | 
| 941 |  |  |  |  |  |  |  | 
| 942 |  |  |  |  |  |  | sub Gtk3::Container::add_with_properties { | 
| 943 |  |  |  |  |  |  | my ($container, $widget, @rest) = @_; | 
| 944 |  |  |  |  |  |  | $widget->freeze_child_notify; | 
| 945 |  |  |  |  |  |  | $container->add ($widget); | 
| 946 |  |  |  |  |  |  | if ($widget->get_parent) { | 
| 947 |  |  |  |  |  |  | $container->child_set ($widget, @rest); | 
| 948 |  |  |  |  |  |  | } | 
| 949 |  |  |  |  |  |  | $widget->thaw_child_notify; | 
| 950 |  |  |  |  |  |  | } | 
| 951 |  |  |  |  |  |  |  | 
| 952 |  |  |  |  |  |  | sub Gtk3::Container::child_get { | 
| 953 |  |  |  |  |  |  | my ($container, $child, @rest) = @_; | 
| 954 |  |  |  |  |  |  | my $properties = _rest_to_ref (\@rest); | 
| 955 |  |  |  |  |  |  | my @values; | 
| 956 |  |  |  |  |  |  | foreach my $property (@$properties) { | 
| 957 |  |  |  |  |  |  | my $pspec = Gtk3::ContainerClass::find_child_property ($container, $property); | 
| 958 |  |  |  |  |  |  | croak "Cannot find type information for property '$property' on $container" | 
| 959 |  |  |  |  |  |  | unless defined $pspec; | 
| 960 |  |  |  |  |  |  | my $value_wrapper = Glib::Object::Introspection::GValueWrapper->new ( | 
| 961 |  |  |  |  |  |  | $pspec->get_value_type, undef); | 
| 962 |  |  |  |  |  |  | $container->child_get_property ($child, $property, $value_wrapper); | 
| 963 |  |  |  |  |  |  | push @values, $value_wrapper->get_value; | 
| 964 |  |  |  |  |  |  | } | 
| 965 |  |  |  |  |  |  | return @values[0..$#values]; | 
| 966 |  |  |  |  |  |  | } | 
| 967 |  |  |  |  |  |  |  | 
| 968 |  |  |  |  |  |  | sub Gtk3::Container::child_set { | 
| 969 |  |  |  |  |  |  | my ($container, $child, @rest) = @_; | 
| 970 |  |  |  |  |  |  | my ($properties, $values) = _unpack_keys_and_values (\@rest); | 
| 971 |  |  |  |  |  |  | foreach my $i (0..$#$properties) { | 
| 972 |  |  |  |  |  |  | my $property = $properties->[$i]; | 
| 973 |  |  |  |  |  |  | my $value = $values->[$i]; | 
| 974 |  |  |  |  |  |  | my $pspec = Gtk3::ContainerClass::find_child_property ($container, $property); | 
| 975 |  |  |  |  |  |  | croak "Cannot find type information for property '$property' on $container" | 
| 976 |  |  |  |  |  |  | unless defined $pspec; | 
| 977 |  |  |  |  |  |  | my $value_wrapper = Glib::Object::Introspection::GValueWrapper->new ( | 
| 978 |  |  |  |  |  |  | $pspec->get_value_type, $value); | 
| 979 |  |  |  |  |  |  | $container->child_set_property ($child, $property, $value_wrapper); | 
| 980 |  |  |  |  |  |  | } | 
| 981 |  |  |  |  |  |  | } | 
| 982 |  |  |  |  |  |  |  | 
| 983 |  |  |  |  |  |  | =item * C and | 
| 984 |  |  |  |  |  |  | C are forwarded to the corresponding | 
| 985 |  |  |  |  |  |  | functions in C. | 
| 986 |  |  |  |  |  |  |  | 
| 987 |  |  |  |  |  |  | =cut | 
| 988 |  |  |  |  |  |  |  | 
| 989 |  |  |  |  |  |  | sub Gtk3::Container::find_child_property { | 
| 990 |  |  |  |  |  |  | return Gtk3::ContainerClass::find_child_property (@_); | 
| 991 |  |  |  |  |  |  | } | 
| 992 |  |  |  |  |  |  |  | 
| 993 |  |  |  |  |  |  | sub Gtk3::Container::list_child_properties { | 
| 994 |  |  |  |  |  |  | my $ref = Gtk3::ContainerClass::list_child_properties (@_); | 
| 995 |  |  |  |  |  |  | return if not defined $ref; | 
| 996 |  |  |  |  |  |  | return wantarray ? @$ref : $ref->[$#$ref]; | 
| 997 |  |  |  |  |  |  | } | 
| 998 |  |  |  |  |  |  |  | 
| 999 |  |  |  |  |  |  | =item * C returns a list of widgets, or an | 
| 1000 |  |  |  |  |  |  | empty list. | 
| 1001 |  |  |  |  |  |  |  | 
| 1002 |  |  |  |  |  |  | =cut | 
| 1003 |  |  |  |  |  |  |  | 
| 1004 |  |  |  |  |  |  | sub Gtk3::Container::get_focus_chain { | 
| 1005 |  |  |  |  |  |  | my ($container) = @_; | 
| 1006 |  |  |  |  |  |  | my ($is_set, $widgets) = Glib::Object::Introspection->invoke ( | 
| 1007 |  |  |  |  |  |  | $_GTK_BASENAME, 'Container', 'get_focus_chain', | 
| 1008 |  |  |  |  |  |  | $container); | 
| 1009 |  |  |  |  |  |  | return () unless $is_set; | 
| 1010 |  |  |  |  |  |  | return @$widgets; | 
| 1011 |  |  |  |  |  |  | } | 
| 1012 |  |  |  |  |  |  |  | 
| 1013 |  |  |  |  |  |  | =item * C also accepts a list of widgets. | 
| 1014 |  |  |  |  |  |  |  | 
| 1015 |  |  |  |  |  |  | =cut | 
| 1016 |  |  |  |  |  |  |  | 
| 1017 |  |  |  |  |  |  | sub Gtk3::Container::set_focus_chain { | 
| 1018 |  |  |  |  |  |  | my ($container, @rest) = @_; | 
| 1019 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 1020 |  |  |  |  |  |  | $_GTK_BASENAME, 'Container', 'set_focus_chain', | 
| 1021 |  |  |  |  |  |  | $container, _rest_to_ref (\@rest)); | 
| 1022 |  |  |  |  |  |  | } | 
| 1023 |  |  |  |  |  |  |  | 
| 1024 |  |  |  |  |  |  | =item * C also accepts a string. | 
| 1025 |  |  |  |  |  |  |  | 
| 1026 |  |  |  |  |  |  | =cut | 
| 1027 |  |  |  |  |  |  |  | 
| 1028 |  |  |  |  |  |  | sub Gtk3::CssProvider::load_from_data { | 
| 1029 |  |  |  |  |  |  | my ($self, $data) = @_; | 
| 1030 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 1031 |  |  |  |  |  |  | $_GTK_BASENAME, 'CssProvider', 'load_from_data', | 
| 1032 |  |  |  |  |  |  | $self, _unpack_unless_array_ref ($data)); | 
| 1033 |  |  |  |  |  |  | } | 
| 1034 |  |  |  |  |  |  |  | 
| 1035 |  |  |  |  |  |  | =item * For Gtk3::Dialog and Gtk3::InfoBar, a Perl implementation of | 
| 1036 |  |  |  |  |  |  | C is provided. | 
| 1037 |  |  |  |  |  |  |  | 
| 1038 |  |  |  |  |  |  | =cut | 
| 1039 |  |  |  |  |  |  |  | 
| 1040 |  |  |  |  |  |  | # Gtk3::Dialog / Gtk3::InfoBar methods due to overlap | 
| 1041 |  |  |  |  |  |  | { | 
| 1042 |  |  |  |  |  |  | no strict qw(refs); | 
| 1043 |  |  |  |  |  |  | foreach my $dialog_package (qw/Dialog InfoBar/) { | 
| 1044 |  |  |  |  |  |  | *{'Gtk3::' . $dialog_package . '::add_action_widget'} = sub { | 
| 1045 |  |  |  |  |  |  | Glib::Object::Introspection->invoke ( | 
| 1046 |  |  |  |  |  |  | $_GTK_BASENAME, $dialog_package, 'add_action_widget', | 
| 1047 |  |  |  |  |  |  | $_[0], $_[1], $_GTK_RESPONSE_NICK_TO_ID->($_[2])); | 
| 1048 |  |  |  |  |  |  | }; | 
| 1049 |  |  |  |  |  |  | *{'Gtk3::' . $dialog_package . '::add_button'} = sub { | 
| 1050 |  |  |  |  |  |  | Glib::Object::Introspection->invoke ( | 
| 1051 |  |  |  |  |  |  | $_GTK_BASENAME, $dialog_package, 'add_button', | 
| 1052 |  |  |  |  |  |  | $_[0], $_[1], $_GTK_RESPONSE_NICK_TO_ID->($_[2])); | 
| 1053 |  |  |  |  |  |  | }; | 
| 1054 |  |  |  |  |  |  | *{'Gtk3::' . $dialog_package . '::add_buttons'} = sub { | 
| 1055 |  |  |  |  |  |  | my ($dialog, @rest) = @_; | 
| 1056 |  |  |  |  |  |  | for (my $i = 0; $i < @rest; $i += 2) { | 
| 1057 |  |  |  |  |  |  | $dialog->add_button ($rest[$i], $rest[$i+1]); | 
| 1058 |  |  |  |  |  |  | } | 
| 1059 |  |  |  |  |  |  | }; | 
| 1060 |  |  |  |  |  |  | *{'Gtk3::' . $dialog_package . '::response'} = sub { | 
| 1061 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 1062 |  |  |  |  |  |  | $_GTK_BASENAME, $dialog_package, 'response', | 
| 1063 |  |  |  |  |  |  | $_[0], $_GTK_RESPONSE_NICK_TO_ID->($_[1])); | 
| 1064 |  |  |  |  |  |  | }; | 
| 1065 |  |  |  |  |  |  | *{'Gtk3::' . $dialog_package . '::set_default_response'} = sub { | 
| 1066 |  |  |  |  |  |  | Glib::Object::Introspection->invoke ( | 
| 1067 |  |  |  |  |  |  | $_GTK_BASENAME, $dialog_package, 'set_default_response', | 
| 1068 |  |  |  |  |  |  | $_[0], $_GTK_RESPONSE_NICK_TO_ID->($_[1])); | 
| 1069 |  |  |  |  |  |  | }; | 
| 1070 |  |  |  |  |  |  | *{'Gtk3::' . $dialog_package . '::set_response_sensitive'} = sub { | 
| 1071 |  |  |  |  |  |  | Glib::Object::Introspection->invoke ( | 
| 1072 |  |  |  |  |  |  | $_GTK_BASENAME, $dialog_package, 'set_response_sensitive', | 
| 1073 |  |  |  |  |  |  | $_[0], $_GTK_RESPONSE_NICK_TO_ID->($_[1]), $_[2]); | 
| 1074 |  |  |  |  |  |  | }; | 
| 1075 |  |  |  |  |  |  | } | 
| 1076 |  |  |  |  |  |  | } | 
| 1077 |  |  |  |  |  |  |  | 
| 1078 |  |  |  |  |  |  | sub Gtk3::Dialog::get_response_for_widget { | 
| 1079 |  |  |  |  |  |  | my $id = Glib::Object::Introspection->invoke ( | 
| 1080 |  |  |  |  |  |  | $_GTK_BASENAME, 'Dialog', 'get_response_for_widget', @_); | 
| 1081 |  |  |  |  |  |  | return $_GTK_RESPONSE_ID_TO_NICK->($id); | 
| 1082 |  |  |  |  |  |  | } | 
| 1083 |  |  |  |  |  |  |  | 
| 1084 |  |  |  |  |  |  | sub Gtk3::Dialog::get_widget_for_response { | 
| 1085 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 1086 |  |  |  |  |  |  | $_GTK_BASENAME, 'Dialog', 'get_widget_for_response', | 
| 1087 |  |  |  |  |  |  | $_[0], $_GTK_RESPONSE_NICK_TO_ID->($_[1])); | 
| 1088 |  |  |  |  |  |  | } | 
| 1089 |  |  |  |  |  |  |  | 
| 1090 |  |  |  |  |  |  | =item * C can optionally be called as C<< Gtk3::Dialog->new | 
| 1091 |  |  |  |  |  |  | (TITLE, PARENT, FLAGS, ...) >> where C<...> is a series of button text and | 
| 1092 |  |  |  |  |  |  | response id pairs. | 
| 1093 |  |  |  |  |  |  |  | 
| 1094 |  |  |  |  |  |  | =cut | 
| 1095 |  |  |  |  |  |  |  | 
| 1096 |  |  |  |  |  |  | sub Gtk3::Dialog::new { | 
| 1097 |  |  |  |  |  |  | my ($class, $title, $parent, $flags, @rest) = @_; | 
| 1098 |  |  |  |  |  |  | if (@_ == 1) { | 
| 1099 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 1100 |  |  |  |  |  |  | $_GTK_BASENAME, 'Dialog', 'new', @_); | 
| 1101 |  |  |  |  |  |  | } elsif ((@_ < 4) || (@rest % 2)){ | 
| 1102 |  |  |  |  |  |  | croak ("Usage: Gtk3::Dialog->new ()\n" . | 
| 1103 |  |  |  |  |  |  | "  or Gtk3::Dialog->new (TITLE, PARENT, FLAGS, ...)\n" . | 
| 1104 |  |  |  |  |  |  | "  where ... is a series of button text and response id pairs"); | 
| 1105 |  |  |  |  |  |  | } else { | 
| 1106 |  |  |  |  |  |  | my $dialog = Gtk3::Dialog->new; | 
| 1107 |  |  |  |  |  |  | defined $title and $dialog->set_title ($title); | 
| 1108 |  |  |  |  |  |  | defined $parent and $dialog->set_transient_for ($parent); | 
| 1109 |  |  |  |  |  |  | $flags & 'modal' and $dialog->set_modal (Glib::TRUE); | 
| 1110 |  |  |  |  |  |  | $flags & 'destroy-with-parent' and $dialog->set_destroy_with_parent (Glib::TRUE); | 
| 1111 |  |  |  |  |  |  | $dialog->add_buttons (@rest); | 
| 1112 |  |  |  |  |  |  | return $dialog; | 
| 1113 |  |  |  |  |  |  | } | 
| 1114 |  |  |  |  |  |  | } | 
| 1115 |  |  |  |  |  |  |  | 
| 1116 |  |  |  |  |  |  | =item * A Perl implementation of C is provided. | 
| 1117 |  |  |  |  |  |  |  | 
| 1118 |  |  |  |  |  |  | =cut | 
| 1119 |  |  |  |  |  |  |  | 
| 1120 |  |  |  |  |  |  | sub Gtk3::Dialog::new_with_buttons { | 
| 1121 |  |  |  |  |  |  | &Gtk3::Dialog::new; | 
| 1122 |  |  |  |  |  |  | } | 
| 1123 |  |  |  |  |  |  |  | 
| 1124 |  |  |  |  |  |  | sub Gtk3::Dialog::run { | 
| 1125 |  |  |  |  |  |  | my $id = Glib::Object::Introspection->invoke ( | 
| 1126 |  |  |  |  |  |  | $_GTK_BASENAME, 'Dialog', 'run', @_); | 
| 1127 |  |  |  |  |  |  | return $_GTK_RESPONSE_ID_TO_NICK->($id); | 
| 1128 |  |  |  |  |  |  | } | 
| 1129 |  |  |  |  |  |  |  | 
| 1130 |  |  |  |  |  |  | sub Gtk3::Dialog::set_alternative_button_order { | 
| 1131 |  |  |  |  |  |  | my ($dialog, @rest) = @_; | 
| 1132 |  |  |  |  |  |  | return unless @rest; | 
| 1133 |  |  |  |  |  |  | Glib::Object::Introspection->invoke ( | 
| 1134 |  |  |  |  |  |  | $_GTK_BASENAME, 'Dialog', 'set_alternative_button_order_from_array', | 
| 1135 |  |  |  |  |  |  | $dialog, [map { $_GTK_RESPONSE_NICK_TO_ID->($_) } @rest]); | 
| 1136 |  |  |  |  |  |  | } | 
| 1137 |  |  |  |  |  |  |  | 
| 1138 |  |  |  |  |  |  | =item * The C argument of C is optional. | 
| 1139 |  |  |  |  |  |  |  | 
| 1140 |  |  |  |  |  |  | =cut | 
| 1141 |  |  |  |  |  |  |  | 
| 1142 |  |  |  |  |  |  | sub Gtk3::Editable::insert_text { | 
| 1143 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 1144 |  |  |  |  |  |  | $_GTK_BASENAME, 'Editable', 'insert_text', | 
| 1145 |  |  |  |  |  |  | @_ == 4 ? @_ : (@_[0,1], -1, $_[2])); # wants length in bytes | 
| 1146 |  |  |  |  |  |  | } | 
| 1147 |  |  |  |  |  |  |  | 
| 1148 |  |  |  |  |  |  | =item * A Perl implementation of C is provided. | 
| 1149 |  |  |  |  |  |  |  | 
| 1150 |  |  |  |  |  |  | =cut | 
| 1151 |  |  |  |  |  |  |  | 
| 1152 |  |  |  |  |  |  | sub Gtk3::FileChooserDialog::new { | 
| 1153 |  |  |  |  |  |  | my ($class, $title, $parent, $action, @varargs) = @_; | 
| 1154 |  |  |  |  |  |  |  | 
| 1155 |  |  |  |  |  |  | if (@varargs % 2) { | 
| 1156 |  |  |  |  |  |  | croak 'Usage: Gtk3::FileChooserDialog->new' . | 
| 1157 |  |  |  |  |  |  | ' (title, parent, action, button-text =>' . | 
| 1158 |  |  |  |  |  |  | " response-id, ...)\n"; | 
| 1159 |  |  |  |  |  |  | } | 
| 1160 |  |  |  |  |  |  |  | 
| 1161 |  |  |  |  |  |  | my $result = Glib::Object::new ( | 
| 1162 |  |  |  |  |  |  | $class, | 
| 1163 |  |  |  |  |  |  | title => $title, | 
| 1164 |  |  |  |  |  |  | action => $action, | 
| 1165 |  |  |  |  |  |  | ); | 
| 1166 |  |  |  |  |  |  |  | 
| 1167 |  |  |  |  |  |  | if ($parent) { | 
| 1168 |  |  |  |  |  |  | $result->set_transient_for ($parent); | 
| 1169 |  |  |  |  |  |  | } | 
| 1170 |  |  |  |  |  |  |  | 
| 1171 |  |  |  |  |  |  | for (my $i = 0; $i < @varargs; $i += 2) { | 
| 1172 |  |  |  |  |  |  | $result->add_button ($varargs[$i], $varargs[$i+1]); | 
| 1173 |  |  |  |  |  |  | } | 
| 1174 |  |  |  |  |  |  |  | 
| 1175 |  |  |  |  |  |  | return $result; | 
| 1176 |  |  |  |  |  |  | } | 
| 1177 |  |  |  |  |  |  |  | 
| 1178 |  |  |  |  |  |  | =item * C uses the defaults homogeneous = FALSE and spacing = | 
| 1179 |  |  |  |  |  |  | 5. | 
| 1180 |  |  |  |  |  |  |  | 
| 1181 |  |  |  |  |  |  | =cut | 
| 1182 |  |  |  |  |  |  |  | 
| 1183 |  |  |  |  |  |  | sub Gtk3::HBox::new { | 
| 1184 |  |  |  |  |  |  | my ($class, $homogeneous, $spacing) = @_; | 
| 1185 |  |  |  |  |  |  | $homogeneous = 0 unless defined $homogeneous; | 
| 1186 |  |  |  |  |  |  | $spacing = 5 unless defined $spacing; | 
| 1187 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 1188 |  |  |  |  |  |  | $_GTK_BASENAME, 'HBox', 'new', $class, $homogeneous, $spacing); | 
| 1189 |  |  |  |  |  |  | } | 
| 1190 |  |  |  |  |  |  |  | 
| 1191 |  |  |  |  |  |  | # Gtk3::Image | 
| 1192 |  |  |  |  |  |  | { | 
| 1193 |  |  |  |  |  |  | no strict qw(refs); | 
| 1194 |  |  |  |  |  |  | foreach my $ctor (qw/new_from_stock new_from_icon_set new_from_icon_name new_from_gicon/) { | 
| 1195 |  |  |  |  |  |  | *{'Gtk3::Image::' . $ctor} = sub { | 
| 1196 |  |  |  |  |  |  | my ($class, $thing, $size) = @_; | 
| 1197 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 1198 |  |  |  |  |  |  | $_GTK_BASENAME, 'Image', $ctor, $class, $thing, | 
| 1199 |  |  |  |  |  |  | $_GTK_ICON_SIZE_NICK_TO_ID->($size)); | 
| 1200 |  |  |  |  |  |  | } | 
| 1201 |  |  |  |  |  |  | } | 
| 1202 |  |  |  |  |  |  | foreach my $getter (qw/get_stock get_icon_set get_icon_name get_gicon/) { | 
| 1203 |  |  |  |  |  |  | *{'Gtk3::Image::' . $getter} = sub { | 
| 1204 |  |  |  |  |  |  | my ($image) = @_; | 
| 1205 |  |  |  |  |  |  | my ($thing, $size) = Glib::Object::Introspection->invoke ( | 
| 1206 |  |  |  |  |  |  | $_GTK_BASENAME, 'Image', $getter, $image); | 
| 1207 |  |  |  |  |  |  | return ($thing, $_GTK_ICON_SIZE_ID_TO_NICK->($size)); | 
| 1208 |  |  |  |  |  |  | } | 
| 1209 |  |  |  |  |  |  | } | 
| 1210 |  |  |  |  |  |  | foreach my $setter (qw/set_from_stock set_from_icon_set set_from_icon_name set_from_gicon/) { | 
| 1211 |  |  |  |  |  |  | *{'Gtk3::Image::' . $setter} = sub { | 
| 1212 |  |  |  |  |  |  | my ($image, $thing, $size) = @_; | 
| 1213 |  |  |  |  |  |  | Glib::Object::Introspection->invoke ( | 
| 1214 |  |  |  |  |  |  | $_GTK_BASENAME, 'Image', $setter, $image, $thing, | 
| 1215 |  |  |  |  |  |  | $_GTK_ICON_SIZE_NICK_TO_ID->($size)); | 
| 1216 |  |  |  |  |  |  | } | 
| 1217 |  |  |  |  |  |  | } | 
| 1218 |  |  |  |  |  |  | } | 
| 1219 |  |  |  |  |  |  |  | 
| 1220 |  |  |  |  |  |  | =item * The default C constructor of Gtk3::ImageMenuItem reroutes to | 
| 1221 |  |  |  |  |  |  | C if given an extra argument. | 
| 1222 |  |  |  |  |  |  |  | 
| 1223 |  |  |  |  |  |  | =cut | 
| 1224 |  |  |  |  |  |  |  | 
| 1225 |  |  |  |  |  |  | sub Gtk3::ImageMenuItem::new { | 
| 1226 |  |  |  |  |  |  | my ($class, $mnemonic) = @_; | 
| 1227 |  |  |  |  |  |  | if (defined $mnemonic) { | 
| 1228 |  |  |  |  |  |  | return $class->new_with_mnemonic ($mnemonic); | 
| 1229 |  |  |  |  |  |  | } | 
| 1230 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 1231 |  |  |  |  |  |  | $_GTK_BASENAME, 'ImageMenuItem', 'new', @_); | 
| 1232 |  |  |  |  |  |  | } | 
| 1233 |  |  |  |  |  |  |  | 
| 1234 |  |  |  |  |  |  | =item * C can optionally be called as C<< | 
| 1235 |  |  |  |  |  |  | Gtk3::InfoBar->new (...) >> where C<...> is a series of button text and | 
| 1236 |  |  |  |  |  |  | response id pairs. | 
| 1237 |  |  |  |  |  |  |  | 
| 1238 |  |  |  |  |  |  | =cut | 
| 1239 |  |  |  |  |  |  |  | 
| 1240 |  |  |  |  |  |  | sub Gtk3::InfoBar::new { | 
| 1241 |  |  |  |  |  |  | my ($class, @buttons) = @_; | 
| 1242 |  |  |  |  |  |  | if (@_ == 1) { | 
| 1243 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 1244 |  |  |  |  |  |  | $_GTK_BASENAME, 'InfoBar', 'new', @_); | 
| 1245 |  |  |  |  |  |  | } elsif (@buttons % 2) { | 
| 1246 |  |  |  |  |  |  | croak "Usage: Gtk3::InfoBar->new_with_buttons (button-text => response_id, ...)\n"; | 
| 1247 |  |  |  |  |  |  | } else { | 
| 1248 |  |  |  |  |  |  | my $infobar = Gtk3::InfoBar->new; | 
| 1249 |  |  |  |  |  |  | for (my $i = 0; $i < @buttons; $i += 2) { | 
| 1250 |  |  |  |  |  |  | $infobar->add_button ($buttons[$i], $buttons[$i+1]); | 
| 1251 |  |  |  |  |  |  | } | 
| 1252 |  |  |  |  |  |  | return $infobar; | 
| 1253 |  |  |  |  |  |  | } | 
| 1254 |  |  |  |  |  |  | } | 
| 1255 |  |  |  |  |  |  |  | 
| 1256 |  |  |  |  |  |  | =item * A Perl reimplementation of C is | 
| 1257 |  |  |  |  |  |  | provided. | 
| 1258 |  |  |  |  |  |  |  | 
| 1259 |  |  |  |  |  |  | =cut | 
| 1260 |  |  |  |  |  |  |  | 
| 1261 |  |  |  |  |  |  | sub Gtk3::InfoBar::new_with_buttons { | 
| 1262 |  |  |  |  |  |  | &Gtk3::InfoBar::new; | 
| 1263 |  |  |  |  |  |  | } | 
| 1264 |  |  |  |  |  |  |  | 
| 1265 |  |  |  |  |  |  | =item * The default C constructor of Gtk3::LinkButton reroutes to | 
| 1266 |  |  |  |  |  |  | C if given an extra argument. | 
| 1267 |  |  |  |  |  |  |  | 
| 1268 |  |  |  |  |  |  | =cut | 
| 1269 |  |  |  |  |  |  |  | 
| 1270 |  |  |  |  |  |  | sub Gtk3::LinkButton::new { | 
| 1271 |  |  |  |  |  |  | my ($class, $uri, $label) = @_; | 
| 1272 |  |  |  |  |  |  | if (defined $label) { | 
| 1273 |  |  |  |  |  |  | return Gtk3::LinkButton->new_with_label ($uri, $label); | 
| 1274 |  |  |  |  |  |  | } else { | 
| 1275 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 1276 |  |  |  |  |  |  | $_GTK_BASENAME, 'LinkButton', 'new', @_); | 
| 1277 |  |  |  |  |  |  | } | 
| 1278 |  |  |  |  |  |  | } | 
| 1279 |  |  |  |  |  |  |  | 
| 1280 |  |  |  |  |  |  | =item * C also accepts a list of type names. | 
| 1281 |  |  |  |  |  |  |  | 
| 1282 |  |  |  |  |  |  | =cut | 
| 1283 |  |  |  |  |  |  |  | 
| 1284 |  |  |  |  |  |  | sub Gtk3::ListStore::new { | 
| 1285 |  |  |  |  |  |  | return _common_tree_model_new ('ListStore', @_); | 
| 1286 |  |  |  |  |  |  | } | 
| 1287 |  |  |  |  |  |  |  | 
| 1288 |  |  |  |  |  |  | =item * Gtk3::ListStore has a C method that calls C | 
| 1289 |  |  |  |  |  |  | instead of C. | 
| 1290 |  |  |  |  |  |  |  | 
| 1291 |  |  |  |  |  |  | =cut | 
| 1292 |  |  |  |  |  |  |  | 
| 1293 |  |  |  |  |  |  | # Reroute 'get' to Gtk3::TreeModel instead of Glib::Object. | 
| 1294 |  |  |  |  |  |  | sub Gtk3::ListStore::get { | 
| 1295 |  |  |  |  |  |  | return Gtk3::TreeModel::get (@_); | 
| 1296 |  |  |  |  |  |  | } | 
| 1297 |  |  |  |  |  |  |  | 
| 1298 |  |  |  |  |  |  | =item * C also accepts a list of C<< | 
| 1299 |  |  |  |  |  |  | column => value >> pairs and reroutes to C. | 
| 1300 |  |  |  |  |  |  |  | 
| 1301 |  |  |  |  |  |  | =cut | 
| 1302 |  |  |  |  |  |  |  | 
| 1303 |  |  |  |  |  |  | sub Gtk3::ListStore::insert_with_values { | 
| 1304 |  |  |  |  |  |  | my ($model, $position, @columns_and_values) = @_; | 
| 1305 |  |  |  |  |  |  | my ($columns, $values) = _unpack_keys_and_values (\@columns_and_values); | 
| 1306 |  |  |  |  |  |  | if (not defined $columns) { | 
| 1307 |  |  |  |  |  |  | croak ("Usage: Gtk3::ListStore::insert_with_values (\$model, \$position, \\\@columns, \\\@values)\n", | 
| 1308 |  |  |  |  |  |  | " -or-: Gtk3::ListStore::insert_with_values (\$model, \$position, \$column1 => \$value1, ...)"); | 
| 1309 |  |  |  |  |  |  | } | 
| 1310 |  |  |  |  |  |  | my @wrapped_values = (); | 
| 1311 |  |  |  |  |  |  | foreach my $i (0..$#{$columns}) { | 
| 1312 |  |  |  |  |  |  | my $column_type = $model->get_column_type ($columns->[$i]); | 
| 1313 |  |  |  |  |  |  | push @wrapped_values, | 
| 1314 |  |  |  |  |  |  | Glib::Object::Introspection::GValueWrapper->new ( | 
| 1315 |  |  |  |  |  |  | $column_type, $values->[$i]); | 
| 1316 |  |  |  |  |  |  | } | 
| 1317 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 1318 |  |  |  |  |  |  | $_GTK_BASENAME, 'ListStore', 'insert_with_valuesv', # FIXME: missing rename-to annotation? | 
| 1319 |  |  |  |  |  |  | $model, $position, $columns, \@wrapped_values); | 
| 1320 |  |  |  |  |  |  | } | 
| 1321 |  |  |  |  |  |  |  | 
| 1322 |  |  |  |  |  |  | =item * C also accepts a list of C<< column => value >> | 
| 1323 |  |  |  |  |  |  | pairs. | 
| 1324 |  |  |  |  |  |  |  | 
| 1325 |  |  |  |  |  |  | =cut | 
| 1326 |  |  |  |  |  |  |  | 
| 1327 |  |  |  |  |  |  | sub Gtk3::ListStore::set { | 
| 1328 |  |  |  |  |  |  | return _common_tree_model_set ('ListStore', @_); | 
| 1329 |  |  |  |  |  |  | } | 
| 1330 |  |  |  |  |  |  |  | 
| 1331 |  |  |  |  |  |  | =item * C reroutes to C for better | 
| 1332 |  |  |  |  |  |  | callback handling. | 
| 1333 |  |  |  |  |  |  |  | 
| 1334 |  |  |  |  |  |  | =cut | 
| 1335 |  |  |  |  |  |  |  | 
| 1336 |  |  |  |  |  |  | sub Gtk3::Menu::popup { | 
| 1337 |  |  |  |  |  |  | my $self = shift; | 
| 1338 |  |  |  |  |  |  | $self->popup_for_device (undef, @_); | 
| 1339 |  |  |  |  |  |  | } | 
| 1340 |  |  |  |  |  |  |  | 
| 1341 |  |  |  |  |  |  | =item * C allows the given menu position func to | 
| 1342 |  |  |  |  |  |  | return only x and y coordinates, defaulting C to FALSE. | 
| 1343 |  |  |  |  |  |  |  | 
| 1344 |  |  |  |  |  |  | =cut | 
| 1345 |  |  |  |  |  |  |  | 
| 1346 |  |  |  |  |  |  | sub Gtk3::Menu::popup_for_device { | 
| 1347 |  |  |  |  |  |  | my ($menu, $device, $parent_menu_shell, $parent_menu_item, $func, $data, $button, $activate_time) = @_; | 
| 1348 |  |  |  |  |  |  | my $real_func = $func ? sub { | 
| 1349 |  |  |  |  |  |  | my @stuff = eval { $func->(@_) }; | 
| 1350 |  |  |  |  |  |  | if ($@) { | 
| 1351 |  |  |  |  |  |  | warn "*** menu position callback ignoring error: $@"; | 
| 1352 |  |  |  |  |  |  | } | 
| 1353 |  |  |  |  |  |  | if (@stuff == 3) { | 
| 1354 |  |  |  |  |  |  | return (@stuff); | 
| 1355 |  |  |  |  |  |  | } elsif (@stuff == 2) { | 
| 1356 |  |  |  |  |  |  | return (@stuff, Glib::FALSE); # provide a default for push_in | 
| 1357 |  |  |  |  |  |  | } else { | 
| 1358 |  |  |  |  |  |  | warn "*** menu position callback must return two integers " . | 
| 1359 |  |  |  |  |  |  | "(x, y) or two integers and a boolean (x, y, push_in)"; | 
| 1360 |  |  |  |  |  |  | return (0, 0, Glib::FALSE); | 
| 1361 |  |  |  |  |  |  | } | 
| 1362 |  |  |  |  |  |  | } : undef; | 
| 1363 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 1364 |  |  |  |  |  |  | $_GTK_BASENAME, 'Menu', 'popup_for_device', | 
| 1365 |  |  |  |  |  |  | $menu, $device, $parent_menu_shell, $parent_menu_item, $real_func, $data, $button, $activate_time); | 
| 1366 |  |  |  |  |  |  | } | 
| 1367 |  |  |  |  |  |  |  | 
| 1368 |  |  |  |  |  |  | =item * The default C constructor of Gtk3::MenuItem reroutes to | 
| 1369 |  |  |  |  |  |  | C if given an extra argument. | 
| 1370 |  |  |  |  |  |  |  | 
| 1371 |  |  |  |  |  |  | =cut | 
| 1372 |  |  |  |  |  |  |  | 
| 1373 |  |  |  |  |  |  | sub Gtk3::MenuItem::new { | 
| 1374 |  |  |  |  |  |  | my ($class, $mnemonic) = @_; | 
| 1375 |  |  |  |  |  |  | if (defined $mnemonic) { | 
| 1376 |  |  |  |  |  |  | return $class->new_with_mnemonic ($mnemonic); | 
| 1377 |  |  |  |  |  |  | } | 
| 1378 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 1379 |  |  |  |  |  |  | $_GTK_BASENAME, 'MenuItem', 'new', @_); | 
| 1380 |  |  |  |  |  |  | } | 
| 1381 |  |  |  |  |  |  |  | 
| 1382 |  |  |  |  |  |  | =item * A Perl reimplementation of C is provided. | 
| 1383 |  |  |  |  |  |  |  | 
| 1384 |  |  |  |  |  |  | =cut | 
| 1385 |  |  |  |  |  |  |  | 
| 1386 |  |  |  |  |  |  | sub Gtk3::MessageDialog::new { | 
| 1387 |  |  |  |  |  |  | my ($class, $parent, $flags, $type, $buttons, $format, @args) = @_; | 
| 1388 |  |  |  |  |  |  | my $dialog = Glib::Object::new ($class, message_type => $type, | 
| 1389 |  |  |  |  |  |  | buttons => $buttons); | 
| 1390 |  |  |  |  |  |  | if (defined $format) { | 
| 1391 |  |  |  |  |  |  | # sprintf can handle empty @args | 
| 1392 |  |  |  |  |  |  | my $msg = sprintf $format, @args; | 
| 1393 |  |  |  |  |  |  | $dialog->set (text => $msg); | 
| 1394 |  |  |  |  |  |  | } | 
| 1395 |  |  |  |  |  |  | if (defined $parent) { | 
| 1396 |  |  |  |  |  |  | $dialog->set_transient_for ($parent); | 
| 1397 |  |  |  |  |  |  | } | 
| 1398 |  |  |  |  |  |  | if ($flags & 'modal') { | 
| 1399 |  |  |  |  |  |  | $dialog->set_modal (Glib::TRUE); | 
| 1400 |  |  |  |  |  |  | } | 
| 1401 |  |  |  |  |  |  | if ($flags & 'destroy-with-parent') { | 
| 1402 |  |  |  |  |  |  | $dialog->set_destroy_with_parent (Glib::TRUE); | 
| 1403 |  |  |  |  |  |  | } | 
| 1404 |  |  |  |  |  |  | return $dialog; | 
| 1405 |  |  |  |  |  |  | } | 
| 1406 |  |  |  |  |  |  |  | 
| 1407 |  |  |  |  |  |  | =item * The group handling in the constructors and accessors of | 
| 1408 |  |  |  |  |  |  | Gtk3::RadioAction, Gtk3::RadioButton, Gtk3::RadioMenuItem and | 
| 1409 |  |  |  |  |  |  | Gtk3::RadioToolButton is amended to work correctly when given array refs of | 
| 1410 |  |  |  |  |  |  | group members or single group members. | 
| 1411 |  |  |  |  |  |  |  | 
| 1412 |  |  |  |  |  |  | =cut | 
| 1413 |  |  |  |  |  |  |  | 
| 1414 |  |  |  |  |  |  | # Gtk3::RadioAction, Gtk3::RadioButton, Gtk3::RadioMenuItem and | 
| 1415 |  |  |  |  |  |  | # Gtk3::RadioToolButton constructors. | 
| 1416 |  |  |  |  |  |  | { | 
| 1417 |  |  |  |  |  |  | no strict qw(refs); | 
| 1418 |  |  |  |  |  |  |  | 
| 1419 |  |  |  |  |  |  | my $group_converter = sub { | 
| 1420 |  |  |  |  |  |  | my ($ctor, $group_or_member, $package) = @_; | 
| 1421 |  |  |  |  |  |  | local $@; | 
| 1422 |  |  |  |  |  |  | # undef => [] | 
| 1423 |  |  |  |  |  |  | if (!defined $group_or_member) { | 
| 1424 |  |  |  |  |  |  | return ($ctor, []); | 
| 1425 |  |  |  |  |  |  | } | 
| 1426 |  |  |  |  |  |  | # [] => [] | 
| 1427 |  |  |  |  |  |  | elsif (eval { $#$group_or_member == -1 }) { | 
| 1428 |  |  |  |  |  |  | return ($ctor, []); | 
| 1429 |  |  |  |  |  |  | } | 
| 1430 |  |  |  |  |  |  | # [member1, ...] => member1 | 
| 1431 |  |  |  |  |  |  | elsif (eval { $#$group_or_member >= 0 }) { | 
| 1432 |  |  |  |  |  |  | my $member = $group_or_member->[0]; | 
| 1433 |  |  |  |  |  |  | if (defined $member) { | 
| 1434 |  |  |  |  |  |  | return ($ctor . '_from_widget', $member); | 
| 1435 |  |  |  |  |  |  | } | 
| 1436 |  |  |  |  |  |  | return ($ctor, []); | 
| 1437 |  |  |  |  |  |  | } | 
| 1438 |  |  |  |  |  |  | # member => member | 
| 1439 |  |  |  |  |  |  | elsif (eval { $group_or_member->isa ('Gtk3::' . $package) }) { | 
| 1440 |  |  |  |  |  |  | return ($ctor . '_from_widget', $group_or_member); | 
| 1441 |  |  |  |  |  |  | } | 
| 1442 |  |  |  |  |  |  | else { | 
| 1443 |  |  |  |  |  |  | croak ('Unhandled group or member argument encountered'); | 
| 1444 |  |  |  |  |  |  | } | 
| 1445 |  |  |  |  |  |  | }; | 
| 1446 |  |  |  |  |  |  |  | 
| 1447 |  |  |  |  |  |  | # Gtk3::RadioAction/Gtk3::RadioButton/Gtk3::RadioMenuItem/Gtk3::RadioToolButton | 
| 1448 |  |  |  |  |  |  | foreach my $package (qw/RadioAction RadioButton RadioMenuItem RadioToolButton/) { | 
| 1449 |  |  |  |  |  |  | *{'Gtk3::' . $package . '::set_group'} = sub { | 
| 1450 |  |  |  |  |  |  | my ($button, $group) = @_; | 
| 1451 |  |  |  |  |  |  | my $real_group = $group; | 
| 1452 |  |  |  |  |  |  | if (eval { $#$group >= 0 }) { | 
| 1453 |  |  |  |  |  |  | $real_group = $group->[0]; | 
| 1454 |  |  |  |  |  |  | } | 
| 1455 |  |  |  |  |  |  | $button->set (group => $real_group); | 
| 1456 |  |  |  |  |  |  | }; | 
| 1457 |  |  |  |  |  |  | } | 
| 1458 |  |  |  |  |  |  |  | 
| 1459 |  |  |  |  |  |  | # Gtk3::RadioButton/Gtk3::RadioMenuItem | 
| 1460 |  |  |  |  |  |  | foreach my $package (qw/RadioButton RadioMenuItem/) { | 
| 1461 |  |  |  |  |  |  | foreach my $ctor (qw/new new_with_label new_with_mnemonic/) { | 
| 1462 |  |  |  |  |  |  | # Avoid using the list-based API, as G:O:I does not support the memory | 
| 1463 |  |  |  |  |  |  | # ownership semantics.  Use the item-based API instead. | 
| 1464 |  |  |  |  |  |  | *{'Gtk3::' . $package . '::' . $ctor} = sub { | 
| 1465 |  |  |  |  |  |  | my ($class, $group_or_member, @rest) = @_; | 
| 1466 |  |  |  |  |  |  | my ($real_ctor, $real_group_or_member) = | 
| 1467 |  |  |  |  |  |  | $group_converter->($ctor, $group_or_member, $package); | 
| 1468 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 1469 |  |  |  |  |  |  | $_GTK_BASENAME, $package, $real_ctor, | 
| 1470 |  |  |  |  |  |  | $class, $real_group_or_member, @rest); | 
| 1471 |  |  |  |  |  |  | }; | 
| 1472 |  |  |  |  |  |  |  | 
| 1473 |  |  |  |  |  |  | # Work around . | 
| 1474 |  |  |  |  |  |  | *{'Gtk3::' . $package . '::' . $ctor . '_from_widget'} = sub { | 
| 1475 |  |  |  |  |  |  | my ($class, $member, @rest) = @_; | 
| 1476 |  |  |  |  |  |  | my $real_ctor = $ctor; | 
| 1477 |  |  |  |  |  |  | my $real_group_or_member = $member; | 
| 1478 |  |  |  |  |  |  | if (!defined $member) { | 
| 1479 |  |  |  |  |  |  | $real_group_or_member = []; | 
| 1480 |  |  |  |  |  |  | } else { | 
| 1481 |  |  |  |  |  |  | $real_ctor .= '_from_widget'; | 
| 1482 |  |  |  |  |  |  | } | 
| 1483 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 1484 |  |  |  |  |  |  | $_GTK_BASENAME, $package, $real_ctor, | 
| 1485 |  |  |  |  |  |  | $class, $real_group_or_member, @rest); | 
| 1486 |  |  |  |  |  |  | }; | 
| 1487 |  |  |  |  |  |  | } | 
| 1488 |  |  |  |  |  |  | } | 
| 1489 |  |  |  |  |  |  |  | 
| 1490 |  |  |  |  |  |  | # GtkRadioToolButton | 
| 1491 |  |  |  |  |  |  | foreach my $ctor (qw/new new_from_stock/) { | 
| 1492 |  |  |  |  |  |  | # Avoid using the list-based API, as G:O:I does not support the memory | 
| 1493 |  |  |  |  |  |  | # ownership semantics.  Use the item-based API instead. | 
| 1494 |  |  |  |  |  |  | *{'Gtk3::RadioToolButton::' . $ctor} = sub { | 
| 1495 |  |  |  |  |  |  | my ($class, $group_or_member, @rest) = @_; | 
| 1496 |  |  |  |  |  |  | my ($real_ctor, $real_group_or_member) = | 
| 1497 |  |  |  |  |  |  | $group_converter->($ctor, $group_or_member, 'RadioToolButton'); | 
| 1498 |  |  |  |  |  |  | $real_ctor =~ s/_from_stock_from_/_with_stock_from_/; # you gotta be kidding me... | 
| 1499 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 1500 |  |  |  |  |  |  | $_GTK_BASENAME, 'RadioToolButton', $real_ctor, | 
| 1501 |  |  |  |  |  |  | $class, $real_group_or_member, @rest); | 
| 1502 |  |  |  |  |  |  | }; | 
| 1503 |  |  |  |  |  |  | } | 
| 1504 |  |  |  |  |  |  | } | 
| 1505 |  |  |  |  |  |  |  | 
| 1506 |  |  |  |  |  |  | =item * Perl reimplementations of C and | 
| 1507 |  |  |  |  |  |  | C are provided. | 
| 1508 |  |  |  |  |  |  |  | 
| 1509 |  |  |  |  |  |  | =cut | 
| 1510 |  |  |  |  |  |  |  | 
| 1511 |  |  |  |  |  |  | sub Gtk3::RecentChooserDialog::new { | 
| 1512 |  |  |  |  |  |  | my ($class, $title, $parent, @buttons) = @_; | 
| 1513 |  |  |  |  |  |  | my $dialog = Glib::Object::new ($class, title => $title); | 
| 1514 |  |  |  |  |  |  | for (my $i = 0; $i < @buttons; $i += 2) { | 
| 1515 |  |  |  |  |  |  | $dialog->add_button ($buttons[$i], $buttons[$i+1]); | 
| 1516 |  |  |  |  |  |  | } | 
| 1517 |  |  |  |  |  |  | if (defined $parent) { | 
| 1518 |  |  |  |  |  |  | $dialog->set_transient_for ($parent); | 
| 1519 |  |  |  |  |  |  | } | 
| 1520 |  |  |  |  |  |  | return $dialog; | 
| 1521 |  |  |  |  |  |  | } | 
| 1522 |  |  |  |  |  |  |  | 
| 1523 |  |  |  |  |  |  | sub Gtk3::RecentChooserDialog::new_for_manager { | 
| 1524 |  |  |  |  |  |  | my ($class, $title, $parent, $mgr, @buttons) = @_; | 
| 1525 |  |  |  |  |  |  | my $dialog = Glib::Object::new ($class, title => $title, | 
| 1526 |  |  |  |  |  |  | recent_manager => $mgr); | 
| 1527 |  |  |  |  |  |  | for (my $i = 0; $i < @buttons; $i += 2) { | 
| 1528 |  |  |  |  |  |  | $dialog->add_button ($buttons[$i], $buttons[$i+1]); | 
| 1529 |  |  |  |  |  |  | } | 
| 1530 |  |  |  |  |  |  | if (defined $parent) { | 
| 1531 |  |  |  |  |  |  | $dialog->set_transient_for ($parent); | 
| 1532 |  |  |  |  |  |  | } | 
| 1533 |  |  |  |  |  |  | return $dialog; | 
| 1534 |  |  |  |  |  |  | } | 
| 1535 |  |  |  |  |  |  |  | 
| 1536 |  |  |  |  |  |  | =item * Redirects are provided from C to | 
| 1537 |  |  |  |  |  |  | C for C, C, C, C and | 
| 1538 |  |  |  |  |  |  | C. | 
| 1539 |  |  |  |  |  |  |  | 
| 1540 |  |  |  |  |  |  | =cut | 
| 1541 |  |  |  |  |  |  |  | 
| 1542 |  |  |  |  |  |  | { | 
| 1543 |  |  |  |  |  |  | no strict qw/refs/; | 
| 1544 |  |  |  |  |  |  |  | 
| 1545 |  |  |  |  |  |  | my %stock_name_corrections = ( | 
| 1546 |  |  |  |  |  |  | 'Gtk3::Stock::add' => 'Gtk3::stock_add', | 
| 1547 |  |  |  |  |  |  | 'Gtk3::Stock::add_static' => 'Gtk3::stock_add_static', | 
| 1548 |  |  |  |  |  |  | 'Gtk3::Stock::list_ids' => 'Gtk3::stock_list_ids', | 
| 1549 |  |  |  |  |  |  | 'Gtk3::Stock::lookup' => 'Gtk3::stock_lookup', | 
| 1550 |  |  |  |  |  |  | 'Gtk3::Stock::set_translate_func' => 'Gtk3::stock_set_translate_func', | 
| 1551 |  |  |  |  |  |  | ); | 
| 1552 |  |  |  |  |  |  |  | 
| 1553 |  |  |  |  |  |  | foreach my $new (keys %stock_name_corrections) { | 
| 1554 |  |  |  |  |  |  | *{$new} = \&{$stock_name_corrections{$new}}; | 
| 1555 |  |  |  |  |  |  | } | 
| 1556 |  |  |  |  |  |  | } | 
| 1557 |  |  |  |  |  |  |  | 
| 1558 |  |  |  |  |  |  | =item * A Perl reimplementation of C is provided. | 
| 1559 |  |  |  |  |  |  |  | 
| 1560 |  |  |  |  |  |  | =cut | 
| 1561 |  |  |  |  |  |  |  | 
| 1562 |  |  |  |  |  |  | sub Gtk3::StyleContext::get { | 
| 1563 |  |  |  |  |  |  | my ($context, $state, @properties) = @_; | 
| 1564 |  |  |  |  |  |  | my @values = map { $context->get_property ($_, $state) } @properties; | 
| 1565 |  |  |  |  |  |  | return @values[0..$#values]; | 
| 1566 |  |  |  |  |  |  | } | 
| 1567 |  |  |  |  |  |  |  | 
| 1568 |  |  |  |  |  |  | =item * A Perl reimplementation of C is provided. | 
| 1569 |  |  |  |  |  |  |  | 
| 1570 |  |  |  |  |  |  | =cut | 
| 1571 |  |  |  |  |  |  |  | 
| 1572 |  |  |  |  |  |  | sub Gtk3::TextBuffer::create_tag { | 
| 1573 |  |  |  |  |  |  | my ($buffer, $tag_name, @rest) = @_; | 
| 1574 |  |  |  |  |  |  | if (@rest % 2) { | 
| 1575 |  |  |  |  |  |  | croak ('Usage: $buffer->create_tag ($tag_name, $property1 => $value1, ...'); | 
| 1576 |  |  |  |  |  |  | } | 
| 1577 |  |  |  |  |  |  | my $tag = Gtk3::TextTag->new ($tag_name); | 
| 1578 |  |  |  |  |  |  | my $tag_table = $buffer->get_tag_table; | 
| 1579 |  |  |  |  |  |  | $tag_table->add ($tag); | 
| 1580 |  |  |  |  |  |  | for (my $i = 0 ; $i < @rest ; $i += 2) { | 
| 1581 |  |  |  |  |  |  | $tag->set_property ($rest[$i], $rest[$i+1]); | 
| 1582 |  |  |  |  |  |  | } | 
| 1583 |  |  |  |  |  |  | return $tag; | 
| 1584 |  |  |  |  |  |  | } | 
| 1585 |  |  |  |  |  |  |  | 
| 1586 |  |  |  |  |  |  | =item * The C arguments of C, | 
| 1587 |  |  |  |  |  |  | C, C, C, | 
| 1588 |  |  |  |  |  |  | C and C are optional. | 
| 1589 |  |  |  |  |  |  |  | 
| 1590 |  |  |  |  |  |  | =cut | 
| 1591 |  |  |  |  |  |  |  | 
| 1592 |  |  |  |  |  |  | sub Gtk3::TextBuffer::insert { | 
| 1593 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 1594 |  |  |  |  |  |  | $_GTK_BASENAME, 'TextBuffer', 'insert', | 
| 1595 |  |  |  |  |  |  | @_ == 4 ? @_ : (@_[0,1,2], -1)); # wants length in bytes | 
| 1596 |  |  |  |  |  |  | } | 
| 1597 |  |  |  |  |  |  |  | 
| 1598 |  |  |  |  |  |  | sub Gtk3::TextBuffer::insert_at_cursor { | 
| 1599 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 1600 |  |  |  |  |  |  | $_GTK_BASENAME, 'TextBuffer', 'insert_at_cursor', | 
| 1601 |  |  |  |  |  |  | @_ == 3 ? @_ : (@_[0,1], -1)); # wants length in bytes | 
| 1602 |  |  |  |  |  |  | } | 
| 1603 |  |  |  |  |  |  |  | 
| 1604 |  |  |  |  |  |  | sub Gtk3::TextBuffer::insert_interactive { | 
| 1605 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 1606 |  |  |  |  |  |  | $_GTK_BASENAME, 'TextBuffer', 'insert_interactive', | 
| 1607 |  |  |  |  |  |  | @_ == 5 ? @_ : (@_[0,1,2], -1, $_[3])); # wants length in bytes | 
| 1608 |  |  |  |  |  |  | } | 
| 1609 |  |  |  |  |  |  |  | 
| 1610 |  |  |  |  |  |  | sub Gtk3::TextBuffer::insert_interactive_at_cursor { | 
| 1611 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 1612 |  |  |  |  |  |  | $_GTK_BASENAME, 'TextBuffer', 'insert_interactive_at_cursor', | 
| 1613 |  |  |  |  |  |  | @_ == 4 ? @_ : (@_[0,1], -1, $_[2])); # wants length in bytes | 
| 1614 |  |  |  |  |  |  | } | 
| 1615 |  |  |  |  |  |  |  | 
| 1616 |  |  |  |  |  |  | sub Gtk3::TextBuffer::insert_markup { | 
| 1617 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 1618 |  |  |  |  |  |  | $_GTK_BASENAME, 'TextBuffer', 'insert_markup', | 
| 1619 |  |  |  |  |  |  | @_ == 4 ? @_ : (@_[0,1,2], -1)); # wants length in bytes | 
| 1620 |  |  |  |  |  |  | } | 
| 1621 |  |  |  |  |  |  |  | 
| 1622 |  |  |  |  |  |  | =item * Perl reimplementations of C and | 
| 1623 |  |  |  |  |  |  | C are provided which do not require a C | 
| 1624 |  |  |  |  |  |  | argument. | 
| 1625 |  |  |  |  |  |  |  | 
| 1626 |  |  |  |  |  |  | =cut | 
| 1627 |  |  |  |  |  |  |  | 
| 1628 |  |  |  |  |  |  | sub Gtk3::TextBuffer::insert_with_tags { | 
| 1629 |  |  |  |  |  |  | my ($buffer, $iter, $text, @tags) = @_; | 
| 1630 |  |  |  |  |  |  | my $start_offset = $iter->get_offset; | 
| 1631 |  |  |  |  |  |  | $buffer->insert ($iter, $text); | 
| 1632 |  |  |  |  |  |  | my $start = $buffer->get_iter_at_offset ($start_offset); | 
| 1633 |  |  |  |  |  |  | foreach my $tag (@tags) { | 
| 1634 |  |  |  |  |  |  | $buffer->apply_tag ($tag, $start, $iter); | 
| 1635 |  |  |  |  |  |  | } | 
| 1636 |  |  |  |  |  |  | } | 
| 1637 |  |  |  |  |  |  |  | 
| 1638 |  |  |  |  |  |  | sub Gtk3::TextBuffer::insert_with_tags_by_name { | 
| 1639 |  |  |  |  |  |  | my ($buffer, $iter, $text, @tag_names) = @_; | 
| 1640 |  |  |  |  |  |  | my $start_offset = $iter->get_offset; | 
| 1641 |  |  |  |  |  |  | $buffer->insert ($iter, $text); | 
| 1642 |  |  |  |  |  |  | my $tag_table = $buffer->get_tag_table; | 
| 1643 |  |  |  |  |  |  | my $start = $buffer->get_iter_at_offset ($start_offset); | 
| 1644 |  |  |  |  |  |  | foreach my $tag_name (@tag_names) { | 
| 1645 |  |  |  |  |  |  | my $tag = $tag_table->lookup ($tag_name); | 
| 1646 |  |  |  |  |  |  | if (!$tag) { | 
| 1647 |  |  |  |  |  |  | warn "no tag with name $tag_name"; | 
| 1648 |  |  |  |  |  |  | } else { | 
| 1649 |  |  |  |  |  |  | $buffer->apply_tag ($tag, $start, $iter); | 
| 1650 |  |  |  |  |  |  | } | 
| 1651 |  |  |  |  |  |  | } | 
| 1652 |  |  |  |  |  |  | } | 
| 1653 |  |  |  |  |  |  |  | 
| 1654 |  |  |  |  |  |  | sub Gtk3::TextBuffer::set_text { | 
| 1655 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 1656 |  |  |  |  |  |  | $_GTK_BASENAME, 'TextBuffer', 'set_text', | 
| 1657 |  |  |  |  |  |  | @_ == 3 ? @_ : (@_[0,1], -1)); # wants length in bytes | 
| 1658 |  |  |  |  |  |  | } | 
| 1659 |  |  |  |  |  |  |  | 
| 1660 |  |  |  |  |  |  | =item * A Perl reimplementation of C is provided. | 
| 1661 |  |  |  |  |  |  |  | 
| 1662 |  |  |  |  |  |  | =cut | 
| 1663 |  |  |  |  |  |  |  | 
| 1664 |  |  |  |  |  |  | sub Gtk3::TreeModel::get { | 
| 1665 |  |  |  |  |  |  | my ($model, $iter, @columns) = @_; | 
| 1666 |  |  |  |  |  |  | if (!@columns) { | 
| 1667 |  |  |  |  |  |  | @columns = (0..($model->get_n_columns-1)); | 
| 1668 |  |  |  |  |  |  | } | 
| 1669 |  |  |  |  |  |  | my @values = map { $model->get_value ($iter, $_) } @columns; | 
| 1670 |  |  |  |  |  |  | return @values[0..$#values]; | 
| 1671 |  |  |  |  |  |  | } | 
| 1672 |  |  |  |  |  |  |  | 
| 1673 |  |  |  |  |  |  | =item * A redirect is added from C to | 
| 1674 |  |  |  |  |  |  | so that Gtk3::TreeModelFilter objects can be | 
| 1675 |  |  |  |  |  |  | constructed normally. | 
| 1676 |  |  |  |  |  |  |  | 
| 1677 |  |  |  |  |  |  | =cut | 
| 1678 |  |  |  |  |  |  |  | 
| 1679 |  |  |  |  |  |  | # Not needed anymore once | 
| 1680 |  |  |  |  |  |  | # is fixed. | 
| 1681 |  |  |  |  |  |  | sub Gtk3::TreeModelFilter::new { | 
| 1682 |  |  |  |  |  |  | my ($class, $child_model, $root) = @_; | 
| 1683 |  |  |  |  |  |  | Glib::Object::Introspection->invoke ( | 
| 1684 |  |  |  |  |  |  | $_GTK_BASENAME, 'TreeModel', 'filter_new', $child_model, $root); | 
| 1685 |  |  |  |  |  |  | } | 
| 1686 |  |  |  |  |  |  |  | 
| 1687 |  |  |  |  |  |  | =item * Gtk3::TreeModelFilter has a C method that calls | 
| 1688 |  |  |  |  |  |  | C instead of C. | 
| 1689 |  |  |  |  |  |  |  | 
| 1690 |  |  |  |  |  |  | =cut | 
| 1691 |  |  |  |  |  |  |  | 
| 1692 |  |  |  |  |  |  | # Reroute 'get' to Gtk3::TreeModel instead of Glib::Object. | 
| 1693 |  |  |  |  |  |  | sub Gtk3::TreeModelFilter::get { | 
| 1694 |  |  |  |  |  |  | return Gtk3::TreeModel::get (@_); | 
| 1695 |  |  |  |  |  |  | } | 
| 1696 |  |  |  |  |  |  |  | 
| 1697 |  |  |  |  |  |  | =item * A redirect is added from C to | 
| 1698 |  |  |  |  |  |  | so that Gtk3::TreeModelSort objects can | 
| 1699 |  |  |  |  |  |  | be constructed normally. | 
| 1700 |  |  |  |  |  |  |  | 
| 1701 |  |  |  |  |  |  | =cut | 
| 1702 |  |  |  |  |  |  |  | 
| 1703 |  |  |  |  |  |  | # Not needed anymore once | 
| 1704 |  |  |  |  |  |  | # is fixed. | 
| 1705 |  |  |  |  |  |  | sub Gtk3::TreeModelSort::new_with_model { | 
| 1706 |  |  |  |  |  |  | my ($class, $child_model) = @_; | 
| 1707 |  |  |  |  |  |  | Glib::Object::Introspection->invoke ( | 
| 1708 |  |  |  |  |  |  | $_GTK_BASENAME, 'TreeModel', 'sort_new_with_model', $child_model); | 
| 1709 |  |  |  |  |  |  | } | 
| 1710 |  |  |  |  |  |  |  | 
| 1711 |  |  |  |  |  |  | =item * Gtk3::TreeModelSort has a C method that calls | 
| 1712 |  |  |  |  |  |  | C instead of C. | 
| 1713 |  |  |  |  |  |  |  | 
| 1714 |  |  |  |  |  |  | =cut | 
| 1715 |  |  |  |  |  |  |  | 
| 1716 |  |  |  |  |  |  | # Reroute 'get' to Gtk3::TreeModel instead of Glib::Object. | 
| 1717 |  |  |  |  |  |  | sub Gtk3::TreeModelSort::get { | 
| 1718 |  |  |  |  |  |  | return Gtk3::TreeModel::get (@_); | 
| 1719 |  |  |  |  |  |  | } | 
| 1720 |  |  |  |  |  |  |  | 
| 1721 |  |  |  |  |  |  | =item * C redirects to C if an additional | 
| 1722 |  |  |  |  |  |  | argument is given. | 
| 1723 |  |  |  |  |  |  |  | 
| 1724 |  |  |  |  |  |  | =cut | 
| 1725 |  |  |  |  |  |  |  | 
| 1726 |  |  |  |  |  |  | sub Gtk3::TreePath::new { | 
| 1727 |  |  |  |  |  |  | my ($class, @args) = @_; | 
| 1728 |  |  |  |  |  |  | my $method = (@args == 1) ? 'new_from_string' : 'new'; | 
| 1729 |  |  |  |  |  |  | Glib::Object::Introspection->invoke ( | 
| 1730 |  |  |  |  |  |  | $_GTK_BASENAME, 'TreePath', $method, @_); | 
| 1731 |  |  |  |  |  |  | } | 
| 1732 |  |  |  |  |  |  |  | 
| 1733 |  |  |  |  |  |  | =item * A Perl reimplementation of C is | 
| 1734 |  |  |  |  |  |  | provided. | 
| 1735 |  |  |  |  |  |  |  | 
| 1736 |  |  |  |  |  |  | =cut | 
| 1737 |  |  |  |  |  |  |  | 
| 1738 |  |  |  |  |  |  | sub Gtk3::TreePath::new_from_indices { | 
| 1739 |  |  |  |  |  |  | my ($class, @indices) = @_; | 
| 1740 |  |  |  |  |  |  | my $path = Gtk3::TreePath->new; | 
| 1741 |  |  |  |  |  |  | foreach (@indices) { | 
| 1742 |  |  |  |  |  |  | $path->append_index ($_); | 
| 1743 |  |  |  |  |  |  | } | 
| 1744 |  |  |  |  |  |  | return $path; | 
| 1745 |  |  |  |  |  |  | } | 
| 1746 |  |  |  |  |  |  |  | 
| 1747 |  |  |  |  |  |  | =item * C also accepts a list of type names. | 
| 1748 |  |  |  |  |  |  |  | 
| 1749 |  |  |  |  |  |  | =cut | 
| 1750 |  |  |  |  |  |  |  | 
| 1751 |  |  |  |  |  |  | sub Gtk3::TreeStore::new { | 
| 1752 |  |  |  |  |  |  | return _common_tree_model_new ('TreeStore', @_); | 
| 1753 |  |  |  |  |  |  | } | 
| 1754 |  |  |  |  |  |  |  | 
| 1755 |  |  |  |  |  |  | =item * Gtk3::TreeStore has a C method that calls C | 
| 1756 |  |  |  |  |  |  | instead of C. | 
| 1757 |  |  |  |  |  |  |  | 
| 1758 |  |  |  |  |  |  | =cut | 
| 1759 |  |  |  |  |  |  |  | 
| 1760 |  |  |  |  |  |  | # Reroute 'get' to Gtk3::TreeModel instead of Glib::Object. | 
| 1761 |  |  |  |  |  |  | sub Gtk3::TreeStore::get { | 
| 1762 |  |  |  |  |  |  | return Gtk3::TreeModel::get (@_); | 
| 1763 |  |  |  |  |  |  | } | 
| 1764 |  |  |  |  |  |  |  | 
| 1765 |  |  |  |  |  |  | =item * C also accepts a list of C<< | 
| 1766 |  |  |  |  |  |  | column => value >> pairs. | 
| 1767 |  |  |  |  |  |  |  | 
| 1768 |  |  |  |  |  |  | =cut | 
| 1769 |  |  |  |  |  |  |  | 
| 1770 |  |  |  |  |  |  | sub Gtk3::TreeStore::insert_with_values { | 
| 1771 |  |  |  |  |  |  | my ($model, $parent, $position, @columns_and_values) = @_; | 
| 1772 |  |  |  |  |  |  | my ($columns, $values) = _unpack_keys_and_values (\@columns_and_values); | 
| 1773 |  |  |  |  |  |  | if (not defined $columns) { | 
| 1774 |  |  |  |  |  |  | croak ("Usage: Gtk3::TreeStore::insert_with_values (\$model, \$parent, \$position, \\\@columns, \\\@values)\n", | 
| 1775 |  |  |  |  |  |  | " -or-: Gtk3::TreeStore::insert_with_values (\$model, \$parent, \$position, \$column1 => \$value1, ...)"); | 
| 1776 |  |  |  |  |  |  | } | 
| 1777 |  |  |  |  |  |  | my @wrapped_values = (); | 
| 1778 |  |  |  |  |  |  | foreach my $i (0..$#{$columns}) { | 
| 1779 |  |  |  |  |  |  | my $column_type = $model->get_column_type ($columns->[$i]); | 
| 1780 |  |  |  |  |  |  | push @wrapped_values, | 
| 1781 |  |  |  |  |  |  | Glib::Object::Introspection::GValueWrapper->new ( | 
| 1782 |  |  |  |  |  |  | $column_type, $values->[$i]); | 
| 1783 |  |  |  |  |  |  | } | 
| 1784 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 1785 |  |  |  |  |  |  | $_GTK_BASENAME, 'TreeStore', 'insert_with_values', | 
| 1786 |  |  |  |  |  |  | $model, $parent, $position, $columns, \@wrapped_values); | 
| 1787 |  |  |  |  |  |  | } | 
| 1788 |  |  |  |  |  |  |  | 
| 1789 |  |  |  |  |  |  | =item * C also accepts a list of C<< column => value >> | 
| 1790 |  |  |  |  |  |  | pairs. | 
| 1791 |  |  |  |  |  |  |  | 
| 1792 |  |  |  |  |  |  | =cut | 
| 1793 |  |  |  |  |  |  |  | 
| 1794 |  |  |  |  |  |  | sub Gtk3::TreeStore::set { | 
| 1795 |  |  |  |  |  |  | return _common_tree_model_set ('TreeStore', @_); | 
| 1796 |  |  |  |  |  |  | } | 
| 1797 |  |  |  |  |  |  |  | 
| 1798 |  |  |  |  |  |  | =item * C redirects to C if an additional | 
| 1799 |  |  |  |  |  |  | argument is given. | 
| 1800 |  |  |  |  |  |  |  | 
| 1801 |  |  |  |  |  |  | =cut | 
| 1802 |  |  |  |  |  |  |  | 
| 1803 |  |  |  |  |  |  | sub Gtk3::TreeView::new { | 
| 1804 |  |  |  |  |  |  | my ($class, @args) = @_; | 
| 1805 |  |  |  |  |  |  | my $method = (@args == 1) ? 'new_with_model' : 'new'; | 
| 1806 |  |  |  |  |  |  | Glib::Object::Introspection->invoke ( | 
| 1807 |  |  |  |  |  |  | $_GTK_BASENAME, 'TreeView', $method, @_); | 
| 1808 |  |  |  |  |  |  | } | 
| 1809 |  |  |  |  |  |  |  | 
| 1810 |  |  |  |  |  |  | =item * A Perl reimplementation of | 
| 1811 |  |  |  |  |  |  | C is provided. | 
| 1812 |  |  |  |  |  |  |  | 
| 1813 |  |  |  |  |  |  | =cut | 
| 1814 |  |  |  |  |  |  |  | 
| 1815 |  |  |  |  |  |  | sub Gtk3::TreeView::insert_column_with_attributes { | 
| 1816 |  |  |  |  |  |  | my ($tree_view, $position, $title, $cell, @rest) = @_; | 
| 1817 |  |  |  |  |  |  | if (@rest % 2) { | 
| 1818 |  |  |  |  |  |  | croak ('Usage: $tree_view->insert_column_with_attributes (position, title, cell_renderer, attr1 => col1, ...)'); | 
| 1819 |  |  |  |  |  |  | } | 
| 1820 |  |  |  |  |  |  | my $column = Gtk3::TreeViewColumn->new; | 
| 1821 |  |  |  |  |  |  | my $n = $tree_view->insert_column ($column, $position); | 
| 1822 |  |  |  |  |  |  | $column->set_title ($title); | 
| 1823 |  |  |  |  |  |  | $column->pack_start ($cell, Glib::TRUE); | 
| 1824 |  |  |  |  |  |  | for (my $i = 0; $i < @rest; $i += 2) { | 
| 1825 |  |  |  |  |  |  | $column->add_attribute ($cell, $rest[$i], $rest[$i+1]); | 
| 1826 |  |  |  |  |  |  | } | 
| 1827 |  |  |  |  |  |  | return $n; | 
| 1828 |  |  |  |  |  |  | } | 
| 1829 |  |  |  |  |  |  |  | 
| 1830 |  |  |  |  |  |  | =item * A Perl reimplementation of C | 
| 1831 |  |  |  |  |  |  | is provided. | 
| 1832 |  |  |  |  |  |  |  | 
| 1833 |  |  |  |  |  |  | =cut | 
| 1834 |  |  |  |  |  |  |  | 
| 1835 |  |  |  |  |  |  | sub Gtk3::TreeViewColumn::new_with_attributes { | 
| 1836 |  |  |  |  |  |  | my ($class, $title, $cell, @rest) = @_; | 
| 1837 |  |  |  |  |  |  | if (@rest % 2) { | 
| 1838 |  |  |  |  |  |  | croak ('Usage: Gtk3::TreeViewColumn->new_with_attributes (title, cell_renderer, attr1 => col1, ...)'); | 
| 1839 |  |  |  |  |  |  | } | 
| 1840 |  |  |  |  |  |  | my $object = $class->new; | 
| 1841 |  |  |  |  |  |  | $object->set_title ($title); | 
| 1842 |  |  |  |  |  |  | $object->pack_start ($cell, Glib::TRUE); | 
| 1843 |  |  |  |  |  |  | for (my $i = 0; $i < @rest; $i += 2) { | 
| 1844 |  |  |  |  |  |  | $object->add_attribute ($cell, $rest[$i], $rest[$i+1]); | 
| 1845 |  |  |  |  |  |  | } | 
| 1846 |  |  |  |  |  |  | return $object; | 
| 1847 |  |  |  |  |  |  | } | 
| 1848 |  |  |  |  |  |  |  | 
| 1849 |  |  |  |  |  |  | =item * Perl reimplementations of C and | 
| 1850 |  |  |  |  |  |  | C are provided. | 
| 1851 |  |  |  |  |  |  |  | 
| 1852 |  |  |  |  |  |  | =cut | 
| 1853 |  |  |  |  |  |  |  | 
| 1854 |  |  |  |  |  |  | # Gtk3::TreeViewColumn::set_attributes and Gtk3::CellLayout::set_attributes | 
| 1855 |  |  |  |  |  |  | { | 
| 1856 |  |  |  |  |  |  | no strict 'refs'; | 
| 1857 |  |  |  |  |  |  | foreach my $package (qw/TreeViewColumn CellLayout/) { | 
| 1858 |  |  |  |  |  |  | *{'Gtk3::' . $package . '::set_attributes'} = sub { | 
| 1859 |  |  |  |  |  |  | my ($object, $cell, @rest) = @_; | 
| 1860 |  |  |  |  |  |  | if (@rest % 2) { | 
| 1861 |  |  |  |  |  |  | croak ('Usage: $object->set_attributes (cell_renderer, attr1 => col1, ...)'); | 
| 1862 |  |  |  |  |  |  | } | 
| 1863 |  |  |  |  |  |  | $object->clear_attributes ($cell); | 
| 1864 |  |  |  |  |  |  | for (my $i = 0; $i < @rest; $i += 2) { | 
| 1865 |  |  |  |  |  |  | $object->add_attribute ($cell, $rest[$i], $rest[$i+1]); | 
| 1866 |  |  |  |  |  |  | } | 
| 1867 |  |  |  |  |  |  | } | 
| 1868 |  |  |  |  |  |  | } | 
| 1869 |  |  |  |  |  |  | } | 
| 1870 |  |  |  |  |  |  |  | 
| 1871 |  |  |  |  |  |  | =item * C takes no C argument. | 
| 1872 |  |  |  |  |  |  |  | 
| 1873 |  |  |  |  |  |  | =cut | 
| 1874 |  |  |  |  |  |  |  | 
| 1875 |  |  |  |  |  |  | sub Gtk3::UIManager::add_ui_from_string { | 
| 1876 |  |  |  |  |  |  | my ($manager, $string) = @_; | 
| 1877 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 1878 |  |  |  |  |  |  | $_GTK_BASENAME, 'UIManager', 'add_ui_from_string', | 
| 1879 |  |  |  |  |  |  | $manager, $string, -1); # wants length in bytes | 
| 1880 |  |  |  |  |  |  | } | 
| 1881 |  |  |  |  |  |  |  | 
| 1882 |  |  |  |  |  |  | =item * C uses the defaults homogeneous = FALSE and spacing = | 
| 1883 |  |  |  |  |  |  | 5. | 
| 1884 |  |  |  |  |  |  |  | 
| 1885 |  |  |  |  |  |  | =cut | 
| 1886 |  |  |  |  |  |  |  | 
| 1887 |  |  |  |  |  |  | sub Gtk3::VBox::new { | 
| 1888 |  |  |  |  |  |  | my ($class, $homogeneous, $spacing) = @_; | 
| 1889 |  |  |  |  |  |  | $homogeneous = 0 unless defined $homogeneous; | 
| 1890 |  |  |  |  |  |  | $spacing = 5 unless defined $spacing; | 
| 1891 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 1892 |  |  |  |  |  |  | $_GTK_BASENAME, 'VBox', 'new', $class, $homogeneous, $spacing); | 
| 1893 |  |  |  |  |  |  | } | 
| 1894 |  |  |  |  |  |  |  | 
| 1895 |  |  |  |  |  |  | =item * C and C also accept | 
| 1896 |  |  |  |  |  |  | strings, array references and C objects for the C | 
| 1897 |  |  |  |  |  |  | parameter. | 
| 1898 |  |  |  |  |  |  |  | 
| 1899 |  |  |  |  |  |  | =cut | 
| 1900 |  |  |  |  |  |  |  | 
| 1901 |  |  |  |  |  |  | sub Gtk3::Widget::add_events { | 
| 1902 |  |  |  |  |  |  | my ($widget, $events) = @_; | 
| 1903 |  |  |  |  |  |  | eval { | 
| 1904 |  |  |  |  |  |  | $events = Glib::Object::Introspection->convert_sv_to_flags ( | 
| 1905 |  |  |  |  |  |  | 'Gtk3::Gdk::EventMask', $events); | 
| 1906 |  |  |  |  |  |  | }; | 
| 1907 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 1908 |  |  |  |  |  |  | $_GTK_BASENAME, 'Widget', 'add_events', $widget, $events); | 
| 1909 |  |  |  |  |  |  | } | 
| 1910 |  |  |  |  |  |  |  | 
| 1911 |  |  |  |  |  |  | sub Gtk3::Widget::set_events { | 
| 1912 |  |  |  |  |  |  | my ($widget, $events) = @_; | 
| 1913 |  |  |  |  |  |  | eval { | 
| 1914 |  |  |  |  |  |  | $events = Glib::Object::Introspection->convert_sv_to_flags ( | 
| 1915 |  |  |  |  |  |  | 'Gtk3::Gdk::EventMask', $events); | 
| 1916 |  |  |  |  |  |  | }; | 
| 1917 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 1918 |  |  |  |  |  |  | $_GTK_BASENAME, 'Widget', 'set_events', $widget, $events); | 
| 1919 |  |  |  |  |  |  | } | 
| 1920 |  |  |  |  |  |  |  | 
| 1921 |  |  |  |  |  |  | =item * C returns a C object | 
| 1922 |  |  |  |  |  |  | that can also be compared to numeric values with C<< == >> and C<< >= >>. | 
| 1923 |  |  |  |  |  |  |  | 
| 1924 |  |  |  |  |  |  | =cut | 
| 1925 |  |  |  |  |  |  |  | 
| 1926 |  |  |  |  |  |  | sub Gtk3::Widget::get_events { | 
| 1927 |  |  |  |  |  |  | my ($widget) = @_; | 
| 1928 |  |  |  |  |  |  | my $events = Glib::Object::Introspection->invoke ( | 
| 1929 |  |  |  |  |  |  | $_GTK_BASENAME, 'Widget', 'get_events', $widget); | 
| 1930 |  |  |  |  |  |  | return Glib::Object::Introspection->convert_flags_to_sv ( | 
| 1931 |  |  |  |  |  |  | 'Gtk3::Gdk::EventMask', $events); | 
| 1932 |  |  |  |  |  |  | } | 
| 1933 |  |  |  |  |  |  |  | 
| 1934 |  |  |  |  |  |  | sub Gtk3::Widget::render_icon { | 
| 1935 |  |  |  |  |  |  | my ($widget, $stock_id, $size, $detail) = @_; | 
| 1936 |  |  |  |  |  |  | Glib::Object::Introspection->invoke ( | 
| 1937 |  |  |  |  |  |  | $_GTK_BASENAME, 'Widget', 'render_icon', $widget, $stock_id, | 
| 1938 |  |  |  |  |  |  | $_GTK_ICON_SIZE_NICK_TO_ID->($size), $detail); | 
| 1939 |  |  |  |  |  |  | } | 
| 1940 |  |  |  |  |  |  |  | 
| 1941 |  |  |  |  |  |  | =item * C and | 
| 1942 |  |  |  |  |  |  | C are forwarded to the corresponding | 
| 1943 |  |  |  |  |  |  | functions in C. | 
| 1944 |  |  |  |  |  |  |  | 
| 1945 |  |  |  |  |  |  | =cut | 
| 1946 |  |  |  |  |  |  |  | 
| 1947 |  |  |  |  |  |  | sub Gtk3::Widget::find_style_property { | 
| 1948 |  |  |  |  |  |  | return Gtk3::WidgetClass::find_style_property (@_); | 
| 1949 |  |  |  |  |  |  | } | 
| 1950 |  |  |  |  |  |  |  | 
| 1951 |  |  |  |  |  |  | sub Gtk3::Widget::list_style_properties { | 
| 1952 |  |  |  |  |  |  | my $ref = Gtk3::WidgetClass::list_style_properties (@_); | 
| 1953 |  |  |  |  |  |  | return if not defined $ref; | 
| 1954 |  |  |  |  |  |  | return wantarray ? @$ref : $ref->[$#$ref]; | 
| 1955 |  |  |  |  |  |  | } | 
| 1956 |  |  |  |  |  |  |  | 
| 1957 |  |  |  |  |  |  | =item * A Perl reimplementation of C is provided. | 
| 1958 |  |  |  |  |  |  |  | 
| 1959 |  |  |  |  |  |  | =cut | 
| 1960 |  |  |  |  |  |  |  | 
| 1961 |  |  |  |  |  |  | sub Gtk3::Widget::style_get { | 
| 1962 |  |  |  |  |  |  | my ($widget, @rest) = @_; | 
| 1963 |  |  |  |  |  |  | my $properties = _rest_to_ref (\@rest); | 
| 1964 |  |  |  |  |  |  | my @values; | 
| 1965 |  |  |  |  |  |  | foreach my $property (@$properties) { | 
| 1966 |  |  |  |  |  |  | my $pspec = Gtk3::WidgetClass::find_style_property ($widget, $property); | 
| 1967 |  |  |  |  |  |  | croak "Cannot find type information for property '$property' on $widget" | 
| 1968 |  |  |  |  |  |  | unless defined $pspec; | 
| 1969 |  |  |  |  |  |  | my $value_wrapper = Glib::Object::Introspection::GValueWrapper->new ( | 
| 1970 |  |  |  |  |  |  | $pspec->get_value_type, undef); | 
| 1971 |  |  |  |  |  |  | $widget->style_get_property ($property, $value_wrapper); | 
| 1972 |  |  |  |  |  |  | push @values, $value_wrapper->get_value; | 
| 1973 |  |  |  |  |  |  | } | 
| 1974 |  |  |  |  |  |  | return @values[0..$#values]; | 
| 1975 |  |  |  |  |  |  | } | 
| 1976 |  |  |  |  |  |  |  | 
| 1977 |  |  |  |  |  |  | =item * C uses the default type = 'toplevel'. | 
| 1978 |  |  |  |  |  |  |  | 
| 1979 |  |  |  |  |  |  | =cut | 
| 1980 |  |  |  |  |  |  |  | 
| 1981 |  |  |  |  |  |  | sub Gtk3::Window::new { | 
| 1982 |  |  |  |  |  |  | my ($class, $type) = @_; | 
| 1983 |  |  |  |  |  |  | $type = 'toplevel' unless defined $type; | 
| 1984 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 1985 |  |  |  |  |  |  | $_GTK_BASENAME, 'Window', 'new', $class, $type); | 
| 1986 |  |  |  |  |  |  | } | 
| 1987 |  |  |  |  |  |  |  | 
| 1988 |  |  |  |  |  |  | # --- Gdk --- | 
| 1989 |  |  |  |  |  |  |  | 
| 1990 |  |  |  |  |  |  | =item * A constructor C is provided that can be called as | 
| 1991 |  |  |  |  |  |  | C<< Gtk3::Gdk::RGBA->new (r, g, b, a) >>. | 
| 1992 |  |  |  |  |  |  |  | 
| 1993 |  |  |  |  |  |  | =cut | 
| 1994 |  |  |  |  |  |  |  | 
| 1995 |  |  |  |  |  |  | sub Gtk3::Gdk::RGBA::new { | 
| 1996 |  |  |  |  |  |  | my ($class, @rest) = @_; | 
| 1997 |  |  |  |  |  |  | # Handle Gtk3::Gdk::RGBA->new (r, g, b, a) specially. | 
| 1998 |  |  |  |  |  |  | if (4 == @rest) { | 
| 1999 |  |  |  |  |  |  | my %data; | 
| 2000 |  |  |  |  |  |  | @data{qw/red green blue alpha/} = @rest; | 
| 2001 |  |  |  |  |  |  | return Glib::Boxed::new ($class, \%data); | 
| 2002 |  |  |  |  |  |  | } | 
| 2003 |  |  |  |  |  |  | # Fall back to Glib::Boxed::new. | 
| 2004 |  |  |  |  |  |  | return Glib::Boxed::new ($class, @rest); | 
| 2005 |  |  |  |  |  |  | } | 
| 2006 |  |  |  |  |  |  |  | 
| 2007 |  |  |  |  |  |  | =item * C can be called as a function returning a new | 
| 2008 |  |  |  |  |  |  | instance (C<< $rgba = Gtk3::Gdk::RGBA::parse ($spec) >>) or as a method (C<< | 
| 2009 |  |  |  |  |  |  | $rgba->parse ($spec) >>). | 
| 2010 |  |  |  |  |  |  |  | 
| 2011 |  |  |  |  |  |  | =cut | 
| 2012 |  |  |  |  |  |  |  | 
| 2013 |  |  |  |  |  |  | sub Gtk3::Gdk::RGBA::parse { | 
| 2014 |  |  |  |  |  |  | my $have_instance; | 
| 2015 |  |  |  |  |  |  | { | 
| 2016 |  |  |  |  |  |  | local $@; | 
| 2017 |  |  |  |  |  |  | $have_instance = eval { $_[0]->isa ('Gtk3::Gdk::RGBA') }; | 
| 2018 |  |  |  |  |  |  | } | 
| 2019 |  |  |  |  |  |  | # This needs to be switched around if/when | 
| 2020 |  |  |  |  |  |  | #  is fixed. | 
| 2021 |  |  |  |  |  |  | if ($have_instance) { | 
| 2022 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 2023 |  |  |  |  |  |  | $_GDK_BASENAME, 'RGBA', 'parse', @_); | 
| 2024 |  |  |  |  |  |  | } else { | 
| 2025 |  |  |  |  |  |  | my $instance = Gtk3::Gdk::RGBA->new; | 
| 2026 |  |  |  |  |  |  | my $success = Glib::Object::Introspection->invoke ( | 
| 2027 |  |  |  |  |  |  | $_GDK_BASENAME, 'RGBA', 'parse', | 
| 2028 |  |  |  |  |  |  | $instance, @_); | 
| 2029 |  |  |  |  |  |  | return $success ? $instance : undef; | 
| 2030 |  |  |  |  |  |  | } | 
| 2031 |  |  |  |  |  |  | } | 
| 2032 |  |  |  |  |  |  |  | 
| 2033 |  |  |  |  |  |  | =item * C optionally computes the C | 
| 2034 |  |  |  |  |  |  | automatically from the given C. | 
| 2035 |  |  |  |  |  |  |  | 
| 2036 |  |  |  |  |  |  | =cut | 
| 2037 |  |  |  |  |  |  |  | 
| 2038 |  |  |  |  |  |  | sub Gtk3::Gdk::Window::new { | 
| 2039 |  |  |  |  |  |  | my ($class, $parent, $attr, $attr_mask) = @_; | 
| 2040 |  |  |  |  |  |  | if (not defined $attr_mask) { | 
| 2041 |  |  |  |  |  |  | $attr_mask = Gtk3::Gdk::WindowAttributesType->new ([]); | 
| 2042 |  |  |  |  |  |  | if (exists $attr->{title})                                         { $attr_mask |= 'GDK_WA_TITLE' } | 
| 2043 |  |  |  |  |  |  | if (exists $attr->{x})                                             { $attr_mask |= 'GDK_WA_X' } | 
| 2044 |  |  |  |  |  |  | if (exists $attr->{y})                                             { $attr_mask |= 'GDK_WA_Y' } | 
| 2045 |  |  |  |  |  |  | if (exists $attr->{cursor})                                        { $attr_mask |= 'GDK_WA_CURSOR' } | 
| 2046 |  |  |  |  |  |  | if (exists $attr->{visual})                                        { $attr_mask |= 'GDK_WA_VISUAL' } | 
| 2047 |  |  |  |  |  |  | if (exists $attr->{wmclass_name} && exists $attr->{wmclass_class}) { $attr_mask |= 'GDK_WA_WMCLASS' } | 
| 2048 |  |  |  |  |  |  | if (exists $attr->{override_redirect})                             { $attr_mask |= 'GDK_WA_NOREDIR' } | 
| 2049 |  |  |  |  |  |  | if (exists $attr->{type_hint})                                     { $attr_mask |= 'GDK_WA_TYPE_HINT' } | 
| 2050 |  |  |  |  |  |  | if (!Gtk3::CHECK_VERSION (3, 4, 4)) { | 
| 2051 |  |  |  |  |  |  | # Before 3.4.4 or 3.5.6, the attribute mask parameter lacked proper | 
| 2052 |  |  |  |  |  |  | # annotations, hence we numerify it here.  FIXME: This breaks | 
| 2053 |  |  |  |  |  |  | # encapsulation. | 
| 2054 |  |  |  |  |  |  | $attr_mask = $$attr_mask; | 
| 2055 |  |  |  |  |  |  | } | 
| 2056 |  |  |  |  |  |  | } | 
| 2057 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 2058 |  |  |  |  |  |  | $_GDK_BASENAME, 'Window', 'new', | 
| 2059 |  |  |  |  |  |  | $class, $parent, $attr, $attr_mask); | 
| 2060 |  |  |  |  |  |  | } | 
| 2061 |  |  |  |  |  |  |  | 
| 2062 |  |  |  |  |  |  | # --- GdkPixbuf --- | 
| 2063 |  |  |  |  |  |  |  | 
| 2064 |  |  |  |  |  |  | sub Gtk3::Gdk::Pixbuf::CHECK_VERSION { | 
| 2065 |  |  |  |  |  |  | my ($major, $minor, $micro) = @_; | 
| 2066 |  |  |  |  |  |  | return | 
| 2067 |  |  |  |  |  |  | (Gtk3::Gdk::PIXBUF_MAJOR () > $major) || | 
| 2068 |  |  |  |  |  |  | (Gtk3::Gdk::PIXBUF_MAJOR () == $major && Gtk3::Gdk::PIXBUF_MINOR () > $minor) || | 
| 2069 |  |  |  |  |  |  | (Gtk3::Gdk::PIXBUF_MAJOR () == $major && Gtk3::Gdk::PIXBUF_MINOR () == $minor && Gtk3::Gdk::PIXBUF_MICRO () >= $micro); | 
| 2070 |  |  |  |  |  |  | } | 
| 2071 |  |  |  |  |  |  |  | 
| 2072 |  |  |  |  |  |  | =item * C returns a byte string. | 
| 2073 |  |  |  |  |  |  |  | 
| 2074 |  |  |  |  |  |  | =cut | 
| 2075 |  |  |  |  |  |  |  | 
| 2076 |  |  |  |  |  |  | sub Gtk3::Gdk::Pixbuf::get_pixels { | 
| 2077 |  |  |  |  |  |  | my $pixel_aref = Glib::Object::Introspection->invoke ( | 
| 2078 |  |  |  |  |  |  | $_GDK_PIXBUF_BASENAME, 'Pixbuf', 'get_pixels', @_); | 
| 2079 |  |  |  |  |  |  | return pack 'C*', @{$pixel_aref}; | 
| 2080 |  |  |  |  |  |  | } | 
| 2081 |  |  |  |  |  |  |  | 
| 2082 |  |  |  |  |  |  | =item * C is reimplemented in terms of | 
| 2083 |  |  |  |  |  |  | C for correct memory management.  No C and | 
| 2084 |  |  |  |  |  |  | C arguments are needed. | 
| 2085 |  |  |  |  |  |  |  | 
| 2086 |  |  |  |  |  |  | =cut | 
| 2087 |  |  |  |  |  |  |  | 
| 2088 |  |  |  |  |  |  | sub Gtk3::Gdk::Pixbuf::new_from_data { | 
| 2089 |  |  |  |  |  |  | my ($class, $data, $colorspace, $has_alpha, $bits_per_sample, $width, $height, $rowstride) = @_; | 
| 2090 |  |  |  |  |  |  | die 'Only RGB is currently supported' unless $colorspace eq 'rgb'; | 
| 2091 |  |  |  |  |  |  | die 'Only 8 bits per pixel are currently supported' unless $bits_per_sample == 8; | 
| 2092 |  |  |  |  |  |  | my $length = Gtk3::Gdk::PIXDATA_HEADER_LENGTH () + | 
| 2093 |  |  |  |  |  |  | $rowstride*$height; | 
| 2094 |  |  |  |  |  |  | my $type = Gtk3::Gdk::PixdataType->new ([qw/sample_width_8 encoding_raw/]); | 
| 2095 |  |  |  |  |  |  | $type |= $has_alpha ? 'color_type_rgba' : 'color_type_rgb'; | 
| 2096 |  |  |  |  |  |  | my @header_numbers = (0x47646b50, | 
| 2097 |  |  |  |  |  |  | $length, | 
| 2098 |  |  |  |  |  |  | $$type, # FIXME: This kind of breaks encapsulation. | 
| 2099 |  |  |  |  |  |  | $rowstride, | 
| 2100 |  |  |  |  |  |  | $width, | 
| 2101 |  |  |  |  |  |  | $height); | 
| 2102 |  |  |  |  |  |  | # Convert to 8 bit unsigned chars, padding to 32 bit little-endian first. | 
| 2103 |  |  |  |  |  |  | my @header = map { unpack ("C*", pack ("N", $_)) } @header_numbers; | 
| 2104 |  |  |  |  |  |  | my $inline_data = _unpack_unless_array_ref ($data); | 
| 2105 |  |  |  |  |  |  | unshift @$inline_data, @header; | 
| 2106 |  |  |  |  |  |  | return Gtk3::Gdk::Pixbuf->new_from_inline ($inline_data); | 
| 2107 |  |  |  |  |  |  | } | 
| 2108 |  |  |  |  |  |  |  | 
| 2109 |  |  |  |  |  |  | =item * C does not take a C | 
| 2110 |  |  |  |  |  |  | argument.  It is always set to TRUE for correct memory management. | 
| 2111 |  |  |  |  |  |  |  | 
| 2112 |  |  |  |  |  |  | =cut | 
| 2113 |  |  |  |  |  |  |  | 
| 2114 |  |  |  |  |  |  | sub Gtk3::Gdk::Pixbuf::new_from_inline { | 
| 2115 |  |  |  |  |  |  | my ($class, $data) = @_; | 
| 2116 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 2117 |  |  |  |  |  |  | $_GDK_PIXBUF_BASENAME, 'Pixbuf', 'new_from_inline', | 
| 2118 |  |  |  |  |  |  | $class, _unpack_unless_array_ref ($data), Glib::TRUE); # always copy pixels | 
| 2119 |  |  |  |  |  |  | } | 
| 2120 |  |  |  |  |  |  |  | 
| 2121 |  |  |  |  |  |  | =item * C also accepts a list of XPM | 
| 2122 |  |  |  |  |  |  | lines. | 
| 2123 |  |  |  |  |  |  |  | 
| 2124 |  |  |  |  |  |  | =cut | 
| 2125 |  |  |  |  |  |  |  | 
| 2126 |  |  |  |  |  |  | sub Gtk3::Gdk::Pixbuf::new_from_xpm_data { | 
| 2127 |  |  |  |  |  |  | my ($class, @rest) = @_; | 
| 2128 |  |  |  |  |  |  | my $data = _rest_to_ref (\@rest); | 
| 2129 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 2130 |  |  |  |  |  |  | $_GDK_PIXBUF_BASENAME, 'Pixbuf', 'new_from_xpm_data', | 
| 2131 |  |  |  |  |  |  | $class, $data); | 
| 2132 |  |  |  |  |  |  | } | 
| 2133 |  |  |  |  |  |  |  | 
| 2134 |  |  |  |  |  |  | # Version check for the new annotations described in | 
| 2135 |  |  |  |  |  |  | # . | 
| 2136 |  |  |  |  |  |  | my $_GET_SAVE_VARIANT = sub { | 
| 2137 |  |  |  |  |  |  | my ($method) = @_; | 
| 2138 |  |  |  |  |  |  | if (Gtk3::Gdk::Pixbuf::CHECK_VERSION (2, 31, 3)) { | 
| 2139 |  |  |  |  |  |  | return $method . 'v'; | 
| 2140 |  |  |  |  |  |  | } elsif (Gtk3::Gdk::Pixbuf::CHECK_VERSION (2, 31, 2)) { | 
| 2141 |  |  |  |  |  |  | return $method; | 
| 2142 |  |  |  |  |  |  | } else { | 
| 2143 |  |  |  |  |  |  | return $method . 'v'; | 
| 2144 |  |  |  |  |  |  | } | 
| 2145 |  |  |  |  |  |  | }; | 
| 2146 |  |  |  |  |  |  |  | 
| 2147 |  |  |  |  |  |  | =item * C, C and C | 
| 2148 |  |  |  |  |  |  | also accept C<< key => value >> pairs and invoke the correct C function as | 
| 2149 |  |  |  |  |  |  | appropriate for the current gdk-pixbuf version. | 
| 2150 |  |  |  |  |  |  |  | 
| 2151 |  |  |  |  |  |  | =cut | 
| 2152 |  |  |  |  |  |  |  | 
| 2153 |  |  |  |  |  |  | sub Gtk3::Gdk::Pixbuf::save { | 
| 2154 |  |  |  |  |  |  | my ($pixbuf, $filename, $type, @rest) = @_; | 
| 2155 |  |  |  |  |  |  | my ($keys, $values) = _unpack_keys_and_values (\@rest); | 
| 2156 |  |  |  |  |  |  | if (not defined $keys) { | 
| 2157 |  |  |  |  |  |  | croak ("Usage: \$pixbuf->save (\$filename, \$type, \\\@keys, \\\@values)\n", | 
| 2158 |  |  |  |  |  |  | " -or-: \$pixbuf->save (\$filename, \$type, \$key1 => \$value1, ...)"); | 
| 2159 |  |  |  |  |  |  | } | 
| 2160 |  |  |  |  |  |  | my $method = $_GET_SAVE_VARIANT->('save'); | 
| 2161 |  |  |  |  |  |  | Glib::Object::Introspection->invoke ( | 
| 2162 |  |  |  |  |  |  | $_GDK_PIXBUF_BASENAME, 'Pixbuf', $method, | 
| 2163 |  |  |  |  |  |  | $pixbuf, $filename, $type, $keys, $values); | 
| 2164 |  |  |  |  |  |  | } | 
| 2165 |  |  |  |  |  |  |  | 
| 2166 |  |  |  |  |  |  | sub Gtk3::Gdk::Pixbuf::save_to_buffer { | 
| 2167 |  |  |  |  |  |  | my ($pixbuf, $type, @rest) = @_; | 
| 2168 |  |  |  |  |  |  | my ($keys, $values) = _unpack_keys_and_values (\@rest); | 
| 2169 |  |  |  |  |  |  | if (not defined $keys) { | 
| 2170 |  |  |  |  |  |  | croak ("Usage: \$pixbuf->save_to_buffer (\$type, \\\@keys, \\\@values)\n", | 
| 2171 |  |  |  |  |  |  | " -or-: \$pixbuf->save_to_buffer (\$type, \$key1 => \$value1, ...)"); | 
| 2172 |  |  |  |  |  |  | } | 
| 2173 |  |  |  |  |  |  | my $method = $_GET_SAVE_VARIANT->('save_to_buffer'); | 
| 2174 |  |  |  |  |  |  | my (undef, $buffer) = | 
| 2175 |  |  |  |  |  |  | Glib::Object::Introspection->invoke ( | 
| 2176 |  |  |  |  |  |  | $_GDK_PIXBUF_BASENAME, 'Pixbuf', $method, | 
| 2177 |  |  |  |  |  |  | $pixbuf, $type, $keys, $values); | 
| 2178 |  |  |  |  |  |  | return $buffer; | 
| 2179 |  |  |  |  |  |  | } | 
| 2180 |  |  |  |  |  |  |  | 
| 2181 |  |  |  |  |  |  | sub Gtk3::Gdk::Pixbuf::save_to_callback { | 
| 2182 |  |  |  |  |  |  | my ($pixbuf, $save_func, $user_data, $type, @rest) = @_; | 
| 2183 |  |  |  |  |  |  | my ($keys, $values) = _unpack_keys_and_values (\@rest); | 
| 2184 |  |  |  |  |  |  | if (not defined $keys) { | 
| 2185 |  |  |  |  |  |  | croak ("Usage: \$pixbuf->save_to_callback (\$save_func, \$user_data, \$type, \\\@keys, \\\@values)\n", | 
| 2186 |  |  |  |  |  |  | " -or-: \$pixbuf->save_to_callback (\$save_func, \$user_data, \$type, \$key1 => \$value1, ...)"); | 
| 2187 |  |  |  |  |  |  | } | 
| 2188 |  |  |  |  |  |  | my $method = $_GET_SAVE_VARIANT->('save_to_callback'); | 
| 2189 |  |  |  |  |  |  | Glib::Object::Introspection->invoke ( | 
| 2190 |  |  |  |  |  |  | $_GDK_PIXBUF_BASENAME, 'Pixbuf', $method, | 
| 2191 |  |  |  |  |  |  | $pixbuf, $save_func, $user_data, $type, $keys, $values); | 
| 2192 |  |  |  |  |  |  | } | 
| 2193 |  |  |  |  |  |  |  | 
| 2194 |  |  |  |  |  |  | # --- Pango --- | 
| 2195 |  |  |  |  |  |  |  | 
| 2196 |  |  |  |  |  |  | =item * The C arguments of C and C | 
| 2197 |  |  |  |  |  |  | are optional. | 
| 2198 |  |  |  |  |  |  |  | 
| 2199 |  |  |  |  |  |  | =cut | 
| 2200 |  |  |  |  |  |  |  | 
| 2201 |  |  |  |  |  |  | sub Pango::Layout::set_text { | 
| 2202 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 2203 |  |  |  |  |  |  | $_PANGO_BASENAME, 'Layout', 'set_text', | 
| 2204 |  |  |  |  |  |  | @_ == 3 ? @_ : (@_[0,1], -1)); # wants length in bytes | 
| 2205 |  |  |  |  |  |  | } | 
| 2206 |  |  |  |  |  |  |  | 
| 2207 |  |  |  |  |  |  | sub Pango::Layout::set_markup { | 
| 2208 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 2209 |  |  |  |  |  |  | $_PANGO_BASENAME, 'Layout', 'set_markup', | 
| 2210 |  |  |  |  |  |  | @_ == 3 ? @_ : (@_[0,1], -1)); # wants length in bytes | 
| 2211 |  |  |  |  |  |  | } | 
| 2212 |  |  |  |  |  |  |  | 
| 2213 |  |  |  |  |  |  | =back | 
| 2214 |  |  |  |  |  |  |  | 
| 2215 |  |  |  |  |  |  | =cut | 
| 2216 |  |  |  |  |  |  |  | 
| 2217 |  |  |  |  |  |  | # - Fixes ------------------------------------------------------------------- # | 
| 2218 |  |  |  |  |  |  |  | 
| 2219 |  |  |  |  |  |  | =head2 Perl compatibility | 
| 2220 |  |  |  |  |  |  |  | 
| 2221 |  |  |  |  |  |  | As of 5.20.0, perl does not automatically re-check the locale environment for | 
| 2222 |  |  |  |  |  |  | changes.  If a function thus changes the locale behind perl's back, problems | 
| 2223 |  |  |  |  |  |  | might arise whenever numbers are formatted, for example when checking versions. | 
| 2224 |  |  |  |  |  |  | To ensure perl's assumption about the locale are up-to-date, the functions | 
| 2225 |  |  |  |  |  |  | C, C, C and C are amended | 
| 2226 |  |  |  |  |  |  | to let perl know of any changes. | 
| 2227 |  |  |  |  |  |  |  | 
| 2228 |  |  |  |  |  |  | =cut | 
| 2229 |  |  |  |  |  |  |  | 
| 2230 |  |  |  |  |  |  | # Compatibility with perl 5.20 and non-dot locales.  Wrap all functions that | 
| 2231 |  |  |  |  |  |  | # might end up calling setlocale() such that POSIX::setlocale() is also called | 
| 2232 |  |  |  |  |  |  | # to ensure perl knows about the current locale.  See the discussion in | 
| 2233 |  |  |  |  |  |  | # , | 
| 2234 |  |  |  |  |  |  | # , | 
| 2235 |  |  |  |  |  |  | # . | 
| 2236 |  |  |  |  |  |  | if ($^V ge v5.20.0) { | 
| 2237 |  |  |  |  |  |  | require POSIX; | 
| 2238 |  |  |  |  |  |  | no strict 'refs'; | 
| 2239 |  |  |  |  |  |  | no warnings 'redefine'; | 
| 2240 |  |  |  |  |  |  |  | 
| 2241 |  |  |  |  |  |  | my $disable_setlocale = 0; | 
| 2242 |  |  |  |  |  |  | *{'Gtk3::disable_setlocale'} = sub { | 
| 2243 |  |  |  |  |  |  | $disable_setlocale = 1; | 
| 2244 |  |  |  |  |  |  | Glib::Object::Introspection->invoke ( | 
| 2245 |  |  |  |  |  |  | $_GTK_BASENAME, undef, 'disable_setlocale', @_); | 
| 2246 |  |  |  |  |  |  | }; | 
| 2247 |  |  |  |  |  |  |  | 
| 2248 |  |  |  |  |  |  | # These two already have overrides. | 
| 2249 |  |  |  |  |  |  | foreach my $function (qw/Gtk3::init Gtk3::init_check/) { | 
| 2250 |  |  |  |  |  |  | my $orig = \&{$function}; | 
| 2251 |  |  |  |  |  |  | *{$function} = sub { | 
| 2252 |  |  |  |  |  |  | if (!$disable_setlocale) { | 
| 2253 |  |  |  |  |  |  | POSIX::setlocale (POSIX::LC_ALL (), ''); | 
| 2254 |  |  |  |  |  |  | } | 
| 2255 |  |  |  |  |  |  | $orig->(@_); | 
| 2256 |  |  |  |  |  |  | }; | 
| 2257 |  |  |  |  |  |  | } | 
| 2258 |  |  |  |  |  |  |  | 
| 2259 |  |  |  |  |  |  | foreach my $function (qw/init_with_args parse_args/) { | 
| 2260 |  |  |  |  |  |  | *{'Gtk3::' . $function} = sub { | 
| 2261 |  |  |  |  |  |  | if (!$disable_setlocale) { | 
| 2262 |  |  |  |  |  |  | POSIX::setlocale (POSIX::LC_ALL (), ''); | 
| 2263 |  |  |  |  |  |  | } | 
| 2264 |  |  |  |  |  |  | Glib::Object::Introspection->invoke ( | 
| 2265 |  |  |  |  |  |  | $_GTK_BASENAME, undef, $function, @_); | 
| 2266 |  |  |  |  |  |  | }; | 
| 2267 |  |  |  |  |  |  | } | 
| 2268 |  |  |  |  |  |  | } | 
| 2269 |  |  |  |  |  |  |  | 
| 2270 |  |  |  |  |  |  | # - Helpers ----------------------------------------------------------------- # | 
| 2271 |  |  |  |  |  |  |  | 
| 2272 |  |  |  |  |  |  | sub _common_tree_model_new { | 
| 2273 |  |  |  |  |  |  | my ($package, $class, @types) = @_; | 
| 2274 |  |  |  |  |  |  | my $real_types; | 
| 2275 |  |  |  |  |  |  | { | 
| 2276 |  |  |  |  |  |  | local $@; | 
| 2277 |  |  |  |  |  |  | $real_types = (@types == 1 && eval { @{$types[0]} }) | 
| 2278 |  |  |  |  |  |  | ? $types[0] | 
| 2279 |  |  |  |  |  |  | : \@types; | 
| 2280 |  |  |  |  |  |  | } | 
| 2281 |  |  |  |  |  |  | return Glib::Object::Introspection->invoke ( | 
| 2282 |  |  |  |  |  |  | $_GTK_BASENAME, $package, 'new', | 
| 2283 |  |  |  |  |  |  | $class, $real_types); | 
| 2284 |  |  |  |  |  |  | } | 
| 2285 |  |  |  |  |  |  |  | 
| 2286 |  |  |  |  |  |  | sub _common_tree_model_set { | 
| 2287 |  |  |  |  |  |  | my ($package, $model, $iter, @columns_and_values) = @_; | 
| 2288 |  |  |  |  |  |  | my ($columns, $values) = _unpack_keys_and_values (\@columns_and_values); | 
| 2289 |  |  |  |  |  |  | if (not defined $columns) { | 
| 2290 |  |  |  |  |  |  | croak ("Usage: Gtk3::${package}::set (\$model, \$iter, \\\@columns, \\\@values)\n", | 
| 2291 |  |  |  |  |  |  | " -or-: Gtk3::${package}::set (\$model, \$iter, \$column1 => \$value1, ...)"); | 
| 2292 |  |  |  |  |  |  | } | 
| 2293 |  |  |  |  |  |  | my @wrapped_values = (); | 
| 2294 |  |  |  |  |  |  | foreach my $i (0..$#{$columns}) { | 
| 2295 |  |  |  |  |  |  | my $column_type = $model->get_column_type ($columns->[$i]); | 
| 2296 |  |  |  |  |  |  | push @wrapped_values, | 
| 2297 |  |  |  |  |  |  | Glib::Object::Introspection::GValueWrapper->new ( | 
| 2298 |  |  |  |  |  |  | $column_type, $values->[$i]); | 
| 2299 |  |  |  |  |  |  | } | 
| 2300 |  |  |  |  |  |  | Glib::Object::Introspection->invoke ( | 
| 2301 |  |  |  |  |  |  | $_GTK_BASENAME, $package, 'set', | 
| 2302 |  |  |  |  |  |  | $model, $iter, $columns, \@wrapped_values); | 
| 2303 |  |  |  |  |  |  | } | 
| 2304 |  |  |  |  |  |  |  | 
| 2305 |  |  |  |  |  |  | sub _unpack_keys_and_values { | 
| 2306 |  |  |  |  |  |  | my ($keys_and_values) = @_; | 
| 2307 |  |  |  |  |  |  | my (@keys, @values); | 
| 2308 |  |  |  |  |  |  | my $have_array_refs; | 
| 2309 |  |  |  |  |  |  | { | 
| 2310 |  |  |  |  |  |  | local $@; | 
| 2311 |  |  |  |  |  |  | $have_array_refs = | 
| 2312 |  |  |  |  |  |  | @$keys_and_values == 2 && eval { @{$keys_and_values->[0]} }; | 
| 2313 |  |  |  |  |  |  | } | 
| 2314 |  |  |  |  |  |  | if ($have_array_refs) { | 
| 2315 |  |  |  |  |  |  | @keys = @{$keys_and_values->[0]}; | 
| 2316 |  |  |  |  |  |  | @values = @{$keys_and_values->[1]}; | 
| 2317 |  |  |  |  |  |  | } elsif (@$keys_and_values % 2 == 0) { | 
| 2318 |  |  |  |  |  |  | # To preserve the order of the key-value pairs, avoid creating an | 
| 2319 |  |  |  |  |  |  | # intermediate hash. | 
| 2320 |  |  |  |  |  |  | my @range = 0 .. (@$keys_and_values/2-1); | 
| 2321 |  |  |  |  |  |  | @keys = @$keys_and_values[map { 2*$_ } @range]; | 
| 2322 |  |  |  |  |  |  | @values = @$keys_and_values[map { 2*$_+1 } @range]; | 
| 2323 |  |  |  |  |  |  | } else { | 
| 2324 |  |  |  |  |  |  | return (); | 
| 2325 |  |  |  |  |  |  | } | 
| 2326 |  |  |  |  |  |  | return (\@keys, \@values); | 
| 2327 |  |  |  |  |  |  | } | 
| 2328 |  |  |  |  |  |  |  | 
| 2329 |  |  |  |  |  |  | sub _unpack_unless_array_ref { | 
| 2330 |  |  |  |  |  |  | my ($data) = @_; | 
| 2331 |  |  |  |  |  |  | local $@; | 
| 2332 |  |  |  |  |  |  | return eval { @{$data} } | 
| 2333 |  |  |  |  |  |  | ? $data | 
| 2334 |  |  |  |  |  |  | : [unpack 'C*', $data]; | 
| 2335 |  |  |  |  |  |  | } | 
| 2336 |  |  |  |  |  |  |  | 
| 2337 |  |  |  |  |  |  | sub _rest_to_ref { | 
| 2338 |  |  |  |  |  |  | my ($rest) = @_; | 
| 2339 |  |  |  |  |  |  | local $@; | 
| 2340 |  |  |  |  |  |  | if (scalar @$rest == 1 && eval { defined $rest->[0]->[0] }) { | 
| 2341 |  |  |  |  |  |  | return $rest->[0]; | 
| 2342 |  |  |  |  |  |  | } else { | 
| 2343 |  |  |  |  |  |  | return $rest; | 
| 2344 |  |  |  |  |  |  | } | 
| 2345 |  |  |  |  |  |  | } | 
| 2346 |  |  |  |  |  |  |  | 
| 2347 |  |  |  |  |  |  | package Gtk3::Gdk::EventMask; | 
| 2348 |  |  |  |  |  |  | $Gtk3::Gdk::EventMask::VERSION = '0.032'; | 
| 2349 |  |  |  |  |  |  | use overload | 
| 2350 |  |  |  |  |  |  | '==' => \&eq, | 
| 2351 |  |  |  |  |  |  | '>=' => \≥ | 
| 2352 |  |  |  |  |  |  | use Scalar::Util qw/looks_like_number/; | 
| 2353 |  |  |  |  |  |  |  | 
| 2354 |  |  |  |  |  |  | my $_convert_one = sub { | 
| 2355 |  |  |  |  |  |  | return Glib::Object::Introspection->convert_flags_to_sv ( | 
| 2356 |  |  |  |  |  |  | 'Gtk3::Gdk::EventMask', $_[0]); | 
| 2357 |  |  |  |  |  |  | }; | 
| 2358 |  |  |  |  |  |  |  | 
| 2359 |  |  |  |  |  |  | my $_convert_two = sub { | 
| 2360 |  |  |  |  |  |  | my ($a, $b) = @_; | 
| 2361 |  |  |  |  |  |  | if (looks_like_number ($a)) { | 
| 2362 |  |  |  |  |  |  | $a = $_convert_one->($a); | 
| 2363 |  |  |  |  |  |  | } | 
| 2364 |  |  |  |  |  |  | if (looks_like_number ($b)) { | 
| 2365 |  |  |  |  |  |  | $b = $_convert_one->($b); | 
| 2366 |  |  |  |  |  |  | } | 
| 2367 |  |  |  |  |  |  | return ($a, $b); | 
| 2368 |  |  |  |  |  |  | }; | 
| 2369 |  |  |  |  |  |  |  | 
| 2370 |  |  |  |  |  |  | sub eq { | 
| 2371 |  |  |  |  |  |  | my ($a, $b, $swap) = @_; | 
| 2372 |  |  |  |  |  |  | ($a, $b) = $_convert_two->($a, $b); | 
| 2373 |  |  |  |  |  |  | return Glib::Flags::eq ($a, $b, $swap); | 
| 2374 |  |  |  |  |  |  | } | 
| 2375 |  |  |  |  |  |  |  | 
| 2376 |  |  |  |  |  |  | sub ge { | 
| 2377 |  |  |  |  |  |  | my ($a, $b, $swap) = @_; | 
| 2378 |  |  |  |  |  |  | ($a, $b) = $_convert_two->($a, $b); | 
| 2379 |  |  |  |  |  |  | return Glib::Flags::ge ($a, $b, $swap); | 
| 2380 |  |  |  |  |  |  | } | 
| 2381 |  |  |  |  |  |  |  | 
| 2382 |  |  |  |  |  |  | package Gtk3; | 
| 2383 |  |  |  |  |  |  |  | 
| 2384 |  |  |  |  |  |  | 1; | 
| 2385 |  |  |  |  |  |  |  | 
| 2386 |  |  |  |  |  |  | __END__ |