view release on metacpan or  search on metacpan

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

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(
    #    -text     => $name,
    #    -variable => \$self->{flags}{$name},
    #    -font     => ['fixed', 10]
    #);
    #$cb->pack(-side => 'left');

    for my $name (@options) {
        $row++;
        my $label = $self->{table}->Label(
            -text     => $name,
        );
        $self->{table}->put($row, 0, $label);

        my $cb = $self->{table}->Optionmenu(
            -variable => \$self->{config}{$name},
            -options  => [$self->{range}{$name}[0] .. $self->{range}{$name}[1]],
            -command => sub { $self->config_changed },
        );
        $self->{table}->put($row, 1, $cb);
        $self->{widgets}{$name} = $cb;
    }
}

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

    if ($self->{autotidy}) {
        $self->run_tidy;
    }
}


sub update_config {
    my ($self) = @_;
    #my $name = 'indent-columns';
    #$self->{config}{$name} = $self->{widgets}{$name}->get;
}

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

    $self->{text} = $self->{top}->Text(
        -state => 'normal',
        -font => ['fixed', 12],
    );
    $self->{text}->pack(-fill => 'both', -expand => 1);
}

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

    my $start_dir = getcwd();
    my $file_selector = $self->{top}->FileSelect(-directory => $start_dir);
    my $filename = $file_selector->Show;
    $self->load_perl_file($filename);
}

sub load_perl_file {
    my ($self, $filename) = @_;

    if ($filename and -f $filename) {
        if (open my $fh, '<', $filename) {
            local $/ = undef;
            my $content = <$fh>;
            $self->{text}->delete("0.0", 'end');
            $self->{text}->insert("0.0", $content);
        } else {
            print "TODO: Report error $! for '$filename'\n";
        }
    }
}

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

    $self->update_config;

    my $rc = '';
    while (my ($name, $value) = each %{$self->{config}}) {
        $rc .= "--$name=$value\n";
    }
    for my $name (keys %{$self->{flags}}) {
        $rc .= "--$name\n";
    }
    #print $rc;
    return $rc;
}

sub run_tidy {
    my ($self) = @_;
    #print Dumper \%skip;
    #
    my $rc = $self->get_rc();

    #for my $field (sort keys %config) {
    #    if (defined $config{$field}) {
    #        $rc .= "$field=$config{$field}\n";
    #    } else {
    #        $rc .= "$field\n";
    #    }
    #}

    my $code = $self->{text}->get("0.0", 'end');
    my $clean;