← Back to branch summary

~ubuntu-branches/ubuntu/trusty/padre/trusty-proposed

« back to all changes in this revision

Viewing changes to lib/Padre/Wx/Syntax.pm

  • Committer: Package Import Robot
  • Author(s): Damyan Ivanov
  • Date: 2011-08-28 18:44:38 UTC
  • mfrom: (1.3.2 upstream) (13.1.2 experimental)
  • Revision ID: package-import@ubuntu.com-20110828184438-yytfgygb1otbnxoe
Tags: 0.90.ds1-1
* New upstream release
 + update dependencies:
   - add libcapture-tiny-perl 0.06 to Depends
   - add (build-) dependency on libmodule-corelist-perl 2.22 or a suitable
     perl
   - remove module-refresh and module-starter from (build-)dependencies
   - bump (build-)dependency on libppix-editortools-perl to 0.13
   - add (build-)dependency on libprobe-perl-perl
 + update debian/copyright to match the new release

* Move Vcs-Git from apps/ to packages/
* stop removing bundled fork of ORLite::Migrate (now heavily modified)
* update debian/not-real-manual.list
* revert the plugin API version bump
* add Breaks: for incompatible plugin versions
* upload to unstable
* add pod-spelling.patch from upstream
* update disable-tcp-server.patch to apply cleanly

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/Padre/Wx/Syntax.pm
4
4
use strict;
5
5
use warnings;
6
6
use Params::Util          ();
 
7
use Padre::Feature        ();
7
8
use Padre::Role::Task     ();
8
9
use Padre::Wx::Role::View ();
9
10
use Padre::Wx::Role::Main ();
10
11
use Padre::Wx             ();
11
12
use Padre::Wx::Icon       ();
12
13
use Padre::Wx::TreeCtrl   ();
 
14
use Padre::Wx::HtmlWindow ();
13
15
use Padre::Logger;
14
16
 
15
 
our $VERSION = '0.76';
 
17
our $VERSION = '0.90';
16
18
our @ISA     = qw{
17
19
        Padre::Role::Task
18
20
        Padre::Wx::Role::View
19
21
        Padre::Wx::Role::Main
20
 
        Padre::Wx::TreeCtrl
 
22
        Wx::Panel
21
23
};
22
24
 
23
25
# perldiag error message classification
66
68
        },
67
69
);
68
70
 
69
 
 
70
71
sub new {
71
72
        my $class = shift;
72
73
        my $main  = shift;
73
74
        my $panel = shift || $main->bottom;
 
75
        my $self  = $class->SUPER::new($panel);
74
76
 
75
77
        # Create the underlying object
76
 
        my $self = $class->SUPER::new(
77
 
                $panel,
 
78
        $self->{tree} = Padre::Wx::TreeCtrl->new(
 
79
                $self,
78
80
                -1,
79
81
                Wx::wxDefaultPosition,
80
82
                Wx::wxDefaultSize,
81
83
                Wx::wxTR_SINGLE | Wx::wxTR_FULL_ROW_HIGHLIGHT | Wx::wxTR_HAS_BUTTONS
82
84
        );
83
85
 
 
86
        $self->{help} = Padre::Wx::HtmlWindow->new(
 
87
                $self,
 
88
                -1,
 
89
                Wx::wxDefaultPosition,
 
90
                Wx::wxDefaultSize,
 
91
                Wx::wxBORDER_STATIC,
 
92
        );
 
93
        $self->{help}->Hide;
 
94
 
 
95
        my $sizer = Wx::BoxSizer->new(Wx::wxHORIZONTAL);
 
96
        $sizer->Add( $self->{tree}, 3, Wx::wxALL | Wx::wxEXPAND, 2 );
 
97
        $sizer->Add( $self->{help}, 2, Wx::wxALL | Wx::wxEXPAND, 2 );
 
98
        $self->SetSizer($sizer);
 
99
 
84
100
        # Additional properties
85
 
        $self->{model}    = [];
86
 
        $self->{document} = '';
87
 
        $self->{length}   = -1;
 
101
        $self->{model}  = [];
 
102
        $self->{length} = -1;
88
103
 
89
104
        # Prepare the available images
90
105
        my $images = Wx::ImageList->new( 16, 16 );
107
122
                        ),
108
123
                ),
109
124
        };
110
 
        $self->AssignImageList($images);
 
125
        $self->{tree}->AssignImageList($images);
111
126
 
112
127
        Wx::Event::EVT_TREE_ITEM_ACTIVATED(
113
 
                $self, $self,
 
128
                $self,
 
129
                $self->{tree},
114
130
                sub {
115
131
                        $_[0]->on_tree_item_activated( $_[1] );
116
132
                },
117
133
        );
118
134
 
 
135
        Wx::Event::EVT_TREE_SEL_CHANGED(
 
136
                $self,
 
137
                $self->{tree},
 
138
                sub {
 
139
                        $_[0]->on_tree_item_selection_changed( $_[1] );
 
140
                },
 
141
        );
 
142
 
119
143
        $self->Hide;
120
144
 
 
145
        if (Padre::Feature::STYLE_GUI) {
 
146
                $self->recolour;
 
147
        }
 
148
 
121
149
        return $self;
122
150
}
123
151
 
 
152
 
 
153
 
 
154
 
 
155
 
124
156
######################################################################
125
157
# Padre::Wx::Role::View Methods
126
158
 
133
165
}
134
166
 
135
167
sub view_close {
136
 
        shift->main->show_syntax(0);
 
168
        $_[0]->main->show_syntaxcheck(0);
137
169
}
138
170
 
139
 
 
140
 
 
141
 
 
142
 
 
143
 
#####################################################################
144
 
# Timer Control
145
 
 
146
 
sub start {
 
171
sub view_start {
147
172
        my $self = shift;
148
 
        $self->running and return;
149
 
        TRACE('Starting the syntax checker') if DEBUG;
150
173
 
151
174
        # Add the margins for the syntax markers
152
175
        foreach my $editor ( $self->main->editors ) {
157
180
                # Set margin 1 16 px wide
158
181
                $editor->SetMarginWidth( 1, 16 );
159
182
        }
160
 
 
161
 
        if ( Params::Util::_INSTANCE( $self->{timer}, 'Wx::Timer' ) ) {
162
 
                $self->on_timer( undef, 1 );
163
 
        } else {
164
 
                TRACE('Creating new timer') if DEBUG;
165
 
                $self->{timer} = Wx::Timer->new(
166
 
                        $self,
167
 
                        Padre::Wx::ID_TIMER_SYNTAX
168
 
                );
169
 
                Wx::Event::EVT_TIMER(
170
 
                        $self,
171
 
                        Padre::Wx::ID_TIMER_SYNTAX,
172
 
                        sub {
173
 
                                $self->on_timer( $_[1], $_[2] );
174
 
                        },
175
 
                );
176
 
        }
177
 
        $self->{timer}->Start( 1000, 0 );
178
 
 
179
 
        return;
180
183
}
181
184
 
182
 
sub stop {
 
185
sub view_stop {
183
186
        my $self = shift;
184
 
        $self->running or return;
185
 
        TRACE('Stopping the syntax checker') if DEBUG;
186
 
 
187
 
        # Stop the timer
188
 
        if ( Params::Util::_INSTANCE( $self->{timer}, 'Wx::Timer' ) ) {
189
 
                $self->{timer}->Stop;
190
 
        }
191
 
 
192
 
        # Remove the editor margin
193
 
        foreach my $editor ( $self->main->editors ) {
 
187
        my $main = $self->main;
 
188
        my $lock = $main->lock('UPDATE');
 
189
 
 
190
        # Clear out any state and tasks
 
191
        $self->task_reset;
 
192
        $self->clear;
 
193
 
 
194
        # Remove the editor margins
 
195
        foreach my $editor ( $main->editors ) {
194
196
                $editor->SetMarginWidth( 1, 0 );
195
197
        }
196
198
 
197
 
        # Clear out the existing data
198
 
        $self->clear;
199
 
 
200
199
        return;
201
200
}
202
201
 
203
 
sub running {
204
 
        !!( $_[0]->{timer} and $_[0]->{timer}->IsRunning );
205
 
}
206
 
 
207
202
 
208
203
 
209
204
 
211
206
#####################################################################
212
207
# Event Handlers
213
208
 
 
209
sub on_tree_item_selection_changed {
 
210
        my $self  = shift;
 
211
        my $event = shift;
 
212
        my $item  = $event->GetItem or return;
 
213
        my $issue = $self->{tree}->GetPlData($item);
 
214
 
 
215
        if ( $issue and $issue->{diagnostics} ) {
 
216
                my $diag = $issue->{diagnostics};
 
217
                $self->_update_help_page($diag);
 
218
        } else {
 
219
                $self->_update_help_page;
 
220
        }
 
221
}
 
222
 
214
223
sub on_tree_item_activated {
215
 
        my ( $self, $event ) = @_;
216
 
        my $item   = $event->GetItem         or return;
217
 
        my $error  = $self->GetPlData($item) or return;
218
 
        my $editor = $self->current->editor  or return;
219
 
        my $line   = $error->{line};
 
224
        my $self   = shift;
 
225
        my $event  = shift;
 
226
        my $item   = $event->GetItem or return;
 
227
        my $issue  = $self->{tree}->GetPlData($item) or return;
 
228
        my $editor = $self->current->editor or return;
 
229
        my $line   = $issue->{line};
220
230
 
221
 
        return
222
 
                if not defined($line)
223
 
                        or $line !~ /^\d+$/o
224
 
                        or $editor->GetLineCount < $line;
 
231
        # Does it point to somewhere valid?
 
232
        return unless defined $line;
 
233
        return if $line !~ /^\d+$/o;
 
234
        return if $editor->GetLineCount < $line;
225
235
 
226
236
        # Select the problem after the event has finished
227
237
        Wx::Event::EVT_IDLE(
233
243
        );
234
244
}
235
245
 
236
 
sub on_timer {
237
 
        my $self  = shift;
238
 
        my $event = shift;
239
 
        $event->Skip(0) if defined $event;
240
 
        $self->refresh;
241
 
}
242
 
 
243
246
 
244
247
 
245
248
 
268
271
        }
269
272
 
270
273
        # Remove all items from the tool
271
 
        $self->DeleteAllItems;
 
274
        $self->{tree}->DeleteAllItems;
 
275
 
 
276
        # Clear the help page
 
277
        $self->_update_help_page;
272
278
 
273
279
        return;
274
280
}
275
281
 
 
282
# Pick up colouring from the current editor style
 
283
sub recolour {
 
284
        my $self   = shift;
 
285
        my $config = $self->config;
 
286
 
 
287
        # Load the editor style
 
288
        require Padre::Wx::Editor;
 
289
        my $data = Padre::Wx::Editor::data( $config->editor_style ) or return;
 
290
 
 
291
        # Find the colours we need
 
292
        my $foreground = $data->{padre}->{colors}->{PADRE_BLACK}->{foreground};
 
293
        my $background = $data->{padre}->{background};
 
294
 
 
295
        # Apply them to the widgets
 
296
        if ( defined $foreground and defined $background ) {
 
297
                $foreground = Padre::Wx::color($foreground);
 
298
                $background = Padre::Wx::color($background);
 
299
 
 
300
                $self->{tree}->SetForegroundColour($foreground);
 
301
                $self->{tree}->SetBackgroundColour($background);
 
302
 
 
303
                # $self->{search}->SetForegroundColour($foreground);
 
304
                # $self->{search}->SetBackgroundColour($background);
 
305
        }
 
306
 
 
307
        return 1;
 
308
}
 
309
 
 
310
# Nothing to implement here
276
311
sub relocale {
277
 
 
278
 
        # Nothing to implement here
279
312
        return;
280
313
}
281
314
 
282
315
sub refresh {
283
316
        my $self = shift;
284
 
        my $document = $self->current->document or return;
285
 
 
286
 
        # allows us to check when an empty or unsaved document is open
287
 
        my $filename = defined( $document->filename ) ? $document->filename : '';
288
 
 
289
 
        my $length = $document->text_length;
290
 
 
291
 
        if ( $filename eq $self->{document} ) {
292
 
 
293
 
                # Shortcut if nothing has changed.
294
 
                # NOTE: Given the speed at which the timer fires a cheap
295
 
                # length check is better than an expensive MD5 check.
296
 
                return if ( $length eq $self->{length} );
297
 
        }
298
 
 
299
 
        $self->{document} = $filename;
300
 
        $self->{length}   = $length;
 
317
 
 
318
        # Abort any in-flight checks
 
319
        $self->task_reset;
 
320
 
 
321
        # Do we have a document with something in it?
 
322
        my $document = $self->current->document;
 
323
        unless ( $document and not $document->is_unused ) {
 
324
                $self->clear;
 
325
                return;
 
326
        }
 
327
 
 
328
        # Is there a syntax check task for this document type
 
329
        my $task = $document->task_syntax;
 
330
        unless ($task) {
 
331
                $self->clear;
 
332
                return;
 
333
        }
301
334
 
302
335
        # Fire the background task discarding old results
303
 
        $self->task_reset;
304
336
        $self->task_request(
305
 
                task     => $document->task_syntax,
 
337
                task     => $task,
306
338
                document => $document,
307
339
        );
 
340
 
 
341
        # Clear out the syntax check window, leaving the margin as is
 
342
        $self->{tree}->DeleteAllItems;
 
343
        $self->_update_help_page;
 
344
 
 
345
        return 1;
308
346
}
309
347
 
310
348
sub task_finish {
323
361
        my $filename = $current->filename;
324
362
        my $lock     = $self->main->lock('UPDATE');
325
363
 
 
364
        # Clear all indicators
 
365
        $editor->StartStyling( 0, Wx::wxSTC_INDICS_MASK );
 
366
        $editor->SetStyling( $editor->GetTextLength - 1, 0 );
 
367
 
 
368
        # NOTE: Recolor the document to make sure we do not accidentally
 
369
        # remove syntax highlighting while syntax checking
 
370
        $document->colourize;
 
371
 
326
372
        # Flush old results
327
373
        $self->clear;
328
374
 
329
 
        my $root = $self->AddRoot('Root');
 
375
        my $root = $self->{tree}->AddRoot('Root');
330
376
 
331
377
        # If there are no errors clear the synax checker pane
332
378
        unless ( Params::Util::_ARRAY($model) ) {
339
385
                                $project_dir = quotemeta $project_dir;
340
386
                                $filename =~ s/^$project_dir[\\\/]?//;
341
387
                        }
342
 
                        $self->SetItemText(
 
388
                        $self->{tree}->SetItemText(
343
389
                                $root,
344
390
                                sprintf( Wx::gettext('No errors or warnings found in %s.'), $filename )
345
391
                        );
346
392
                } else {
347
 
                        $self->SetItemText( $root, Wx::gettext('No errors or warnings found.') );
 
393
                        $self->{tree}->SetItemText( $root, Wx::gettext('No errors or warnings found.') );
348
394
                }
349
 
                $self->SetItemImage( $root, $self->{images}->{ok} );
 
395
                $self->{tree}->SetItemImage( $root, $self->{images}->{ok} );
350
396
                return;
351
397
        }
352
398
 
353
 
        $self->SetItemText(
 
399
        $self->{tree}->SetItemText(
354
400
                $root,
355
401
                defined $filename
356
402
                ? sprintf( Wx::gettext('Found %d issue(s) in %s'), scalar @$model, $filename )
357
403
                : sprintf( Wx::gettext('Found %d issue(s)'),       scalar @$model )
358
404
        );
359
 
        $self->SetItemImage( $root, $self->{images}->{root} );
 
405
        $self->{tree}->SetItemImage( $root, $self->{images}->{root} );
360
406
 
361
407
        my $i = 0;
362
408
        ISSUE:
363
409
        foreach my $issue ( sort { $a->{line} <=> $b->{line} } @$model ) {
364
410
 
365
 
                if ( not exists $issue->{type} ) {
366
 
                        require Data::Dumper;
367
 
                        TRACE( "Cannot handle issue:\n" . Data::Dumper::Dumper($issue) ) if DEBUG;
368
 
                        next ISSUE;
369
 
                }
370
 
 
371
 
                my $line = $issue->{line} - 1;
372
 
                my $type = $issue->{type};
373
 
                $editor->MarkerAdd( $line, $MESSAGE{$type}{marker} );
374
 
 
375
 
                my $item = $self->AppendItem(
 
411
                my $line       = $issue->{line} - 1;
 
412
                my $type       = exists $issue->{type} ? $issue->{type} : 'F';
 
413
                my $marker     = $MESSAGE{$type}{marker};
 
414
                my $is_warning = $marker == Padre::Wx::MarkWarn();
 
415
                $editor->MarkerAdd( $line, $marker );
 
416
 
 
417
                # Underline the syntax warning/error line with an orange or red squiggle indicator
 
418
                my $start  = $editor->PositionFromLine($line);
 
419
                my $indent = $editor->GetLineIndentPosition($line);
 
420
                my $end    = $editor->GetLineEndPosition($line);
 
421
 
 
422
                # Change only the indicators
 
423
                $editor->StartStyling( $indent, Wx::wxSTC_INDICS_MASK );
 
424
                $editor->SetStyling( $end - $indent, $is_warning ? Wx::wxSTC_INDIC1_MASK : Wx::wxSTC_INDIC2_MASK );
 
425
 
 
426
                my $item = $self->{tree}->AppendItem(
376
427
                        $root,
377
428
                        sprintf(
378
429
                                Wx::gettext('Line %d:   (%s)   %s'),
380
431
                                $MESSAGE{$type}{label},
381
432
                                $issue->{message}
382
433
                        ),
383
 
                        $MESSAGE{$type}{marker} == Padre::Wx::MarkWarn() ? $self->{images}{warning} : $self->{images}{error}
 
434
                        $is_warning ? $self->{images}{warning} : $self->{images}{error}
384
435
                );
385
 
                $self->SetPlData( $item, $issue );
386
 
 
387
 
                if ( defined $issue->{diagnostics} ) {
388
 
                        my @diags = split /\n/, $issue->{diagnostics};
389
 
                        for my $diag (@diags) {
390
 
                                $self->AppendItem( $item, $diag, $self->{images}{diagnostics} );
391
 
                        }
 
436
                $self->{tree}->SetPlData( $item, $issue );
 
437
        }
 
438
 
 
439
        $self->{tree}->Expand($root);
 
440
        $self->{tree}->EnsureVisible($root);
 
441
 
 
442
        return 1;
 
443
}
 
444
 
 
445
# Updates the help page. It shows the text if it is defined otherwise clears and hides it
 
446
sub _update_help_page {
 
447
        my $self = shift;
 
448
        my $text = shift;
 
449
 
 
450
        # load the escaped HTML string into the shown page otherwise hide
 
451
        # if the text is undefined
 
452
        my $help = $self->{help};
 
453
        if ( defined $text ) {
 
454
                require CGI;
 
455
                $text = CGI::escapeHTML($text);
 
456
                $text =~ s/\n/<br>/g;
 
457
                my $WARN_TEXT = $MESSAGE{'W'}{label};
 
458
                if ( $text =~ /^\((W\s+(\w+)|D|S|F|P|X|A)\)/ ) {
 
459
                        my ( $category, $warning_category ) = ( $1, $2 );
 
460
                        my $category_label = ( $category =~ /^W/ ) ? $MESSAGE{'W'}{label} : $MESSAGE{$1}{label};
 
461
                        my $notes =
 
462
                                defined($warning_category)
 
463
                                ? "<code>no warnings '$warning_category';    # disable</code><br>"
 
464
                                . "<code>use warnings '$warning_category';   # enable</code><br><br>"
 
465
                                : '';
 
466
                        $text =~ s{^\((W\s+(\w+)|D|S|F|P|X|A)\)}{<h3>$category_label</h3>$notes};
392
467
                }
 
468
                $help->SetPage($text);
 
469
                $help->Show;
 
470
        } else {
 
471
                $help->SetPage('');
 
472
                $help->Hide;
393
473
        }
394
474
 
395
 
        $self->Expand($root);
396
 
        $self->EnsureVisible($root);
 
475
        # Sticky note light-yellow background
 
476
        $self->{help}->SetBackgroundColour( Wx::Colour->new( 0xFD, 0xFC, 0xBB ) );
397
477
 
398
 
        return 1;
 
478
        # Relayout to actually hide/show the help page
 
479
        $self->Layout;
399
480
}
400
481
 
401
482
# Selects the problemistic line :)
416
497
        my $current_line = $editor->LineFromPosition( $editor->GetCurrentPos );
417
498
 
418
499
        # Start with the first child
419
 
        my $root = $self->GetRootItem;
420
 
        my ( $child, $cookie ) = $self->GetFirstChild($root);
 
500
        my $root = $self->{tree}->GetRootItem;
 
501
        my ( $child, $cookie ) = $self->{tree}->GetFirstChild($root);
421
502
        my $first_line = undef;
422
503
        while ($cookie) {
423
504
 
424
505
                # Get the line and check that it is a valid line number
425
 
                my $issue = $self->GetPlData($child) or return;
 
506
                my $issue = $self->{tree}->GetPlData($child) or return;
426
507
                my $line = $issue->{line};
427
508
 
428
509
                if (   not defined($line)
429
510
                        or ( $line !~ /^\d+$/o )
430
511
                        or ( $line > $editor->GetLineCount ) )
431
512
                {
432
 
                        ( $child, $cookie ) = $self->GetNextChild( $root, $cookie );
 
513
                        ( $child, $cookie ) = $self->{tree}->GetNextChild( $root, $cookie );
433
514
                        next;
434
515
                }
435
516
                $line--;
453
534
                }
454
535
 
455
536
                # Get the next child if there is one
456
 
                ( $child, $cookie ) = $self->GetNextChild( $root, $cookie );
 
537
                ( $child, $cookie ) = $self->{tree}->GetNextChild( $root, $cookie );
457
538
        }
458
539
 
459
540
        # The next problem is simply the first (wrap around)
462
543
 
463
544
1;
464
545
 
465
 
# Copyright 2008-2010 The Padre development team as listed in Padre.pm.
 
546
# Copyright 2008-2011 The Padre development team as listed in Padre.pm.
466
547
# LICENSE
467
548
# This program is free software; you can redistribute it and/or
468
549
# modify it under the same terms as Perl 5 itself.