view release on metacpan or  search on metacpan

lib/App/PerlTidy/Tk.pm  view on Meta::CPAN

    $self->{autotidy} = 0;

    $self->load_default_configuration;

    $self->{top} = MainWindow->new();
    if (exists $config->{geometry}) {
        $self->{top}->geometry($config->{geometry});
    }

    $self->{top}->bind("<Control-Shift-plus>", sub { $self->zoom($zoom) });
    $self->{top}->bind("<Control-minus>", sub { $self->zoom(-$zoom) });
    $self->{top}->bind("<Control-q>", sub { $self->exit_app(); });

    $self->create_menu;
    $self->create_text_widget;
    $self->create_config_panel;

    if ($perlfile) {
        $self->load_perl_file($perlfile);
    }

    return $self;
}

sub run {
    my ($self) = @_;
    MainLoop;
}

sub load_default_configuration {
    my ($self) = @_;

    my ($option_string, $defaults, $expansion, $category, $option_range) = Perl::Tidy::generate_options();
    #print Dumper $option_range;
    $option_range->{'indent-columns'} ||= [1, 8];
    $self->{range} = $option_range;
    #$self->{defaults} = $defaults;
    $self->{config} = {}; # options that have a value
    $self->{flags} = {}; # options that only have presence
    $self->{widgets} = {};
    #print Dumper $option_string;
    for my $def (sort @$defaults) {
        my ($name, $value) = split /=/, $def;
        #print "$name\n";
        next if $skip{$name};
        if (defined $value) {
            #print "   $value\n";
            $self->{config}{$name} = $value;
        } else {
            $self->{flags}{$name} = 1;
        }
    }
}


sub create_menu {
    my ($self) = @_;

    my $main_menu = $self->{top}->Menu();

    my $file_menu = $main_menu->cascade(-label => 'File', -underline => 0);
    $file_menu->command(-label => 'Open Perl File', -command => sub { $self->show_open(); }, -underline => 0);
    #$file_menu->command(-label => 'Load Config', -command => sub { $self->load_config(); }, -underline => 0);
    $file_menu->command(-label => 'Save Config', -command => sub { $self->save_config(); }, -underline => 0);
    $file_menu->command(-label => 'Quit (Ctrl-q)', -command => sub { $self->exit_app(); }, -underline => 0);

    my $action_menu = $main_menu->cascade(-label => 'Action', -underline => 0);
    $action_menu->command(-label => 'Tidy', -command => sub { $self->run_tidy; });
    $action_menu->command(-label => 'Zoom in (Ctrl-Shift-+)', -command => sub { $self->zoom($zoom); });
    $action_menu->command(-label => 'Zoom Out (Ctrl--)', -command => sub { $self->zoom(-$zoom); });
    $action_menu->checkbutton(-label => 'Autotidy', -variable => \$self->{autotidy});

    my $about_menu = $main_menu->cascade(-label => 'Help', -underline => 0);
    $about_menu->command(-label => 'About', -command => sub { $self->show_about; }, -underline => 0);

    $self->{top}->configure(-menu => $main_menu);
}

sub save_config {
    my ($self) = @_;

    my $start_dir = getcwd();
    my $file_selector = $self->{top}->FileSelect(-directory => $start_dir);
    my $filename = $file_selector->Show;
    if (-e $filename) {
        my $dialog = $self->{top}->Dialog(
            -title   => 'Overwrite?',
            -text    => "The file $filename already exists. Overwrite?",
            -popover => $self->{top},
            -buttons => ['Yes', 'No'],
        );
        my $res = $dialog->Show;
        return if $res ne 'Yes';
    }
    my $rc = $self->get_rc();
    if (open my $fh, '>', $filename) {
        my $localtime = scalar localtime;
        print $fh "# Saved by App::PerlTidy::Tk on $localtime\n\n";
        print $fh $rc;
    } else {
        my $dialog = $self->{top}->Dialog(
            -title   => 'Error',
            -text    => "Could not write to file. $!",
            -popover => $self->{top},
            -buttons => ['OK'],
        );
    }
}

sub load_config {
    my ($self) = @_;
}

sub zoom {
    my ($self, $number) = @_;
    my $font_info = $self->{text}->configure('-font');
    #print "${$font_info->[4]}\n";  # 'fixed 20';
    my ($font, $size) = split / /, ${$font_info->[4]};
    $size += $number;
    $self->{text}->configure(-font => ['fixed', $size]);
}

sub create_config_panel {
    my ($self) = @_;

    $self->{table}  = $self->{top}->Table(-columns => 2, -rows => 1, -fixedrows => 1, -scrollbars => '');
    $self->{table}->pack(-expand=> 1, -fill => 'both');

    my $row = -1;

    #my $name = 'line-up-parentheses';
    #print $self->{flags}{$name}, "\n";
    #my $cb = $self->{top}->Checkbutton(