package Syntax::Kamelon::Wx::PluggableTextCtrl;

use strict;
use warnings;
use Carp;

use vars qw($VERSION);
$VERSION="0.01";

use Wx qw( :textctrl :font :colour );
use Wx::DND;
use Wx qw( wxTheClipboard );
use base qw( Wx::TextCtrl );
use Wx::Event qw( EVT_CHAR );

require Syntax::Kamelon::Wx::PluggableTextCtrl::KeyEchoes;
require Syntax::Kamelon::Wx::PluggableTextCtrl::UndoRedo;
require Syntax::Kamelon::Wx::PluggableTextCtrl::Highlighter;

my $defaultfont = [10, wxFONTFAMILY_MODERN, wxFONTSTYLE_NORMAL, wxFONTWEIGHT_NORMAL, 0];

my $debug = 0;

if ($debug) {
   use Data::Dumper;
}

sub new {
   my $class = shift;
   my $self = $class->SUPER::new(@_);

   $self->{CALLBACK} = sub {};
   $self->{COMMANDS} = {
      'doremove' => \&DoRemove,
      'doreplace' => \&DoReplace,
      'dowrite' => \&DoWrite,
   };
   $self->{LISTENING} = 0;
   
   $self->{OVRMODE} = 0;
   $self->{PLUGINS} = [];

   $self->SetFont( Wx::Font->new(@$defaultfont) );
   EVT_CHAR($self, \&OnChar);

   return $self;
}

sub AppendText {
   my $self = shift;
   unless ($self->Broadcast('append', @_)) {
      $self->SUPER::Append(@_);
   }
}

sub Broadcast {
   my $self = shift;
   my $plugs = $self->{PLUGINS};
   my $flag = 0;
   foreach (@$plugs) {
      if ($_->Receive(@_)) {
         $flag = 1;
      }
   }
   return $flag;
}

sub Call2Remove {
   my ($self, $call, $index, $txt) = @_;
   if ($call =~ /.*remove$/) {
      return ($index, $index + length($txt))
   } else {
      carp "Call '$call' is not a remove type";
      return undef
   }
}

sub Call2Replace {
   my ($self, $call, $index, $old, $txt, $sel) = @_;
   if ($call =~ /.*replace$/) {
      return ($index, $index + length($old), $txt)
   } else {
      carp "Call '$call' is not a replace type";
      return undef
   }
}

sub Call2WriteText {
   my ($self, $call, $index, $txt) = @_;
   if ($call =~ /.*write$/) {
      return $txt
   } else {
      carp "Call '$call' is not a write type";
      return undef
   }
}

sub Callback {
   my $self = shift;
   if (@_) { $self->{CALLBACK} = shift; }
   return $self->{CALLBACK};
}

sub CanUndo {
   my $self = shift;
   return $self->Broadcast('canundo');
}

sub CanRedo {
   my $self = shift;
   return $self->Broadcast('canredo');
}

sub Clear {
   my $self = shift;
   unless ($self->Broadcast('clear')) {
      $self->SUPER::Clear;
   }
}

sub ClearSelection {
   my $self = shift;
   my $ins = $self->GetInsertionPoint;
   $self->SetSelection($ins, $ins);
}

sub Command {
   my $self = shift;
   my $name = shift;
   if (@_) { $self->{COMMANDS}->{$name} = shift }
   return $self->{COMMANDS}->{$name}
}

sub Copy {
   my $self = shift;
   unless ($self->Broadcast('copy')) {
      $self->SUPER::Copy;
   }
}

sub Cut {
   my $self = shift;
   unless ($self->Broadcast('cut')) {
      $self->SUPER::Cut;
   }
}

sub DoRemove {
   my $self = shift;
   my ($index, $txt, $sel, $ins) = @_;
   $self->ClearSelection;
   $self->SUPER::Remove($index, $index + length($txt));
   if (defined($ins)) {
      $self->SetInsertionPoint($ins);
   }
   return 1
}

sub DoReplace {
   my ($self, $index, $old, $txt, $sel, $ins) = @_;
   $self->ClearSelection;
   $self->SUPER::Replace($index, $index + length($old), $txt);
   if ($sel) {
      $self->SetSelection($index, $index + length($txt));
   }
   if (defined($ins)) {
      $self->SetInsertionPoint($ins);
   }
   return 1
}

sub DoWrite {
   my ($self, $index, $txt, $sel, $ins) = @_;
   $self->ClearSelection;
   $self->SetInsertionPoint($index);
   $self->SUPER::WriteText($txt);
   if ($sel) {
      $self->SetSelection($index, $index + length($txt));
   }
   if (defined($ins)) {
      $self->SetInsertionPoint($ins);
   }
   return 1
}

sub FindPluginId {
   my ($self, $name) = @_;
   my $plgs = $self->{PLUGINS};
   my $index = 0;
   foreach (@$plgs) {
      if ($name eq $plgs->[$index]->Name) {
         return $index
      }
      $index ++;
   }
#   carp "Plugin $name is not loaded\n";
   return undef;
}

sub FindPlugin {
   my ($self, $name) = @_;
   my $plgs = $self->{PLUGINS};
   foreach (@$plgs) {
      if ($name eq $_->Name) {
			return $_
      }
   }
   return undef;
}

sub GetClipboardText {
   my $self = shift;
   my $txt = undef;
   if (wxTheClipboard->Open) {
      if ($debug) { print "Clipboard open\n" }
      my $textdata = Wx::TextDataObject->new;
      my $ok = wxTheClipboard->GetData( $textdata );
      if( $ok ) {
         $txt = $textdata->GetText;
      }
      if ($debug and defined($txt)) { print "Clipboard text: $txt\n" }
      wxTheClipboard->Close;
   }
   return $txt;
}

sub GetLineNumber {
   my ($self, $index) = @_;
   unless (defined($index)) { $index = $self->GetInsertionPoint };
   my ($col, $line) = $self->PositionToXY($index);
   return $line;
}

sub HasSelection {
   my $self = shift;
   my ($selb, $sele) = $self->GetSelection;
   return ($selb ne $sele)
}

# TODO make this unicode compatible
sub IsWriteable {
   my ($self, $key) = @_;
   if ((($key >= 32) and ($key < 127)) or (($key > 127) and ($key < 256))) {
      return 1
   }
   return 0
}

sub Listening {
   my $self = shift;
   if (@_) {
      my $new = shift;
      unless ($new eq $self->{LISTENING}) {
         my $plgs = $self->{PLUGINS};
         if ($new) {
            unshift @$plgs, $self
         } else {
            shift @$plgs
         }
         $self->{LISTENING} = $new
      }
   }
   return $self->{LISTENING}
}

sub LoadFile {
   my $self = shift;
   unless ($self->Broadcast('load', @_)) {
      $self->SUPER::LoadFile(@_);
   }
}

sub LoadPlugin {
   my $self = shift;
	my $plug = undef;
	my $name = shift;
	#Does anybody have a better idea for this?
	$name = "Syntax::Kamelon::Wx::PluggableTextCtrl::$name";
	$plug = $name->new($self, @_);
	if (defined($plug)) {
		$self->RegisterPlugin($plug);
	} else {
		carp "unable to load plugin $name\n";
	}
}

sub Name {
   my $self = shift;
   my $name = ref $self;
   $name =~s/.*:://;
   if ($debug) { print "plugin name is $name\n" }
   return $name
}

sub OnChar {
   my ($self, $event) = @_;
   my $k = $event->GetKeyCode;
   if ($k eq 322) { #Insert key pressed, record flip insert/ovr mode.
      if ($self->OvrMode) {
         $self->OvrMode(0)
      } else {
         $self->OvrMode(1)
      }
   }
   unless ($self->Broadcast('key', $event)) {
      $event->Skip;
   }
   my $callback = $self->Callback;
   &$callback;
}

sub OvrMode {
   my $self = shift;
   if (@_) { $self->{OVRMODE} = shift; }
   return $self->{OVRMODE};
}

sub Paste {
   my $self = shift;
   unless ($self->Broadcast('paste')) {
      $self->SUPER::Paste;
   }
}

sub Plugin {
   my $self = shift;
   my $id = shift;
   my $plgs = $self->{PLUGINS};
   unless ($id =~ /^\d+$/) {
      $id = $self->FindPluginId($id);
   }
   if (@_) { 
      $self->{PLUGINS}->[$id] = shift; 
   }
   return $self->{PLUGINS}->[$id];
}

sub Receive {
   my $self = shift;
   my $name = shift;
#    if ($debug) { print "received $name\n"; print Dumper $self->{COMMANDS} }
   if (exists $self->{COMMANDS}->{$name}) {
      if ($debug) { print "executing $name\n" }
      my $cmd = $self->Command($name);
      return &$cmd($self, @_);
   }
   return 0
}

sub Redo {
   my $self = shift;
   unless ($self->Broadcast('redo')) {
      $self->SUPER::Redo;
   }
}

sub RegisterPlugin {
   my ($self, $plug) = @_;
   my $pl = $self->{PLUGINS};
   push @$pl, $plug;
}

sub Remove {
   my $self = shift;
   my @call = $self->Remove2Call(@_);
   unless ($self->Broadcast(@call)) {
      $self->SUPER::Remove(@_);
   }
}

sub Remove2Call {
   my ($self, $begin, $end) = @_;
   my $sel = 0;
   my ($selb, $sele) = $self->GetSelection;
   if (($selb eq $begin) and ($sele eq $end)) { $sel = 1 }
   return ('remove', $begin, $self->GetRange($begin, $end), $sel)
}

sub Replace {
   my $self = shift;
   my @call = $self->Replace2Call(@_);
   unless ($self->Broadcast(@call)) {
      $self->SUPER::Replace(@_);
   }
}

sub Replace2Call {
   my ($self, $begin, $end, $txt) = @_;
   my $sel = 0;
   my ($selb, $sele) = $self->GetSelection;
   if (($selb eq $begin) and ($sele eq $end)) { $sel = 1 }
   return ('replace', $begin, $txt, $self->GetRange($begin, $end), $sel)
}

sub SaveFile {
   my $self = shift;
   unless ($self->Broadcast('save', @_)) {
      $self->SUPER::SaveFile(@_);
   }
}

sub NativePlugins {
   my $self = shift;
   return qw[ Highlighter KeyEchoes UndoRedo   ]
}

sub Syntax {
   my $self = shift;
   return $self->Broadcast('syntax', @_);
}

sub Undo {
   my $self = shift;
   unless ($self->Broadcast('undo')) {
      $self->SUPER::Undo;
   }
}

sub WriteText {
   my $self = shift;
   my @call = $self->WriteText2Call(@_);
   unless ($self->Broadcast(@call)) {
      $self->SUPER::WriteText(@_);
   }
}

sub WriteText2Call {
   my ($self, $txt) = @_;
   return ('write', $self->GetInsertionPoint, $txt, 0);
}


1;
__END__