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__ |