view release on metacpan or  search on metacpan

lib/Config/Model/TkUI.pm  view on Meta::CPAN

    # add entry frame, filled by call-back
    # should be a composite widget
    my $e_frame = $eh_frame->Frame->pack(qw/-side top -fill both -expand 1/);
    $e_frame->Label(    #-text => "placeholder",
        -image => $tool_img,
        -width => 400,         # width in pixel for image
    )->pack( -side => 'top' );
    $e_frame->Button(
        -text    => "Run Wizard !",
        -command => sub { $cw->wizard } )->pack( -side => 'bottom' );

    my $b1_sub = sub {
        my $item = $tree->nearest( $tree->pointery - $tree->rooty );
        $cw->on_browse($item);
    };
    my $b3_sub = sub {
        my $item = $tree->nearest( $tree->pointery - $tree->rooty );
        $cw->on_select($item);
    };

    $tree->bind( '<Return>', $b3_sub );
    $tree->bind( '<ButtonRelease-3>', $b3_sub );
    bind_clicks($tree,$b1_sub, $b3_sub);

    # bind button2 to get cut buffer content and try to store cut buffer content
    my $b2_sub = sub {
        my $item = $tree->nearest( $tree->pointery - $tree->rooty );
        $cw->on_cut_buffer_dump($item);
    };
    $tree->bind( '<ButtonRelease-2>', $b2_sub );

    $tree->bind( '<Control-c>', sub { $cw->edit_copy } );
    $tree->bind( '<Control-v>', sub { $cw->edit_paste } );
    $tree->bind( '<Control-f>', sub { $cw->pack_find_widget } );

    my $find_frame = $cw->create_find_widget;

    # create frame for message
    my $msg_label = $cw->Label(
        -textvariable => \$cw->{message},
        -relief => 'sunken',
        -borderwidth => 1,
        -anchor =>'w',
    );
    $msg_label->pack( -pady => 0, -fill => 'x' );

    $args->{-title} = $title;
    $cw->SUPER::Populate($args);

    my $tk_font = $cw->Font(%{$config->{font}});
    $cw->ConfigSpecs(
        -font       => ['DESCENDANTS', 'font','Font', $tk_font ],
        #-background => ['DESCENDANTS', 'background', 'Background', $background],
        #-selectbackground => [$hlist, 'selectBackground', 'SelectBackground',
        #                      $selectbackground],
        -tree_width  => [ 'METHOD',  undef,        undef,        80 ],
        -tree_height => [ 'METHOD',  undef,        undef,        30 ],
        -width       => [ $eh_frame, qw/width Width 1280/ ],
        -height      => [ $eh_frame, qw/height Height 1024/ ],
        -selectmode  => [ $tree,     'selectMode', 'SelectMode', 'single' ],    #single',
                #-oldcursor => [$hlist, undef, undef, undef],
        DEFAULT => [$tree] );

    $cw->Advertise( tree        => $tree );
    $cw->Advertise( menubar     => $menubar );
    $cw->Advertise( history     => $history_menu );
    $cw->Advertise( right_frame => $eh_frame );
    $cw->Advertise( ed_frame    => $e_frame );
    $cw->Advertise( find_frame  => $find_frame );
    $cw->Advertise( msg_label   => $msg_label );
    $cw->Advertise( prev_btn    => $previous_btn );
    $cw->Advertise( next_btn    => $next_btn );

    $cw->OnDestroy(sub {$cw->Parent->destroy if ref($cw->Parent) eq 'MainWindow'} );

    $cw->Delegates;
}

sub show_message {
    my ( $cw, $msg ) = @_;
    # $cw->Subwidget('msg_label')->configure(-background => "red"); # does not work
    $cw->{message} = $msg;

    if (my $id = $cw->{id}) {
        $cw->afterCancel($id) ;
    } ;

    my $unshow = sub {
        delete $cw->{id};
        $cw->{message} = '';
    } ;
    $cw->{id} = $cw->after(5000,$unshow) ;
}

sub tree_width {
    my ( $cw, $value ) = @_;
    $cw->Subwidget('tree')->configure( -width => $value );
}

sub tree_height {
    my ( $cw, $value ) = @_;
    $cw->Subwidget('tree')->configure( -height => $value );
}

my $parser = Pod::POM->new();

# parse from my documentation
my $pom = $parser->parse_file(__FILE__)
    || die $parser->error();

my $help_text;
my $info_text;
foreach my $head1 ( $pom->head1() ) {
    $help_text = Pod::POM::View::Text->view_head1($head1)
        if $head1->title eq 'USAGE';
    $info_text = Pod::POM::View::Text->view_head1($head1)
        if $head1->title =~ /more information/i;

}

sub add_file_menu($cw, $menubar, $extra_menu) {