Ticket #1239: PerlTidy.pm.patch

lib/Padre/Plugin/PerlTidy.pm

@@ -23 +23 @@
 use Padre::Plugin  ();
 use base 'Padre::Plugin';
 
-our $VERSION = 0.17;
-
+our $VERSION = 0.18;
+use File::Spec::Functions;
+use FindBin qw($Bin);
+use Perl::Tidy;
 
 # This constant is used when storing
 # and restoring the cursor position.
 # Keep it small to limit resource use.
-use constant {
-    SELECTIONSIZE => 40,
-};
+use constant { SELECTIONSIZE => 40, };
 
 sub padre_interfaces {
-    'Padre::Plugin' => '0.43', 'Padre::Config' => '0.54';
+    return (
+        'Padre::Plugin'   => '0.43',
+        'Padre::Config'   => '0.54',
+        'Padre::Wx::Main' => '0.86',
+    );
 }
 
 sub plugin_name {
-    Wx::gettext('Perl Tidy');
+    return Wx::gettext('Perl Tidy');
 }
 
 sub menu_plugins_simple {
@@ -52 +56 @@
             \&export_document,
         Wx::gettext('Export selected text to HTML file') =>
             \&export_selection,
-        '---' => undef,
-        Wx::gettext('Configure tidy') =>
-            \&configure_tidy,
+        '---'                         => undef,
+        Wx::gettext('Configure tidy') => \&configure_tidy,
     ];
 }
 
+my $over_ride;
+
 sub _tidy {
     my $main       = shift;
     my $current    = shift;
@@ -82 +87 @@
         destination => \$destination,
         errorfile   => \$errorfile,
     );
+    if ($over_ride) {
+        $tidyargs{'perltidyrc'} = $perltidyrc;
+    }
 
-    #Make sure output is visible...
-    $main->show_output(1);
-    my $output = $main->output;
+    my $output;
+    if ( $main->config->info_on_statusbar ) {
+
+        # print "info_on_statusbar: " . $main->config->info_on_statusbar . "\n";
+        $main->info( Wx::gettext("Running Tidy, don't forget to save changes.") );
+    } else {
+
+        #Make sure output is visible...
+        $main->show_output(1);
+        $output = $main->output;
+    }
 
     #   CLAUDIO: This code breaks the plugin, temporary disabled.
     #   Have a look at Perl::Tidy line 126 for details: expecting a reference related to a file and not Wx::CommandEvent).
@@ -101 +117 @@
     #   }
 
     # TODO: suppress the senseless warning from PerlTidy
-    require Perl::Tidy;
+    # require Perl::Tidy;
     eval { Perl::Tidy::perltidy(%tidyargs); };
 
     if ($@) {
@@ -110 +126 @@
     }
 
     if ( defined $errorfile ) {
-        my $filename = $document->filename ? $document->filename : $document->get_title;
+        $main->show_output(1);
+        $output = $main->output;
+        my $filename =
+              $document->filename
+            ? $document->filename
+            : $document->get_title;
         my $width = length($filename) + 2;
         $output->AppendText( "\n\n" . "-" x $width . "\n" . $filename . "\n" . "-" x $width . "\n" );
         $output->AppendText("$errorfile\n");
@@ -126 +147 @@
     # Tidy the current selected text
     my $current = $main->current;
     my $text    = $current->text;
-    my $tidy    = _tidy( $main, $current, $text, $perltidyrc );
+    $over_ride = 0;
+    $perltidyrc = _which_tidyrc( $main, $perltidyrc );
+    my $tidy = _tidy( $main, $current, $text, $perltidyrc );
     unless ( defined Params::Util::_STRING($tidy) ) {
         return;
     }
@@ -155 +178 @@
     my $current  = $main->current;
     my $document = $current->document;
     my $text     = $document->text_get;
-    my $tidy     = _tidy( $main, $current, $text, $perltidyrc );
+    $over_ride = 0;
+    $perltidyrc = _which_tidyrc( $main, $perltidyrc );
+    my $tidy = _tidy( $main, $current, $text, $perltidyrc );
     unless ( defined Params::Util::_STRING($tidy) ) {
         return;
     }
@@ -193 +218 @@
         $default_dir = $dialog->GetDirectory;
         my $path = File::Spec->catfile( $default_dir, $filename );
         if ( -e $path ) {
-            return $path if $main->yes_no( Wx::gettext("File already exists. Overwrite it?"), Wx::gettext("Exist") );
+            return $path
+                if $main->yes_no(
+                Wx::gettext("File already exists. Overwrite it?"),
+                Wx::gettext("Exist")
+                );
         } else {
             return $path;
         }
@@ -266 +295 @@
 
 sub export_document {
 
-
     my $main = shift;
     my $text = $main->current->document->text_get;
     _export( $main, $text );
@@ -341 +369 @@
     return;
 }
 
+#######
+# method _which_tidyrc
+# Pick the revelant tidyrc file
+#######
+sub _which_tidyrc {
+    my $main       = shift;
+    my $perltidyrc = shift;
+
+    # perl tidy Padre/tools
+    if ( $ENV{'PADRE_DEV'} ) {
+        eval { $perltidyrc = catfile( $Bin, '../../tools/perltidyrc' ); };
+        if ( -e $perltidyrc ) {
+            $over_ride = 1;
+            return $perltidyrc;
+        } else {
+
+            # $main->info_on_statusbar(0);
+            $main->info( Wx::gettext("You need to install from SVN Padre/tools.") );
+
+            # $main->info_on_statusbar(1);
+        }
+
+    }
+
+    # perl tidy, PBP
+    elsif ( $main->config->lang_perl5_beginner ) {
+        my $pbprc = $INC{'Padre/Plugin/PerlTidy.pm'};
+        $pbprc =~ s/\.pm//;
+
+        eval { $perltidyrc = catfile( $pbprc, 'pbptidyrc' ); };
+        if ( -e $perltidyrc ) {
+            $over_ride = 1;
+            return $perltidyrc;
+        }
+    }
+    return;
+}
+
 1;
 
 =pod