It seems fileevent is broken. Maybe current hardware can read much faster than when Tk was originally designed, so Tk can't manage to update before next line comes in?
#! /usr/bin/perl
use strict;
use warnings;
use Tk;
{ my $in;
sub stop { undef $in }
sub run {
my ($type, $entry) = @_;
my $command = $entry->cget('-text');
if (1 == $type) {
my $out = $_[2];
open $in, '-|', $command or die $!;
my $repeat;
$repeat = ($entry->repeat(1, sub {
return $entry->afterCancel($repeat)
if $repeat && ! defined $in;
read $in, my $buff, 100;
if (length $buff) {
$out->insert(end => $buff);
$out->yview('end');
}
}));
} elsif (2 == $type) {
system "$command&";
}
}
}
my $mw = MainWindow->new(-title => 'Two background processes');
my $le_read_from = $mw->LabEntry(-label => 'Read from:',
-labelPack => [qw[ -side left ]],
-text => 'find')->pack;
my $le_process = $mw->LabEntry(-label => 'Run in the background:',
-labelPack => [qw[ -side left ]],
-text => 'xterm')->pack;
my $out;
my $f_b = $mw->Frame->pack;
my $b_run1 = $f_b->Button(-text => 'Run 1',
-command => sub { run(1, $le_read_from, $out
+) })
->pack(-side => 'left');
my $b_run2 = $f_b->Button(-text => 'Run 2',
-command => [\&run, 2, $le_process])
->pack;
my $f_b2 = $mw->Frame->pack;
my $b_clear1 = $f_b2->Button(-text => 'Clear',
-command => sub { $out->delete('0.0', 'en
+d') })
->pack(-side => 'left');
my $b_stop = $f_b2->Button(-text => 'Stop',
-command => \&stop)->pack(-side => 'left');
my $b_quit = $f_b2->Button(-text => 'Quit',
-command => sub { Tk::exit })->pack;
my $playground = $mw->Text->pack;
$playground->insert('0.0',
"You can type any text here to check the interactivity.\n");
$out = $mw->ROText->pack;
MainLoop();
map{substr$_->[0],$_->[1]||0,1}[\*||{},3],[[]],[ref qr-1,-,-1],[{}],[sub{}^*ARGV,3]