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->SetFontWx::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 >= 32and ($key < 127)) or (($key > 127and ($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 $beginand ($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 $beginand ($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$txt0);
 
}
 

 

 
1;
 
__END__