package Padre::Wx::Syntax;

use 5.008;
use strict;
use warnings;
use Params::Util          ();
use Padre::Role::Task     ();
use Padre::Wx::Role::View ();
use Padre::Wx::Role::Main ();
use Padre::Wx             ();
use Padre::Wx::Icon       ();
use Padre::Wx::TreeCtrl   ();
use Padre::Wx::HtmlWindow ();
use Padre::Logger;

our $VERSION = '0.86';
our @ISA     = qw{
	Padre::Role::Task
	Padre::Wx::Role::View
	Padre::Wx::Role::Main
	Wx::Panel
};

use constant TIMER => Wx::NewId();

# perldiag error message classification
my %MESSAGE = (

	# (W) A warning (optional).
	'W' => {
		label  => Wx::gettext('Warning'),
		marker => Padre::Wx::MarkWarn(),
	},

	# (D) A deprecation (enabled by default).
	'D' => {
		label  => Wx::gettext('Deprecation'),
		marker => Padre::Wx::MarkWarn(),
	},

	# (S) A severe warning (enabled by default).
	'S' => {
		label  => Wx::gettext('Severe Warning'),
		marker => Padre::Wx::MarkWarn(),
	},

	# (F) A fatal error (trappable).
	'F' => {
		label  => Wx::gettext('Fatal Error'),
		marker => Padre::Wx::MarkError(),
	},

	# (P) An internal error you should never see (trappable).
	'P' => {
		label  => Wx::gettext('Internal Error'),
		marker => Padre::Wx::MarkError(),
	},

	# (X) A very fatal error (nontrappable).
	'X' => {
		label  => Wx::gettext('Very Fatal Error'),
		marker => Padre::Wx::MarkError(),
	},

	# (A) An alien error message (not generated by Perl).
	'A' => {
		label  => Wx::gettext('Alien Error'),
		marker => Padre::Wx::MarkError(),
	},
);


sub new {
	my $class = shift;
	my $main  = shift;
	my $panel = shift || $main->bottom;

	# Create the parent panel which will contain the search and tree
	my $self = $class->SUPER::new($panel);

	# Create the underlying object
	$self->{tree} = Padre::Wx::TreeCtrl->new(
		$self,
		-1,
		Wx::wxDefaultPosition,
		Wx::wxDefaultSize,
		Wx::wxTR_SINGLE | Wx::wxTR_FULL_ROW_HIGHLIGHT | Wx::wxTR_HAS_BUTTONS
	);

	$self->{help} = Padre::Wx::HtmlWindow->new(
		$self,
		-1,
		Wx::wxDefaultPosition,
		Wx::wxDefaultSize,
		Wx::wxBORDER_STATIC,
	);
	$self->{help}->Hide;

	my $sizer = Wx::BoxSizer->new(Wx::wxHORIZONTAL);
	$sizer->Add( $self->{tree}, 3, Wx::wxALL | Wx::wxEXPAND, 2 );
	$sizer->Add( $self->{help}, 2, Wx::wxALL | Wx::wxEXPAND, 2 );
	$self->SetSizer($sizer);

	# Additional properties
	$self->{model}    = [];
	$self->{document} = '';
	$self->{length}   = -1;

	# Prepare the available images
	my $images = Wx::ImageList->new( 16, 16 );
	$self->{images} = {
		error       => $images->Add( Padre::Wx::Icon::icon('status/padre-syntax-error') ),
		warning     => $images->Add( Padre::Wx::Icon::icon('status/padre-syntax-warning') ),
		ok          => $images->Add( Padre::Wx::Icon::icon('status/padre-syntax-ok') ),
		diagnostics => $images->Add(
			Wx::ArtProvider::GetBitmap(
				'wxART_GO_FORWARD',
				'wxART_OTHER_C',
				[ 16, 16 ],
			),
		),
		root => $images->Add(
			Wx::ArtProvider::GetBitmap(
				'wxART_HELP_FOLDER',
				'wxART_OTHER_C',
				[ 16, 16 ],
			),
		),
	};
	$self->{tree}->AssignImageList($images);

	Wx::Event::EVT_TREE_ITEM_ACTIVATED(
		$self,
		$self->{tree},
		sub {
			$_[0]->on_tree_item_activated( $_[1] );
		},
	);

	Wx::Event::EVT_TREE_SEL_CHANGED(
		$self,
		$self->{tree},
		sub {
			$_[0]->on_tree_item_selection_changed( $_[1] );
		},
	);

	$self->Hide;

	return $self;
}





######################################################################
# Padre::Wx::Role::View Methods

sub view_panel {
	return 'bottom';
}

sub view_label {
	shift->gettext_label(@_);
}

sub view_close {
	$_[0]->task_reset;
	$_[0]->main->show_syntaxcheck(0);
}





#####################################################################
# Timer Control

sub start {
	my $self = shift;
	$self->running and return;
	TRACE('Starting the syntax checker') if DEBUG;

	# Add the margins for the syntax markers
	foreach my $editor ( $self->main->editors ) {

		# Margin number 1 for symbols
		$editor->SetMarginType( 1, Wx::wxSTC_MARGIN_SYMBOL );

		# Set margin 1 16 px wide
		$editor->SetMarginWidth( 1, 16 );
	}

	if ( Params::Util::_INSTANCE( $self->{timer}, 'Wx::Timer' ) ) {
		$self->on_timer( undef, 1 );
	} else {
		TRACE('Creating new timer') if DEBUG;
		$self->{timer} = Wx::Timer->new( $self, TIMER );
		Wx::Event::EVT_TIMER(
			$self, TIMER,
			sub {
				$self->on_timer( $_[1], $_[2] );
			},
		);
	}
	$self->{timer}->Start( 1000, 0 );

	return;
}

sub stop {
	my $self = shift;
	$self->running or return;
	TRACE('Stopping the syntax checker') if DEBUG;

	# Stop the timer
	if ( Params::Util::_INSTANCE( $self->{timer}, 'Wx::Timer' ) ) {
		$self->{timer}->Stop;
	}

	# Remove the editor margin
	foreach my $editor ( $self->main->editors ) {
		$editor->SetMarginWidth( 1, 0 );
	}

	# Clear out the existing data
	$self->clear;

	return;
}

sub running {
	!!( $_[0]->{timer} and $_[0]->{timer}->IsRunning );
}





#####################################################################
# Event Handlers

sub on_tree_item_selection_changed {
	my ( $self, $event ) = @_;

	my $item = $event->GetItem or return;
	my $issue = $self->{tree}->GetPlData($item);

	if ( $issue && $issue->{diagnostics} ) {
		my $diag = $issue->{diagnostics};
		$self->_update_help_page($diag);
	} else {
		$self->_update_help_page;
	}
}

sub on_tree_item_activated {
	my ( $self, $event ) = @_;

	my $item   = $event->GetItem                 or return;
	my $issue  = $self->{tree}->GetPlData($item) or return;
	my $editor = $self->current->editor          or return;
	my $line   = $issue->{line};

	return
		if not defined($line)
			or $line !~ /^\d+$/o
			or $editor->GetLineCount < $line;

	# Select the problem after the event has finished
	Wx::Event::EVT_IDLE(
		$self,
		sub {
			$self->select_problem( $line - 1 );
			Wx::Event::EVT_IDLE( $self, undef );
		},
	);
}

sub on_timer {
	my $self  = shift;
	my $event = shift;
	$event->Skip(0) if defined $event;
	$self->refresh;
}





#####################################################################
# General Methods

sub bottom {
	TRACE("DEPRECATED") if DEBUG;
	shift->main->bottom;
}

sub gettext_label {
	Wx::gettext('Syntax Check');
}

# Remove all markers and empty the list
sub clear {
	my $self = shift;
	my $lock = $self->main->lock('UPDATE');

	# Remove the margins for the syntax markers
	foreach my $editor ( $self->main->editors ) {
		$editor->MarkerDeleteAll(Padre::Wx::MarkError);
		$editor->MarkerDeleteAll(Padre::Wx::MarkWarn);
	}

	# Remove all items from the tool
	$self->{tree}->DeleteAllItems;

	# Clear the help page
	$self->_update_help_page;

	return;
}

sub relocale {

	# Nothing to implement here
	return;
}

sub refresh {
	my $self = shift;
	my $document = $self->current->document or return;

	# If the document is unused, shortcut to avoid pointless tasks
	if ( $document->is_unused ) {
		my $lock = $self->main->lock('UPDATE');
		$self->clear;
		return;
	}

	# Allows us to check when an empty or unsaved document is open
	my $filename = defined( $document->filename ) ? $document->filename : '';

	my $length = $document->text_length;

	if ( $filename eq $self->{document} ) {

		# Shortcut if nothing has changed.
		# NOTE: Given the speed at which the timer fires a cheap
		# length check is better than an expensive MD5 check.
		return if ( $length eq $self->{length} );
	}

	$self->{document} = $filename;
	$self->{length}   = $length;

	# Fire the background task discarding old results
	$self->task_reset;
	$self->task_request(
		task     => $document->task_syntax,
		document => $document,
	);
}

sub task_finish {
	my $self = shift;
	my $task = shift;
	$self->{model} = $task->{model};
	$self->render;
}

sub render {
	my $self     = shift;
	my $model    = $self->{model} || [];
	my $current  = $self->current;
	my $editor   = $current->editor;
	my $document = $current->document;
	my $filename = $current->filename;
	my $lock     = $self->main->lock('UPDATE');

	# Flush old results
	$self->clear;

	my $root = $self->{tree}->AddRoot('Root');

	# If there are no errors clear the synax checker pane
	unless ( Params::Util::_ARRAY($model) ) {

		# Relative-to-the-project filename.
		# Check that the document has been saved.
		if ( defined $filename ) {
			my $project_dir = $document->project_dir;
			if ( defined $project_dir ) {
				$project_dir = quotemeta $project_dir;
				$filename =~ s/^$project_dir[\\\/]?//;
			}
			$self->{tree}->SetItemText(
				$root,
				sprintf( Wx::gettext('No errors or warnings found in %s.'), $filename )
			);
		} else {
			$self->{tree}->SetItemText( $root, Wx::gettext('No errors or warnings found.') );
		}
		$self->{tree}->SetItemImage( $root, $self->{images}->{ok} );
		return;
	}

	$self->{tree}->SetItemText(
		$root,
		defined $filename
		? sprintf( Wx::gettext('Found %d issue(s) in %s'), scalar @$model, $filename )
		: sprintf( Wx::gettext('Found %d issue(s)'),       scalar @$model )
	);
	$self->{tree}->SetItemImage( $root, $self->{images}->{root} );

	my $i = 0;
	ISSUE:
	foreach my $issue ( sort { $a->{line} <=> $b->{line} } @$model ) {

		if ( not exists $issue->{type} ) {
			require Data::Dumper;
			TRACE( "Cannot handle issue:\n" . Data::Dumper::Dumper($issue) ) if DEBUG;
			next ISSUE;
		}

		my $line = $issue->{line} - 1;
		my $type = $issue->{type};
		$editor->MarkerAdd( $line, $MESSAGE{$type}{marker} );

		my $item = $self->{tree}->AppendItem(
			$root,
			sprintf(
				Wx::gettext('Line %d:   (%s)   %s'),
				$line + 1,
				$MESSAGE{$type}{label},
				$issue->{message}
			),
			$MESSAGE{$type}{marker} == Padre::Wx::MarkWarn() ? $self->{images}{warning} : $self->{images}{error}
		);
		$self->{tree}->SetPlData( $item, $issue );
	}

	$self->{tree}->Expand($root);
	$self->{tree}->EnsureVisible($root);

	return 1;
}

# Updates the help page. It shows the text if it is defined otherwise clears and hides it
sub _update_help_page {
	my $self = shift;
	my $text = shift;

	# load the escaped HTML string into the shown page otherwise hide
	# if the text is undefined
	my $help = $self->{help};
	if ( defined $text ) {
		require CGI;
		$text = CGI::escapeHTML($text);
		$text =~ s/\n/<br>/g;
		my $WARN_TEXT = $MESSAGE{'W'}{label};
		if ( $text =~ /^\((W\s+(\w+)|D|S|F|P|X|A)\)/ ) {
			my ( $category, $warning_category ) = ( $1, $2 );
			my $category_label = ( $category =~ /^W/ ) ? $MESSAGE{'W'}{label} : $MESSAGE{$1}{label};
			my $notes =
				defined($warning_category)
				? "<code>no warnings '$warning_category';    # disable</code><br>"
				. "<code>use warnings '$warning_category';   # enable</code><br><br>"
				: '';
			$text =~ s{^\((W\s+(\w+)|D|S|F|P|X|A)\)}{<h3>$category_label</h3>$notes};
		}
		$help->SetPage($text);
		$help->Show;
	} else {
		$help->SetPage('');
		$help->Hide;
	}

	#Sticky note light-yellow background
	$self->{help}->SetBackgroundColour( Wx::Colour->new( 0xFD, 0xFC, 0xBB ) );

	# Relayout to actually hide/show the help page
	$self->Layout;
}

# Selects the problemistic line :)
sub select_problem {
	my $self   = shift;
	my $line   = shift;
	my $editor = $self->current->editor or return;
	$editor->EnsureVisible($line);
	$editor->goto_pos_centerize( $editor->GetLineIndentPosition($line) );
	$editor->SetFocus;
}

# Selects the next problem in the editor.
# Wraps to the first one when at the end.
sub select_next_problem {
	my $self         = shift;
	my $editor       = $self->current->editor or return;
	my $current_line = $editor->LineFromPosition( $editor->GetCurrentPos );

	# Start with the first child
	my $root = $self->{tree}->GetRootItem;
	my ( $child, $cookie ) = $self->{tree}->GetFirstChild($root);
	my $first_line = undef;
	while ($cookie) {

		# Get the line and check that it is a valid line number
		my $issue = $self->{tree}->GetPlData($child) or return;
		my $line = $issue->{line};

		if (   not defined($line)
			or ( $line !~ /^\d+$/o )
			or ( $line > $editor->GetLineCount ) )
		{
			( $child, $cookie ) = $self->{tree}->GetNextChild( $root, $cookie );
			next;
		}
		$line--;

		if ( not $first_line ) {

			# record the position of the first problem
			$first_line = $line;
		}

		if ( $line > $current_line ) {

			# select the next problem
			$self->select_problem($line);

			# no need to wrap around...
			$first_line = undef;

			# and we're done here...
			last;
		}

		# Get the next child if there is one
		( $child, $cookie ) = $self->{tree}->GetNextChild( $root, $cookie );
	}

	# The next problem is simply the first (wrap around)
	$self->select_problem($first_line) if $first_line;
}

1;

# Copyright 2008-2011 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.
