perl tk process output site:perlmonks.org, tk ipc site:perlmonks.org

Re: Perl:TK - standard output to text widget

Re: Perl/Tk while {1} and a responsive UI

Tk GUI and Listen?

A widget is a thing, it is an it, it is an object -- many GUI toolkits have used the term, some use control, but a widget, is still, just a thing :) text widget means text thing :) you have to know and tell us explicitly which GUI toolkit you're working with

"turning a frame into a text widget" makes no sense. A frame is something that you would put a text widget into. You might want to make a new text widget appear inside of a frame or not. I doubt that you would want to destroy that frame.

Below is a simple Tk application. Make and copy the testing123.pl code into its own file. Run main program. Some kind of event like clicking a button is needed to start the whole process. The testing123.pl program randomly puts a little delay so that you can see that the lines are being displayed in realtime. The key to that is that a screen update method is called to "refresh" the screen after every line is added.

Update: I noticed that if you press GoButton again, it adds yet another text widget underneath the first one. I guess that is a "feature" of this demo!

#!/usr/bin/perl -w
use strict;

use Tk;

my $mw = MainWindow->new;

my $main_frame = $mw->Frame()->pack(-side=>'top',-fill=>'x');
my $go_button = $main_frame->Button(-text=>'Go Button',
              -command => \&do_command)->pack();

MainLoop;

sub do_command
{
   # create and display text widget
   my $tw = $main_frame->Text()->pack();

   open (COPY_PROJ, '-|', 'perl testing123.pl') or die "unable to star
+t $!";

   my $first_line = "Copying project...please wait";
   $tw->insert( 'end', $first_line );
   
   my $copy_proj_line;
   
   while (defined ($copy_proj_line =<COPY_PROJ>) ) 
   {
       $tw->insert( 'end', $copy_proj_line );
       $tw->update(); ### this is the key to see values as they come
   }   
}

__END__

file: testing123.pl:

#!/usr/bin/perl -w
use strict;
$|=1;  #no buffering on stdout

for (1..10)
{ 
   print "line number $_\n";
   sleep 1 if (rand() > 0.5);
}
[download]

Thanks Marshall, By using update() I can now get the output to show up in the text widget... The one problem which I am still not sure how to solve is, the process I mention is invoked by hitting the button...this button stays depressed for like 5 seconds or so...what's the trick to un-depress this button as soon as it's clicked...?

Great to hear that you've made progress! I don't have much to go on here as you haven't shown your button code. My button "works" so you will have to figure out what is different between what you are doing and what I did.

Try to boil the problem down to the simplest set of code possible that still illustrates the problem. Sometimes that process itself results in some enlightenment. If it doesn't, post the code here and we'll look at it. Without seeing the code, it would just be guessing on my part.

#!/usr/bin/perl
use warnings;
use strict;
use IPC::Open3;
use Tk;
use Tk::ProgressBar;

my $mw = new MainWindow;
$mw->geometry("600x400");
my $tframe = $mw->Frame()->pack();

my $count = 0;
my $l1 = $tframe->Label(-text => '%',
               -bg       => 'black',
               -fg       => 'green',
               )->pack(-side => 'left');
       
my $l2 = $tframe->Label(
               -text => $count,
               #-textvariable => \$count,
               -bg       => 'black',
               -fg       => 'green',
               -width => 3,   
           )->pack(-side => 'left');



my $p = $tframe->ProgressBar(
 -troughcolor => 'black',
    -fg       => 'lightgreen',
    -blocks   => 1,
    -width    => 20,
    -length   => 200,
    -from     => 0,
    -to       => 100,
    -variable => \$count,
)->pack(-side =>'right');

my $tout = $mw->Scrolled(
    'Text',
    -foreground => 'white',
    -background => 'black',
    -width  => 80,
    -height => 20,
                 )->pack;

$tout->tagConfigure( 'red',   -foreground => 'red' );

my $pid = open3( 0, \*OUT, \*ERR, "STDERR_STDOUT-IPC3-sender" );
#the 0 is for ignoring \*IN  (STDIN)
$mw->fileevent( \*OUT, 'readable', \&write_out );
$mw->fileevent( \*ERR, 'readable', \&write_err );

MainLoop;
#############################################################
sub write_out {
    $count = <OUT>;
    chomp $count;
#    use Encode;
#    eval $count;   #prevents raw unicode, you may not need it
#    print "$count\n";
    $l2->configure('-text'=> $count);
    $tout->insert( "end", "$count\n" );
    $tout->see("end");
}
####################################################
sub write_err {
    my $str = <ERR>;
    $tout->insert( "end", "\t$str", 'red' );
    $tout->see("end");
}
__END__
[download]

#!/usr/bin/perl
use warnings;
use strict;

$| = 1;
my $count = 0;
while(1){
 $count++;
 print "$count\n";
 warn "\tuh oh warning $count\n"; #send something to stderr
 sleep 1;
}
[download]