view release on metacpan or  search on metacpan

lib/App/CPAN2Pkg/UI/Tk.pm  view on Meta::CPAN

    )->pack( left, pad2 );
    $mw->bind( '<Return>', $s->postback( '_on_btn_submit' ) );

    #
    my $f = $mw->Frame->pack( top, xfill2 );
    my $f1 = $f->Frame->pack( left, filly );
    my $f2 = $f->Frame->pack( left, xfill2 );
    $self->_build_hlist( $f1 );
    $self->_build_close_btn( $f1 );
    $self->_build_notebook( $f2 );

    # center & show the window
    # FIXME: restore last position saved?
    $mw->Popup;
    $mw->minsize($mw->width, $mw->height);
    $self->_w("ent_module")->focus;
}


#
# $main->_build_close_btn( $parent );
#
# build the button to close all finished modules.
#
sub _build_close_btn {
    my ($self, $parent) = @_;

    my $b = $parent->Button(
        -text    => "Clean all finished modules",
        -command => $self->_session->postback( "_on_btn_clean_all" ),
    )->pack( bottom, fillx );
}

#
# $main->_build_hlist( $parent );
#
# build the hierarchical list holding all the module status.
#
sub _build_hlist {
    my ($self, $parent) = @_;

    my $hlist = $parent->Scrolled( 'HList',
        -scrollbars => 'osoe',
        -width      => 30,
        -columns    => 3,
        -header     => 1,
    )->pack( top, xfilly );
    $self->_set_w( hlist => $hlist );

    $hlist->header( create => 0, -text => 'local' );
    $hlist->header( create => 1, -text => 'bs' );
    $hlist->header( create => 2, -text => 'module' );

    $hlist->bind( '<Double-1>', $self->_session->postback('_on_hlist_2click') );
}

#
# $main->_build_notebook( $parent );
#
# build the notebook holding one pane per module being built. first tab
# contains the legend.
#
sub _build_notebook {
    my ($self, $parent) = @_;

    # create the notebook that will hold module details
    my $nb = $parent->NoteBook->pack( top, xfill2 );
    $self->_set_w('notebook', $nb);

    # create a first tab with the legend
    my $legend = $nb->add("Legend", -label=>"Legend");

    #my $legend = $mw->Frame->pack( top, fillx );
    my @lab1 = ( 'not started', 'not available', 'building', 'installing', 'available', 'error' );
    my @col1 = qw{ black yellow orange blue green red };
    my @lab2 = ( 'not started', 'not available', 'importing', 'building', 'available', 'error' );
    my @col2 = qw{ black yellow purple orange green red };
    $legend->Label( -text => 'Local' )
      ->grid( -row => 0, -column => 0, -columnspan=>2, -sticky => 'w' );
    $legend->Label( -text => 'Build System' )
      ->grid( -row => 0, -column => 2,  -columnspan=>2,-sticky => 'w' );
    my $buldir = $SHAREDIR->subdir( 'bullets' );
    foreach my $i ( 0 .. $#lab1 ) {
        $legend->Label( -image => _image( $buldir->file( $col1[$i] . ".png" ) ) )
          ->grid( -row => $i + 1, -column => 0, ipad5 );
        $legend->Label( -image => _image( $buldir->file( $col2[$i] . ".png" ) ) )
          ->grid( -row => $i + 1, -column => 2, ipad5 );
        $legend->Label( -text => $lab1[$i] )->grid( -row=>$i+1, -column=>1, -sticky => 'w' );
        $legend->Label( -text => $lab2[$i] )->grid( -row=>$i+1, -column=>3, -sticky => 'w' );
    }

}


# -- private subs

#
#    my $img = _image( $path );
#
# Return a tk image loaded from C<$path>. If the photo has already been
# loaded, return a handle on it.
#
sub _image {
    my $path = shift;
    my $img = $poe_main_window->Photo($path);
    return $img if $img->width;
    return $poe_main_window->Photo($path, -file=>$path);
}



no Moose;
__PACKAGE__->meta->make_immutable;
1;

__END__

=pod

=head1 NAME

App::CPAN2Pkg::UI::Tk - main cpan2pkg window

=head1 VERSION

version 3.004

=head1 DESCRIPTION

This class implements the whole L<Tk> graphical interface. It is a POE
session driving events and updating the display as workers change
status.

=head1 EVENTS

=head2 log_out

=head2 log_err

=head2 log_comment

=head2 log_result

=head2 log_step

    log_XXX( $module, $line )

Log a C<$line> of output / stderr / comment / result / step in
C<$module> tab.