Config-Model-TkUI

 view release on metacpan or  search on metacpan

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

    $cw->add_help_menu($menubar);

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

    $cw->add_edit_menu($menubar);

    my $history_menu = $menubar->cascade(-label => 'History');

    my $option_menu = $menubar->cascade( -label => 'Options');
    $option_menu->command( -label => 'Font', -command => sub { $cw->set_font(); });

    # create 'hide empty values'
    $cw->{hide_empty_values} = 0;
    $option_menu->checkbutton(
        -label  => "Hide empty values",
        -variable => \$cw->{hide_empty_values},
        -command  => sub { $cw->reload($cw->{location}) },
    );

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

        @$extra_menu,
        [
            command  => 'debug ...',
            -command => sub {
                require Tk::ObjScanner;
                Tk::ObjScanner::scan_object( $cw->{instance}->config_root );
            }
        ],
        [ command => 'quit (Ctrl-q)', -command => sub { $cw->quit } ],
    ];
    $menubar->cascade( -label => 'File', -menuitems => $file_items );

    return;
}

sub add_help_menu {
    my ( $cw, $menubar ) = @_;

    my $about_sub = sub {
        $cw->Dialog(
            -title => 'About',

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

            -exitbutton => 0,
        );
    };

    my $help_items = [
        [ qw/command About -command/, $about_sub ],
        [ qw/command Usage -command/, $help_sub ],
        [ command => 'More info',   -command => $info_sub ],
        [ command => "$class help", -command => $man_sub ],
    ];
    $menubar->cascade( -label => 'Help', -menuitems => $help_items );
}

sub add_edit_menu($cw, $menubar) {
    my $edit_items = [
        # [ qw/command cut   -command/, sub{ $cw->edit_cut }],
        [ command => 'copy (Ctrl-c)',  '-command', sub { $cw->edit_copy } ],
        [ command => 'paste (Ctrl-v)', '-command', sub { $cw->edit_paste } ],
        [ command => 'find (Ctrl-f)',  '-command', sub { $cw->pack_find_widget; } ],
    ];
    $menubar->cascade( -label => 'Edit', -menuitems => $edit_items );
    return;
}

# Note: this callback is called by Tk::Tree *before* changing the
# indicator. And the indicator is used by Tk::Tree to store the
# open/close/none mode. So we can't rely on getmode for path that are
# opening. Hence the parameter passed to the sub stored with each
# Tk::Tree item
sub open_item {
    my ( $cw, $path ) = @_;

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

    if ($history->@* > 1 and $loc eq $history->[-1]) {
        return;
    }

    push $history->@*, $loc;
    my $path_idx = $cw->{path_index} = $history->$#*;

    # enable previous button when history has more than one item
    $cw->Subwidget('prev_btn')->configure(-state => $path_idx > 0 ? 'normal' : 'disabled');

    my $h_cascade = $cw->Subwidget('history');

    my $max_count = 20;
    $cw->{history_count} //= 0;

    if ($cw->{history_count}++ > $max_count) {
        # delete all history entries from the menu
        $h_cascade->menu->delete(0, 'end');

        # Add the last $max_count history entries to the menu
        for (my $i = 0; $i <= $max_count; $i++) {
            my $entry_idx = $path_idx - $i;
            $h_cascade->menu->add(
                'command',
                -label => $history->[$entry_idx],
                -command =>sub { $cw->go_to_loc($path_idx); }
            );
        }
    }
    else {
        # add a menu entry
        $h_cascade->command(
            -label => $loc,
            -command => sub { $cw->go_to_loc($path_idx); }
        );
    }

    return;
}

sub go_to_loc ($cw, $idx) {
    my $path = $cw->{path_history}[$idx];