[SCM] Packaging for padre-plugin-perltidy branch, upstream, updated. upstream/0.06-1-g790bd9e
Ryan Niebur
ryanryan52 at gmail.com
Tue Jun 16 07:50:05 UTC 2009
The following commit has been merged in the upstream branch:
commit 790bd9e54bcc468b75d6f671bdf8fbff0b0dbf45
Author: Ryan Niebur <ryanryan52 at gmail.com>
Date: Tue Jun 16 00:49:38 2009 -0700
Imported Upstream version 0.07
diff --git a/Changes b/Changes
index 2eead0f..8de4e10 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,15 @@
Revision history for Perl extension Padre::Plugin::PerlTidy.
+0.07 Fri Jun 12 2009
+ - Added translations:
+ - German (hjansen)
+ - Arabic (azawawi)
+ - Spanish (brunov)
+ - Brazilian Portuguese (garu)
+ - Cursor location is kept after cleaning (instead of beginning document).
+ (claudio)
+ - Menu tests are now locale agnostic (BRICAS)
+
0.06 Wed May 20 2009
- Keyboard shortcuts added (claudio)
- Added translations:
diff --git a/META.yml b/META.yml
index 7f5abff..eb2a2d2 100644
--- a/META.yml
+++ b/META.yml
@@ -8,7 +8,7 @@ build_requires:
configure_requires:
ExtUtils::MakeMaker: 6.42
distribution_type: module
-generated_by: 'Module::Install version 0.88'
+generated_by: 'Module::Install version 0.91'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -26,5 +26,7 @@ requires:
Perl::Tidy: 0
perl: 5.8.1
resources:
+ homepage: http://padre.perlide.org/
license: http://dev.perl.org/licenses/
-version: 0.06
+ repository: http://svn.perlide.org/padre/trunk/Padre-Plugin-PerlTidy
+version: 0.07
diff --git a/Makefile.PL b/Makefile.PL
index 3a1659e..43c8a47 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -9,6 +9,9 @@ requires 'Padre' => '0.26';
requires 'Perl::Tidy';
test_requires 'Test::More';
+homepage 'http://padre.perlide.org/';
+repository 'http://svn.perlide.org/padre/trunk/Padre-Plugin-PerlTidy';
+
extra_tests;
is_padre_plugin; # authors: Install Module::Install::PadrePlugin
diff --git a/inc/Module/Install.pm b/inc/Module/Install.pm
index d39e460..51eda5d 100644
--- a/inc/Module/Install.pm
+++ b/inc/Module/Install.pm
@@ -28,7 +28,7 @@ BEGIN {
# This is not enforced yet, but will be some time in the next few
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
- $VERSION = '0.88';
+ $VERSION = '0.91';
# Storage for the pseudo-singleton
$MAIN = undef;
diff --git a/inc/Module/Install/Base.pm b/inc/Module/Install/Base.pm
index c08b3f0..60a74d2 100644
--- a/inc/Module/Install/Base.pm
+++ b/inc/Module/Install/Base.pm
@@ -4,7 +4,7 @@ package Module::Install::Base;
use strict 'vars';
use vars qw{$VERSION};
BEGIN {
- $VERSION = '0.88';
+ $VERSION = '0.91';
}
# Suspend handler for "redefined" warnings
@@ -13,42 +13,34 @@ BEGIN {
$SIG{__WARN__} = sub { $w };
}
-### This is the ONLY module that shouldn't have strict on
-# use strict;
-
-#line 45
+#line 42
sub new {
- my ($class, %args) = @_;
-
- foreach my $method ( qw(call load) ) {
- next if defined &{"$class\::$method"};
- *{"$class\::$method"} = sub {
- shift()->_top->$method(@_);
- };
+ my $class = shift;
+ unless ( defined &{"${class}::call"} ) {
+ *{"${class}::call"} = sub { shift->_top->call(@_) };
}
-
- bless( \%args, $class );
+ unless ( defined &{"${class}::load"} ) {
+ *{"${class}::load"} = sub { shift->_top->load(@_) };
+ }
+ bless { @_ }, $class;
}
-#line 66
+#line 61
sub AUTOLOAD {
- my $self = shift;
local $@;
- my $autoload = eval {
- $self->_top->autoload
- } or return;
- goto &$autoload;
+ my $func = eval { shift->_top->autoload } or return;
+ goto &$func;
}
-#line 83
+#line 75
sub _top {
$_[0]->{_top};
}
-#line 98
+#line 90
sub admin {
$_[0]->_top->{admin}
@@ -56,7 +48,7 @@ sub admin {
Module::Install::Base::FakeAdmin->new;
}
-#line 114
+#line 106
sub is_admin {
$_[0]->admin->VERSION;
@@ -83,4 +75,4 @@ BEGIN {
1;
-#line 162
+#line 154
diff --git a/inc/Module/Install/Can.pm b/inc/Module/Install/Can.pm
index fd64344..e65e4f6 100644
--- a/inc/Module/Install/Can.pm
+++ b/inc/Module/Install/Can.pm
@@ -2,16 +2,16 @@
package Module::Install::Can;
use strict;
-use Module::Install::Base;
-use Config ();
-use File::Spec ();
-use ExtUtils::MakeMaker ();
+use Config ();
+use File::Spec ();
+use ExtUtils::MakeMaker ();
+use Module::Install::Base ();
-use vars qw{$VERSION $ISCORE @ISA};
+use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.88';
+ $VERSION = '0.91';
+ @ISA = 'Module::Install::Base';
$ISCORE = 1;
- @ISA = qw{Module::Install::Base};
}
# check if we can load some module
diff --git a/inc/Module/Install/Fetch.pm b/inc/Module/Install/Fetch.pm
index e0acf6b..05f2079 100644
--- a/inc/Module/Install/Fetch.pm
+++ b/inc/Module/Install/Fetch.pm
@@ -2,13 +2,13 @@
package Module::Install::Fetch;
use strict;
-use Module::Install::Base;
+use Module::Install::Base ();
-use vars qw{$VERSION $ISCORE @ISA};
+use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.88';
+ $VERSION = '0.91';
+ @ISA = 'Module::Install::Base';
$ISCORE = 1;
- @ISA = qw{Module::Install::Base};
}
sub get_file {
diff --git a/inc/Module/Install/Makefile.pm b/inc/Module/Install/Makefile.pm
index 3d10124..98779db 100644
--- a/inc/Module/Install/Makefile.pm
+++ b/inc/Module/Install/Makefile.pm
@@ -2,14 +2,14 @@
package Module::Install::Makefile;
use strict 'vars';
-use Module::Install::Base;
-use ExtUtils::MakeMaker ();
+use ExtUtils::MakeMaker ();
+use Module::Install::Base ();
-use vars qw{$VERSION $ISCORE @ISA};
+use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.88';
+ $VERSION = '0.91';
+ @ISA = 'Module::Install::Base';
$ISCORE = 1;
- @ISA = qw{Module::Install::Base};
}
sub Makefile { $_[0] }
diff --git a/inc/Module/Install/Metadata.pm b/inc/Module/Install/Metadata.pm
index 6fd221f..653193d 100644
--- a/inc/Module/Install/Metadata.pm
+++ b/inc/Module/Install/Metadata.pm
@@ -2,18 +2,17 @@
package Module::Install::Metadata;
use strict 'vars';
-use Module::Install::Base;
+use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.88';
- @ISA = qw{Module::Install::Base};
+ $VERSION = '0.91';
+ @ISA = 'Module::Install::Base';
$ISCORE = 1;
}
my @boolean_keys = qw{
sign
- mymeta
};
my @scalar_keys = qw{
@@ -440,21 +439,21 @@ sub license_from {
/ixms ) {
my $license_text = $1;
my @phrases = (
- 'under the same (?:terms|license) as perl itself' => 'perl', 1,
- 'GNU general public license' => 'gpl', 1,
- 'GNU public license' => 'gpl', 1,
- 'GNU lesser general public license' => 'lgpl', 1,
- 'GNU lesser public license' => 'lgpl', 1,
- 'GNU library general public license' => 'lgpl', 1,
- 'GNU library public license' => 'lgpl', 1,
- 'BSD license' => 'bsd', 1,
- 'Artistic license' => 'artistic', 1,
- 'GPL' => 'gpl', 1,
- 'LGPL' => 'lgpl', 1,
- 'BSD' => 'bsd', 1,
- 'Artistic' => 'artistic', 1,
- 'MIT' => 'mit', 1,
- 'proprietary' => 'proprietary', 0,
+ 'under the same (?:terms|license) as (?:perl|the perl programming language) itself' => 'perl', 1,
+ 'GNU general public license' => 'gpl', 1,
+ 'GNU public license' => 'gpl', 1,
+ 'GNU lesser general public license' => 'lgpl', 1,
+ 'GNU lesser public license' => 'lgpl', 1,
+ 'GNU library general public license' => 'lgpl', 1,
+ 'GNU library public license' => 'lgpl', 1,
+ 'BSD license' => 'bsd', 1,
+ 'Artistic license' => 'artistic', 1,
+ 'GPL' => 'gpl', 1,
+ 'LGPL' => 'lgpl', 1,
+ 'BSD' => 'bsd', 1,
+ 'Artistic' => 'artistic', 1,
+ 'MIT' => 'mit', 1,
+ 'proprietary' => 'proprietary', 0,
);
while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
$pattern =~ s{\s+}{\\s+}g;
@@ -506,6 +505,17 @@ sub requires_from {
}
}
+sub test_requires_from {
+ my $self = shift;
+ my $content = Module::Install::_readperl($_[0]);
+ my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg;
+ while ( @requires ) {
+ my $module = shift @requires;
+ my $version = shift @requires;
+ $self->test_requires( $module => $version );
+ }
+}
+
# Convert triple-part versions (eg, 5.6.1 or 5.8.9) to
# numbers (eg, 5.006001 or 5.008009).
# Also, convert double-part versions (eg, 5.8)
@@ -516,7 +526,8 @@ sub _perl_version {
$v =~ s/(\.\d\d\d)000$/$1/;
$v =~ s/_.+$//;
if ( ref($v) ) {
- $v = $v + 0; # Numify
+ # Numify
+ $v = $v + 0;
}
return $v;
}
@@ -526,23 +537,58 @@ sub _perl_version {
######################################################################
-# MYMETA.yml Support
+# MYMETA Support
sub WriteMyMeta {
die "WriteMyMeta has been deprecated";
}
-sub write_mymeta {
+sub write_mymeta_yaml {
my $self = shift;
- # If there's no existing META.yml there is nothing we can do
- return unless -f 'META.yml';
-
# We need YAML::Tiny to write the MYMETA.yml file
unless ( eval { require YAML::Tiny; 1; } ) {
return 1;
}
+ # Generate the data
+ my $meta = $self->_write_mymeta_data or return 1;
+
+ # Save as the MYMETA.yml file
+ print "Writing MYMETA.yml\n";
+ YAML::Tiny::DumpFile('MYMETA.yml', $meta);
+}
+
+sub write_mymeta_json {
+ my $self = shift;
+
+ # We need JSON to write the MYMETA.json file
+ unless ( eval { require JSON; 1; } ) {
+ return 1;
+ }
+
+ # Generate the data
+ my $meta = $self->_write_mymeta_data or return 1;
+
+ # Save as the MYMETA.yml file
+ print "Writing MYMETA.json\n";
+ Module::Install::_write(
+ 'MYMETA.json',
+ JSON->new->pretty(1)->canonical->encode($meta),
+ );
+}
+
+sub _write_mymeta_data {
+ my $self = shift;
+
+ # If there's no existing META.yml there is nothing we can do
+ return undef unless -f 'META.yml';
+
+ # We need Parse::CPAN::Meta to load the file
+ unless ( eval { require Parse::CPAN::Meta; 1; } ) {
+ return undef;
+ }
+
# Merge the perl version into the dependencies
my $val = $self->Meta->{values};
my $perl = delete $val->{perl_version};
@@ -558,7 +604,7 @@ sub write_mymeta {
}
# Load the advisory META.yml file
- my @yaml = YAML::Tiny::LoadFile('META.yml');
+ my @yaml = Parse::CPAN::Meta::LoadFile('META.yml');
my $meta = $yaml[0];
# Overwrite the non-configure dependency hashs
@@ -572,9 +618,7 @@ sub write_mymeta {
$meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } };
}
- # Save as the MYMETA.yml file
- print "Writing MYMETA.yml\n";
- YAML::Tiny::DumpFile('MYMETA.yml', $meta);
+ return $meta;
}
1;
diff --git a/inc/Module/Install/Win32.pm b/inc/Module/Install/Win32.pm
index d91b287..f2f99df 100644
--- a/inc/Module/Install/Win32.pm
+++ b/inc/Module/Install/Win32.pm
@@ -2,12 +2,12 @@
package Module::Install::Win32;
use strict;
-use Module::Install::Base;
+use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.88';
- @ISA = qw{Module::Install::Base};
+ $VERSION = '0.91';
+ @ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/WriteAll.pm b/inc/Module/Install/WriteAll.pm
index e82f5d3..12471e5 100644
--- a/inc/Module/Install/WriteAll.pm
+++ b/inc/Module/Install/WriteAll.pm
@@ -2,11 +2,11 @@
package Module::Install::WriteAll;
use strict;
-use Module::Install::Base;
+use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.88';
+ $VERSION = '0.91';;
@ISA = qw{Module::Install::Base};
$ISCORE = 1;
}
@@ -41,8 +41,18 @@ sub WriteAll {
# The Makefile write process adds a couple of dependencies,
# so write the META.yml files after the Makefile.
- $self->Meta->write if $args{meta};
- $self->Meta->write_mymeta if $self->mymeta;
+ if ( $args{meta} ) {
+ $self->Meta->write;
+ }
+
+ # Experimental support for MYMETA
+ if ( $ENV{X_MYMETA} ) {
+ if ( $ENV{X_MYMETA} eq 'JSON' ) {
+ $self->Meta->write_mymeta_json;
+ } else {
+ $self->Meta->write_mymeta_yaml;
+ }
+ }
return 1;
}
diff --git a/lib/Padre/Plugin/PerlTidy.pm b/lib/Padre/Plugin/PerlTidy.pm
index 32fa820..4fdac2e 100644
--- a/lib/Padre/Plugin/PerlTidy.pm
+++ b/lib/Padre/Plugin/PerlTidy.pm
@@ -1,16 +1,5 @@
package Padre::Plugin::PerlTidy;
-use 5.008001;
-use strict;
-use warnings;
-
-use base 'Padre::Plugin';
-
-use Padre::Wx ();
-use Padre::Util ('_T');
-
-our $VERSION = '0.06';
-
=pod
=head1 NAME
@@ -27,8 +16,19 @@ file if it exists (see Perl::Tidy documentation).
=cut
+use 5.008001;
+use strict;
+use warnings;
+use Padre::Current ();
+use Padre::Util ('_T');
+use Padre::Wx ();
+use Padre::Plugin ();
+
+our $VERSION = '0.07';
+our @ISA = 'Padre::Plugin';
+
sub padre_interfaces {
- 'Padre::Plugin' => '0.26',
+ 'Padre::Plugin' => '0.26'
}
sub menu_plugins_simple {
@@ -49,7 +49,7 @@ sub _tidy {
my $doc = $main->current->document;
- if ( !$doc->isa( 'Padre::Document::Perl' ) ) {
+ if ( !$doc->isa('Padre::Document::Perl') ) {
return Wx::MessageBox( _T('Document is not a Perl document'),
_T('Error'), Wx::wxOK | Wx::wxCENTRE, $main );
}
@@ -67,21 +67,21 @@ sub _tidy {
);
};
- if ( $@ ) {
+ if ($@) {
my $error_string = $@;
- Wx::MessageBox(
- $error_string,
- _T("PerlTidy Error"),
- Wx::wxOK | Wx::wxCENTRE, $main
- );
+ Wx::MessageBox( $error_string, _T("PerlTidy Error"),
+ Wx::wxOK | Wx::wxCENTRE, $main );
return;
}
if ( defined $error ) {
my $width = length( $doc->filename ) + 2;
- Padre::Current->main->output->AppendText(
- "\n\n" . "-" x $width . "\n" . $doc->filename . "\n" . "-" x $width . "\n" );
- Padre::Current->main->output->AppendText( "$error\n" );
+ Padre::Current->main->output->AppendText( "\n\n"
+ . "-" x $width . "\n"
+ . $doc->filename . "\n"
+ . "-" x $width
+ . "\n" );
+ Padre::Current->main->output->AppendText("$error\n");
Padre::Current->main->show_output(1);
}
return $output;
@@ -98,7 +98,7 @@ sub tidy_selection {
$newtext =~ s{\n$}{};
my $editor = $main->current->editor;
- $editor->ReplaceSelection( $newtext );
+ $editor->ReplaceSelection($newtext);
}
sub tidy_document {
@@ -111,14 +111,16 @@ sub tidy_document {
return unless defined $newtext && length $newtext;
- $doc->text_set( $newtext );
+ my ( $regex, $start ) = _store_cursor_position($main);
+ $doc->text_set($newtext);
+ _restore_cursor_position( $main, $regex, $start );
}
sub _get_filename {
my $main = shift;
- my $doc = $main->current->document or return;
- my $current = $doc->filename;
+ my $doc = $main->current->document or return;
+ my $current = $doc->filename;
my $default_dir = '';
if ( defined $current ) {
@@ -129,31 +131,24 @@ sub _get_filename {
require File::Spec;
while (1) {
- my $dialog = Wx::FileDialog->new(
- $main,
- _T("Save file as..."),
- $default_dir,
+ my $dialog =
+ Wx::FileDialog->new( $main, _T("Save file as..."), $default_dir,
$doc->filename . '.html',
- "*.*",
- Wx::wxFD_SAVE,
- );
+ "*.*", Wx::wxFD_SAVE, );
if ( $dialog->ShowModal == Wx::wxID_CANCEL ) {
return;
}
my $filename = $dialog->GetFilename;
$default_dir = $dialog->GetDirectory;
- my $path = File::Spec->catfile($default_dir, $filename);
+ my $path = File::Spec->catfile( $default_dir, $filename );
if ( -e $path ) {
- my $res = Wx::MessageBox(
- _T("File already exists. Overwrite it?"),
- _T("Exist"),
- Wx::wxYES_NO,
- $main,
- );
+ my $res = Wx::MessageBox( _T("File already exists. Overwrite it?"),
+ _T("Exist"), Wx::wxYES_NO, $main, );
if ( $res == Wx::wxYES ) {
return $path;
}
- } else {
+ }
+ else {
return $path;
}
}
@@ -168,7 +163,7 @@ sub _export {
my $doc = $main->current->document;
- if ( !$doc->isa( 'Padre::Document::Perl' ) ) {
+ if ( !$doc->isa('Padre::Document::Perl') ) {
return Wx::MessageBox( _T('Document is not a Perl document'),
_T('Error'), Wx::wxOK | Wx::wxCENTRE, $main );
}
@@ -190,22 +185,23 @@ sub _export {
);
};
- if ( $@ ) {
+ if ($@) {
my $error_string = $@;
- Wx::MessageBox(
- $error_string,
- _T('PerlTidy Error'),
- Wx::wxOK | Wx::wxCENTRE, $main
- );
+ Wx::MessageBox( $error_string, _T('PerlTidy Error'),
+ Wx::wxOK | Wx::wxCENTRE, $main );
return;
}
if ( defined $error ) {
my $width = length( $doc->filename ) + 2;
- Padre::Current->main->output->AppendText(
- "\n\n" . "-" x $width . "\n" . $doc->filename . "\n" . "-" x $width . "\n" );
- Padre::Current->main->output->AppendText( "$error\n" );
- Padre::Current->main->show_output(1);
+ my $main = Padre::Current->main;
+ $main->output->AppendText( "\n\n"
+ . "-" x $width . "\n"
+ . $doc->filename . "\n"
+ . "-" x $width
+ . "\n" );
+ $main->output->AppendText("$error\n");
+ $main->show_output(1);
}
return;
@@ -229,6 +225,67 @@ sub export_document {
return;
}
+
+sub _restore_cursor_position {
+
+ # parameter: $main, compiled regex
+ my ( $main, $regex, $start ) = @_;
+ my $shuffle = 80;
+ my $doc = $main->current->document;
+ my $editor = $doc->editor;
+ my $text = $editor->GetTextRange(
+ ( $start - $shuffle ) > 0 ? $start - $shuffle
+ : 0,
+ ( $start + $shuffle < $editor->GetLength() ) ? $start + $shuffle
+ : $editor->GetLength()
+ );
+ eval {
+ if ( $text =~ /($regex)/ ) {
+ my $pos = $start + length $1;
+ $editor->SetCurrentPos($pos);
+ $editor->SetSelection( $pos, $pos );
+ }
+ };
+ return;
+}
+
+sub _store_cursor_position {
+
+ # parameter: $main
+ # returns: compiled regex, start position
+ # compiled regex is /^./ if no valid regex can be reconstructed.
+ my $main = shift;
+ my $doc = $main->current->document;
+ my $editor = $doc->editor;
+ my $pos = $editor->GetCurrentPos;
+
+ # A smaller selection to save memory
+ my $sel_width = 80; # chars before
+ my $start;
+
+ if ( ( $pos - $sel_width ) > 0 ) {
+ $start = $pos - $sel_width;
+ }
+ else {
+ $start = 0;
+ }
+ my $prefix = $editor->GetTextRange( $start, $pos );
+ my $regex;
+ eval {
+ $prefix =~ s/(\W)/\\$1/gm; # Escape non-word chars
+ $prefix =~
+ s/(\\\s+)/(\\s+|\\r*\\n)*/gm; # Replace whitespace by regex \s+
+ $regex = qr{$prefix};
+ };
+ if ($@) {
+ $regex = qw{^.};
+ print @_;
+ }
+ return ( $regex, $start );
+}
+
+
+
1;
=pod
diff --git a/t/01-load.t b/t/01-load.t
index faf349f..1b50cab 100644
--- a/t/01-load.t
+++ b/t/01-load.t
@@ -16,7 +16,11 @@ diag "Wx Version: $Wx::VERSION " . Wx::wxVERSION_STRING();
my @menu = Padre::Plugin::PerlTidy->menu_plugins_simple;
is @menu, 2, 'one menu item';
is $menu[0], 'PerlTidy', 'plugin name';
- is $menu[1][0], 'Tidy the active document', 'menu item 1';
- is $menu[1][2], 'Tidy the selected text', 'menu item 2';
+
+ # check for existence and not the actual words as these
+ # are locale specific
+ ok $menu[1][0], 'menu item 1';
+ ok $menu[1][2], 'menu item 2';
+
BEGIN { $tests += 4; }
}
--
Packaging for padre-plugin-perltidy
More information about the Pkg-perl-cvs-commits
mailing list