package Gapp::Object;
{
  $Gapp::Object::VERSION = '0.47.7';
}

use Moose;
use MooseX::LazyRequire;
use MooseX::SemiAffordanceAccessor;
use MooseX::StrictConstructor;

use MooseX::Types::Moose qw( ArrayRef HashRef Str Undef );

use Gtk2;
use Gapp::Layout::Default;
use Gapp::Types qw( GappAction GappLayout );


# passed to gobject constructor

has 'args' => (
    is => 'rw',
    isa => 'Maybe[ArrayRef]',
);


# signals to connect to
has 'connected_signals' => (
    is => 'ro',
    isa => 'ArrayRef',
    default => sub { [ ] },
    init_arg => 'signal_connect',
);


# the method/function used to construct the gobject
has 'constructor' => (
    is => 'rw',
    isa => 'Str',
    default => 'new',
);

# allow user to customize widget, called after gobject is built
has 'customize' => (
    is => 'rw',
    isa => 'CodeRef|Undef',
);

# gobject class
has 'gclass' => (
    is => 'rw',
    isa => 'Str',
    lazy_required => 1,
);

# the actual gtk-widget
has 'gobject' => (
    is => 'rw',
    isa => 'Object',
    lazy_build => 1,
    predicate => 'has_gobject',
);

# explicitly set the layout
has 'layout' => (
    is => 'rw',
    isa => GappLayout|Undef,
    predicate => 'has_layout',
    coerce => 1,
);

# the layout to use (parent layout if not explicitly set for this widget)
has '_used_layout' => (
    is => 'rw',
    isa => GappLayout|Undef,
    clearer => '_clear_used_layout',
);



has '_gapp_signals' => (
    is => 'rw',
    isa => 'HashRef',
    default => sub { { } },
);


sub find_layout {
    my ( $self, $default ) = @_;
    return $self->_used_layout if $self->_used_layout;
    
    if ( $self->layout ) {
        $self->_set_used_layout( $self->layout );
    }
    else {
        if ( $self->can('parent') && $self->parent ) {
            $self->_set_used_layout( $self->parent->find_layout );
        }
        else {
            no warnings;
            $self->_set_used_layout( $default || $Gapp::Layout || Gapp::Layout::Default->Layout );
        }
    }
    return $self->_used_layout;
}

sub _forget_layout {
    my ( $self ) = @_;
    $self->_clear_used_layout;
    
    if ( $self->can('children') ) {
        $_->_forget_layout for $self->children;
    }
}

# for subclassing
sub _on_set_layout {
    
}



# properties to apply to the widget
has 'properties' => (
    is => 'ro',
    isa => 'HashRef',
    traits => [qw( Hash )],
    default => sub { { } },
    handles => {
        get_property => 'get',
        set_property => 'set',
    }
);

# gapp traits to apply
has 'traits' => (
    is => 'rw',
    isa => 'ArrayRef',
    default => sub { [ ] },
);

# we replace the new method with our own which applies any
# traits that may have been passed in
sub new {
    my ( $class, %args ) = @_;
    my ( $new_class, @traits ) = $class->interpolate_class(\%args);
    $new_class->_new( %args, ( scalar(@traits) ? ( traits => \@traits ) : () ) );
}

# access to Moose's new
sub _new {
    my ( $class, @args ) = @_;
    $class->SUPER::new( @args );
}


# create an anonamous class with the traits applied
# copied and modified from Moose::Meta::Attribute
sub interpolate_class {
    my ( $class, $options ) = @_;

    $class = ref( $class ) || $class;

    my @traits;
    if ( my $traits = $options->{traits} ) {
        
        my $i = 0;
        
        while ( $i < @$traits ) {
            
            my $trait = $traits->[$i++];
            
            next if ref($trait); # options to a trait we discarded
            
            # resolve short trait names
            $trait = Gapp::Util::resolve_gapp_trait_alias( Widget => $trait )
                  || $trait;
            
            next if $class->does( $trait );
            
            push @traits, $trait;
                
            # are there options?
            push @traits, $traits->[$i++]
                if $traits->[$i] && ref($traits->[$i]);
                
        }
        
        # apply the traits
        if ( @traits ) {
            $class = Moose::Util::with_traits( $class, @traits );
        }
    }

    return ( wantarray ? ( $class, @traits ) : $class );
}

# returns widgets higher in the heirarchy
sub find_ancestors {
    my ( $self ) = @_;
    my $parent = $self->parent;
    return $parent ? ( $parent, $parent->find_ancestors ) : ();
}

# returns the top-most widget in the heirarchy
sub find_toplevel {
    my ( $self ) = @_;
    my @ancestors = $self->find_ancestors;   
    return @ancestors ? $ancestors[-1] : $self;
}


# connect signals to the g-object
# connects the signal immediately if the g-object exists
# otherwise stores signal info to connect once g-object is constructed
sub signal_connect {
    my ( $self, $name, $code, @args ) = @_;
    

    
    # attach the signal if the gtk widget has been constructed
    if ( $self->has_gobject ) {
        $self->_apply_signal( [ $name, $code, @args ] );
    }
    else {
        push @{ $self->connected_signals }, [ $name, $code, @args ];
    }
}



# call customize code-ref if set
sub _apply_customize {
    my ( $self ) = @_;
    $self->customize->( $self, $self->gobject ) if $self->customize;
}

# call builder method from layout
sub _apply_builders {
    my ( $self ) = @_;
    no warnings;
    $self->find_layout->build_widget( $self );
}

# call builder method from layout
sub _apply_stylers {
    my ( $self ) = @_;
    no warnings;
    $self->find_layout->style_widget( $self );
}

# call builder method from layout
sub _apply_painters {
    my ( $self ) = @_;
    no warnings;
    $self->find_layout->paint_widget( $self ) if $self->can('action') && $self->action;
}

# apply any properties to the gobject
sub _apply_properties {
    my ( $self ) = @_;
    for my $p ( keys %{ $self->properties } ) {
        my $value = $self->properties->{$p};
        $self->gobject->set( $p, $self->properties->{$p} );
    }
}

# apply any signals to the gobject
sub _apply_signals {
    my ( $self ) = @_;
    map { $self->_apply_signal( $_ ) } @{ $self->connected_signals };
}

sub _apply_signal {
    my ( $self, $signal ) = @_;
    my ( $name, $action, @args ) = @$signal;
    
    return if $name =~ /^gapp/;
    
    if ( is_GappAction( $action ) ) {
        $self->gobject->signal_connect( $name => sub {
            my ( $gtkw, @gtkargs ) = @_;
            return $action->perform( $self, \@args, $gtkw,  \@gtkargs );
        });
    }
    else {
        $self->gobject->signal_connect( $name => sub {
            my ( $gtkw, @gtkargs ) = @_;
            return $action->( $self, \@args, $gtkw,  \@gtkargs );
        });
    }
}

# construct and format the widget
sub _build_gobject {
    my ( $self ) = @_;

    $self->_apply_stylers;
    
    my $w = $self->_construct_gobject( @_ );
    $self->_apply_properties;
    $self->_apply_builders;
    $self->_apply_painters;
    $self->_apply_signals;
    $self->_apply_customize;

    return $w;
}


# create and set the actual gobject
sub _construct_gobject {
    my ( $self ) = @_;
    
    my $gclass = $self->gclass;
    my $gconstructor = $self->constructor;
    
    # use any build-arguments if they exist
    my $w = $gclass->$gconstructor( $self->args ? @{$self->args} : ( ) );
    $self->set_gobject( $w );
    return $w;
}



1;

__END__

=pod

=head1 NAME

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

=head1 OBJECT HIERARCHY

=over 4

=item L<Gapp::Widget>

=back

=head1 DESCRIPTION

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

=head1 PROVIDED ATTRIBUTES

=over 4

=item B<args>

=over 4

=item isa: ArrayRef|Undef

=item default: undef

=back

If C<args> is set, the contents of the ArrayRef will be passed into the
constructor when the Gtk+ widget is instantiated. The example below will create
a popup window instead of a standard toplevel window.

 Gapp::Window->new( args => [ 'popup' ] );

=item B<gclass>

=over 4

=item isa: ClassName

=item required: lazy

=back

This is the class of the CGObject> to be created. Most Gapp widgets provide
this in their class definition, but you can override it by passing in your own
value.

 Gapp::Window->new( gclass => 'Gtk2::Ex::CustomWindow' );

=item B<constructor>

=over 4

=item isa: Str|CodeRef

=item default: new

=back

This constructor is called on the C<gclass> to instantiate a Gtk+ widget. Change
the constructor if you want to use the helpers provided by Gtk+ like
C<new_with_label> or C<new_with_mnemonic>.

=item B<customize>

=over 4

=item isa: CodeRef|Undef

=item default: undef

=back

Setting the C<customize> attribute allows you to tweak the Gtk+ widget after it
has been instantiated. Use this sparingly, you should define the appearnce of
your widgets using L<Gapp::Layout>.

If you find you need to use C<customize> because parts of Gapp are incomplete,
or could be remedied by more robustness, please file a bug or submit a patch.

=item B<expand>

=over 4

=item isa: Bool

=item default: 0

=back

If the widget should expand inside it's container. (Table 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. (Table widgets ignore this value
because widget layout is determind by the L<Gapp::TableMap>)

=back

=item B<gobject>

=over 4

=item isa: Object

=item default: 0

=back

The actual C<GObject> instance. The C<GObject> will be constructed the first time it
is requested. After the object has been constructed, changes you make to the
Gapp layer will not be reflected in the Gtk+ widget.

=item B<layout>

=over 4

=item isa: L<Gapp::Layout::Object>

=item default: L<Gapp::Layout::Default>

=back

The layout used to determine widget positioning.

=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<properties>

=over 4

=item isa: HashRef

=item handles:

=over 4

=item get:

get_property

=item set:

set_property

=back

=item B<traits>

=over 4

=item isa: ArrayRef

=item default: []

=back

The traits to apply to the widget.

=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