Changeset 2198

Timestamp:

12/25/08 15:22:27 (3 years ago)

Author:

pshangov

Message:

• The Error List now requires Parse::ErrorString::Perl 0.08
• support for messages with "at" and "near" information at the end. Added t/files/error_near.pl to test "near" messages. "At" messages can be tested with the existing t/files/missing_brace_1.pl
• support for errors inside eval
• support for error messages reformatted by "use diagnostics"
• support for stack traces on fatal errors when "use diagnostics" is in force. Added test script t/files/error_stack.pl
• file paths are truncated for clarity where possible (see info on "file" method in Parse::ErrorString::Perl)
• the type of error (e.g. warning or fatal) is displayed in the title bar of the diagnostics message box
• change in language for diagnostic messages is detected automatically and applied the next time a script is run (no restart needed)
• if for some reason a translation of a perl error is not available in a translated perldiag, fall back to default perldiag
• loading of Parse::ErrorString::Perl is delayed until the first time a script is run, thus visibly improving Padre startup time
• loading of Parse::ErrorString::Perl is now implemented as non-blocking Padre::Task

Location:

trunk/Padre

Files:

• Makefile.PL (modified) (1 diff)
• lib/Padre/Wx/ErrorList.pm (modified) (8 diffs)
• t/files/error_near.pl (added)
• t/files/error_stack.pl (added)

trunk/Padre/Makefile.PL

@@ -89 +89 @@
 }
 
-requires       'Parse::ErrorString::Perl'=> '0.06';
+requires       'Parse::ErrorString::Perl'=> '0.08';
 test_requires  'Test::Compile'           => '0.08' unless win32;
 test_requires  'Test::More'              => '0.47';

trunk/Padre/lib/Padre/Wx/ErrorList.pm

@@ -21 +21 @@
         enabled  => 'enabled',
         index    => 'index',
+        config   => 'config',
+        lang     => 'lang',
         parser   => 'parser',
-        config   => 'config',
     };
 
@@ -42 +43 @@
     my $root = $self->AddRoot( 'Root', -1, -1, Wx::TreeItemData->new( 'Data' ) );
     $self->{root} = $root;  
+
+    Wx::Event::EVT_TREE_ITEM_ACTIVATED($self, $self, \&on_activate);
+    Wx::Event::EVT_TREE_KEY_DOWN($self, $self, \&on_f1);
     
     $self->{mw} = $mw;
@@ -60 +64 @@
     $self->Show;
     $self->{mw}->{gui}->{bottompane}->SetSelection($index);
-    my $lang = $self->config->{diagnostics_lang};
-    if ($lang) {
-        $lang =~ s/^\s*//;
-        $lang =~ s/\s*$//;
-        $self->{parser} = Parse::ErrorString::Perl->new(lang => $lang);
-    } else {
-        $self->{parser} = Parse::ErrorString::Perl->new;
-    }
     $self->{enabled} = 1;
 }
@@ -82 +78 @@
     my $self = shift;
     return unless $self->enabled;
-    my $root = $self->root;
-    
+    
+    my $cur_lang = $self->config->{diagnostics_lang};
+    $cur_lang =~ s/^\s*//;
+    $cur_lang =~ s/\s*$//;
+    my $old_lang = $self->lang;
+    $self->{lang} = $cur_lang;
+
     my $data = $self->data;
-    my $parser = $self->parser;
-    my @errors = defined $data && $data ne '' ? $parser->parse_string($data) : ();
     $self->{data} = "";
-    Wx::Event::EVT_TREE_KEY_DOWN($self, $self, \&on_f1);
-    
-    foreach my $err (@errors) {
-        my $message = $err->message . " at " . $err->file_msgpath . " line " . $err->line;
-        my $err_tree_item = $self->AppendItem( $root, $message, -1, -1, Wx::TreeItemData->new( $err ) );
-        
-        Wx::Event::EVT_TREE_ITEM_ACTIVATED($self, $self, \&on_activate);
-    }
+    return unless $data;
+    
+
+    my $parser_task = Padre::Task::ErrorParser->new(
+        parser    => $self->parser,
+        cur_lang  => $cur_lang,
+        old_lang  => $old_lang,
+        data      => $data,
+    );
+    
+    $parser_task->schedule;
 }
 
@@ -105 +107 @@
         #my $item = $event->GetItem;
         my $item = $self->GetSelection;
+        return unless $item;
         my $err = $self->GetPlData($item);
+        return if $err->isa('Parse::ErrorString::Perl::StackItem');
         my $diagnostics = gettext("No diagnostics available for this error!");
         if ($err->diagnostics) {
@@ -112 +116 @@
         }
         $diagnostics = $^O eq 'MSWin32' ? $diagnostics : encode('utf8', $diagnostics);
-        my $dialog = Wx::MessageDialog->new($self->mw, $diagnostics, "Diagnostics", Wx::wxOK);
+        my $dialog_title = gettext("Diagnostics");
+        if ($err->type_description) {
+            $dialog_title .= (": " . gettext($err->type_description));
+        }
+        my $dialog = Wx::MessageDialog->new($self->mw, $diagnostics, $dialog_title, Wx::wxOK);
         $dialog->ShowModal;
     }
@@ -121 +129 @@
     my $event = shift;
     my $item = $event->GetItem;
+    return unless $item;
     my $err = $self->GetPlData($item);
     my $mw = $self->mw;
+    return if $err->file eq 'eval';
     $mw->setup_editor($err->file_abspath);
     my $editor = $mw->selected_editor;
@@ -148 +158 @@
 }
 
+package Padre::Task::ErrorParser;
+
+use base 'Padre::Task';
+
+use Class::XSAccessor
+    getters => {
+        parser       => 'parser',
+        old_lang     => 'old_lang',
+        cur_lang     => 'cur_lang',
+        data         => 'data',
+    };
+
+sub run {
+    my $self = shift;
+    unless ($self->parser and ( (!$self->cur_lang and !$self->old_lang) or ($self->cur_lang eq $self->old_lang) )) {
+        if ($self->cur_lang) {
+            $self->{parser} = Parse::ErrorString::Perl->new(lang => $self->cur_lang);
+        } else {
+            $self->{parser} = Parse::ErrorString::Perl->new;
+        }
+    }
+    return 1;
+}
+
+sub finish {
+    my $self = shift;
+    my $mw = shift;
+
+    my $errorlist = $mw->errorlist;
+    
+    my $data = $self->data;
+    my $parser = $self->parser;
+    $errorlist->{parser} = $parser;
+
+    my @errors = defined $data && $data ne '' ? $parser->parse_string($data) : ();
+    
+    foreach my $err (@errors) {
+        my $message = $err->message . " at " . $err->file . " line " . $err->line;
+        #$message = encode('utf8', $message);
+        if ($err->near) {
+            my $near = $err->near;
+            # some day when we have unicode in wx ...
+            #$near =~ s/\n/\x{c2b6}/g;
+            $near =~ s/\n/\\n/g;
+            $near =~ s/\r//g;
+            $message .= ", near \"$near\"";
+        } elsif ($err->at) {
+            my $at = $err->at;
+            $message .= ", at $at";
+        }
+        my $err_tree_item = $errorlist->AppendItem( $errorlist->root, $message, -1, -1, Wx::TreeItemData->new( $err ) );
+        
+        if ($err->stack) {
+            foreach my $stack_item ($err->stack) {
+                my $stack_message = $stack_item->sub . 
+                    " called at " . $stack_item->file . 
+                    " line " . $stack_item->line;
+                $errorlist->AppendItem( $err_tree_item, $stack_message, -1, -1, Wx::TreeItemData->new( $stack_item ) );
+            }
+        }
+    }
+    
+    return 1;
+}
+
 1;