aboutsummaryrefslogtreecommitdiff
path: root/Perl
diff options
context:
space:
mode:
authorlecoanet2002-04-11 09:03:51 +0000
committerlecoanet2002-04-11 09:03:51 +0000
commit3c7edcc3de4d409d45f014576c95de748a88d4de (patch)
tree20b04f5b0ea429548f3bcd6bb35f8f66f407a621 /Perl
parentaf0d7c4e5d2e4b939125fdf196867d800700adeb (diff)
downloadtkzinc-3c7edcc3de4d409d45f014576c95de748a88d4de.zip
tkzinc-3c7edcc3de4d409d45f014576c95de748a88d4de.tar.gz
tkzinc-3c7edcc3de4d409d45f014576c95de748a88d4de.tar.bz2
tkzinc-3c7edcc3de4d409d45f014576c95de748a88d4de.tar.xz
Support de l'�dition des textes dans les fields
Am�lioration de la prise en compte de la s�lection et correction de bugs
Diffstat (limited to 'Perl')
-rw-r--r--Perl/ZincText.pm110
1 files changed, 82 insertions, 28 deletions
diff --git a/Perl/ZincText.pm b/Perl/ZincText.pm
index 2785b39..0cf04b5 100644
--- a/Perl/ZincText.pm
+++ b/Perl/ZincText.pm
@@ -9,6 +9,7 @@ sub new {
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 {
@@ -17,60 +18,99 @@ sub new {
$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', '<Control-a>' => sub {setCur($zinc, 0);});
- $zinc->bind('text', '<Home>' => sub {setCur($zinc, 0);});
- $zinc->bind('text', '<Control-e>' => sub {setCur($zinc, 'end');});
- $zinc->bind('text', '<End>' => sub {setCur($zinc, 'end');});
- $zinc->bind('text', '<KeyPress>' => sub {insertChar($zinc);});
- $zinc->bind('text', '<Shift-KeyPress>' => sub {insertChar($zinc);});
- $zinc->bind('text', '<Return>' => sub {
- $zinc->insert($zinc->focus(), 'insert', "\n"); });
+ $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)});
- $zinc->bind('text', '<Control-d>' => sub {
- $zinc->dchars($zinc->focus(), 'sel.first', 'sel.last'); });
- $zinc->bind('text', '<Control-y>' => sub {
- $zinc->insert($zinc->focus(), 'insert', Tk::selection('get')); });
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();
- $w->insert($w->focus(), 'insert', $c);
+ if ((ord($c) < 32) || (ord($c) == 128)) {
+ return;
+ }
+
+ insertChar($w, $c);
}
sub setCur {
my ($w, $where) = @_;
- my $it = $w->focus();
+ my @it = $w->focus();
- $w->cursor($it, $where);
+ if (@it != 0) {
+ $w->cursor(@it, $where);
+ }
}
sub moveCur {
my ($w, $dir) = @_;
- my $it = $w->focus();
- my $index = $w->index($it, 'insert');
+ my @it = $w->focus();
+ my $index;
- $w->cursor($it, $index + $dir);
+ 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($x, $y) = ($e->x(), $e->y());
+ my $part = $w->currentpart(1);
- $w->cursor('current', "\@$x,$y");
- $w->focus('current');
- $w->Tk::focus;
- $w->select('from', 'current', "\@$x,$y");
+ $w->cursor('current', $part, "\@$x,$y");
+ $w->focus('current', $part);
+ $w->Tk::focus();
+ $w->select('from', 'current', $part, "\@$x,$y");
}
@@ -78,16 +118,30 @@ sub extendSel {
my($w) = @_;
my $e = $w->XEvent;
my($x, $y) = ($e->x, $e->y);
- $w->select('to', 'current', "\@$x,$y");
+ my $part = $w->currentpart(1);
+
+ $w->select('to', 'current', $part, "\@$x,$y");
}
sub textDel {
my($w, $dir) = @_;
- my $it = $w->focus();
- my $ind = $w->index($it, 'insert') + $dir;
-
- $w->dchars($it, $ind) if ($ind >= 0);
+ 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;