Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Bug in Tk::Text

0 views
Skip to first unread message

thundergnat

unread,
Mar 4, 2005, 2:34:13 PM3/4/05
to ni...@ing-simmons.net
If you resize a Text widget (or a derivation) so that the bottom of
the window is NOT exactly at the bottom of a line of text, and then
try to move the cursor down past the bottom of the text displayed in
the window using the arrow key, the cursor advances two lines instead
of one. It doesn't seem to matter whether the text widget is scrolled
or not and is independent of the font & font size.

Here's a demo script with both a scrolled and unscrolled text widget:

Open the script and resize either window until the bottom is not
exactly between two lines; place the cursor near the bottom and arrow
down. When it reaches the bottom of the window, the cursor will start
skipping every other line.


#!/usr/bin/perl

use strict;
use warnings;
use Tk;

my $w1 = MainWindow->new;
my $t1 = $w1->Text->pack(
-expand =>1,
-fill => 'both'
);
$t1->insert('end',"$_\n") for (1..100);


my $w2 = MainWindow->new;
my $t2 = $w2->Scrolled('Text',
-scrollbars => 'se'
)->pack(
-expand =>1,
-fill => 'both'
);
$t2->insert('end',"$_\n") for (1..100);

MainLoop;

After poking around a bit through the guts of Text.pm, I found the
problem in sub UpDownLine.

Line 1202 reads:

($ly + $lh) > ( $w->height - 2*$w->cget(-bd) - 2*$w->cget(-highlightthickness) ) )

<Check if last line y position plus line height is greater than visible
window height (window height - decorations and borders)>

But it really should be checking if it is greater than the visible
height minus any fraction of a line.


Modifying the line to read:

($ly + $lh) > ( $w->height - 2*$w->cget(-bd) - 2*$w->cget(-highlightthickness) - $lh + 1) )

fixes the problem without any repercussions that I can see.

I can fix this locally by putting a modified UpDownLine subroutine
in any derived widget I build, but it seems like it would be better
to fix the problem at the source.

Thanks

thundergnat

unread,
Mar 4, 2005, 4:35:41 PM3/4/05
to
Talking to myself, not a good sign.

Heres another demo script that illustrates the problem
better. It pops up two text windows, one using the
original subroutine an on that derives a fixed sub.

Put the cursor near the bottom of each and arrow down.
In the original, the cursor starts skipping lines,
in the modified version, it moves one line at a time.

Pardon the formatting of the UpDownLine sub, that's
exactly the way it appears in Text.pm.

#!/usr/bin/perl

{#######################################################################
package FixedText;

use base qw(Tk::Text);

Construct Tk::Widget 'FixedText';

sub UpDownLine
{
my ($w,$n) = @_;
$w->see('insert');
my $i = $w->index('insert');

my ($line,$char) = split(/\./,$i);

my $testX; #used to check the "new" position
my $testY; #used to check the "new" position

(my $bx, my $by, my $bw, my $bh) = $w->bbox($i);
(my $lx, my $ly, my $lw, my $lh) = $w->dlineinfo($i);

if ( ($n == -1) and ($by <= $bh) )
{
#On first display line.. so scroll up and recalculate..
$w->yview('scroll', -1, 'units');
unless (($w->yview)[0]) {
#first line of entire text - keep same position.
return $i;
}
($bx, $by, $bw, $bh) = $w->bbox($i);
($lx, $ly, $lw, $lh) = $w->dlineinfo($i);
}
elsif ( ($n == 1) and


($ly + $lh) > ( $w->height - 2*$w->cget(-bd) - 2*$w->cget(-highlightthickness) - $lh + 1) )

{
#On last display line.. so scroll down and recalculate..
$w->yview('scroll', 1, 'units');
($bx, $by, $bw, $bh) = $w->bbox($i);
($lx, $ly, $lw, $lh) = $w->dlineinfo($i);
}

# Calculate the vertical position of the next display line
my $Yoffset = 0;
$Yoffset = $by - $ly + 1 if ($n== -1);
$Yoffset = $ly + $lh + 1 - $by if ($n == 1);
$Yoffset*=$n;
$testY = $by + $Yoffset;

# Save the original 'x' position of the insert cursor if:
# 1. This is the first time through -- or --
# 2. The insert cursor position has changed from the previous
# time the up or down key was pressed -- or --
# 3. The cursor has reached the beginning or end of the widget.

if (not defined $w->{'origx'} or ($w->{'lastindex'} != $i) )
{
$w->{'origx'} = $bx;
}

# Try to keep the same column if possible
$testX = $w->{'origx'};

# Get the coordinates of the possible new position
my $testindex = $w->index('@'.$testX.','.$testY );
$w->see($testindex);
my ($nx,$ny,$nw,$nh) = $w->bbox($testindex);

# Which side of the character should we position the cursor -
# mainly for a proportional font
if ($testX > $nx+$nw/2)
{
$testX = $nx+$nw+1;
}

my $newindex = $w->index('@'.$testX.','.$testY );

if ( $w->compare($newindex,'==','end - 1 char') and ($ny == $ly ) )
{
# Then we are trying to the 'end' of the text from
# the same display line - don't do that
return $i;
}

$w->{'lastindex'} = $newindex;
$w->see($newindex);
return $newindex;
}

1;
}###############################################################################


use strict;
use warnings;
use Tk;

my $w1 = MainWindow->new;
my $t1 = $w1->Text->pack(
-expand =>1,
-fill => 'both'
);

$w1->title('Original UpDownLine');


$t1->insert('end',"$_\n") for (1..100);

my $w2 = MainWindow->new;

my $t2 = $w2->FixedText->pack(


-expand =>1,
-fill => 'both'
);

$w2->title('Modified UpDownLine');


$t2->insert('end',"$_\n") for (1..100);

$w1->update;

my $geometry = $w1->geometry;
my ($width,$height,$x,$y) = split/[x+]/,$geometry;

$height += 8;
$width /= 2;
$geometry = $width.'x'.$height."+$x+$y";
$w1->geometry($geometry);
$x += $width+10;
$geometry = $width.'x'.$height."+$x+$y";
$w2->geometry($geometry);

MainLoop;

Jack D

unread,
Mar 5, 2005, 11:43:48 PM3/5/05
to

"thundergnat" <thund...@hotmail.com> wrote in message
news:4228B835...@hotmail.com...

It took me quite a while to get the UpDownLine sub to work properly. Where
were you last year when I dared people to break it.<lol>

http://groups.google.ca/groups?selm=bvfjnr%249q6%241%40fidoii.CC.Lehigh.EDU

>
> I can fix this locally by putting a modified UpDownLine subroutine
> in any derived widget I build, but it seems like it would be better
> to fix the problem at the source.

I can generate a patch on Monday and mail it to the ptk list. (Or feel free
to do so yourself)

Jack
PS..Kudos to me for at least documenting/explaining what I was trying to do
:-). I guess the logic was somewhat flawed.


0 new messages