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->SetFont( Wx::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 >= 32) and ($key < 127)) or (($key > 127) and ($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 $begin) and ($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 $begin) and ($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, $txt, 0);
0430 }
0431
0432
0433 1;
0434 __END__