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__