File Coverage

blib/lib/Tickit/Widget/Menu/base.pm
Criterion Covered Total %
statement 12 12 100.0
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 16 16 100.0


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-2014 -- leonerd@leonerd.org.uk
5              
6             package Tickit::Widget::Menu::base;
7              
8 1     1   5 use strict;
  1         1  
  1         23  
9 1     1   3 use warnings;
  1         1  
  1         25  
10 1     1   3 use feature qw( switch );
  1         1  
  1         49  
11              
12 1     1   6 use base qw( Tickit::Widget Tickit::Widget::Menu::itembase );
  1         1  
  1         476  
13              
14             our $VERSION = '0.11';
15              
16             use Carp;
17              
18             use Tickit::Utils qw( textwidth );
19              
20             use constant separator => [];
21              
22             sub new
23             {
24             my $class = shift;
25             my %args = @_;
26              
27             foreach my $method (qw( pos2item on_mouse_item redraw_item popup_item activated )) {
28             $class->can( $method ) or
29             croak "$class cannot ->$method - do you subclass and implement it?";
30             }
31             my $self = $class->SUPER::new( %args );
32             $self->_init_itembase( %args );
33              
34             $self->{items} = [];
35             $self->{itemwidths} = [];
36              
37             $self->{active_idx} = undef; # index of keyboard-selected highlight
38              
39             if( $args{items} ) {
40             $self->push_item( $_ ) for @{ $args{items} };
41             }
42              
43             return $self;
44             }
45              
46             sub items
47             {
48             my $self = shift;
49             return @{ $self->{items} };
50             }
51              
52             sub _itemwidth
53             {
54             my $self = shift;
55             my ( $idx ) = @_;
56             return $self->{itemwidths}[$idx];
57             }
58              
59             sub push_item
60             {
61             my $self = shift;
62             my ( $item ) = @_;
63              
64             push @{ $self->{items} }, $item;
65             push @{ $self->{itemwidths} }, $item == separator ? 0 : textwidth $item->name;
66             }
67              
68             sub highlight_item
69             {
70             my $self = shift;
71             my ( $idx ) = @_;
72              
73             return if defined $self->{active_idx} and $idx == $self->{active_idx};
74              
75             my $have_window = defined $self->window;
76              
77             if( defined( my $old_idx = $self->{active_idx} ) ) {
78             undef $self->{active_idx};
79             my $old_item = $self->{items}[$old_idx];
80             if( $old_item->isa( "Tickit::Widget::Menu" ) ) {
81             $old_item->dismiss;
82             }
83             $self->redraw_item( $old_idx ) if $have_window;
84             }
85              
86             $self->{active_idx} = $idx;
87             $self->redraw_item( $idx ) if $have_window;
88             }
89              
90             sub expand_item
91             {
92             my $self = shift;
93             my ( $idx ) = @_;
94              
95             $self->highlight_item( $idx );
96              
97             my $item = $self->{items}[$idx];
98             if( $item->isa( "Tickit::Widget::Menu" ) ) {
99             $self->popup_item( $idx );
100             $item->set_supermenu( $self );
101             }
102             # else don't bother expanding non-menus
103             }
104              
105             sub activate_item
106             {
107             my $self = shift;
108             my ( $idx ) = @_;
109              
110             my $item = $self->{items}[$idx];
111             if( $item->isa( "Tickit::Widget::Menu" ) ) {
112             $self->expand_item( $idx );
113             }
114             else {
115             $self->activated;
116             $item->activate;
117             }
118             }
119              
120             sub set_on_activated
121             {
122             my $self = shift;
123             ( $self->{on_activated} ) = @_;
124             }
125              
126             sub dismiss
127             {
128             my $self = shift;
129              
130             if( defined $self->{active_idx} ) {
131             my $item = $self->{items}[$self->{active_idx}];
132             $item->dismiss if $item->isa( "Tickit::Widget::Menu" );
133             }
134              
135             undef $self->{active_idx};
136             }
137              
138             sub key_highlight_next
139             {
140             my $self = shift;
141              
142             my $items = $self->{items};
143             my $idx = $self->{active_idx};
144              
145             if( defined $idx ) {
146             $idx++, $idx %= @$items;
147             }
148             else {
149             $idx = 0;
150             }
151              
152             $idx++, $idx %= @$items while $items->[$idx] == separator;
153              
154             $self->highlight_item( $idx );
155              
156             return 1;
157             }
158              
159             sub key_highlight_prev
160             {
161             my $self = shift;
162              
163             my $items = $self->{items};
164             my $idx = $self->{active_idx};
165              
166             if( defined $idx ) {
167             $idx--, $idx %= @$items;
168             }
169             else {
170             $idx = $#$items;
171             }
172              
173             $idx--, $idx %= @$items while $items->[$idx] == separator;
174              
175             $self->highlight_item( $idx );
176              
177             return 1;
178             }
179              
180             sub key_dismiss
181             {
182             my $self = shift;
183              
184             $self->dismiss;
185              
186             return 1;
187             }
188              
189             sub key_activate
190             {
191             my $self = shift;
192              
193             if( defined( my $idx = $self->{active_idx} ) ) {
194             $self->activate_item( $idx );
195             }
196              
197             return 1;
198             }
199              
200             sub on_mouse
201             {
202             my $self = shift;
203             my ( $args ) = @_;
204              
205             my $line = $args->line;
206             my $col = $args->col;
207              
208             if( $line < 0 or $line >= $self->window->lines or
209             $col < 0 or $col >= $self->window->cols ) {
210             $self->dismiss, return 0 if $args->type eq "press";
211             return 0;
212             }
213              
214             my ( $item, $item_idx, $item_col ) = $self->pos2item( $line, $col );
215             $item or return 1;
216              
217             $self->on_mouse_item( $args, $item, $item_idx, $item_col );
218             }
219              
220             0x55AA;