Changeset 2187

Timestamp:

12/23/08 12:11:42 (3 years ago)

Author:

hjansen

Message:

Added HTML export feature

Location:

trunk/Padre-Plugin-PerlTidy

Files:

• Changes (modified) (1 diff)
• lib/Padre/Plugin/PerlTidy.pm (modified) (2 diffs)

trunk/Padre-Plugin-PerlTidy/Changes

@@ -1 +1 @@
 Revision history for Perl extension Padre::Plugin::PerlTidy.
+
+0.04
+    - Add HTML export feature (HJANSEN)
 
 0.03  Mon Dec 15 2008

trunk/Padre-Plugin-PerlTidy/lib/Padre/Plugin/PerlTidy.pm

@@ -30 +30 @@
 sub menu_plugins_simple {
     PerlTidy => [
-        'Tidy the active document' => \&tidy_document,
-        'Tidy the selected text'   => \&tidy_selection,
+        Wx::gettext('Tidy the active document') => \&tidy_document,
+        Wx::gettext('Tidy the selected text')   => \&tidy_selection,
+        Wx::gettext('Export active document to HTML file') => \&export_document,
+        Wx::gettext('Export selected text to HTML file')   => \&export_selection,
     ];
 }
@@ -108 +110 @@
 }
 
+sub _get_filename {
+    my $self = shift;
+
+    my $doc     = $self->selected_document or return;
+    my $current = $doc->filename;
+    my $default_dir = '';
+
+    if ( defined $current ) {
+        require File::Basename;
+        $default_dir = File::Basename::dirname($current);
+    }
+
+    require File::Spec;
+
+    while (1) {
+        my $dialog = Wx::FileDialog->new(
+            $self,
+            Wx::gettext("Save file as..."),
+            $default_dir,
+            $doc->filename . '.html',
+            "*.*",
+            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);
+        if ( -e $path ) {
+            my $res = Wx::MessageBox(
+                Wx::gettext("File already exists. Overwrite it?"),
+                Wx::gettext("Exist"),
+                Wx::wxYES_NO,
+                $self,
+            );
+            if ( $res == Wx::wxYES ) {
+                return $path;
+            }
+        } else {
+            return $path;
+        }
+    }
+}
+
+sub _export {
+    my ( $self, $src ) = @_;
+
+    require Perl::Tidy;
+
+    return unless defined $src;
+
+    my $doc = $self->selected_document;
+
+    if ( !$doc->isa( 'Padre::Document::Perl' ) ) {
+        return Wx::MessageBox( 'Document is not a Perl document',
+            "Error", Wx::wxOK | Wx::wxCENTRE, $self );
+    }
+
+    my $filename = _get_filename($self);
+
+    return unless defined $filename;
+
+    my ( $output, $error );
+
+    # TODO: suppress the senseless warning from PerlTidy
+    eval {
+        Perl::Tidy::perltidy(
+            argv        => \'-html -nnn',
+            source      => \$src,
+            destination => $filename,
+            errorfile   => \$error,
+        );
+    };
+
+    if ( $@ ) {
+        my $error_string = $@;
+        Wx::MessageBox(
+            $error_string,
+            "PerlTidy Error",
+            Wx::wxOK | Wx::wxCENTRE, $self
+        );
+        return;
+    }
+
+    if ( defined $error ) {
+        my $width = length( $doc->filename ) + 2;
+        $self->{ gui }->{ output_panel }->AppendText(
+            "\n\n" . "-" x $width . "\n" . $doc->filename . "\n" . "-" x $width . "\n" );
+        $self->{ gui }->{ output_panel }->AppendText( "$error\n" );
+        $self->{ gui }->{ output_panel }->select;
+    }
+
+    return;
+}
+
+sub export_selection {
+    my ( $self, $event ) = @_;
+    my $src = $self->selected_text;
+
+    _export( $self, $src );
+    return;
+}
+
+sub export_document {
+    my ( $self, $event ) = @_;
+
+    my $doc = $self->selected_document;
+    my $src = $doc->text_get;
+
+    _export( $self, $src );
+    return;
+}
+
+
 =head1 INSTALLATION