package Padre::Document::Perl::Lexer;

use strict;
use warnings;
use PPI::Document;
use PPI::Dumper;
use Text::Balanced;

our $VERSION = '0.27';

sub class_to_color {
	my $class = shift;
	my $css = class_to_css($class);
	my %colors = (
		keyword         => 4, # dark green
		structure       => 6,
		core            => 1, # red
		pragma          => 7, # purple
		'Whitespace'    => 0,
		'Structure'     => 0,

		'Number'        => 1,
		'Float'         => 1,

		'HereDoc'       => 4,
		'Data'          => 4,
		'Operator'      => 6,
		'Comment'       => 2, # it's good, it's green
		'Pod'           => 2,
		'End'           => 2,
		'Label'         => 0,
		'Word'          => 0, # stay the black
		'Quote'         => 9,
		'Single'        => 9,
		'Double'        => 9,
		'Interpolate'   => 9,
		'QuoteLike'     => 7,
		'Regexp'        => 7,
		'Words'         => 7,
		'Readline'      => 7,
		'Match'         => 3,
		'Substitute'    => 5,
		'Transliterate' => 5,
		'Separator'     => 0,
		'Symbol'        => 0,
		'Prototype'     => 0,
		'ArrayIndex'    => 0,
		'Cast'          => 0,
		'Magic'         => 0,
		'Octal'         => 0,
		'Hex'           => 0,
		'Literal'       => 0,
	);
	
	return $colors{$css};
}

sub colorize {
	my $class = shift;
	
	my $doc = Padre::Current->document;
	my $editor = $doc->editor;
	
	# DEBUG
	# my $dp = Padre->ide->wx->main_window->{debugpane};
	# $dp->Clear;
	
	# start and end position for styling, as sent from Wx::STC
	# the algorithm used by Wx::STC to determine what needs styling
	# is not precise enough for our need, but is a good starting point
	my ($start_pos, $end_pos) = @_;

	my (
		$text,               # the text that we will send to PPI for parsing
		$start_line,         # number of first line of text to parse and style
		$end_line,           # number of last line of text to parse and style
		$styling_start_pos,  # number of first character to parse and style
		$styling_end_pos,    # number of last character to parse and style
		$line_count,         # number of lines within the document
		$last_char,          # index of the last character in the file
	);
	
	# convert start and end position to start of first line and end of last line
	# rather than starting to parse and style from the position sent by Wx::STC,
	# we will shift the start and end position to the start of the first line and
	# end of the last line respectively
	$start_line = $editor->LineFromPosition($start_pos);
	$end_line = $editor->LineFromPosition($end_pos);
	$styling_start_pos = $editor->PositionFromLine($start_line);
	$styling_end_pos = $editor->GetLineEndPosition($end_line);
	$line_count = $editor->GetLineCount();
	$last_char = $editor->GetLineEndPosition($line_count-1);
	
	# basically we let PPI start parsing the text within the start and end
	# positions we just determined, unless there is a chance that our start
	# ro end position is within some multiline token - a quotelike expression
	# or POD
	
	# this check is not necessary if we are on the first line of text	
	if ($start_line > 0) {
		
		# get first char on the preceding line, but skip newline symbols
		my $previous_char = $styling_start_pos-1; 
		while ($editor->GetCharAt($previous_char) == 10 or $editor->GetCharAt($previous_char) == 13) {
			$previous_char--;
			last if $previous_char <= 1;
		}
		$previous_char--;
		
		if ($previous_char > 0) {
		
			# get the start position of the previous token
			# NOTE TO SELF: why did I have to decrement $previous_char again?
			my $previous_style = $editor->GetStyleAt($previous_char--);
		
			my $start_of_previous_token = $previous_char;
		
			while ($editor->GetStyleAt($start_of_previous_token) == $previous_style) {
				$start_of_previous_token--;
				last if $start_of_previous_token <= 0;
			}
			$start_of_previous_token++;
			
			# get the text of the previous token
			my $prev_token_text = $editor->GetTextRange($start_of_previous_token, $styling_start_pos-1);
			my $prev_ppi_doc = PPI::Document->new( \$prev_token_text );
			
			if ($prev_ppi_doc) {
				# check if the previous token is a quotelike
				my @tokens = $prev_ppi_doc->tokens;	
				my $prev_token = $tokens[-1];
				
				if ( $prev_token->isa("PPI::Token::Quote") 
					or $prev_token->isa("PPI::Token::QuoteLike") 
					or $prev_token->isa("PPI::Token::Regexp") 
				) {
					# check if the quotelike token is complete
					if ( !Text::Balanced::extract_quotelike($prev_token->content) ) {
						# if the token beore the text we are to parse and style
						# is an unfinished quotelike expression, include it
						# in the text to parse and style
						$styling_start_pos = $start_of_previous_token;
					}
				} elsif ( $prev_token->isa("PPI::Token::Pod") ) {
					# ditto for pod
					$styling_start_pos = $start_of_previous_token;
				}
			}
		}
	}

	# ditto for the token after
	if ($styling_end_pos < $last_char) {		
		my $next_char = $styling_end_pos + 1; 
		while ($editor->GetCharAt($next_char) == 10 or $editor->GetCharAt($next_char) == 13) {
			$next_char++;
			last if $next_char >= $last_char;
		}
		
		
		if ($next_char < $last_char) {
				
			my $next_style = $editor->GetStyleAt($next_char);
		
			my $end_of_next_token = $next_char;
		
			while ($editor->GetStyleAt($end_of_next_token) == $next_style) {
				$end_of_next_token++;
				last if $end_of_next_token == $last_char;
			}
			$end_of_next_token--;
			
			
			my $next_token_text = $editor->GetTextRange($styling_end_pos + 1, $end_of_next_token);
			my $next_ppi_doc = PPI::Document->new( \$next_token_text );
			
			if ($next_ppi_doc) {
				my @tokens = $next_ppi_doc->tokens;	
				my $next_token = $tokens[0];
				
				if ( $next_token->isa("PPI::Token::Quote") 
					or $next_token->isa("PPI::Token::QuoteLike") 
					or $next_token->isa("PPI::Token::Regexp") 
					or $next_token->isa("PPI::Token::Pod")
				) {
					$styling_end_pos = $end_of_next_token;
				}
			}
		}
	}
	
	# check if we have to style it all
	if ($end_pos and $doc->{_is_colorized}) {
		$text = $editor->GetTextRange($styling_start_pos, $styling_end_pos);
		clear_style($styling_start_pos, $styling_end_pos);
	} else {
		do_full_styling();
		return;
	}

	return unless $text;
	
	
	
	# now that we have determined the proper starting position,
	# feed the text to PPI
	my $ppi_doc = PPI::Document->new( \$text );	
	
	# DEBUG
	# $dp->AppendText($text);
	# $dp->AppendText("\n" . '='x10 . "\n");
	# my $dumper = PPI::Dumper->new($ppi_doc);
	# $dp->AppendText($dumper->string);
	
	if ($ppi_doc) {
		my @tokens = $ppi_doc->tokens;
		$ppi_doc->index_locations;
		
		my (@prepared_extra_tokens, @prepared_tokens);
		
		# check to see if the last token is quotelike or pod
		my $last_token = $tokens[-1];
		if ( $last_token->isa("PPI::Token::Quote") 
			or $last_token->isa("PPI::Token::QuoteLike") 
			or $last_token->isa("PPI::Token::Regexp") ) {
			if ( !Text::Balanced::extract_quotelike($last_token->content) ) {
				
				# get the position at which this token starts
				my ($row, $rowchar, $col) = @{ $last_token->location };
				my $new_start_pos = ($editor->PositionFromLine($start_line+$row-1)+ $rowchar-1);
				
				# get the line at which it ends
				my $token_end_line = ($editor->LineFromPosition($new_start_pos + $last_token->length));
				
				# get the next up to 50 lines
				my $new_end_pos = $editor->GetLineEndPosition($token_end_line + 50);
				
				if ($new_end_pos > $new_start_pos) {
					my $extra_text = $editor->GetTextRange($new_start_pos, $new_end_pos);
					clear_style($new_start_pos, $new_end_pos);
					
					# parse from start of this token
					my $extra_ppi_doc = PPI::Document->new( \$extra_text );
					my $dumper = PPI::Dumper->new($extra_ppi_doc);
					
					
					
					my @extra_tokens = $extra_ppi_doc->tokens;
					$extra_ppi_doc->index_locations;
				
					@prepared_extra_tokens = prepare_tokens($new_start_pos, @extra_tokens);
					
					# remove the last token since it is included in the extra tokens
					
					pop @tokens;
				}
			}
		} elsif ($last_token->isa("PPI::Token::Pod")) {
			# get the position at which this token starts
			my ($row, $rowchar, $col) = @{ $last_token->location };
			my $token_start_line = $start_line+$row-1;
			my $new_start_pos = ($editor->PositionFromLine($token_start_line)+ $rowchar-1);
				
			# get the line at which it ends
			my $token_end_line = ($editor->LineFromPosition($new_start_pos + $last_token->length));
			
			# if we are in the first line of pod, start searching for the next line;
			# otherwise start searching from the last line of the pod token
			my $start_search_for_pod_end = $token_end_line;
			$start_search_for_pod_end++ if $token_end_line == $token_start_line;
			
			my $pod_end = $start_search_for_pod_end;
			
			while (my $pod_last_line = $editor->GetLine($pod_end)) {
				 last if $pod_last_line =~ /^=cut\s/;
				 $pod_end++;
			}
			
			my $extra_text = $editor->GetTextRange($new_start_pos, $editor->GetLineEndPosition($pod_end));
			clear_style($new_start_pos, $editor->GetLineEndPosition($pod_end));
					
			# parse from start of this token
			my $extra_ppi_doc = PPI::Document->new( \$extra_text );
					
			my @extra_tokens = $extra_ppi_doc->tokens;
			$extra_ppi_doc->index_locations;
				
			@prepared_extra_tokens = prepare_tokens($new_start_pos, $extra_tokens[0]);
			pop @tokens;
		}
		
		@prepared_tokens =  prepare_tokens($styling_start_pos, @tokens);
		
		do_styling(@prepared_tokens, @prepared_extra_tokens);
	}
}

sub prepare_tokens {
	my ($offset, @tokens) = @_;
	
	my $doc = Padre::Current->document;
	my $editor = $doc->editor;
	
	my @prepared_tokens;

	my $start_line = $editor->LineFromPosition($offset);
	my $offset_from_start_line = ($offset - $editor->PositionFromLine($start_line));
	
	foreach my $t (@tokens) {
		my ($row, $rowchar, $col) = @{ $t->location };
		
		if ($row == 1) {$rowchar += $offset_from_start_line;}
		
		my $start = ($editor->PositionFromLine($start_line+$row-1) + $rowchar -1);
		my $content = $t->content;
		my $new_lines = ($content =~ s/\n/\n/gs);
		my %token = (
			start  => $start,
			length => ($t->length + $new_lines),
			color  => class_to_color($t),
		);
		
		push @prepared_tokens, \%token;
	}
	
	return @prepared_tokens;
}

sub clear_style {
	my ($styling_start_pos, $styling_end_pos) = @_;
	
	my $doc = Padre::Current->document;
	my $editor = $doc->editor;
	
	for my $i ( 0..31 ) {
		$editor->StartStyling($styling_start_pos, $i);
		$editor->SetStyling($styling_end_pos-$styling_start_pos, 0);
	}
}

sub do_full_styling {
	my $doc = Padre::Current->document;
	my $editor = $doc->editor;

	$doc->remove_color;
	my $text = $doc->text_get;
	return unless $text;
	my $ppi_doc = PPI::Document->new( \$text );	
	my @tokens = $ppi_doc->tokens;
	$ppi_doc->index_locations;
	my @prepared_tokens =  prepare_tokens(1, @tokens);
	do_styling(@prepared_tokens);
	$doc->{_is_colorized} = 1;
}

sub do_styling {
	my $doc = Padre::Current->document;
	my $editor = $doc->editor;
	
	foreach my $t (@_) {
		$editor->StartStyling($t->{start}, $t->{color});
		$editor->SetStyling($t->{length}, $t->{color});
	}
}


sub class_to_css {
	my $Token = shift;
	if ( $Token->isa('PPI::Token::Word') ) {
		# There are some words we can be very confident are
		# being used as keywords
		unless ( $Token->snext_sibling and $Token->snext_sibling->content eq '=>' ) {
			if ( $Token->content =~ /^(?:sub|return)$/ ) {
				return 'keyword';
			} elsif ( $Token->content =~ /^(?:undef|shift|defined|bless)$/ ) {
				return 'core';
			}
		}
		
		if ( $Token->previous_sibling and $Token->previous_sibling->content eq '->' ) {
			if ( $Token->content =~ /^(?:new)$/ ) {
				return 'core';
			}
		}

		if ( $Token->parent->isa('PPI::Statement::Include') ) {
			if ( $Token->content =~ /^(?:use|no)$/ ) {
				return 'keyword';
			}
			if ( $Token->content eq $Token->parent->pragma ) {
				return 'pragma';
			}
		} elsif ( $Token->parent->isa('PPI::Statement::Variable') ) {
			if ( $Token->content =~ /^(?:my|local|our)$/ ) {
				return 'keyword';
			}
		} elsif ( $Token->parent->isa('PPI::Statement::Compond') ) {
			if ( $Token->content =~ /^(?:if|else|elsif|unless|for|foreach|while|my)$/ ) {
				return 'keyword';
			}
		} elsif ( $Token->parent->isa('PPI::Statement::Package') ) {
			if ( $Token->content eq 'package' ) {
				return 'keyword';
			}
		} elsif ( $Token->parent->isa('PPI::Statement::Scheduled') ) {
			return 'keyword';
		}
	}

	# Normal coloring
	my $css = ref $Token;
	$css =~ s/^.+:://;
	$css;
}

1;

# Copyright 2008-2009 The Padre development team as listed in Padre.pm.
# LICENSE
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl 5 itself.
