view release on metacpan or  search on metacpan

lib/Tickit/ContainerWidget.pm  view on Meta::CPAN

use base qw( Tickit::Widget );

our $VERSION = '0.52';

use Carp;

use Scalar::Util qw( refaddr );

=head1 NAME

C<Tickit::ContainerWidget> - abstract base class for widgets that contain
other widgets

=head1 SYNOPSIS

 TODO

=head1 DESCRIPTION

This class acts as an abstract base class for widgets that contain at leaast
one other widget object. It provides storage for a hash of "options"
associated with each child widget.

=head1 STYLE

The following style tags are used:

=over 4

=item :focus-child

Set whenever a child widget within the container has the input focus.

=back

=cut

=head1 CONSTRUCTOR

=cut

=head2 new

   $widget = Tickit::ContainerWidget->new( %args )

Constructs a new C<Tickit::ContainerWidget> object. Must be called on a
subclass that implements the required methods; see the B<SUBCLASS METHODS>
section below.

=cut

sub new
{
   my $class = shift;

   foreach my $method (qw( children )) {
      $class->can( $method ) or
         croak "$class cannot ->$method - do you subclass and implement it?";
   }

   my $self = $class->SUPER::new( @_ );

   $self->{child_opts} = {};

   return $self;
}

=head1 METHODS

=cut

=head2 add

   $widget->add( $child, %opts )

Sets the child widget's parent, stores the options for the child, and calls
the C<children_changed> method. The concrete implementation will have to
implement storage of this child widget.

Returns the container C<$widget> itself, for easy chaining.

=cut

sub add
{
   my $self = shift;
   my ( $child, %opts ) = @_;

   $child and $child->isa( "Tickit::Widget" ) or
      croak "Expected child to be a Tickit::Widget";

   $child->set_parent( $self );

   $self->{child_opts}{refaddr $child} = \%opts;

   $self->children_changed;

   return $self;
}

=head2 remove

   $widget->remove( $child_or_index )

Removes the child widget's parent, and calls the C<children_changed> method.
The concrete implementation will have to remove this child from its storage.

Returns the container C<$widget> itself, for easy chaining.

=cut

sub remove
{
   my $self = shift;
   my ( $child ) = @_;

   $child->set_parent( undef );
   $child->window->close if $child->window;
   $child->set_window( undef );

   delete $self->{child_opts}{refaddr $child};

lib/Tickit/ContainerWidget.pm  view on Meta::CPAN

   $opts = $widget->child_opts( $child )

Returns the options currently set for the given child as a key/value list in
list context, or as a HASH reference in scalar context. The HASH reference in
scalar context is the actual hash used to store the options - modifications to
it will be preserved.

=cut

sub child_opts
{
   my $self = shift;
   my ( $child ) = @_;

   my $opts = $self->{child_opts}{refaddr $child};
   return $opts if !wantarray;
   return %$opts;
}

=head2 set_child_opts

   $widget->set_child_opts( $child, %newopts )

Sets new options on the given child. Any options whose value is given as
C<undef> are deleted.

=cut

sub set_child_opts
{
   my $self = shift;
   my ( $child, %newopts ) = @_;

   my $opts = $self->{child_opts}{refaddr $child};

   foreach ( keys %newopts ) {
      defined $newopts{$_} ? ( $opts->{$_} = $newopts{$_} ) : ( delete $opts->{$_} );
   }

   $self->children_changed;
}

sub child_resized
{
   my $self = shift;
   $self->reshape if $self->window;
   $self->resized;
}

sub children_changed
{
   my $self = shift;

   $self->reshape if $self->window;
   $self->resized;
}

sub window_gained
{
   my $self = shift;
   $self->SUPER::window_gained( @_ );

   $self->window->set_focus_child_notify( 1 );
}

sub window_lost
{
   my $self = shift;

   foreach my $child ( $self->children ) {
      my $childwin = $child->window;
      $childwin and $childwin->close;

      $child->set_window( undef );
   }

   $self->SUPER::window_lost( @_ );
}

sub _on_win_focus
{
   my $self = shift;
   $self->SUPER::_on_win_focus( @_ );

   $self->set_style_tag( "focus-child" => $_[1] ) if $_[2];
}

=head2 find_child

   $child = $widget->find_child( $how, $other, %args )

Returns a child widget. The C<$how> argument determines how this is done,
relative to the child widget given by C<$other>:

=over 4

=item first

The first child returned by C<children> (C<$other> is ignored)

=item last

The last child returned by C<children> (C<$other> is ignored)

=item before

The child widget just before C<$other> in the order given by C<children>

=item after

The child widget just after C<$other> in the order given by C<children>

=back

Takes the following named arguments:

=over 8

=item where => CODE

Optional. If defined, gives a filter function to filter the list of children
before searching for the required one. Will be invoked once per child, with
the child widget set as C<$_>; it should return a boolean value to indicate if
that child should be included in the search.

=back

=cut

sub find_child
{
   my $self = shift;
   my ( $how, $other, %args ) = @_;

   my $children = $args{children} // "children";
   my @children = $self->$children;
   if( my $where = $args{where} ) {
      @children = grep { defined $other and $_ == $other or $where->() } @children;
   }

   if( $how eq "first" ) {
      return $children[0];
   }