in reply to Re^5: Tk gui bug
in thread Tk gui bug

Now, a few more challenges: The GUI is initiated from the command line. Should I alias the GUI's name to run it in the background so that the user keeps control? Also, do I run the programs from the GUI in the background also? AND,how does one tie STDERR to a MessageBox which pops up when there is an error? If you have some general ideas, I'd appreciate it. -HONYOK

Replies are listed 'Best First'.
Re^7: Tk gui bug
by zentara (Cardinal) on Feb 03, 2009 at 17:01 UTC
    I don't know what you are talking about "initiated from commandline", they all are. As far as tieing STDERR to a MessageBox, put at the top of your script
    require Tk::ErrorDialog;

    I'm not really a human, but I play one on earth Remember How Lucky You Are
      That's helpful, thank you. Now I'd like to redirect STDOUT and STDERR from an external program to my text widget in real time. The example below writes to the text widget, but not in real time AND the STDERR is written first rather than last. (the example below does not exhibit this last problem.) I've parsed many solutions and am thoroughly confused at this point.
      #!/usr/bin/perl -w use warnings; use strict; use Tk; use Tk::NoteBook; require Tk::Pane; use Tie::IxHash; use Tk::LabEntry; my $mw = MainWindow->new; $mw->geometry( "600x500"); $mw->title("Survival Kit"); ##################NOTES######## ##expansion from 2nd tab has bug? ###default hash tie my %tools, 'Tie::IxHash', 'program1' => ordered_hash_ref ( 'PARM1' => 'Y', 'PARM2' => 'files', ' +PARM3' => 'list', 'PARM4' => 'Y', 'PARM5' => 'N'), 'program2' => ordered_hash_ref ( 'PARM' => '', 'PARM0' => 0, 'PARM1' = +> 1, 'PARM2' => 2, 'PARM3' => 3, 'PARM4' => 4, 'PARM5' => 5, 'PARM6' +=> 6, 'PARM7' => 7, 'PARM8' => 8, 'PARM9' =>9, 'PARM10' => 10 ); + ## create notebook my $book = $mw->NoteBook()->pack(-expand=>1,-fill=>'both'); #####program1####### my $tab_cnt=1; for my $tab (keys %tools){ ##create tab,scroll pane,frames my $tab_tab=$book->add("Sheet $tab_cnt", -label => "$tab")->pack +(-expand=>1,-fill=>'both'); my $tab_spane=$tab_tab->Scrolled('Pane',-background=>'slate grey +')->pack(-expand=>1, -fill=>'both'); my $tab_frame1=$tab_spane->Frame(-background=>'blue')->pack(-sid +e=>'left',-expand=>1,-fill=>'both',-padx=>15); my $tab_frame2=$tab_spane->Frame(-background=>'red')->pack(-side +=>'bottom',-anchor=>'s',-fill=>'x'); $tab_cnt++; #create columns my $tab_column1 = $tab_frame1->Frame()->pack(-side=>'left',-exp +and=>1,-fill=>'both'); my $tab_column2 = $tab_frame2->Frame()->pack(-side=>'right',-ex +pand=>1,-fill=>'both'); ##now fill frames my $parm_cnt=1; #print "Processing tool: $tab\n"; foreach my $parm ( keys %{$tools{$tab}}) { #print " $parm = $tools{$tab}{$parm}\n"; my $tab_test; if ($parm_cnt < 7 ){ $tab_test=$tab_column1->LabEntry(-label => "$parm=" +); $tab_test->Subwidget('entry')->configure(-textvariable => + \$tools{$tab}{$parm} ); $tab_test->configure(-labelPack=>[-side=>'left']); $tab_test->pack(-anchor=>'e'); } else { $tab_test=$tab_column2->LabEntry(-label => "$parm=" +); $tab_test->Subwidget('entry')->configure(-textvariable => + \$tools{$tab}{$parm} ); $tab_test->configure(-labelPack=>[-side=>'left']); $tab_test->pack(-anchor=>'e'); } $parm_cnt++; } #######go and save button############# my $run=$tab_tab->Button(-text => "\n $tab \n ",-command=> +\&go ,-command =>[\&save_parms,$tab],-background=>'slate grey')->pack +; } MainLoop; ####################### subs ############################### sub save_parms { my $tab = shift; #print $tab; #program > FILE 2>&1 #open STDOUT,">tmpfile" or die "Cannot open temp file"; #open STDOUT, '>/dev/null'; #open STDERR, '>>&STDOUT'; #close STDOUT; ####stderr stdout dialog box################### my $popup = Tk::MainWindow->new; $popup->title("${tab} Info"); my $text = $popup->Scrolled('Text',-label => "Output/Errors",-width = +> 45,-height => 20); $text->pack; $| = 1; tie(*STDERR, 'Tk::Text', $text); tie(*STDOUT, 'Tk::Text', $text); $SIG{'__WARN__'} = sub { print STDERR @_ }; my $button = $popup->Button( -text => 'Close', -command => [$popup=> 'destroy']); $button->pack; ################################################ if ( "$tab" eq "program1"){ open (my $parfile,"> program1_parms.txt") or warn "$!\n"; foreach my $parm ( keys %{$tools{$tab}} ) { print $parfile "$parm=$tools{$tab}{$parm}\n"; } close $parfile; print STDOUT `cat program1_parms.txt 2>&1 `; sleep 5; print STDERR "HELP!"; } } ## order hashes## sub ordered_hash_ref { tie my %hash, 'Tie::IxHash', @_; return \%hash; }
      -honyok
        You need to open up your external programs with IPC::Open3 ( possibly a 2>&1 redirect in a piped open), but IPC::Open3 is you general purpose solution. Here is a basic example, you setup a fileevent on the inputs:
        #!/usr/bin/perl use warnings; use strict; use IPC::Open3; use Tk; my $mw = new MainWindow; $mw->geometry("600x400"); $mw->Button(-text => "See STDERR", -command => \&do_Toplevel)->pack(); my $tout = $mw->Scrolled( 'Text', -foreground => 'white', -background => 'black', -width => 80, -height => 20, )->pack; my $top = $mw->Toplevel(); $top->withdraw; my $terr = $top->Scrolled( 'Text', -foreground => 'hotpink', -background => 'black', -width => 80, -height => 20, )->pack; my $pid = open3( 0, \*OUT, \*ERR, "$0-sender" ); #the 0 is for ignoring \*IN (STDIN) $mw->fileevent( \*OUT, 'readable', \&write_out ); $mw->fileevent( \*ERR, 'readable', \&write_err ); MainLoop; ##################################################### sub do_Toplevel { if (! Exists($top)) { $top = $mw->Toplevel( ); $top->title("T-ERR"); $top->Button(-text => "Close", -command => sub { $top->withdraw })->pack; } else { $top->deiconify( ); $top->raise( ); } } ############################### sub write_out { my $str = <OUT>; $tout->insert( "1.0", $str ); $tout->see("1.0"); } ############################ sub write_err { my $str = <ERR>; $terr->insert( "1.0", $str ); $terr->see("1.0"); } ########################################### __END__
        and the simple sender to play with
        #!/usr/bin/perl use warnings; use strict; $| = 1; my $count = 0; while(1){ $count++; print "$count\n"; warn "\tuh oh warning $count\n"; sleep 1; }

        I'm not really a human, but I play one on earth Remember How Lucky You Are