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->SetFontWx::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 undef
75
   }
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 undef
85
   }
86
}
87

88
sub Call2WriteText {
89
   my ($self$call$index$txt) = @_;
90
   if ($call =~ /.*write$/) {
91
      return $txt
92
   } else {
93
      carp "Call '$call' is not a write type";
94
      return undef
95
   }
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 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 >= 32and ($key < 127)) or (($key > 127and ($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 $beginand ($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 $beginand ($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$txt0);
430
}
431

432

433
1;
434
__END__