Line Numbers/Theme DarkGray

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 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 >= 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__