view release on metacpan or  search on metacpan

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

    my $tk_font = $main_window->FontDialog->Show;
    if (defined $tk_font) {
        $main_window->RefontTree(-font => $tk_font);
        $config->{font} = {$tk_font->actual} ;
        $cw->ConfigSpecs( -font => ['DESCENDANTS', 'font','Font', $tk_font ]);
        $ypp->dump_file($config_file->stringify, $config);
    }
}

sub Populate {
    my ( $cw, $args ) = @_;

    unless ( defined $error_img ) {
        $error_img = $cw->Photo( -file => $icon_path . 'stop.png' );
        $cust_img  = $cw->Photo( -file => $icon_path . 'next.png' );

        # snatched from oxygen-icon-theme
        $warn_img = $cw->Photo( -file => $icon_path . 'dialog-warning.png' );

        # snatched from openclipart-png
        $tool_img = $cw->Photo( -file => $icon_path . 'tools_nicu_buculei_01.png' );

        # snatched from gnome gnome-icon-theme package
        foreach my $img_name (qw/next previous window-close gtk-execute/) {
            $gnome_img{$img_name} = $cw->Photo(
                -file => $icon_path . "gnome-$img_name.png"
            );
        }
    }

    if ($args->{-root}) {
        carp "TkUI: -root parameter is deprecated in favor of -instance";
        my $root = delete $args->{-root};
        $cw->{instance} = $root->instance;
    }

    $cw->{instance} //= delete $args->{-instance};

    foreach my $parm (qw/-store_sub -quit/) {
        my $attr = $parm;
        $attr =~ s/^-//;
        $cw->{$attr} = delete $args->{$parm};
    }

    my $extra_menu = delete $args->{'-extra-menu'} || [];

    my $title = delete $args->{'-title'}
        || $0 . " " . $cw->{instance}->config_root->config_class_name;

    # check unknown parameters
    croak "Unknown parameter ", join( ' ', keys %$args ) if %$args;

    # initialize internal attributes
    $cw->{location} = '';
    $cw->{current_mode} = 'view';

    $cw->setup_scanner();

    # create top menu
    require Tk::Menubutton;
    my $menubar = $cw->Menu;
    $cw->configure( -menu => $menubar );
    $cw->{my_menu} = $menubar;

    $cw->add_file_menu($menubar, $extra_menu);
    $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}) },
    );

    # create 'show only custom values'
    $cw->{show_only_custom} = 0;
    $option_menu->checkbutton(
        -label => 'Show only custom values',
        -variable => \$cw->{show_only_custom},
        -command  => sub { $cw->reload($cw->{location}) },
    );

    # create 'show only custom values'
    $cw->{auto_save_mode} = 0;
    $option_menu->checkbutton(
        -label => 'Auto save',
        -variable => \$cw->{auto_save_mode},
    );

    my $weak_cw = $cw;
    weaken($weak_cw);
    $cw->{instance}->on_change_cb( sub {
        $weak_cw->save if $weak_cw->{auto_save_mode};;
    });

    # create frame for location entry
    my $loc_frame = $cw->Frame( -relief => 'sunken', -borderwidth => 1 )
        ->pack( -pady => 0, -fill => 'x' );
    $cw->{path_history} = [];
    $cw->{path_index} = 0;

    # add button
    my $previous_btn = $loc_frame->Button (
        -image => $gnome_img{'previous'},
        -state => 'disabled',
        -command => sub { $cw->go_to_previous();},
    );