1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
|
package ZincText;
sub new {
my $proto = shift;
my $type = ref($proto) || $proto;
my ($zinc) = @_;
my $self = {};
$zinc->bind('text', '<1>' => sub {startSel($zinc)});
$zinc->bind('text', '<2>' => sub {pasteSel($zinc)});
$zinc->bind('text', '<B1-Motion>' => sub {extendSel($zinc)});
$zinc->bind('text', '<Shift-B1-Motion>' => sub {extendSel($zinc)});
$zinc->bind('text', '<Shift-1>' => sub {
my $e = $zinc->XEvent();
my($x, $y) = ($e->x, $e->y);
$zinc->select('adjust', 'current', "\@$x,$y"); });
$zinc->bind('text', '<Left>' => sub {moveCur($zinc, -1);});
$zinc->bind('text', '<Right>' => sub {moveCur($zinc, 1);});
$zinc->bind('text', '<Up>' => sub {setCur($zinc, 'up');});
$zinc->bind('text', '<Down>' => sub {setCur($zinc, 'down');});
$zinc->bind('text', '<Control-a>' => sub {setCur($zinc, 'bol');});
$zinc->bind('text', '<Home>' => sub {setCur($zinc, 'bol');});
$zinc->bind('text', '<Control-e>' => sub {setCur($zinc, 'eol');});
$zinc->bind('text', '<End>' => sub {setCur($zinc, 'eol');});
$zinc->bind('text', '<Meta-less>' => sub {setCur($zinc, 0);});
$zinc->bind('text', '<Meta-greater>' => sub {setCur($zinc, 'end');});
$zinc->bind('text', '<KeyPress>' => sub {insertKey($zinc);});
$zinc->bind('text', '<Shift-KeyPress>' => sub {insertKey($zinc);});
$zinc->bind('text', '<Return>' => sub { insertChar($zinc, chr(10)); });
$zinc->bind('text', '<BackSpace>' => sub {textDel($zinc, -1)});
$zinc->bind('text', '<Control-h>' => sub {textDel($zinc, -1)});
$zinc->bind('text', '<Delete>' => sub {textDel($zinc, 0)});
bless ($self, $type);
return $self;
}
sub pasteSel {
my ($w) = @_;
my $e = $w->XEvent;
my($x, $y) = ($e->x(), $e->y());
my @it = $w->focus();
if (@it != 0) {
eval { $w->insert(@it, "\@$x,$y", $w->SelectionGet()); };
}
}
sub insertChar {
my ($w, $c) = @_;
my @it = $w->focus();
my @selit = $w->select('item');
if (@it == 0) {
return;
}
if ((scalar(@selit) == scalar(@it)) &&
($selit[0] == $it[0]) && ($selit[1] == $it[1])) {
$w->dchars(@it, 'sel.first', 'sel.last');
}
$w->insert(@it, 'insert', $c);
}
sub insertKey {
my ($w) = @_;
my $c = $w->XEvent->A();
if ((ord($c) < 32) || (ord($c) == 128)) {
return;
}
insertChar($w, $c);
}
sub setCur {
my ($w, $where) = @_;
my @it = $w->focus();
if (@it != 0) {
$w->cursor(@it, $where);
}
}
sub moveCur {
my ($w, $dir) = @_;
my @it = $w->focus();
my $index;
if (@it != 0) {
$index = $w->index(@it, 'insert');
$w->cursor(@it, $index + $dir);
}
}
sub startSel {
my($w) = @_;
my $e = $w->XEvent;
my($x, $y) = ($e->x(), $e->y());
my $part = $w->currentpart(1);
$w->cursor('current', $part, "\@$x,$y");
$w->focus('current', $part);
$w->Tk::focus();
$w->select('from', 'current', $part, "\@$x,$y");
}
sub extendSel {
my($w) = @_;
my $e = $w->XEvent;
my($x, $y) = ($e->x, $e->y);
my $part = $w->currentpart(1);
$w->select('to', 'current', $part, "\@$x,$y");
}
sub textDel {
my($w, $dir) = @_;
my @it = $w->focus();
my @selit = $w->select('item');
my $ind;
if (@it == 0) {
return;
}
if ((scalar(@selit) == scalar(@it)) &&
($selit[0] == $it[0]) && ($selit[1] == $it[1])) {
$w->dchars(@it, 'sel.first', 'sel.last');
}
else {
$ind = $w->index(@it, 'insert') + $dir;
$w->dchars(@it, $ind, $ind) if ($ind >= 0);
}
}
1;
|