Content
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
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
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
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) {
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
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__