Ticket #1239: PerlTidy.pm.patch

File PerlTidy.pm.patch, 4.8 KB (added by bowtie, 3 years ago)
  • lib/Padre/Plugin/PerlTidy.pm

     
    2323use Padre::Plugin  (); 
    2424use base 'Padre::Plugin'; 
    2525 
    26 our $VERSION = 0.17; 
    27  
     26our $VERSION = 0.18; 
     27use File::Spec::Functions; 
     28use FindBin qw($Bin); 
     29use Perl::Tidy; 
    2830 
    2931# This constant is used when storing 
    3032# and restoring the cursor position. 
    3133# Keep it small to limit resource use. 
    32 use constant { 
    33     SELECTIONSIZE => 40, 
    34 }; 
     34use constant { SELECTIONSIZE => 40, }; 
    3535 
    3636sub padre_interfaces { 
    37     'Padre::Plugin' => '0.43', 'Padre::Config' => '0.54'; 
     37    return ( 
     38        'Padre::Plugin'   => '0.43', 
     39        'Padre::Config'   => '0.54', 
     40        'Padre::Wx::Main' => '0.86', 
     41    ); 
    3842} 
    3943 
    4044sub plugin_name { 
    41     Wx::gettext('Perl Tidy'); 
     45    return Wx::gettext('Perl Tidy'); 
    4246} 
    4347 
    4448sub menu_plugins_simple { 
     
    5256            \&export_document, 
    5357        Wx::gettext('Export selected text to HTML file') => 
    5458            \&export_selection, 
    55         '---' => undef, 
    56         Wx::gettext('Configure tidy') => 
    57             \&configure_tidy, 
     59        '---'                         => undef, 
     60        Wx::gettext('Configure tidy') => \&configure_tidy, 
    5861    ]; 
    5962} 
    6063 
     64my $over_ride; 
     65 
    6166sub _tidy { 
    6267    my $main       = shift; 
    6368    my $current    = shift; 
     
    8287        destination => \$destination, 
    8388        errorfile   => \$errorfile, 
    8489    ); 
     90    if ($over_ride) { 
     91        $tidyargs{'perltidyrc'} = $perltidyrc; 
     92    } 
    8593 
    86     #Make sure output is visible... 
    87     $main->show_output(1); 
    88     my $output = $main->output; 
     94    my $output; 
     95    if ( $main->config->info_on_statusbar ) { 
     96 
     97        # print "info_on_statusbar: " . $main->config->info_on_statusbar . "\n"; 
     98        $main->info( Wx::gettext("Running Tidy, don't forget to save changes.") ); 
     99    } else { 
     100 
     101        #Make sure output is visible... 
     102        $main->show_output(1); 
     103        $output = $main->output; 
     104    } 
    89105 
    90106    #   CLAUDIO: This code breaks the plugin, temporary disabled. 
    91107    #   Have a look at Perl::Tidy line 126 for details: expecting a reference related to a file and not Wx::CommandEvent). 
     
    101117    #   } 
    102118 
    103119    # TODO: suppress the senseless warning from PerlTidy 
    104     require Perl::Tidy; 
     120    # require Perl::Tidy; 
    105121    eval { Perl::Tidy::perltidy(%tidyargs); }; 
    106122 
    107123    if ($@) { 
     
    110126    } 
    111127 
    112128    if ( defined $errorfile ) { 
    113         my $filename = $document->filename ? $document->filename : $document->get_title; 
     129        $main->show_output(1); 
     130        $output = $main->output; 
     131        my $filename = 
     132              $document->filename 
     133            ? $document->filename 
     134            : $document->get_title; 
    114135        my $width = length($filename) + 2; 
    115136        $output->AppendText( "\n\n" . "-" x $width . "\n" . $filename . "\n" . "-" x $width . "\n" ); 
    116137        $output->AppendText("$errorfile\n"); 
     
    126147    # Tidy the current selected text 
    127148    my $current = $main->current; 
    128149    my $text    = $current->text; 
    129     my $tidy    = _tidy( $main, $current, $text, $perltidyrc ); 
     150    $over_ride = 0; 
     151    $perltidyrc = _which_tidyrc( $main, $perltidyrc ); 
     152    my $tidy = _tidy( $main, $current, $text, $perltidyrc ); 
    130153    unless ( defined Params::Util::_STRING($tidy) ) { 
    131154        return; 
    132155    } 
     
    155178    my $current  = $main->current; 
    156179    my $document = $current->document; 
    157180    my $text     = $document->text_get; 
    158     my $tidy     = _tidy( $main, $current, $text, $perltidyrc ); 
     181    $over_ride = 0; 
     182    $perltidyrc = _which_tidyrc( $main, $perltidyrc ); 
     183    my $tidy = _tidy( $main, $current, $text, $perltidyrc ); 
    159184    unless ( defined Params::Util::_STRING($tidy) ) { 
    160185        return; 
    161186    } 
     
    193218        $default_dir = $dialog->GetDirectory; 
    194219        my $path = File::Spec->catfile( $default_dir, $filename ); 
    195220        if ( -e $path ) { 
    196             return $path if $main->yes_no( Wx::gettext("File already exists. Overwrite it?"), Wx::gettext("Exist") ); 
     221            return $path 
     222                if $main->yes_no( 
     223                Wx::gettext("File already exists. Overwrite it?"), 
     224                Wx::gettext("Exist") 
     225                ); 
    197226        } else { 
    198227            return $path; 
    199228        } 
     
    266295 
    267296sub export_document { 
    268297 
    269  
    270298    my $main = shift; 
    271299    my $text = $main->current->document->text_get; 
    272300    _export( $main, $text ); 
     
    341369    return; 
    342370} 
    343371 
     372####### 
     373# method _which_tidyrc 
     374# Pick the revelant tidyrc file 
     375####### 
     376sub _which_tidyrc { 
     377    my $main       = shift; 
     378    my $perltidyrc = shift; 
     379 
     380    # perl tidy Padre/tools 
     381    if ( $ENV{'PADRE_DEV'} ) { 
     382        eval { $perltidyrc = catfile( $Bin, '../../tools/perltidyrc' ); }; 
     383        if ( -e $perltidyrc ) { 
     384            $over_ride = 1; 
     385            return $perltidyrc; 
     386        } else { 
     387 
     388            # $main->info_on_statusbar(0); 
     389            $main->info( Wx::gettext("You need to install from SVN Padre/tools.") ); 
     390 
     391            # $main->info_on_statusbar(1); 
     392        } 
     393 
     394    } 
     395 
     396    # perl tidy, PBP 
     397    elsif ( $main->config->lang_perl5_beginner ) { 
     398        my $pbprc = $INC{'Padre/Plugin/PerlTidy.pm'}; 
     399        $pbprc =~ s/\.pm//; 
     400 
     401        eval { $perltidyrc = catfile( $pbprc, 'pbptidyrc' ); }; 
     402        if ( -e $perltidyrc ) { 
     403            $over_ride = 1; 
     404            return $perltidyrc; 
     405        } 
     406    } 
     407    return; 
     408} 
     409 
    3444101; 
    345411 
    346412=pod