From 3c7edcc3de4d409d45f014576c95de748a88d4de Mon Sep 17 00:00:00 2001 From: lecoanet Date: Thu, 11 Apr 2002 09:03:51 +0000 Subject: Support de l'�dition des textes dans les fields Am�lioration de la prise en compte de la s�lection et correction de bugs --- Perl/ZincText.pm | 110 +++++++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 82 insertions(+), 28 deletions(-) (limited to 'Perl') 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', '' => sub {extendSel($zinc)}); $zinc->bind('text', '' => sub {extendSel($zinc)}); $zinc->bind('text', '' => sub { @@ -17,60 +18,99 @@ sub new { $zinc->select('adjust', 'current', "\@$x,$y"); }); $zinc->bind('text', '' => sub {moveCur($zinc, -1);}); $zinc->bind('text', '' => sub {moveCur($zinc, 1);}); - $zinc->bind('text', '' => sub {setCur($zinc, 0);}); - $zinc->bind('text', '' => sub {setCur($zinc, 0);}); - $zinc->bind('text', '' => sub {setCur($zinc, 'end');}); - $zinc->bind('text', '' => sub {setCur($zinc, 'end');}); - $zinc->bind('text', '' => sub {insertChar($zinc);}); - $zinc->bind('text', '' => sub {insertChar($zinc);}); - $zinc->bind('text', '' => sub { - $zinc->insert($zinc->focus(), 'insert', "\n"); }); + $zinc->bind('text', '' => sub {setCur($zinc, 'up');}); + $zinc->bind('text', '' => sub {setCur($zinc, 'down');}); + $zinc->bind('text', '' => sub {setCur($zinc, 'bol');}); + $zinc->bind('text', '' => sub {setCur($zinc, 'bol');}); + $zinc->bind('text', '' => sub {setCur($zinc, 'eol');}); + $zinc->bind('text', '' => sub {setCur($zinc, 'eol');}); + $zinc->bind('text', '' => sub {setCur($zinc, 0);}); + $zinc->bind('text', '' => sub {setCur($zinc, 'end');}); + $zinc->bind('text', '' => sub {insertKey($zinc);}); + $zinc->bind('text', '' => sub {insertKey($zinc);}); + $zinc->bind('text', '' => sub { insertChar($zinc, chr(10)); }); $zinc->bind('text', '' => sub {textDel($zinc, -1)}); + $zinc->bind('text', '' => sub {textDel($zinc, -1)}); $zinc->bind('text', '' => sub {textDel($zinc, 0)}); - $zinc->bind('text', '' => sub { - $zinc->dchars($zinc->focus(), 'sel.first', 'sel.last'); }); - $zinc->bind('text', '' => 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; -- cgit v1.1