The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
package Gapp::Widget;
{
  $Gapp::Widget::VERSION = '0.481';
}

use Moose;
use MooseX::SemiAffordanceAccessor;
use MooseX::StrictConstructor;
extends 'Gapp::Object';

has '+gobject' => (
    handles => [qw( destroy hide present show show_all )],  
);

has 'name' => (
    is => 'rw',
    isa => 'Str',
    default => '',
);

# if the widget should expand its container
has 'expand' => (
    is => 'rw',
    isa => 'Bool',
    default => 1 ,
);

# if the widget should fill its container
has 'fill' => (
    is => 'rw',
    isa => 'Bool',
    default => 1 ,
);

# the grwapper wraps encapsulates a widget
has 'gwrapper' => (
    is => 'rw',
    isa => 'Maybe[Gtk2::Object]',
    reader => 'get_gwrapper',
    writer => 'set_gwrapper',
    default => undef,
);

sub gwrapper {
    my ( $self ) = @_;
    $self->get_gwrapper || $self->gobject;
};


# padding around widget in container
has 'padding' => (
    is => 'rw',
    isa => 'Int',
    default => 0,
);

# the parent is set when the widget is added
# to a container widget
has 'parent' => (
    is => 'rw',
    isa => 'Maybe[Gapp::Widget]',
    weak_ref => 1,
);

#has 'toplevel' => (
#    is => 'rw',
#    isa => 'Maybe[Gapp::Widget]',
#    weak_ref => 1,
#);

# tooltip to display
has 'tooltip' => (
    is => 'rw',
    isa => 'Maybe[Str]',
);

sub toplevel {
    my ( $self ) = @_;
    return $self if ! $self->parent;
    
    $self->parent ? $self->parent->toplevel : $self;
}




sub BUILDARGS {
    my $class = shift;
    my %args = @_ == 1 && is_HashRef( $_[0] ) ? %{$_[0]} : @_;
    
    if ( exists $args{alignment} ) {
        $args{properties}{xalign} = $args{alignment}[0];
        $args{properties}{yalign} = $args{alignment}[1];
        delete $args{alignment};
    }
    
    # headers visible
    for my $att ( qw(visible sensitive xalign yalign no_show_all) ) {
        $args{properties}{$att} = delete $args{$att} if exists $args{$att};
    }
    
    __PACKAGE__->SUPER::BUILDARGS( %args );
}


# this stores a reference to the Gapp::Object within the Gtk2::Widget
# this is done so that if the only-references to the Gapp::Object
# go away before the Gtk2::Widget - the Gapp::Object is still
# available to reference in callbacks - when the Gtk2::Widget is
# destroyed, then the circular reference will be deleted as well

after '_build_gobject' => sub {
    my ( $self ) = @_;
    
    if ( $self->gobject->isa('Gtk2::Widget') ) {
        $self->gobject->{_gapp} = $self;
        $_[0]->{_gapp} = undef;
    }
};



    

1;

__END__

=pod

=head1 NAME

Gapp::Widget - The base class for all Gapp widgets

=head1 OBJECT HIERARCHY

=over 4

=item L<Gapp::Object>

=item +-- L<Gapp::Widget>

=back

=head1 DESCRIPTION

All Gapp widgets inherit from L<Gapp::Widget>.

=head1 PROVIDED ATTRIBUTES

=over 4

=item B<expand>

=over 4

=item isa: Bool

=item default: 0

=back

If the widget should expand inside it's container. (Tables widgets ignore this
value because widget expansion is determind by the L<Gapp::TableMap>)

=item B<fill>

=over 4

=item isa: Bool

=item default: 0

=back

If the widget should fill it's container. (Tables widgets ignore this value
because widget layout is determind by the L<Gapp::TableMap>)

=back

=item B<gwrapper>

=over 4

=item is rw

=item isa Gtk2::Widget

=item writer set_gwrapper

=item reader get_gwrapper

=back

The C<gwrapper> is a widget that encapsulates the C<gobject>. This is useful when
creating composite widgets. To retrieve the value of the C<gwrapper> attribute use
the C<get_gwrapper> method. Calling the C<grwapper> will return the C<gwrapper>
if one has been set, otherwise it will return the C<gobject>. 

=item B<padding>

=over 4

=item isa: Int

=item default: 0

=back

Padding around the widget.

=item B<parent>

=over 4

=item isa L<Gapp::Widget>|Undef

=item default undef

=back

The parent widget.

=item B<tooltip>

=over 4

=item isa Str|Undef

=back

The tooltip to display over the widget.

=head1 PROVIDED METHODS

=over 4

=item B<toplevel>

Searches through the widget heirachy to find the furthest widget up the chain
with no parent widget. Returns the calling widget if it has no parent.

=over 4

=item returns L<Gapp::Widget>

=back

=back

=head1 AUTHORS

Jeffrey Ray Hallock E<lt>jeffrey.hallock at gmail dot comE<gt>

=head1 COPYRIGHT & LICENSE

    Copyright (c) 2011-2012 Jeffrey Ray Hallock.

    This program is free software; you can redistribute it and/or
    modify it under the same terms as Perl itself.

=cut