Mastering Perl/Tk

Tk::ExecuteCommand

In Chapter 15, we discussed the Tk:ExecuteCommand program. Here it is in its entirety; see Figure 15-1 for a demonstration.

$Tk::ExecuteCommand::VERSION = '1.1'; package Tk::ExecuteCommand; use IO::Handle; use Proc::Killfam; #use Tk::widgets qw/LabEntry ROText/; use Tk::widgets qw/ROText/; use base qw/Tk::Frame/; use strict; Construct Tk::Widget 'ExecuteCommand'; sub Populate { my($self, $args) = @_; $self->SUPER::Populate($args); my $f1 = $self->Frame->pack; $f1->LabEntry( -label => 'Command to Execute', -labelPack => [qw/-side left/], -textvariable => \$self->{-command}, )->pack(qw/-side left/); my $doit = $f1->Button(-text => 'Do It!')->pack(qw/-side left/); $self->Advertise('doit' => $doit); $self->_reset_doit_button; $self->Frame->pack(qw/pady 10/); $self->Label(-text => 'Command\'s stdout and stderr')->pack; my $text = $self->Scrolled('ROText', -wrap => 'none'); $text->pack(qw/-expand 1 -fill both/); $self->Advertise('text' => $text); $self->OnDestroy([$self => 'kill_command']); $self->{-finish} = 0; $self->ConfigSpecs( -command => [qw/METHOD command Command/, 'sleep 5; pwd'], ); } # end Populate sub command { my($self, $command) = @_; $self->{-command} = $command; } # end command sub _flash_doit { # Flash "Do It" by alternating its background color. my($self, $option, $val1, $val2, $interval) = @_; if ($self->{-finish} == 0) { $self->Subwidget('doit')->configure($option => $val1); $self->idletasks; $self->after($interval, [\&_flash_doit, $self, $option, ...