line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# You may distribute under the terms of either the GNU General Public License |
2
|
|
|
|
|
|
|
# or the Artistic License (the same terms as Perl itself) |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# (C) Paul Evans, 2012-2013 -- leonerd@leonerd.org.uk |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
package Tickit::Widget::MenuBar; |
7
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
1078
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
22
|
|
9
|
1
|
|
|
1
|
|
3
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
20
|
|
10
|
1
|
|
|
1
|
|
2
|
use feature qw( switch ); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
48
|
|
11
|
|
|
|
|
|
|
|
12
|
1
|
|
|
1
|
|
3
|
use base qw( Tickit::Widget::Menu::base ); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
375
|
|
13
|
|
|
|
|
|
|
use Tickit::Style; |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
our $VERSION = '0.11'; |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
use Carp; |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
use Tickit::RenderBuffer qw( LINE_SINGLE ); |
20
|
|
|
|
|
|
|
use List::Util qw( sum max ); |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
# Re-import the constant for compiletime use |
23
|
|
|
|
|
|
|
use constant separator => __PACKAGE__->separator; |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
=head1 NAME |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
C - display a menu horizontally |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
=head1 SYNOPSIS |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
use Tickit; |
32
|
|
|
|
|
|
|
use Tickit::Widget::Menu; |
33
|
|
|
|
|
|
|
use Tickit::Widget::Menu::Item; |
34
|
|
|
|
|
|
|
use Tickit::Widget::MenuBar; |
35
|
|
|
|
|
|
|
use Tickit::Widget::VBox; |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
my $tickit = Tickit->new; |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
my $vbox = Tickit::Widget::VBox->new; |
40
|
|
|
|
|
|
|
$tickit->set_root_widget( $vbox ); |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
$vbox->add( Tickit::Widget::MenuBar->new( |
43
|
|
|
|
|
|
|
items => [ |
44
|
|
|
|
|
|
|
... |
45
|
|
|
|
|
|
|
] |
46
|
|
|
|
|
|
|
); |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
$vbox->add( ... ); |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
$tickit->run; |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
=head1 DESCRIPTION |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
This widget class acts as a container for menu items similar to |
55
|
|
|
|
|
|
|
L but displays them horizonally in a single line. This |
56
|
|
|
|
|
|
|
widget is intended to display long-term, such as in the top line of the root |
57
|
|
|
|
|
|
|
window, rather than being used only transiently as a pop-up menu. |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
This widget should be used similarly to L, except that |
60
|
|
|
|
|
|
|
its name is never useful, and it should be added to a container widget, such |
61
|
|
|
|
|
|
|
as L, for longterm display. It does not have a C |
62
|
|
|
|
|
|
|
or C method. |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
A single separator object can be added as an item, causing all the items after |
65
|
|
|
|
|
|
|
it to be right-justified. |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
=head1 STYLE |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
The default style pen is used as the widget pen. The following style pen |
70
|
|
|
|
|
|
|
prefixes are also used: |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
=over 4 |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
=item highlight => PEN |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
The pen used to highlight the active menu selection |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
=back |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
The following style actions are used: |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=over 4 |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=item highlight_next () |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
=item highlight_prev () |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
Highlight the next or previous item |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
=item highlight_first () |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
Highlight the first menu item |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
=item activate () |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
Activate the highlighted item |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
=item dismiss () |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
Dismiss the menu |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
=back |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
=cut |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
style_definition base => |
107
|
|
|
|
|
|
|
rv => 1, |
108
|
|
|
|
|
|
|
highlight_rv => 0, |
109
|
|
|
|
|
|
|
highlight_bg => "green", |
110
|
|
|
|
|
|
|
"" => "highlight_next", |
111
|
|
|
|
|
|
|
"" => "highlight_prev", |
112
|
|
|
|
|
|
|
"" => "highlight_first", |
113
|
|
|
|
|
|
|
"" => "activate", |
114
|
|
|
|
|
|
|
"" => "dismiss"; |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
use constant KEYPRESSES_FROM_STYLE => 1; |
117
|
|
|
|
|
|
|
use constant WIDGET_PEN_FROM_STYLE => 1; |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
sub lines |
120
|
|
|
|
|
|
|
{ |
121
|
|
|
|
|
|
|
return 1; |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
sub cols |
125
|
|
|
|
|
|
|
{ |
126
|
|
|
|
|
|
|
my $self = shift; |
127
|
|
|
|
|
|
|
return sum( map { $self->_itemwidth( $_ ) } 0 .. $self->items-1 ) + 2 * ( $self->items - 1 ); |
128
|
|
|
|
|
|
|
} |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
sub push_item |
131
|
|
|
|
|
|
|
{ |
132
|
|
|
|
|
|
|
my $self = shift; |
133
|
|
|
|
|
|
|
my ( $item ) = @_; |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
if( $item == separator and grep { $_ == separator } $self->items ) { |
136
|
|
|
|
|
|
|
croak "Cannot have more than one separator in a MenuBar"; |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
$self->SUPER::push_item( $item ); |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
sub reshape |
143
|
|
|
|
|
|
|
{ |
144
|
|
|
|
|
|
|
my $self = shift; |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
$self->{itempos} = \my @pos; |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
my $items = $self->{items}; |
149
|
|
|
|
|
|
|
my $col = 0; |
150
|
|
|
|
|
|
|
my $separator_at; |
151
|
|
|
|
|
|
|
foreach my $idx ( 0 .. $#$items ) { |
152
|
|
|
|
|
|
|
$separator_at = $idx, next if $items->[$idx] == separator; |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
$pos[$idx] = [ $col, undef ]; |
155
|
|
|
|
|
|
|
$col += $self->_itemwidth( $idx ); |
156
|
|
|
|
|
|
|
$pos[$idx][1] = $col; |
157
|
|
|
|
|
|
|
$col += 2; |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
if( defined $separator_at ) { |
161
|
|
|
|
|
|
|
$col -= 2; # undo |
162
|
|
|
|
|
|
|
my $spare = $self->window->cols - $col; |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
$pos[$_][0] += $spare, $pos[$_][1] += $spare for $separator_at+1 .. $#$items; |
165
|
|
|
|
|
|
|
} |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
sub pos2item |
169
|
|
|
|
|
|
|
{ |
170
|
|
|
|
|
|
|
my $self = shift; |
171
|
|
|
|
|
|
|
my ( $line, $col ) = @_; |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
$line == 0 or return (); |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
my $items = $self->{items}; |
176
|
|
|
|
|
|
|
my $pos = $self->{itempos}; |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
foreach my $idx ( 0 .. $#$items ) { |
179
|
|
|
|
|
|
|
next if !defined $pos->[$idx]; # separator |
180
|
|
|
|
|
|
|
last if $col < $pos->[$idx][0]; |
181
|
|
|
|
|
|
|
next unless $col < $pos->[$idx][1]; |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
$col -= $pos->[$idx][0]; |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
return () if $col < 0; |
186
|
|
|
|
|
|
|
return ( $items->[$idx], $idx, $col ); |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
return (); |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
sub redraw_item |
193
|
|
|
|
|
|
|
{ |
194
|
|
|
|
|
|
|
my $self = shift; |
195
|
|
|
|
|
|
|
my ( $idx ) = @_; |
196
|
|
|
|
|
|
|
$self->window->expose( Tickit::Rect->new( |
197
|
|
|
|
|
|
|
top => 0, lines => 1, |
198
|
|
|
|
|
|
|
left => $self->{itempos}[$idx][0], |
199
|
|
|
|
|
|
|
right => $self->{itempos}[$idx][1], |
200
|
|
|
|
|
|
|
) ); |
201
|
|
|
|
|
|
|
} |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
sub render_to_rb |
204
|
|
|
|
|
|
|
{ |
205
|
|
|
|
|
|
|
my $self = shift; |
206
|
|
|
|
|
|
|
my ( $rb, $rect ) = @_; |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
if( $rect->top == 0 ) { |
209
|
|
|
|
|
|
|
$rb->goto( 0, 0 ); |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
my @items = $self->items; |
212
|
|
|
|
|
|
|
foreach my $idx ( 0 .. $#items ) { |
213
|
|
|
|
|
|
|
my $item = $items[$idx]; |
214
|
|
|
|
|
|
|
next if $item == separator; |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
my ( $left, $right ) = @{ $self->{itempos}[$idx] }; |
217
|
|
|
|
|
|
|
last if $left > $rect->right; |
218
|
|
|
|
|
|
|
next if $right < $rect->left; |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
$rb->erase_to( $left ); |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
my $pen = defined $self->{active_idx} && $idx == $self->{active_idx} |
223
|
|
|
|
|
|
|
? $self->get_style_pen( "highlight" ) : undef; |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
$rb->savepen; |
226
|
|
|
|
|
|
|
$rb->setpen( $pen ); |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
$item->render_label( $rb, $right - $left, $self ); |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
$rb->restore; |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
$rb->erase_to( $rect->right ); |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
foreach my $line ( $rect->linerange( 1, undef ) ) { |
237
|
|
|
|
|
|
|
$rb->erase_at( $line, $rect->left, $rect->cols ); |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
} |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
sub popup_item |
242
|
|
|
|
|
|
|
{ |
243
|
|
|
|
|
|
|
my $self = shift; |
244
|
|
|
|
|
|
|
my ( $idx ) = @_; |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
my $items = $self->{items}; |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
my $col = $self->{itempos}[$idx][0]; |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
my $rightmost = $self->window->cols - $items->[$idx]->cols; |
251
|
|
|
|
|
|
|
$col = $rightmost if $col > $rightmost; |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
$items->[$idx]->popup( $self->window, 1, $col ); |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
sub activated |
257
|
|
|
|
|
|
|
{ |
258
|
|
|
|
|
|
|
my $self = shift; |
259
|
|
|
|
|
|
|
$self->dismiss; |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
sub dismiss |
263
|
|
|
|
|
|
|
{ |
264
|
|
|
|
|
|
|
my $self = shift; |
265
|
|
|
|
|
|
|
$self->SUPER::dismiss; |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
# Still have a window after ->dismiss |
268
|
|
|
|
|
|
|
$self->redraw; |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
sub on_key |
272
|
|
|
|
|
|
|
{ |
273
|
|
|
|
|
|
|
my $self = shift; |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
# Always eat all the keys as there's never anything higher to pass them to |
276
|
|
|
|
|
|
|
return 1; |
277
|
|
|
|
|
|
|
} |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
# MenuBar always expands on highlight |
280
|
|
|
|
|
|
|
sub key_highlight_next |
281
|
|
|
|
|
|
|
{ |
282
|
|
|
|
|
|
|
my $self = shift; |
283
|
|
|
|
|
|
|
$self->SUPER::key_highlight_next; |
284
|
|
|
|
|
|
|
$self->expand_item( $self->{active_idx} ); |
285
|
|
|
|
|
|
|
} |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
sub key_highlight_prev |
288
|
|
|
|
|
|
|
{ |
289
|
|
|
|
|
|
|
my $self = shift; |
290
|
|
|
|
|
|
|
$self->SUPER::key_highlight_prev; |
291
|
|
|
|
|
|
|
$self->expand_item( $self->{active_idx} ); |
292
|
|
|
|
|
|
|
} |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
sub key_highlight_first |
295
|
|
|
|
|
|
|
{ |
296
|
|
|
|
|
|
|
my $self = shift; |
297
|
|
|
|
|
|
|
defined $self->{active_idx} or $self->expand_item( 0 ); |
298
|
|
|
|
|
|
|
return 1; |
299
|
|
|
|
|
|
|
} |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
sub on_mouse_item |
302
|
|
|
|
|
|
|
{ |
303
|
|
|
|
|
|
|
my $self = shift; |
304
|
|
|
|
|
|
|
my ( $args, $item, $item_idx, $item_col ) = @_; |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
# We only ever care about button 1 |
307
|
|
|
|
|
|
|
return unless $args->button == 1; |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
my $event = $args->type; |
310
|
|
|
|
|
|
|
if( $event eq "press" ) { |
311
|
|
|
|
|
|
|
# A second click on an active item deactivates |
312
|
|
|
|
|
|
|
if( defined $self->{active_idx} and $item_idx == $self->{active_idx} ) { |
313
|
|
|
|
|
|
|
$self->dismiss; |
314
|
|
|
|
|
|
|
} |
315
|
|
|
|
|
|
|
else { |
316
|
|
|
|
|
|
|
$self->expand_item( $item_idx ); |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
} |
319
|
|
|
|
|
|
|
elsif( $event eq "drag" ) { |
320
|
|
|
|
|
|
|
$self->expand_item( $item_idx ); |
321
|
|
|
|
|
|
|
} |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
return 1; |
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
=head1 AUTHOR |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
Paul Evans |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
=cut |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
0x55AA; |