001 package Syntax::Kamelon::Wx::PluggableTextCtrl;
002 
003 use strict;
004 use warnings;
005 use Carp;
006 
007 use vars qw($VERSION);
008 $VERSION="0.01";
009 
010 use Wx qw( :textctrl :font :colour );
011 use Wx::DND;
012 use Wx qw( wxTheClipboard );
013 use base qw( Wx::TextCtrl );
014 use Wx::Event qw( EVT_CHAR );
015 
016 require Syntax::Kamelon::Wx::PluggableTextCtrl::KeyEchoes;
017 require Syntax::Kamelon::Wx::PluggableTextCtrl::UndoRedo;
018 require Syntax::Kamelon::Wx::PluggableTextCtrl::Highlighter;
019 
020 my $defaultfont = [10, wxFONTFAMILY_MODERN, wxFONTSTYLE_NORMAL, wxFONTWEIGHT_NORMAL, 0];
021 
022 my $debug = 0;
023 
024 if ($debug) {
025    use Data::Dumper;
026 }
027 
028 sub new {
029    my $class = shift;
030    my $self = $class->SUPER::new(@_);
031 
032    $self->{CALLBACK} = sub {};
033    $self->{COMMANDS} = {
034       'doremove' => \&DoRemove,
035       'doreplace' => \&DoReplace,
036       'dowrite' => \&DoWrite,
037    };
038    $self->{LISTENING} = 0;
039    
040    $self->{OVRMODE} = 0;
041    $self->{PLUGINS} = [];
042 
043    $self->SetFont( Wx::Font->new(@$defaultfont) );
044    EVT_CHAR($self, \&OnChar);
045 
046    return $self;
047 }
048 
049 sub AppendText {
050    my $self = shift;
051    unless ($self->Broadcast('append', @_)) {
052       $self->SUPER::Append(@_);
053    }
054 }
055 
056 sub Broadcast {
057    my $self = shift;
058    my $plugs = $self->{PLUGINS};
059    my $flag = 0;
060    foreach (@$plugs) {
061       if ($_->Receive(@_)) {
062          $flag = 1;
063       }
064    }
065    return $flag;
066 }
067 
068 sub Call2Remove {
069    my ($self, $call, $index, $txt) = @_;
070    if ($call =~ /.*remove$/) {
071       return ($index, $index + length($txt))
072    } else {
073       carp "Call '$call' is not a remove type";
074       return undef
075    }
076 }
077 
078 sub Call2Replace {
079    my ($self, $call, $index, $old, $txt, $sel) = @_;
080    if ($call =~ /.*replace$/) {
081       return ($index, $index + length($old), $txt)
082    } else {
083       carp "Call '$call' is not a replace type";
084       return undef
085    }
086 }
087 
088 sub Call2WriteText {
089    my ($self, $call, $index, $txt) = @_;
090    if ($call =~ /.*write$/) {
091       return $txt
092    } else {
093       carp "Call '$call' is not a write type";
094       return undef
095    }
096 }
097 
098 sub Callback {
099    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 1
157 }
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 1
170 }
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 1
184 }
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 $index
193       }
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 compatible
241 sub IsWriteable {
242    my ($self, $key) = @_;
243    if ((($key >= 32) and ($key < 127)) or (($key > 127) and ($key < 256))) {
244       return 1
245    }
246    return 0
247 }
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, $self
257          } else {
258             shift @$plgs
259          }
260          $self->{LISTENING} = $new
261       }
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 $name
293 }
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 0
348 }
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__