#!/usr/bin/perl -w
#
#  Perl/Tk optional vertical scrollbar bug
#
#  102410 -- liverpole
##

###############
## Libraries ##
###############
use strict;
use warnings;
use Tk;
use Tk::ROText;


##################
## Main program ##
##################
my $b_fix  = 0;
my $title  = "Fix for Perl/Tk Optional Scrollbar Bug";
my $mw     = new MainWindow(-title => $title);
my $top    = $mw->Frame->pack;
my $f1     = $top->Frame->pack;
my $f2     = $top->Frame->pack;
my $bot    = $f2->Frame->pack;
my @args   = qw( -bg white -wrap none -width 64 -scrollbars osoe );
my $rot    = $bot->Scrolled('ROText', @args)->pack;
my $c_out  = sub { $rot->insert("end", $_[0] . "\n"); $rot->see("end") };
my $c_quit = sub { exit };
my $c_fix  = sub { nudge_widget($rot) };

if ($b_fix) {
    my @b1args = (-text => 'Fix (^F)',  -bg => 'cyan', -comm => $c_fix);
    my $b1 = $f1->Button(@b1args);
    $b1->pack(-side => 'left');
    $mw->bind("<Control-f>" => sub { $b1->invoke });
}

my $b2  = $f1->Button(-text => 'Quit (^Q)', -bg => 'cyan', -comm => $c_quit);
$b2->pack(-side => 'left');
$mw->bind("<Control-q>" => sub { $b2->invoke });

$mw->after(100 => sub { show_bug($rot, $c_out) });

MainLoop;


#################
## Subroutines ##
#################
sub show_bug {
    my ($rot, $c_out) = @_;
    for (my $i = 0; $i < 64; $i++) {
        my $text = sprintf "%3d.  Text Text Text Text", $i + 1;
        $c_out->($text);
    }
}