File Coverage

blib/lib/Tickit/Widget/Menu/base.pm

Criterion	Covered	Total	%
statement	16	18	88.8
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	22	24	91.6

#  You may distribute under the terms of either the GNU General Public License
#  or the Artistic License (the same terms as Perl itself)
#
#  (C) Paul Evans, 2012-2014 -- [e-mail]

package Tickit::Widget::Menu::base;

use strict;
use warnings;
use feature qw( switch );

use base qw( Tickit::Widget Tickit::Widget::Menu::itembase );

our $VERSION = '0.09';

use Carp;

use Tickit::Utils qw( textwidth );

use constant separator => [];

sub new
{
   my $class = shift;
   my %args = @_;

   foreach my $method (qw( pos2item on_mouse_item redraw_item popup_item activated )) {
      $class->can( $method ) or
         croak "$class cannot ->$method - do you subclass and implement it?";
   }
   my $self = $class->SUPER::new( %args );
   $self->_init_itembase( %args );

   $self->{items} = [];
   $self->{itemwidths} = [];

   $self->{active_idx} = undef; # index of keyboard-selected highlight

   if( $args{items} ) {
      $self->push_item( $_ ) for @{ $args{items} };
   }

   return $self;
}

sub items
{
   my $self = shift;
   return @{ $self->{items} };
}

sub _itemwidth
{
   my $self = shift;
   my ( $idx ) = @_;
   return $self->{itemwidths}[$idx];
}

sub push_item
{
   my $self = shift;
   my ( $item ) = @_;

   push @{ $self->{items} }, $item;
   push @{ $self->{itemwidths} }, $item == separator ? 0 : textwidth $item->name;
}

sub highlight_item
{
   my $self = shift;
   my ( $idx ) = @_;

   return if defined $self->{active_idx} and $idx == $self->{active_idx};

   my $have_window = defined $self->window;

   if( defined( my $old_idx = $self->{active_idx} ) ) {
      undef $self->{active_idx};
      my $old_item = $self->{items}[$old_idx];
      if( $old_item->isa( "Tickit::Widget::Menu" ) ) {
         $old_item->dismiss;
      }
      $self->redraw_item( $old_idx ) if $have_window;
   }

   $self->{active_idx} = $idx;
   $self->redraw_item( $idx ) if $have_window;
}

sub expand_item
{
   my $self = shift;
   my ( $idx ) = @_;

   $self->highlight_item( $idx );

   my $item = $self->{items}[$idx];
   if( $item->isa( "Tickit::Widget::Menu" ) ) {
      $self->popup_item( $idx );
      $item->set_supermenu( $self );
   }
   # else don't bother expanding non-menus
}

sub activate_item
{
   my $self = shift;
   my ( $idx ) = @_;

   my $item = $self->{items}[$idx];
   if( $item->isa( "Tickit::Widget::Menu" ) ) {
      $self->expand_item( $idx );
   }
   else {
      $self->activated;
      $item->activate;
   }
}

sub set_on_activated
{
   my $self = shift;
   ( $self->{on_activated} ) = @_;
}

sub dismiss
{
   my $self = shift;

   if( defined $self->{active_idx} ) {
      my $item = $self->{items}[$self->{active_idx}];
      $item->dismiss if $item->isa( "Tickit::Widget::Menu" );
   }

   undef $self->{active_idx};
}

sub key_highlight_next
{
   my $self = shift;

   my $items = $self->{items};
   my $idx = $self->{active_idx};

   if( defined $idx ) {
      $idx++, $idx %= @$items;
   }
   else {
      $idx = 0;
   }

   $idx++, $idx %= @$items while $items->[$idx] == separator;

   $self->highlight_item( $idx );

   return 1;
}

sub key_highlight_prev
{
   my $self = shift;

   my $items = $self->{items};
   my $idx = $self->{active_idx};

   if( defined $idx ) {
      $idx--, $idx %= @$items;
   }
   else {
      $idx = $#$items;
   }

   $idx--, $idx %= @$items while $items->[$idx] == separator;

   $self->highlight_item( $idx );

   return 1;
}

sub key_dismiss
{
   my $self = shift;

   $self->dismiss;

   return 1;
}

sub key_activate
{
   my $self = shift;

   if( defined( my $idx = $self->{active_idx} ) ) {
      $self->activate_item( $idx );
   }

   return 1;
}

sub on_mouse
{
   my $self = shift;
   my ( $args ) = @_;

   my $line = $args->line;
   my $col  = $args->col;

   if( $line < 0 or $line >= $self->window->lines or
       $col  < 0 or $col  >= $self->window->cols ) {
      $self->dismiss, return 0 if $args->type eq "press";
      return 0;
   }

   my ( $item, $item_idx, $item_col ) = $self->pos2item( $line, $col );
   $item or return 1;

   $self->on_mouse_item( $args, $item, $item_idx, $item_col );
}

0x55AA;