package Padre::Wx::Output;

# Class for the output window at the bottom of Padre.
# This currently has very little customisation code in it,
# but that will change in future.

use 5.008;
use strict;
use warnings;
use utf8;
use Encode                ();
use File::Spec            ();
use Params::Util          ();
use Padre::Wx::Role::View ();
use Padre::Wx::Role::Main ();
use Padre::Wx             ();
use Padre::Logger;
use Wx::RichText; # Is this necesary?

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





######################################################################
# Constructor

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

	# Create the underlying object
	my $self = $class->SUPER::new(
		$panel,
		-1,
		"",
		Wx::wxDefaultPosition,
		Wx::wxDefaultSize,
		Wx::wxTE_READONLY
			| Wx::wxTE_MULTILINE
			| Wx::wxTE_DONTWRAP
			| Wx::wxNO_FULL_REPAINT_ON_RESIZE,
	);

	# Do custom start-up stuff here
	$self->clear;
	$self->set_font;

	# see #351: output should be blank by default at start-up.
	#$self->AppendText( Wx::gettext('No output') );

	Wx::Event::EVT_TEXT_URL(
		$self, $self,
		sub {
			shift->on_text_url(@_);
		},
	);

	return $self;
}





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

sub view_panel {
	return 'bottom';
}

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

sub view_close {
	shift->main->show_output(0);
}





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

sub on_text_url {
	my $self   = shift;
	my $event  = shift;
	my $string = $event->GetString or return;

	require URI;
	my $uri = URI->new($string) or return;
	TRACE("Output URI clicked: $uri") if DEBUG;

	my $file = $uri->file or return;
	my $path = File::Spec->rel2abs($file) or return;
	my $line = $uri->fragment || 1;
	return unless -e $path;

	TRACE("Output Path: $path") if DEBUG;
	TRACE("Output Line: $line") if DEBUG;

	# Open the file and jump to the appropriate line
	$self->main->setup_editor($path);
	my $current = $self->current;
	if ( $current->filename eq $path ) {
		$current->editor->goto_line_centerize( $line - 1 );
	} else {
		TRACE(" Current doc does not match our expectations") if DEBUG;
	}
}





#####################################################################
# Process Execution

# If this is the first time a command has been run,
# set up the ProcessStream bindings.
sub setup_bindings {
	my $self = shift;

	return 1 if $Wx::Perl::ProcessStream::VERSION;
	require Wx::Perl::ProcessStream;

	if ( $Wx::Perl::ProcessStream::VERSION < .20 ) {
		$self->main->error(
			sprintf(
				Wx::gettext(
					      'Wx::Perl::ProcessStream is version %s'
						. ' which is known to cause problems. Get at least 0.20 by typing'
						. "\ncpan Wx::Perl::ProcessStream"
				),
				$Wx::Perl::ProcessStream::VERSION
			)
		);
		return 1;
	}

	Wx::Perl::ProcessStream::EVT_WXP_PROCESS_STREAM_STDOUT(
		$self,
		sub {
			$_[1]->Skip(1);
			$_[0]->style_neutral;
			$_[0]->AppendText( $_[1]->GetLine . "\n" );
			return;
		},
	);

	Wx::Perl::ProcessStream::EVT_WXP_PROCESS_STREAM_STDERR(
		$self,
		sub {
			$_[1]->Skip(1);
			$_[0]->style_bad;
			$_[0]->AppendText( $_[1]->GetLine . "\n" );
			return;
		},
	);

	Wx::Perl::ProcessStream::EVT_WXP_PROCESS_STREAM_EXIT(
		$self,
		sub {
			$_[1]->Skip(1);
			$_[1]->GetProcess->Destroy;
			$_[0]->current->main->menu->run->enable;
		},
	);

	return 1;
}





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

sub bottom {
	warn "Unexpectedly called Padre::Wx::Output::bottom, it should be deprecated";
	shift->main->bottom;
}

sub gettext_label {
	Wx::gettext('Output');
}

# From Sean Healy on wxPerl mailing list.
# Tweaked to avoid strings copying as much as possible.
sub AppendText {
	my $self     = shift;
	my $use_ansi = $self->main->ide->config->main_output_ansi;
	if ( utf8::is_utf8( $_[0] ) ) {
		if ($use_ansi) {
			$self->_handle_ansi_escapes( $_[0] );
		} else {
			$self->SUPER::AppendText( $_[0] );
		}
	} else {
		my $text = Encode::decode( 'utf8', $_[0] );
		if ($use_ansi) {
			$self->_handle_ansi_escapes($text);
		} else {
			$self->SUPER::AppendText($text);
		}
	}

	# Scroll down to the latest position
	# Maybe we should check for a setting
	# so user can set if they want scroll
	$self->ShowPosition( $self->GetLastPosition() );
	return ();
}

SCOPE: {

	# TO DO: This should be some sort of style file,
	# but the main editor style support is too wacky
	# to add this at the moment.
	my $fg_colors = [
		Wx::Colour->new('#000000'), # black
		Wx::Colour->new('#FF0000'), # red
		Wx::Colour->new('#00FF00'), # green
		Wx::Colour->new('#FFFF00'), # yellow
		Wx::Colour->new('#0000FF'), # blue
		Wx::Colour->new('#FF00FF'), # magenta
		Wx::Colour->new('#00FFFF'), # cyan
		Wx::Colour->new('#FFFFFF'), # white
		undef,
		Wx::Colour->new('#000000'), # reset to default (black)
	];
	my $bg_colors = [
		Wx::Colour->new('#000000'), # black
		Wx::Colour->new('#FF0000'), # red
		Wx::Colour->new('#00FF00'), # green
		Wx::Colour->new('#FFFF00'), # yellow
		Wx::Colour->new('#0000FF'), # blue
		Wx::Colour->new('#FF00FF'), # magenta
		Wx::Colour->new('#00FFFF'), # cyan
		Wx::Colour->new('#FFFFFF'), # white
		undef,
		Wx::Colour->new('#FFFFFF'), # reset to default (white)
	];

	sub _handle_ansi_escapes {
		my $self    = shift;
		my $newtext = shift;

		# Read the next TEXT CONTROL-SEQUENCE pair
		my $style      = $self->GetDefaultStyle;
		my $ansi_found = 0;
		while ( $newtext =~ m{ \G (.*?) \033\[ ( (?: \d+ (?:;\d+)* )? ) m }xcg ) {
			$ansi_found = 1;
			my $ctrl = $2;

			# First print the text preceding the control sequence
			$self->_handle_links($1);

			# Split the sequence on ; -- this may be specific to the graphics 'm' sequences, but
			# we don't handle any others at the moment (see regexp above)
			my @cmds = split /;/, $ctrl;

			foreach my $cmd (@cmds) {
				if ( $cmd >= 0 and $cmd < 30 ) {

					# For all these, we need the font object:
					my $font = $style->GetFont;
					if ( $cmd == 0 ) { # reset
						$style->SetTextColour( $fg_colors->[9] );       # reset text color
						$style->SetBackgroundColour( $bg_colors->[9] ); # reset bg color
						                                                # reset bold/italic/underlined state
						$font->SetWeight(Wx::wxFONTWEIGHT_NORMAL);
						$font->SetUnderlined(0);
						$font->SetStyle(Wx::wxFONTSTYLE_NORMAL);
					} elsif ( $cmd == 1 ) {                             # bold
						$font->SetWeight(Wx::wxFONTWEIGHT_BOLD);
					} elsif ( $cmd == 2 ) {                             # faint
						$font->SetWeight(Wx::wxFONTWEIGHT_LIGHT);
					} elsif ( $cmd == 3 ) {                             # italic
						$font->SetStyle(Wx::wxFONTSTYLE_ITALIC);
					} elsif ( $cmd == 4 || $cmd == 21 ) {               # underline (21==double, but we can't do that)
						$font->SetUnderlined(1);
					} elsif ( $cmd == 22 ) {                            # reset bold and faint
						$font->SetWeight(Wx::wxFONTWEIGHT_NORMAL);
					} elsif ( $cmd == 24 ) {                            # reset underline
						$font->SetUnderlined(0);
					}
					$style->SetFont($font);
				}

				# the high range is supposed to be 'high intensity' as supported by aixterm
				elsif ( $cmd >= 30 && $cmd < 40 or $cmd >= 90 && $cmd < 100 ) {

					# foreground
					$cmd -= $cmd > 40 ? 90 : 30;
					my $color = $fg_colors->[$cmd];
					if ( defined $color ) {
						$style->SetTextColour($color);
						$self->SetDefaultStyle($style);
					}
				}

				# the high range is supposed to be 'high intensity' as supported by aixterm
				elsif ( $cmd >= 40 && $cmd < 50 or $cmd >= 100 && $cmd < 110 ) {

					# background
					$cmd -= $cmd > 50 ? 100 : 40;
					my $color = $bg_colors->[$cmd];
					if ( defined $color ) {
						$style->SetBackgroundColour($color);
					}
				}

				$self->SetDefaultStyle($style);
			} # end foreach command in the sequence
		} # end while more control sequences

		# the remaining text
		if ( defined( pos($newtext) ) ) {
			$self->_handle_links( substr( $newtext, pos($newtext) ) );
		}
		unless ($ansi_found) {
			$self->_handle_links($newtext);
		}
	}

	# based on _handle_ansi_escapes
	sub _handle_links {
		my $self    = shift;
		my $newtext = shift;

		my $link_found = 0;

		# matches Perl error messages that look like: <error> at <file> line 45.
		while ( $newtext =~ m{ \G (.*?) \s at \s (.*) \s line \s (\d+).$ }xcg ) {
			$link_found = 1;
			my ( $file, $line ) = ( $2, $3 );

			# first print the text preceding the link
			# TO DO: You can't make SUPER calls to different methods
			$self->SUPER::AppendText($1);
			$self->SUPER::AppendText(' at ');

			# Turn the filename into a file: uri
			$self->BeginURL("file:$file#$line");
			$self->BeginUnderline;
			$self->BeginTextColour( $bg_colors->[4] );
			$self->AppendText("$file");
			$self->EndTextColour;
			$self->EndUnderline;
			$self->EndURL;

			$self->AppendText(" line $line.");
		}

		# the remaining text
		if ( defined pos($newtext) ) {
			$self->SUPER::AppendText( substr( $newtext, pos($newtext) ) );
		}
		unless ($link_found) {
			$self->SUPER::AppendText($newtext);
		}
	}
}

sub select {
	my $self   = shift;
	my $parent = $self->GetParent;
	$parent->SetSelection( $parent->GetPageIndex($self) );
	return;
}

sub SetBackgroundColour {
	my $self = shift;
	my $arg  = shift;
	if ( defined Params::Util::_STRING($arg) ) {
		$arg = Wx::Colour->new($arg);
	}
	return $self->SUPER::SetBackgroundColour($arg);
}

sub clear {
	my $self = shift;
	$self->SetBackgroundColour('#FFFFFF');
	$self->Remove( 0, $self->GetLastPosition );
	$self->Refresh;
	return 1;
}

sub style_good {
	$_[0]->SetBackgroundColour('#CCFFCC');
	$_[0]->Refresh;
}

sub style_bad {
	$_[0]->SetBackgroundColour('#FFCCCC');
	$_[0]->Refresh;
}

sub style_neutral {
	$_[0]->SetBackgroundColour('#FFFFFF');
	$_[0]->Refresh;
}

sub style_busy {
	$_[0]->SetBackgroundColour('#CCCCCC');
	$_[0]->Refresh;
}

sub set_font {
	my $self = shift;
	my $font = Wx::Font->new( 10, Wx::wxTELETYPE, Wx::wxNORMAL, Wx::wxNORMAL );
	my $name = $self->config->editor_font;
	if ( defined $name and length $name ) {
		$font->SetNativeFontInfoUserDesc($name);
	}
	my $style = $self->GetDefaultStyle;
	$style->SetFont($font);
	$self->SetDefaultStyle($style);
	return;
}

sub relocale {

	# do nothing
}

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.
