← Back to branch summary

~ubuntu-branches/ubuntu/karmic/padre/karmic

« back to all changes in this revision

Viewing changes to lib/Padre/Document/Perl/Lexer.pm

  • Committer: Bazaar Package Importer
  • Author(s): Damyan Ivanov
  • Date: 2009-02-18 15:55:00 UTC
  • Revision ID: james.westby@ubuntu.com-20090218155500-verj6agdgojx5ihm
Tags: upstream-0.27.ds1
Import upstream version 0.27.ds1

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/Padre/Document/Perl/Lexer.pm
 
1
package Padre::Document::Perl::Lexer;
 
2
 
 
3
use strict;
 
4
use warnings;
 
5
use PPI::Document;
 
6
use PPI::Dumper;
 
7
use Text::Balanced;
 
8
 
 
9
our $VERSION = '0.27';
 
10
 
 
11
sub class_to_color {
 
12
        my $class = shift;
 
13
        my $css = class_to_css($class);
 
14
        my %colors = (
 
15
                keyword         => 4, # dark green
 
16
                structure       => 6,
 
17
                core            => 1, # red
 
18
                pragma          => 7, # purple
 
19
                'Whitespace'    => 0,
 
20
                'Structure'     => 0,
 
21
 
 
22
                'Number'        => 1,
 
23
                'Float'         => 1,
 
24
 
 
25
                'HereDoc'       => 4,
 
26
                'Data'          => 4,
 
27
                'Operator'      => 6,
 
28
                'Comment'       => 2, # it's good, it's green
 
29
                'Pod'           => 2,
 
30
                'End'           => 2,
 
31
                'Label'         => 0,
 
32
                'Word'          => 0, # stay the black
 
33
                'Quote'         => 9,
 
34
                'Single'        => 9,
 
35
                'Double'        => 9,
 
36
                'Interpolate'   => 9,
 
37
                'QuoteLike'     => 7,
 
38
                'Regexp'        => 7,
 
39
                'Words'         => 7,
 
40
                'Readline'      => 7,
 
41
                'Match'         => 3,
 
42
                'Substitute'    => 5,
 
43
                'Transliterate' => 5,
 
44
                'Separator'     => 0,
 
45
                'Symbol'        => 0,
 
46
                'Prototype'     => 0,
 
47
                'ArrayIndex'    => 0,
 
48
                'Cast'          => 0,
 
49
                'Magic'         => 0,
 
50
                'Octal'         => 0,
 
51
                'Hex'           => 0,
 
52
                'Literal'       => 0,
 
53
        );
 
54
        
 
55
        return $colors{$css};
 
56
}
 
57
 
 
58
sub colorize {
 
59
        my $class = shift;
 
60
        
 
61
        my $doc = Padre::Current->document;
 
62
        my $editor = $doc->editor;
 
63
        
 
64
        # DEBUG
 
65
        # my $dp = Padre->ide->wx->main_window->{debugpane};
 
66
        # $dp->Clear;
 
67
        
 
68
        # start and end position for styling, as sent from Wx::STC
 
69
        # the algorithm used by Wx::STC to determine what needs styling
 
70
        # is not precise enough for our need, but is a good starting point
 
71
        my ($start_pos, $end_pos) = @_;
 
72
 
 
73
        my (
 
74
                $text,               # the text that we will send to PPI for parsing
 
75
                $start_line,         # number of first line of text to parse and style
 
76
                $end_line,           # number of last line of text to parse and style
 
77
                $styling_start_pos,  # number of first character to parse and style
 
78
                $styling_end_pos,    # number of last character to parse and style
 
79
                $line_count,         # number of lines within the document
 
80
                $last_char,          # index of the last character in the file
 
81
        );
 
82
        
 
83
        # convert start and end position to start of first line and end of last line
 
84
        # rather than starting to parse and style from the position sent by Wx::STC,
 
85
        # we will shift the start and end position to the start of the first line and
 
86
        # end of the last line respectively
 
87
        $start_line = $editor->LineFromPosition($start_pos);
 
88
        $end_line = $editor->LineFromPosition($end_pos);
 
89
        $styling_start_pos = $editor->PositionFromLine($start_line);
 
90
        $styling_end_pos = $editor->GetLineEndPosition($end_line);
 
91
        $line_count = $editor->GetLineCount();
 
92
        $last_char = $editor->GetLineEndPosition($line_count-1);
 
93
        
 
94
        # basically we let PPI start parsing the text within the start and end
 
95
        # positions we just determined, unless there is a chance that our start
 
96
        # ro end position is within some multiline token - a quotelike expression
 
97
        # or POD
 
98
        
 
99
        # this check is not necessary if we are on the first line of text       
 
100
        if ($start_line > 0) {
 
101
                
 
102
                # get first char on the preceding line, but skip newline symbols
 
103
                my $previous_char = $styling_start_pos-1; 
 
104
                while ($editor->GetCharAt($previous_char) == 10 or $editor->GetCharAt($previous_char) == 13) {
 
105
                        $previous_char--;
 
106
                        last if $previous_char <= 1;
 
107
                }
 
108
                $previous_char--;
 
109
                
 
110
                if ($previous_char > 0) {
 
111
                
 
112
                        # get the start position of the previous token
 
113
                        # NOTE TO SELF: why did I have to decrement $previous_char again?
 
114
                        my $previous_style = $editor->GetStyleAt($previous_char--);
 
115
                
 
116
                        my $start_of_previous_token = $previous_char;
 
117
                
 
118
                        while ($editor->GetStyleAt($start_of_previous_token) == $previous_style) {
 
119
                                $start_of_previous_token--;
 
120
                                last if $start_of_previous_token <= 0;
 
121
                        }
 
122
                        $start_of_previous_token++;
 
123
                        
 
124
                        # get the text of the previous token
 
125
                        my $prev_token_text = $editor->GetTextRange($start_of_previous_token, $styling_start_pos-1);
 
126
                        my $prev_ppi_doc = PPI::Document->new( \$prev_token_text );
 
127
                        
 
128
                        if ($prev_ppi_doc) {
 
129
                                # check if the previous token is a quotelike
 
130
                                my @tokens = $prev_ppi_doc->tokens;     
 
131
                                my $prev_token = $tokens[-1];
 
132
                                
 
133
                                if ( $prev_token->isa("PPI::Token::Quote") 
 
134
                                        or $prev_token->isa("PPI::Token::QuoteLike") 
 
135
                                        or $prev_token->isa("PPI::Token::Regexp") 
 
136
                                ) {
 
137
                                        # check if the quotelike token is complete
 
138
                                        if ( !Text::Balanced::extract_quotelike($prev_token->content) ) {
 
139
                                                # if the token beore the text we are to parse and style
 
140
                                                # is an unfinished quotelike expression, include it
 
141
                                                # in the text to parse and style
 
142
                                                $styling_start_pos = $start_of_previous_token;
 
143
                                        }
 
144
                                } elsif ( $prev_token->isa("PPI::Token::Pod") ) {
 
145
                                        # ditto for pod
 
146
                                        $styling_start_pos = $start_of_previous_token;
 
147
                                }
 
148
                        }
 
149
                }
 
150
        }
 
151
 
 
152
        # ditto for the token after
 
153
        if ($styling_end_pos < $last_char) {            
 
154
                my $next_char = $styling_end_pos + 1; 
 
155
                while ($editor->GetCharAt($next_char) == 10 or $editor->GetCharAt($next_char) == 13) {
 
156
                        $next_char++;
 
157
                        last if $next_char >= $last_char;
 
158
                }
 
159
                
 
160
                
 
161
                if ($next_char < $last_char) {
 
162
                                
 
163
                        my $next_style = $editor->GetStyleAt($next_char);
 
164
                
 
165
                        my $end_of_next_token = $next_char;
 
166
                
 
167
                        while ($editor->GetStyleAt($end_of_next_token) == $next_style) {
 
168
                                $end_of_next_token++;
 
169
                                last if $end_of_next_token == $last_char;
 
170
                        }
 
171
                        $end_of_next_token--;
 
172
                        
 
173
                        
 
174
                        my $next_token_text = $editor->GetTextRange($styling_end_pos + 1, $end_of_next_token);
 
175
                        my $next_ppi_doc = PPI::Document->new( \$next_token_text );
 
176
                        
 
177
                        if ($next_ppi_doc) {
 
178
                                my @tokens = $next_ppi_doc->tokens;     
 
179
                                my $next_token = $tokens[0];
 
180
                                
 
181
                                if ( $next_token->isa("PPI::Token::Quote") 
 
182
                                        or $next_token->isa("PPI::Token::QuoteLike") 
 
183
                                        or $next_token->isa("PPI::Token::Regexp") 
 
184
                                        or $next_token->isa("PPI::Token::Pod")
 
185
                                ) {
 
186
                                        $styling_end_pos = $end_of_next_token;
 
187
                                }
 
188
                        }
 
189
                }
 
190
        }
 
191
        
 
192
        # check if we have to style it all
 
193
        if ($end_pos and $doc->{_is_colorized}) {
 
194
                $text = $editor->GetTextRange($styling_start_pos, $styling_end_pos);
 
195
                clear_style($styling_start_pos, $styling_end_pos);
 
196
        } else {
 
197
                do_full_styling();
 
198
                return;
 
199
        }
 
200
 
 
201
        return unless $text;
 
202
        
 
203
        
 
204
        
 
205
        # now that we have determined the proper starting position,
 
206
        # feed the text to PPI
 
207
        my $ppi_doc = PPI::Document->new( \$text );     
 
208
        
 
209
        # DEBUG
 
210
        # $dp->AppendText($text);
 
211
        # $dp->AppendText("\n" . '='x10 . "\n");
 
212
        # my $dumper = PPI::Dumper->new($ppi_doc);
 
213
        # $dp->AppendText($dumper->string);
 
214
        
 
215
        if ($ppi_doc) {
 
216
                my @tokens = $ppi_doc->tokens;
 
217
                $ppi_doc->index_locations;
 
218
                
 
219
                my (@prepared_extra_tokens, @prepared_tokens);
 
220
                
 
221
                # check to see if the last token is quotelike or pod
 
222
                my $last_token = $tokens[-1];
 
223
                if ( $last_token->isa("PPI::Token::Quote") 
 
224
                        or $last_token->isa("PPI::Token::QuoteLike") 
 
225
                        or $last_token->isa("PPI::Token::Regexp") ) {
 
226
                        if ( !Text::Balanced::extract_quotelike($last_token->content) ) {
 
227
                                
 
228
                                # get the position at which this token starts
 
229
                                my ($row, $rowchar, $col) = @{ $last_token->location };
 
230
                                my $new_start_pos = ($editor->PositionFromLine($start_line+$row-1)+ $rowchar-1);
 
231
                                
 
232
                                # get the line at which it ends
 
233
                                my $token_end_line = ($editor->LineFromPosition($new_start_pos + $last_token->length));
 
234
                                
 
235
                                # get the next up to 50 lines
 
236
                                my $new_end_pos = $editor->GetLineEndPosition($token_end_line + 50);
 
237
                                
 
238
                                if ($new_end_pos > $new_start_pos) {
 
239
                                        my $extra_text = $editor->GetTextRange($new_start_pos, $new_end_pos);
 
240
                                        clear_style($new_start_pos, $new_end_pos);
 
241
                                        
 
242
                                        # parse from start of this token
 
243
                                        my $extra_ppi_doc = PPI::Document->new( \$extra_text );
 
244
                                        my $dumper = PPI::Dumper->new($extra_ppi_doc);
 
245
                                        
 
246
                                        
 
247
                                        
 
248
                                        my @extra_tokens = $extra_ppi_doc->tokens;
 
249
                                        $extra_ppi_doc->index_locations;
 
250
                                
 
251
                                        @prepared_extra_tokens = prepare_tokens($new_start_pos, @extra_tokens);
 
252
                                        
 
253
                                        # remove the last token since it is included in the extra tokens
 
254
                                        
 
255
                                        pop @tokens;
 
256
                                }
 
257
                        }
 
258
                } elsif ($last_token->isa("PPI::Token::Pod")) {
 
259
                        # get the position at which this token starts
 
260
                        my ($row, $rowchar, $col) = @{ $last_token->location };
 
261
                        my $token_start_line = $start_line+$row-1;
 
262
                        my $new_start_pos = ($editor->PositionFromLine($token_start_line)+ $rowchar-1);
 
263
                                
 
264
                        # get the line at which it ends
 
265
                        my $token_end_line = ($editor->LineFromPosition($new_start_pos + $last_token->length));
 
266
                        
 
267
                        # if we are in the first line of pod, start searching for the next line;
 
268
                        # otherwise start searching from the last line of the pod token
 
269
                        my $start_search_for_pod_end = $token_end_line;
 
270
                        $start_search_for_pod_end++ if $token_end_line == $token_start_line;
 
271
                        
 
272
                        my $pod_end = $start_search_for_pod_end;
 
273
                        
 
274
                        while (my $pod_last_line = $editor->GetLine($pod_end)) {
 
275
                                 last if $pod_last_line =~ /^=cut\s/;
 
276
                                 $pod_end++;
 
277
                        }
 
278
                        
 
279
                        my $extra_text = $editor->GetTextRange($new_start_pos, $editor->GetLineEndPosition($pod_end));
 
280
                        clear_style($new_start_pos, $editor->GetLineEndPosition($pod_end));
 
281
                                        
 
282
                        # parse from start of this token
 
283
                        my $extra_ppi_doc = PPI::Document->new( \$extra_text );
 
284
                                        
 
285
                        my @extra_tokens = $extra_ppi_doc->tokens;
 
286
                        $extra_ppi_doc->index_locations;
 
287
                                
 
288
                        @prepared_extra_tokens = prepare_tokens($new_start_pos, $extra_tokens[0]);
 
289
                        pop @tokens;
 
290
                }
 
291
                
 
292
                @prepared_tokens =  prepare_tokens($styling_start_pos, @tokens);
 
293
                
 
294
                do_styling(@prepared_tokens, @prepared_extra_tokens);
 
295
        }
 
296
}
 
297
 
 
298
sub prepare_tokens {
 
299
        my ($offset, @tokens) = @_;
 
300
        
 
301
        my $doc = Padre::Current->document;
 
302
        my $editor = $doc->editor;
 
303
        
 
304
        my @prepared_tokens;
 
305
 
 
306
        my $start_line = $editor->LineFromPosition($offset);
 
307
        my $offset_from_start_line = ($offset - $editor->PositionFromLine($start_line));
 
308
        
 
309
        foreach my $t (@tokens) {
 
310
                my ($row, $rowchar, $col) = @{ $t->location };
 
311
                
 
312
                if ($row == 1) {$rowchar += $offset_from_start_line;}
 
313
                
 
314
                my $start = ($editor->PositionFromLine($start_line+$row-1) + $rowchar -1);
 
315
                my $content = $t->content;
 
316
                my $new_lines = ($content =~ s/\n/\n/gs);
 
317
                my %token = (
 
318
                        start  => $start,
 
319
                        length => ($t->length + $new_lines),
 
320
                        color  => class_to_color($t),
 
321
                );
 
322
                
 
323
                push @prepared_tokens, \%token;
 
324
        }
 
325
        
 
326
        return @prepared_tokens;
 
327
}
 
328
 
 
329
sub clear_style {
 
330
        my ($styling_start_pos, $styling_end_pos) = @_;
 
331
        
 
332
        my $doc = Padre::Current->document;
 
333
        my $editor = $doc->editor;
 
334
        
 
335
        for my $i ( 0..31 ) {
 
336
                $editor->StartStyling($styling_start_pos, $i);
 
337
                $editor->SetStyling($styling_end_pos-$styling_start_pos, 0);
 
338
        }
 
339
}
 
340
 
 
341
sub do_full_styling {
 
342
        my $doc = Padre::Current->document;
 
343
        my $editor = $doc->editor;
 
344
 
 
345
        $doc->remove_color;
 
346
        my $text = $doc->text_get;
 
347
        return unless $text;
 
348
        my $ppi_doc = PPI::Document->new( \$text );     
 
349
        my @tokens = $ppi_doc->tokens;
 
350
        $ppi_doc->index_locations;
 
351
        my @prepared_tokens =  prepare_tokens(1, @tokens);
 
352
        do_styling(@prepared_tokens);
 
353
        $doc->{_is_colorized} = 1;
 
354
}
 
355
 
 
356
sub do_styling {
 
357
        my $doc = Padre::Current->document;
 
358
        my $editor = $doc->editor;
 
359
        
 
360
        foreach my $t (@_) {
 
361
                $editor->StartStyling($t->{start}, $t->{color});
 
362
                $editor->SetStyling($t->{length}, $t->{color});
 
363
        }
 
364
}
 
365
 
 
366
 
 
367
sub class_to_css {
 
368
        my $Token = shift;
 
369
        if ( $Token->isa('PPI::Token::Word') ) {
 
370
                # There are some words we can be very confident are
 
371
                # being used as keywords
 
372
                unless ( $Token->snext_sibling and $Token->snext_sibling->content eq '=>' ) {
 
373
                        if ( $Token->content =~ /^(?:sub|return)$/ ) {
 
374
                                return 'keyword';
 
375
                        } elsif ( $Token->content =~ /^(?:undef|shift|defined|bless)$/ ) {
 
376
                                return 'core';
 
377
                        }
 
378
                }
 
379
                
 
380
                if ( $Token->previous_sibling and $Token->previous_sibling->content eq '->' ) {
 
381
                        if ( $Token->content =~ /^(?:new)$/ ) {
 
382
                                return 'core';
 
383
                        }
 
384
                }
 
385
 
 
386
                if ( $Token->parent->isa('PPI::Statement::Include') ) {
 
387
                        if ( $Token->content =~ /^(?:use|no)$/ ) {
 
388
                                return 'keyword';
 
389
                        }
 
390
                        if ( $Token->content eq $Token->parent->pragma ) {
 
391
                                return 'pragma';
 
392
                        }
 
393
                } elsif ( $Token->parent->isa('PPI::Statement::Variable') ) {
 
394
                        if ( $Token->content =~ /^(?:my|local|our)$/ ) {
 
395
                                return 'keyword';
 
396
                        }
 
397
                } elsif ( $Token->parent->isa('PPI::Statement::Compond') ) {
 
398
                        if ( $Token->content =~ /^(?:if|else|elsif|unless|for|foreach|while|my)$/ ) {
 
399
                                return 'keyword';
 
400
                        }
 
401
                } elsif ( $Token->parent->isa('PPI::Statement::Package') ) {
 
402
                        if ( $Token->content eq 'package' ) {
 
403
                                return 'keyword';
 
404
                        }
 
405
                } elsif ( $Token->parent->isa('PPI::Statement::Scheduled') ) {
 
406
                        return 'keyword';
 
407
                }
 
408
        }
 
409
 
 
410
        # Normal coloring
 
411
        my $css = ref $Token;
 
412
        $css =~ s/^.+:://;
 
413
        $css;
 
414
}
 
415
 
 
416
1;
 
417
 
 
418
# Copyright 2008-2009 The Padre development team as listed in Padre.pm.
 
419
# LICENSE
 
420
# This program is free software; you can redistribute it and/or
 
421
# modify it under the same terms as Perl 5 itself.