0001 package Syntax::Kamelon::Wx::PluggableTextCtrl;
0002 
0003 use strict;
0004 use warnings;
0005 use Carp;
0006 
0007 use vars qw($VERSION);
0008 $VERSION="0.01";
0009 
0010 use Wx qw( :textctrl :font :colour );
0011 use Wx::DND;
0012 use Wx qw( wxTheClipboard );
0013 use base qw( Wx::TextCtrl );
0014 use Wx::Event qw( EVT_CHAR );
0015 
0016 require Syntax::Kamelon::Wx::PluggableTextCtrl::KeyEchoes;
0017 require Syntax::Kamelon::Wx::PluggableTextCtrl::UndoRedo;
0018 require Syntax::Kamelon::Wx::PluggableTextCtrl::Highlighter;
0019 
0020 my $defaultfont = [10, wxFONTFAMILY_MODERN, wxFONTSTYLE_NORMAL, wxFONTWEIGHT_NORMAL, 0];
0021 
0022 my $debug = 0;
0023 
0024 if ($debug) {
0025    use Data::Dumper;
0026 }
0027 
0028 sub new {
0029    my $class = shift;
0030    my $self = $class->SUPER::new(@_);
0031 
0032    $self->{CALLBACK} = sub {};
0033    $self->{COMMANDS} = {
0034       'doremove' => \&DoRemove,
0035       'doreplace' => \&DoReplace,
0036       'dowrite' => \&DoWrite,
0037    };
0038    $self->{LISTENING} = 0;
0039    
0040    $self->{OVRMODE} = 0;
0041    $self->{PLUGINS} = [];
0042 
0043    $self->SetFontWx::Font->new(@$defaultfont) );
0044    EVT_CHAR($self, \&OnChar);
0045 
0046    return $self;
0047 }
0048 
0049 sub AppendText {
0050    my $self = shift;
0051    unless ($self->Broadcast('append'@_)) {
0052       $self->SUPER::Append(@_);
0053    }
0054 }
0055 
0056 sub Broadcast {
0057    my $self = shift;
0058    my $plugs = $self->{PLUGINS};
0059    my $flag = 0;
0060    foreach (@$plugs) {
0061       if ($_->Receive(@_)) {
0062          $flag = 1;
0063       }
0064    }
0065    return $flag;
0066 }
0067 
0068 sub Call2Remove {
0069    my ($self$call$index$txt) = @_;
0070    if ($call =~ /.*remove$/) {
0071       return ($index$index + length($txt))
0072    } else {
0073       carp "Call '$call' is not a remove type";
0074       return undef
0075    }
0076 }
0077 
0078 sub Call2Replace {
0079    my ($self$call$index$old$txt$sel) = @_;
0080    if ($call =~ /.*replace$/) {
0081       return ($index$index + length($old), $txt)
0082    } else {
0083       carp "Call '$call' is not a replace type";
0084       return undef
0085    }
0086 }
0087 
0088 sub Call2WriteText {
0089    my ($self$call$index$txt) = @_;
0090    if ($call =~ /.*write$/) {
0091       return $txt
0092    } else {
0093       carp "Call '$call' is not a write type";
0094       return undef
0095    }
0096 }
0097 
0098 sub Callback {
0099    my $self = shift;
0100    if (@_) { $self->{CALLBACK} = shift; }
0101    return $self->{CALLBACK};
0102 }
0103 
0104 sub CanUndo {
0105    my $self = shift;
0106    return $self->Broadcast('canundo');
0107 }
0108 
0109 sub CanRedo {
0110    my $self = shift;
0111    return $self->Broadcast('canredo');
0112 }
0113 
0114 sub Clear {
0115    my $self = shift;
0116    unless ($self->Broadcast('clear')) {
0117       $self->SUPER::Clear;
0118    }
0119 }
0120 
0121 sub ClearSelection {
0122    my $self = shift;
0123    my $ins = $self->GetInsertionPoint;
0124    $self->SetSelection($ins$ins);
0125 }
0126 
0127 sub Command {
0128    my $self = shift;
0129    my $name = shift;
0130    if (@_) { $self->{COMMANDS}->{$name} = shift }
0131    return $self->{COMMANDS}->{$name}
0132 }
0133 
0134 sub Copy {
0135    my $self = shift;
0136    unless ($self->Broadcast('copy')) {
0137       $self->SUPER::Copy;
0138    }
0139 }
0140 
0141 sub Cut {
0142    my $self = shift;
0143    unless ($self->Broadcast('cut')) {
0144       $self->SUPER::Cut;
0145    }
0146 }
0147 
0148 sub DoRemove {
0149    my $self = shift;
0150    my ($index$txt$sel$ins) = @_;
0151    $self->ClearSelection;
0152    $self->SUPER::Remove($index$index + length($txt));
0153    if (defined($ins)) {
0154       $self->SetInsertionPoint($ins);
0155    }
0156    return 1
0157 }
0158 
0159 sub DoReplace {
0160    my ($self$index$old$txt$sel$ins) = @_;
0161    $self->ClearSelection;
0162    $self->SUPER::Replace($index$index + length($old), $txt);
0163    if ($sel) {
0164       $self->SetSelection($index$index + length($txt));
0165    }
0166    if (defined($ins)) {
0167       $self->SetInsertionPoint($ins);
0168    }
0169    return 1
0170 }
0171 
0172 sub DoWrite {
0173    my ($self$index$txt$sel$ins) = @_;
0174    $self->ClearSelection;
0175    $self->SetInsertionPoint($index);
0176    $self->SUPER::WriteText($txt);
0177    if ($sel) {
0178       $self->SetSelection($index$index + length($txt));
0179    }
0180    if (defined($ins)) {
0181       $self->SetInsertionPoint($ins);
0182    }
0183    return 1
0184 }
0185 
0186 sub FindPluginId {
0187    my ($self$name) = @_;
0188    my $plgs = $self->{PLUGINS};
0189    my $index = 0;
0190    foreach (@$plgs) {
0191       if ($name eq $plgs->[$index]->Name) {
0192          return $index
0193       }
0194       $index ++;
0195    }
0196 #   carp "Plugin $name is not loaded\n";
0197    return undef;
0198 }
0199 
0200 sub FindPlugin {
0201    my ($self$name) = @_;
0202    my $plgs = $self->{PLUGINS};
0203    foreach (@$plgs) {
0204       if ($name eq $_->Name) {
0205          return $_
0206       }
0207    }
0208    return undef;
0209 }
0210 
0211 sub GetClipboardText {
0212    my $self = shift;
0213    my $txt = undef;
0214    if (wxTheClipboard->Open) {
0215       if ($debug) { print "Clipboard open\n" }
0216       my $textdata = Wx::TextDataObject->new;
0217       my $ok = wxTheClipboard->GetData( $textdata );
0218       if$ok ) {
0219          $txt = $textdata->GetText;
0220       }
0221       if ($debug and defined($txt)) { print "Clipboard text: $txt\n" }
0222       wxTheClipboard->Close;
0223    }
0224    return $txt;
0225 }
0226 
0227 sub GetLineNumber {
0228    my ($self$index) = @_;
0229    unless (defined($index)) { $index = $self->GetInsertionPoint };
0230    my ($col$line) = $self->PositionToXY($index);
0231    return $line;
0232 }
0233 
0234 sub HasSelection {
0235    my $self = shift;
0236    my ($selb$sele) = $self->GetSelection;
0237    return ($selb ne $sele)
0238 }
0239 
0240 TODO make this unicode compatible
0241 sub IsWriteable {
0242    my ($self$key) = @_;
0243    if ((($key >= 32and ($key < 127)) or (($key > 127and ($key < 256))) {
0244       return 1
0245    }
0246    return 0
0247 }
0248 
0249 sub Listening {
0250    my $self = shift;
0251    if (@_) {
0252       my $new = shift;
0253       unless ($new eq $self->{LISTENING}) {
0254          my $plgs = $self->{PLUGINS};
0255          if ($new) {
0256             unshift @$plgs$self
0257          } else {
0258             shift @$plgs
0259          }
0260          $self->{LISTENING} = $new
0261       }
0262    }
0263    return $self->{LISTENING}
0264 }
0265 
0266 sub LoadFile {
0267    my $self = shift;
0268    unless ($self->Broadcast('load'@_)) {
0269       $self->SUPER::LoadFile(@_);
0270    }
0271 }
0272 
0273 sub LoadPlugin {
0274    my $self = shift;
0275    my $plug = undef;
0276    my $name = shift;
0277    #Does anybody have a better idea for this?
0278    $name = "Syntax::Kamelon::Wx::PluggableTextCtrl::$name";
0279    $plug = $name->new($self@_);
0280    if (defined($plug)) {
0281       $self->RegisterPlugin($plug);
0282    } else {
0283       carp "unable to load plugin $name\n";
0284    }
0285 }
0286 
0287 sub Name {
0288    my $self = shift;
0289    my $name = ref $self;
0290    $name =~s/.*:://;
0291    if ($debug) { print "plugin name is $name\n" }
0292    return $name
0293 }
0294 
0295 sub OnChar {
0296    my ($self$event) = @_;
0297    my $k = $event->GetKeyCode;
0298    if ($k eq 322) { #Insert key pressed, record flip insert/ovr mode.
0299       if ($self->OvrMode) {
0300          $self->OvrMode(0)
0301       } else {
0302          $self->OvrMode(1)
0303       }
0304    }
0305    unless ($self->Broadcast('key'$event)) {
0306       $event->Skip;
0307    }
0308    my $callback = $self->Callback;
0309    &$callback;
0310 }
0311 
0312 sub OvrMode {
0313    my $self = shift;
0314    if (@_) { $self->{OVRMODE} = shift; }
0315    return $self->{OVRMODE};
0316 }
0317 
0318 sub Paste {
0319    my $self = shift;
0320    unless ($self->Broadcast('paste')) {
0321       $self->SUPER::Paste;
0322    }
0323 }
0324 
0325 sub Plugin {
0326    my $self = shift;
0327    my $id = shift;
0328    my $plgs = $self->{PLUGINS};
0329    unless ($id =~ /^\d+$/) {
0330       $id = $self->FindPluginId($id);
0331    }
0332    if (@_) { 
0333       $self->{PLUGINS}->[$id] = shift
0334    }
0335    return $self->{PLUGINS}->[$id];
0336 }
0337 
0338 sub Receive {
0339    my $self = shift;
0340    my $name = shift;
0341 #    if ($debug) { print "received $name\n"; print Dumper $self->{COMMANDS} }
0342    if (exists $self->{COMMANDS}->{$name}) {
0343       if ($debug) { print "executing $name\n" }
0344       my $cmd = $self->Command($name);
0345       return &$cmd($self@_);
0346    }
0347    return 0
0348 }
0349 
0350 sub Redo {
0351    my $self = shift;
0352    unless ($self->Broadcast('redo')) {
0353       $self->SUPER::Redo;
0354    }
0355 }
0356 
0357 sub RegisterPlugin {
0358    my ($self$plug) = @_;
0359    my $pl = $self->{PLUGINS};
0360    push @$pl$plug;
0361 }
0362 
0363 sub Remove {
0364    my $self = shift;
0365    my @call = $self->Remove2Call(@_);
0366    unless ($self->Broadcast(@call)) {
0367       $self->SUPER::Remove(@_);
0368    }
0369 }
0370 
0371 sub Remove2Call {
0372    my ($self$begin$end) = @_;
0373    my $sel = 0;
0374    my ($selb$sele) = $self->GetSelection;
0375    if (($selb eq $beginand ($sele eq $end)) { $sel = 1 }
0376    return ('remove'$begin$self->GetRange($begin$end), $sel)
0377 }
0378 
0379 sub Replace {
0380    my $self = shift;
0381    my @call = $self->Replace2Call(@_);
0382    unless ($self->Broadcast(@call)) {
0383       $self->SUPER::Replace(@_);
0384    }
0385 }
0386 
0387 sub Replace2Call {
0388    my ($self$begin$end$txt) = @_;
0389    my $sel = 0;
0390    my ($selb$sele) = $self->GetSelection;
0391    if (($selb eq $beginand ($sele eq $end)) { $sel = 1 }
0392    return ('replace'$begin$txt$self->GetRange($begin$end), $sel)
0393 }
0394 
0395 sub SaveFile {
0396    my $self = shift;
0397    unless ($self->Broadcast('save'@_)) {
0398       $self->SUPER::SaveFile(@_);
0399    }
0400 }
0401 
0402 sub NativePlugins {
0403    my $self = shift;
0404    return qw[ Highlighter KeyEchoes UndoRedo   ]
0405 }
0406 
0407 sub Syntax {
0408    my $self = shift;
0409    return $self->Broadcast('syntax'@_);
0410 }
0411 
0412 sub Undo {
0413    my $self = shift;
0414    unless ($self->Broadcast('undo')) {
0415       $self->SUPER::Undo;
0416    }
0417 }
0418 
0419 sub WriteText {
0420    my $self = shift;
0421    my @call = $self->WriteText2Call(@_);
0422    unless ($self->Broadcast(@call)) {
0423       $self->SUPER::WriteText(@_);
0424    }
0425 }
0426 
0427 sub WriteText2Call {
0428    my ($self$txt) = @_;
0429    return ('write'$self->GetInsertionPoint$txt0);
0430 }
0431 
0432 
0433 1;
0434 __END__