1#!/usr/local/bin/perl -w 2use Tk; 3 4require Tk::IO; 5 6my $top = MainWindow->new; 7my $status = "Ready for job ..."; 8$top->Label(-textvariable => \$status, -anchor => 'w')->pack(-side => 'bottom', -fill => 'x', -anchor => 'w'); 9 10my $t = $top->Text("-relief" => "raised", "-bd" => "2", "-setgrid" => "true"); 11my $s = $top->Scrollbar("-command" => ["yview",$t]); 12$t->configure("-yscrollcommand" => ["set",$s] ); 13 14 15$fh = Tk::IO->new(-linecommand => [$t,'insert','end'], 16 -childcommand => \&Child); 17 18$cmd = 'ls -l'; 19 20$e = $top->Entry("-width" => 40,"-textvariable" => \$cmd); 21$e->pack("-side" => "bottom"); 22 23$b = $top->Button("-text" => "Do It", "-command" => [\&DoIt,$fh,$e]); 24$b->pack("-side" => "bottom"); 25 26$b = $top->Button("-text" => "Quit", "-command" => ['destroy',$top]); 27$b->pack("-side" => "bottom"); 28 29$b = $top->Button("-text" => "Kill", "-command" => sub { $fh->killpg(3)} ); 30$b->pack("-side" => "bottom"); 31 32$s->pack("-side"=>"left","-fill" => "y"); 33$t->pack("-side"=>"left","-expand" => "y", "-fill" => "both"); 34 35$t->bind("<Any-Enter>", sub { $t->focus }); 36 37 38$e->update; 39 40$e->focus; 41 42 43 44Tk::MainLoop; 45 46sub Child 47{ 48 my ($code,$fh) = @_; 49 my $cmd = join(' ',$fh->command); 50 $status = "code=$code from $cmd"; 51} 52 53 54sub DoIt 55{my $fh = shift; 56 my $e = shift; 57 $fh->exec($e->get); 58} 59