File Coverage

blib/lib/Wx/Perl/TreeView.pm

Criterion	Covered	Total	%
statement	1	3	33.3
branch			n/a
condition			n/a
subroutine	1	1	100.0
pod			n/a
total	2	4	50.0

package Wx::Perl::TreeView;

=head1 NAME

Wx::Perl::TreeView - virtual tree control interface

=head1 DESCRIPTION

C provides a "virtual" tree control, similar to
a virtual C.  All the data access methods are contained
inside C.  C forwards
all unknown method calls to the contained C.

=cut

use Wx;

use strict;
use base qw(Wx::EvtHandler);

our $VERSION = '0.02';

use Wx::Event qw(EVT_TREE_ITEM_EXPANDING);

=head2 new

  my $treeview = Wx::Perl::TreeView->new( $tree_control, $model );

Constructs a new C instance using the previously
constructed tree control and model.

=cut

sub new {
    my( $class, $tree, $model ) = @_;
    my $self = $class->SUPER::new;

    $self->{treectrl} = $tree;
    $self->{model}    = $model;

    $tree->PushEventHandler( $self );

    # FIXME work around wxWidgets bug :-(
    my $target = Wx::wxMSW || Wx::wxVERSION >= 2.009 ?
                     $self : $tree;
    EVT_TREE_ITEM_EXPANDING( $target, $tree,
                             sub { $self->_on_item_expanding( $_[1]->GetItem );
                                   $_[1]->Skip;
                                   } );

    $self->reload;

    return $self;
}

sub _on_item_expanding {
    my( $self, $item ) = @_;
    my $tree = $self->treectrl;
    my $model = $self->model;
    my $cookie = $tree->GetPlData( $item )->{cookie};

    $tree->DeleteChildren( $item );

    my $count = $model->get_child_count( $cookie );
    if( $count == 0 ) {
        $tree->SetItemHasChildren( $item, 0 );
        return;
    }

    for( my $i = 0; $i < $count; ++$i ) {
        my( $ccookie, $cstring, $cimage, $ccdata ) =
            $model->get_child( $cookie, $i );

        my $child = $tree->AppendItem
          ( $item, $cstring, ( defined $cimage ? $cimage : -1 ), -1,
            Wx::TreeItemData->new( { cookie => $ccookie, data => $ccdata } ) );
        $tree->SetItemHasChildren( $child, $model->has_children( $ccookie ) );
    }
}

=head2 reload

  $treeview->reload;

Deletes all tree items and readds root node(s) from the model.

=cut

sub reload {
    my( $self ) = @_;
    my( $model, $tree ) = ( $self->model, $self->treectrl );
    $self->DeleteAllItems;

    my( $cookie, $string, $image, $data ) = $model->get_root;
    my $root = $tree->AddRoot
      ( $string, ( defined $image ? $image : -1 ), -1,
        Wx::TreeItemData->new( { cookie => $cookie, data => $data } ) );
    $tree->SetItemHasChildren( $root, $model->has_children( $cookie ) );

    if( $tree->GetWindowStyleFlag & Wx::wxTR_HIDE_ROOT() ) {
        $self->_on_item_expanding( $root );
    }
}

=head2 refresh

  my $refreshed = $treeview->refresh;
  my $refreshed = $treeview->refresh( [ $treeitemid1, $treeitemid2, ... ] );

Walks the tree and refreshes data from the expanded tree
branches. Returns C on success.

If one of the expanded nodes has a different child count in the model
and in the tree, calls C and returns C.

If a list of C is passed as argument, te child count
of these nodes is not checked against the model, and after refreshing
these nodes are expanded.

=cut

sub refresh {
    my( $self, $is_expanding ) = @_;
    $is_expanding ||= [];

    my( $model, $tree ) = ( $self->model, $self->treectrl );

    my( $cookie, $string, $image ) = $model->get_root;
    my( $can_refresh, $data ) = $self->_check( $tree->GetRootItem, $cookie,
                                               $string, $image,
                                               $is_expanding );
    if( $can_refresh ) {
        $self->_refresh( $tree->GetRootItem, $data );
    } else {
        $self->reload;
    }
    $self->_on_item_expanding( $_ ) foreach @$is_expanding;

    return $can_refresh;
}

sub _check {
    my( $self, $pitem, $pcookie, $pstring, $pimage, $pcdata,
        $is_expanding ) = @_;
    my( $model, $tree ) = ( $self->model, $self->treectrl );
    my $data = { text   => $pstring,
                 image  => $pimage,
                 cookie => $pcookie,
                 data   => $pcdata,
                 childs => [],
                 };
    return ( 1, $data ) if grep $_ == $pitem, @$is_expanding;
    return ( 1, $data ) unless $tree->IsExpanded( $pitem );
    my $cchilds = $tree->GetChildrenCount( $pitem, 0 );
    my $mchilds = $model->get_child_count( $pcookie );

    return ( 0, undef ) if $cchilds != $mchilds;

    my( $child, $cookie ) = $tree->GetFirstChild( $pitem );
    my $index = 0;
    while( $child->IsOk ) {
        my( $ccookie, $cstring, $cimage, $ccdata ) =
            $model->get_child( $pcookie, $index );
        my( $can_refresh, $cdata ) = $self->_check
            ( $child, $ccookie, $cstring, $cimage, $ccdata, $is_expanding );
        return ( 0, undef ) unless $can_refresh;
        push @{$data->{childs}}, $cdata;
        ( $child, $cookie ) = $tree->GetNextChild( $pitem, $cookie );
        ++$index;
    }

    return ( 1, $data );
}

sub _refresh {
    my( $self, $item, $data ) = @_;
    my $tree = $self->treectrl;

    $tree->SetItemText( $item, $data->{text} );
    $tree->SetItemImage( $item, defined $data->{image} ? $data->{image} : -1 );
    $tree->SetPlData( $item, { cookie => $data->{cookie},
                               data   => $data->{data},
                               } );

    return unless $tree->IsExpanded( $item );

    my( $child, $cookie ) = $tree->GetFirstChild( $item );
    my $index = 0;
    while( $child->IsOk ) {
        $self->_refresh( $child, $data->{childs}[$index] );
        ( $child, $cookie ) = $tree->GetNextChild( $item, $cookie );
        ++$index;
    }
}

=head2 get_cookie

  my $cookie = $treeview->get_cookie( $treeitemid );

Returns the cookie associated with the given C.

=cut

sub get_cookie {
    my( $self, $item ) = @_;

    return $self->treectrl->GetPlData( $item )->{cookie};
}

=head2 treectrl

  my $treectrl = $treeview->treectrl;

=head2 model

  my $model = $treeview->model;

=cut

sub treectrl { $_[0]->{treectrl} }
sub model    { $_[0]->{model} }

sub GetPlData {
    my( $self, $item ) = @_;

    return $self->treectrl->GetPlData( $item )->{data};
}

sub SetPlData {
    my( $self, $item, $data ) = @_;

    $self->treectrl->GetPlData( $item )->{data} = $data;
}

our $AUTOLOAD;
sub AUTOLOAD {
    my( $self ) = shift;
    ( my $name = $AUTOLOAD ) =~ s/.*:://;
    return unless $self->{treectrl}; # global destruction
    $self->{treectrl}->$name( @_ );
}

1;

__END__