1
package Syntax::Kamelon::Wx::PluggableTextCtrl;2
3
use strict;4
use warnings;5
use Carp;6
7
use vars qw($VERSION);8
$VERSION="0.01";9
10
use Wx qw( :textctrl :font :colour );11
use Wx::DND;12
use Wx qw( wxTheClipboard );13
use base qw( Wx::TextCtrl );14
use Wx::Event qw( EVT_CHAR );15
16
require Syntax::Kamelon::Wx::PluggableTextCtrl::KeyEchoes;17
require Syntax::Kamelon::Wx::PluggableTextCtrl::UndoRedo;18
require Syntax::Kamelon::Wx::PluggableTextCtrl::Highlighter;19
20
my $defaultfont = [10, wxFONTFAMILY_MODERN, wxFONTSTYLE_NORMAL, wxFONTWEIGHT_NORMAL, 0];21
22
my $debug = 0;23
24
if ($debug) {25
   use Data::Dumper;26
}27
28
sub new {29
   my $class = shift;30
   my $self = $class->SUPER::new(@_);31
32
   $self->{CALLBACK} = sub {};33
   $self->{COMMANDS} = {34
      'doremove' => \&DoRemove,35
      'doreplace' => \&DoReplace,36
      'dowrite' => \&DoWrite,37
   };38
   $self->{LISTENING} = 0;39
   40
   $self->{OVRMODE} = 0;41
   $self->{PLUGINS} = [];42
43
   $self->SetFont( Wx::Font->new(@$defaultfont) );44
   EVT_CHAR($self, \&OnChar);45
46
   return $self;47
}48
49
sub AppendText {50
   my $self = shift;51
   unless ($self->Broadcast('append', @_)) {52
      $self->SUPER::Append(@_);53
   }54
}55
56
sub Broadcast {57
   my $self = shift;58
   my $plugs = $self->{PLUGINS};59
   my $flag = 0;60
   foreach (@$plugs) {61
      if ($_->Receive(@_)) {62
         $flag = 1;63
      }64
   }65
   return $flag;66
}67
68
sub Call2Remove {69
   my ($self, $call, $index, $txt) = @_;70
   if ($call =~ /.*remove$/) {71
      return ($index, $index + length($txt))72
   } else {73
      carp "Call '$call' is not a remove type";74
      return undef75
   }76
}77
78
sub Call2Replace {79
   my ($self, $call, $index, $old, $txt, $sel) = @_;80
   if ($call =~ /.*replace$/) {81
      return ($index, $index + length($old), $txt)82
   } else {83
      carp "Call '$call' is not a replace type";84
      return undef85
   }86
}87
88
sub Call2WriteText {89
   my ($self, $call, $index, $txt) = @_;90
   if ($call =~ /.*write$/) {91
      return $txt92
   } else {93
      carp "Call '$call' is not a write type";94
      return undef95
   }96
}97
98
sub Callback {99
   my $self = shift;100
   if (@_) { $self->{CALLBACK} = shift; }101
   return $self->{CALLBACK};102
}103
104
sub CanUndo {105
   my $self = shift;106
   return $self->Broadcast('canundo');107
}108
109
sub CanRedo {110
   my $self = shift;111
   return $self->Broadcast('canredo');112
}113
114
sub Clear {115
   my $self = shift;116
   unless ($self->Broadcast('clear')) {117
      $self->SUPER::Clear;118
   }119
}120
121
sub ClearSelection {122
   my $self = shift;123
   my $ins = $self->GetInsertionPoint;124
   $self->SetSelection($ins, $ins);125
}126
127
sub Command {128
   my $self = shift;129
   my $name = shift;130
   if (@_) { $self->{COMMANDS}->{$name} = shift }131
   return $self->{COMMANDS}->{$name}132
}133
134
sub Copy {135
   my $self = shift;136
   unless ($self->Broadcast('copy')) {137
      $self->SUPER::Copy;138
   }139
}140
141
sub Cut {142
   my $self = shift;143
   unless ($self->Broadcast('cut')) {144
      $self->SUPER::Cut;145
   }146
}147
148
sub DoRemove {149
   my $self = shift;150
   my ($index, $txt, $sel, $ins) = @_;151
   $self->ClearSelection;152
   $self->SUPER::Remove($index, $index + length($txt));153
   if (defined($ins)) {154
      $self->SetInsertionPoint($ins);155
   }156
   return 1157
}158
159
sub DoReplace {160
   my ($self, $index, $old, $txt, $sel, $ins) = @_;161
   $self->ClearSelection;162
   $self->SUPER::Replace($index, $index + length($old), $txt);163
   if ($sel) {164
      $self->SetSelection($index, $index + length($txt));165
   }166
   if (defined($ins)) {167
      $self->SetInsertionPoint($ins);168
   }169
   return 1170
}171
172
sub DoWrite {173
   my ($self, $index, $txt, $sel, $ins) = @_;174
   $self->ClearSelection;175
   $self->SetInsertionPoint($index);176
   $self->SUPER::WriteText($txt);177
   if ($sel) {178
      $self->SetSelection($index, $index + length($txt));179
   }180
   if (defined($ins)) {181
      $self->SetInsertionPoint($ins);182
   }183
   return 1184
}185
186
sub FindPluginId {187
   my ($self, $name) = @_;188
   my $plgs = $self->{PLUGINS};189
   my $index = 0;190
   foreach (@$plgs) {191
      if ($name eq $plgs->[$index]->Name) {192
         return $index193
      }194
      $index ++;195
   }196
#   carp "Plugin $name is not loaded\n";197
   return undef;198
}199
200
sub FindPlugin {201
   my ($self, $name) = @_;202
   my $plgs = $self->{PLUGINS};203
   foreach (@$plgs) {204
      if ($name eq $_->Name) {205
         return $_206
      }207
   }208
   return undef;209
}210
211
sub GetClipboardText {212
   my $self = shift;213
   my $txt = undef;214
   if (wxTheClipboard->Open) {215
      if ($debug) { print "Clipboard open\n" }216
      my $textdata = Wx::TextDataObject->new;217
      my $ok = wxTheClipboard->GetData( $textdata );218
      if( $ok ) {219
         $txt = $textdata->GetText;220
      }221
      if ($debug and defined($txt)) { print "Clipboard text: $txt\n" }222
      wxTheClipboard->Close;223
   }224
   return $txt;225
}226
227
sub GetLineNumber {228
   my ($self, $index) = @_;229
   unless (defined($index)) { $index = $self->GetInsertionPoint };230
   my ($col, $line) = $self->PositionToXY($index);231
   return $line;232
}233
234
sub HasSelection {235
   my $self = shift;236
   my ($selb, $sele) = $self->GetSelection;237
   return ($selb ne $sele)238
}239
240
# TODO make this unicode compatible241
sub IsWriteable {242
   my ($self, $key) = @_;243
   if ((($key >= 32) and ($key < 127)) or (($key > 127) and ($key < 256))) {244
      return 1245
   }246
   return 0247
}248
249
sub Listening {250
   my $self = shift;251
   if (@_) {252
      my $new = shift;253
      unless ($new eq $self->{LISTENING}) {254
         my $plgs = $self->{PLUGINS};255
         if ($new) {256
            unshift @$plgs, $self257
         } else {258
            shift @$plgs259
         }260
         $self->{LISTENING} = $new261
      }262
   }263
   return $self->{LISTENING}264
}265
266
sub LoadFile {267
   my $self = shift;268
   unless ($self->Broadcast('load', @_)) {269
      $self->SUPER::LoadFile(@_);270
   }271
}272
273
sub LoadPlugin {274
   my $self = shift;275
   my $plug = undef;276
   my $name = shift;277
   #Does anybody have a better idea for this?278
   $name = "Syntax::Kamelon::Wx::PluggableTextCtrl::$name";279
   $plug = $name->new($self, @_);280
   if (defined($plug)) {281
      $self->RegisterPlugin($plug);282
   } else {283
      carp "unable to load plugin $name\n";284
   }285
}286
287
sub Name {288
   my $self = shift;289
   my $name = ref $self;290
   $name =~s/.*:://;291
   if ($debug) { print "plugin name is $name\n" }292
   return $name293
}294
295
sub OnChar {296
   my ($self, $event) = @_;297
   my $k = $event->GetKeyCode;298
   if ($k eq 322) { #Insert key pressed, record flip insert/ovr mode.299
      if ($self->OvrMode) {300
         $self->OvrMode(0)301
      } else {302
         $self->OvrMode(1)303
      }304
   }305
   unless ($self->Broadcast('key', $event)) {306
      $event->Skip;307
   }308
   my $callback = $self->Callback;309
   &$callback;310
}311
312
sub OvrMode {313
   my $self = shift;314
   if (@_) { $self->{OVRMODE} = shift; }315
   return $self->{OVRMODE};316
}317
318
sub Paste {319
   my $self = shift;320
   unless ($self->Broadcast('paste')) {321
      $self->SUPER::Paste;322
   }323
}324
325
sub Plugin {326
   my $self = shift;327
   my $id = shift;328
   my $plgs = $self->{PLUGINS};329
   unless ($id =~ /^\d+$/) {330
      $id = $self->FindPluginId($id);331
   }332
   if (@_) { 333
      $self->{PLUGINS}->[$id] = shift; 334
   }335
   return $self->{PLUGINS}->[$id];336
}337
338
sub Receive {339
   my $self = shift;340
   my $name = shift;341
#    if ($debug) { print "received $name\n"; print Dumper $self->{COMMANDS} }342
   if (exists $self->{COMMANDS}->{$name}) {343
      if ($debug) { print "executing $name\n" }344
      my $cmd = $self->Command($name);345
      return &$cmd($self, @_);346
   }347
   return 0348
}349
350
sub Redo {351
   my $self = shift;352
   unless ($self->Broadcast('redo')) {353
      $self->SUPER::Redo;354
   }355
}356
357
sub RegisterPlugin {358
   my ($self, $plug) = @_;359
   my $pl = $self->{PLUGINS};360
   push @$pl, $plug;361
}362
363
sub Remove {364
   my $self = shift;365
   my @call = $self->Remove2Call(@_);366
   unless ($self->Broadcast(@call)) {367
      $self->SUPER::Remove(@_);368
   }369
}370
371
sub Remove2Call {372
   my ($self, $begin, $end) = @_;373
   my $sel = 0;374
   my ($selb, $sele) = $self->GetSelection;375
   if (($selb eq $begin) and ($sele eq $end)) { $sel = 1 }376
   return ('remove', $begin, $self->GetRange($begin, $end), $sel)377
}378
379
sub Replace {380
   my $self = shift;381
   my @call = $self->Replace2Call(@_);382
   unless ($self->Broadcast(@call)) {383
      $self->SUPER::Replace(@_);384
   }385
}386
387
sub Replace2Call {388
   my ($self, $begin, $end, $txt) = @_;389
   my $sel = 0;390
   my ($selb, $sele) = $self->GetSelection;391
   if (($selb eq $begin) and ($sele eq $end)) { $sel = 1 }392
   return ('replace', $begin, $txt, $self->GetRange($begin, $end), $sel)393
}394
395
sub SaveFile {396
   my $self = shift;397
   unless ($self->Broadcast('save', @_)) {398
      $self->SUPER::SaveFile(@_);399
   }400
}401
402
sub NativePlugins {403
   my $self = shift;404
   return qw[ Highlighter KeyEchoes UndoRedo   ]405
}406
407
sub Syntax {408
   my $self = shift;409
   return $self->Broadcast('syntax', @_);410
}411
412
sub Undo {413
   my $self = shift;414
   unless ($self->Broadcast('undo')) {415
      $self->SUPER::Undo;416
   }417
}418
419
sub WriteText {420
   my $self = shift;421
   my @call = $self->WriteText2Call(@_);422
   unless ($self->Broadcast(@call)) {423
      $self->SUPER::WriteText(@_);424
   }425
}426
427
sub WriteText2Call {428
   my ($self, $txt) = @_;429
   return ('write', $self->GetInsertionPoint, $txt, 0);430
}431
432
433
1;434
__END__