Ticket #1239: PerlTidy.pm.patch2

File PerlTidy.pm.patch2, 5.1 KB (added by bowtie, 3 years ago)

new diff for szabgab

Line 
1Index: lib/Padre/Plugin/PerlTidy.pm
2===================================================================
3--- lib/Padre/Plugin/PerlTidy.pm    (revision 14741)
4+++ lib/Padre/Plugin/PerlTidy.pm    (working copy)
5@@ -23,22 +23,26 @@
6 use Padre::Plugin  ();
7 use base 'Padre::Plugin';
8 
9-our $VERSION = 0.17;
10-
11+our $VERSION = 0.19;
12+use File::Spec::Functions;
13+use FindBin qw($Bin);
14+use Perl::Tidy;
15 
16 # This constant is used when storing
17 # and restoring the cursor position.
18 # Keep it small to limit resource use.
19-use constant {
20-   SELECTIONSIZE => 40,
21-};
22+use constant { SELECTIONSIZE => 40, };
23 
24 sub padre_interfaces {
25-   'Padre::Plugin' => '0.43', 'Padre::Config' => '0.54';
26+   return (
27+       'Padre::Plugin'   => '0.43',
28+       'Padre::Config'   => '0.54',
29+       'Padre::Wx::Main' => '0.86',
30+   );
31 }
32 
33 sub plugin_name {
34-   Wx::gettext('Perl Tidy');
35+   return Wx::gettext('Perl Tidy');
36 }
37 
38 sub menu_plugins_simple {
39@@ -52,12 +56,13 @@
40            \&export_document,
41        Wx::gettext('Export selected text to HTML file') =>
42            \&export_selection,
43-       '---' => undef,
44-       Wx::gettext('Configure tidy') =>
45-           \&configure_tidy,
46+       '---'                         => undef,
47+       Wx::gettext('Configure tidy') => \&configure_tidy,
48    ];
49 }
50 
51+my $over_ride;
52+
53 sub _tidy {
54    my $main       = shift;
55    my $current    = shift;
56@@ -82,10 +87,21 @@
57        destination => \$destination,
58        errorfile   => \$errorfile,
59    );
60+   if ($over_ride) {
61+       $tidyargs{'perltidyrc'} = $perltidyrc;
62+   }
63 
64-   #Make sure output is visible...
65-   $main->show_output(1);
66-   my $output = $main->output;
67+   my $output;
68+   if ( $main->config->info_on_statusbar ) {
69+
70+       # print "info_on_statusbar: " . $main->config->info_on_statusbar . "\n";
71+       $main->info( Wx::gettext("Running Tidy, don't forget to save changes.") );
72+   } else {
73+
74+       #Make sure output is visible...
75+       $main->show_output(1);
76+       $output = $main->output;
77+   }
78 
79    #   CLAUDIO: This code breaks the plugin, temporary disabled.
80    #   Have a look at Perl::Tidy line 126 for details: expecting a reference related to a file and not Wx::CommandEvent).
81@@ -101,7 +117,7 @@
82    #   }
83 
84    # TODO: suppress the senseless warning from PerlTidy
85-   require Perl::Tidy;
86+   # require Perl::Tidy;
87    eval { Perl::Tidy::perltidy(%tidyargs); };
88 
89    if ($@) {
90@@ -110,7 +126,12 @@
91    }
92 
93    if ( defined $errorfile ) {
94-       my $filename = $document->filename ? $document->filename : $document->get_title;
95+       $main->show_output(1);
96+       $output = $main->output;
97+       my $filename =
98+             $document->filename
99+           ? $document->filename
100+           : $document->get_title;
101        my $width = length($filename) + 2;
102        $output->AppendText( "\n\n" . "-" x $width . "\n" . $filename . "\n" . "-" x $width . "\n" );
103        $output->AppendText("$errorfile\n");
104@@ -126,7 +147,9 @@
105    # Tidy the current selected text
106    my $current = $main->current;
107    my $text    = $current->text;
108-   my $tidy    = _tidy( $main, $current, $text, $perltidyrc );
109+   $over_ride = 0;
110+   $perltidyrc = _which_tidyrc( $main, $perltidyrc );
111+   my $tidy = _tidy( $main, $current, $text, $perltidyrc );
112    unless ( defined Params::Util::_STRING($tidy) ) {
113        return;
114    }
115@@ -155,7 +178,9 @@
116    my $current  = $main->current;
117    my $document = $current->document;
118    my $text     = $document->text_get;
119-   my $tidy     = _tidy( $main, $current, $text, $perltidyrc );
120+   $over_ride = 0;
121+   $perltidyrc = _which_tidyrc( $main, $perltidyrc );
122+   my $tidy = _tidy( $main, $current, $text, $perltidyrc );
123    unless ( defined Params::Util::_STRING($tidy) ) {
124        return;
125    }
126@@ -193,7 +218,11 @@
127        $default_dir = $dialog->GetDirectory;
128        my $path = File::Spec->catfile( $default_dir, $filename );
129        if ( -e $path ) {
130-           return $path if $main->yes_no( Wx::gettext("File already exists. Overwrite it?"), Wx::gettext("Exist") );
131+           return $path
132+               if $main->yes_no(
133+               Wx::gettext("File already exists. Overwrite it?"),
134+               Wx::gettext("Exist")
135+               );
136        } else {
137            return $path;
138        }
139@@ -232,7 +261,7 @@
140 
141    if ( my $tidyrc = $doc->project->config->config_perltidy ) {
142        $tidyargs{perltidyrc} = $tidyrc;
143-       $output->AppendText("Perl\::Tidy running with project-specific configuration $tidyrc\n");
144+       $output->AppendText( "Perl\::Tidy running with project-specific configuration $tidyrc\n" );
145    } else {
146        $output->AppendText("Perl::Tidy running with default or user configuration\n");
147    }
148@@ -266,7 +295,6 @@
149 
150 sub export_document {
151 
152-
153    my $main = shift;
154    my $text = $main->current->document->text_get;
155    _export( $main, $text );
156@@ -341,6 +369,37 @@
157    return;
158 }
159 
160+#######
161+# method _which_tidyrc
162+# Pick the revelant tidyrc file
163+#######
164+sub _which_tidyrc {
165+   my $main       = shift;
166+   my $perltidyrc = shift;
167+
168+   # perl tidy Padre/tools
169+   if ( $ENV{'PADRE_DEV'} ) {
170+       eval { $perltidyrc = catfile( $Bin, '../../tools/perltidyrc' ); };
171+       if ( -e $perltidyrc ) {
172+           $over_ride = 1;
173+           return $perltidyrc;
174+       } else {
175+
176+           $main->config->info_on_statusbar(0);
177+           $main->info( Wx::gettext("You need to install from SVN Padre/tools.") );
178+           print " here we are \n";
179+           Wx::MessageBox(
180+               Wx::gettext("You need to install from SVN Padre/tools."),
181+               Wx::gettext("tools/perltidyrc missing"),
182+               Wx::wxCANCEL, # Wx::wxYES_NO, #| Wx::wxCANCEL | Wx::wxCENTRE,
183+               $main,
184+           );
185+           $main->config->info_on_statusbar(1);
186+       }
187+   }
188+   return;
189+}
190+
191 1;
192 
193 =pod