view release on metacpan or  search on metacpan

genpTk  view on Meta::CPAN

    # Create a toplevel output window, exec the Unix command and capture 
    # stdout/stderr.  If no stdout/stderr then don't bother to deiconify
    # the toplevel, and, if only doing-it-once, exit.

    my($doit, $doit_bg) = @_;

    update_command;
    $genPerlTk_mw->update;

    my $execute = 1;
    $execute = ($genPerlTk_stdin_dialog->Show eq 'OK') if 
        defined $trailing_file_list and $trailing_file_list eq '';

    if (not $execute) {
	reset_doit_button $doit, $doit_bg;
	return;
    }

    # Special case $required parameters.

end_of_template
    print OUT "    foreach (qw(", join(' ', @P_REQUIRED), ")) {\n";
    print OUT "        no strict qw(refs);\n";
    print OUT "        if (\$\$_ eq '\$REQUIRED' or \$\$_ eq '\$required' or \$\$_ eq '') {\n";
    print OUT "            \$genPerlTk_required_dialog->configure(-text => \"Parameter \\\"\$_\\\" requires a value.\");\n";

    print OUT "            \$genPerlTk_required_dialog->Show;\n";
    print OUT "            reset_doit_button \$doit, \$doit_bg;\n";
    print OUT "            return;\n";
    print OUT "        }\n";
    print OUT "    }\n";
    print OUT <<'end_of_template';
    
    my($t);
    if (Exists($genPerlTk_runme)) {
	$t = $genPerlTk_text;
	$genPerlTk_runme->deiconify;
    } else{
	$genPerlTk_runme = $genPerlTk_mw->Toplevel;
	my $e = $genPerlTk_runme;
end_of_template
    my $my_xcommand = 'x' . $my_command;
    print OUT <<"end_of_template";
	\$e->title('$my_xcommand output');
	\$e->iconname('$my_xcommand');
end_of_template
    print OUT <<'end_of_template';

	# Forward declaration of the Text widget.

	$tf = $e->Frame;
	$t = $tf->Text(qw(-relief raised -bd 2 -setgrid true -font fixed));
	$genPerlTk_text = $t;
	$t->pack(qw(-expand yes -fill both));
        $tf->AddScrollbars($t);
        $tf->configure(-scrollbars => 'se');

	my $m = $e->Frame(qw(-bd 1 -relief raised));
	$m->pack(qw(-side top -fill x -expand yes));
	my $mf = $m->Menubutton(qw(-text File -underline 0 -relief raised));
	$mf->pack(-side => 'left');
	my $fs = $genPerlTk_mw->FileSelect;
	$mf->command(
            -label   => 'Save as ...',
            -command => [sub {save_window @_}, $fs, $t],
        );
	$mf->command(
            -label   => 'Pipe to ...',
            -command => [sub {pipe_window @_}, $t],
        );
	$mf->separator;
	$mf->command(
            -label   => 'Close',
            -command => [$e => 'iconify'],
        );

	$tf->pack;

    } # ifend not Exists
	
    # Open the pipe.  The Do It button has been disabled until now to
    # prevent a race condition.
    
    {
	no strict qw(subs);
	$genPerlTk_pid = open H, "$genPerlTk_command 2>&1 |";
	warn $OS_ERROR if not defined $genPerlTk_pid;
        select H; $OUTPUT_AUTOFLUSH = 1; select STDOUT;
	$genPerlTk_mw->fileevent(H, 'readable' => [sub {
            read_stdout @_;
        }, $t, $doit, $doit_bg]);
    }
    $doit->configure(
        -text    => 'Cancel',
        -relief  => 'raised',
        -state   => 'normal',
        -command => [sub {
            kill_stdout @_;
        }, $t, $doit, $doit_bg],
    );
    flash_widget $doit, '-background' => $genPerlTk_highlight, $doit_bg, 500;
    
} # end execute_command

sub flash_widget {

    # Flash a widget by alternating its foreground and background colors.

    my($w, $option, $val1, $val2, $interval) = @_;

    if ($genPerlTk_fini == 0) {
	$w->configure($option => $val1);
	$genPerlTk_mw->after($interval, [\&flash_widget, $w, $option, $val2,
            $val1, $interval]);
    }

} # end flash_widget

sub kill_stdout {
    

genpTk  view on Meta::CPAN

end_of_template
    initialize_global_variables 0;
    print OUT <<'end_of_template';

# Initialize global generate_PerlTk_program variables.

end_of_template
#    print OUT "\$genPerlTk_aux_files = '$genPerlTk_aux_files';\n";
    print OUT "\$genPerlTk_doit_once = $my_dio;\n";
    print OUT <<'end_of_template';
$genPerlTk_required_dialog = $genPerlTk_mw->Dialog(
    -title   => 'Alert',
    -text    => 'Parameter "_" required a value.',
    -bitmap  => 'error',
    -buttons => [qw(Cancel)],
    -wraplength => '6i',
);
$genPerlTk_stdin_dialog = $genPerlTk_mw->Dialog(
    -title   => 'Alert',
    -text    => 'Is standard input really the file you want to process?',
    -bitmap  => 'warning',
    -buttons => [qw(Cancel OK)],
);
$genPerlTk_fini = 0;

$genPerlTk_highlight = $genPerlTk_mw->optionGet(qw(highlight Highlight));
if (not defined $genPerlTk_highlight) {
    if ($genPerlTk_mw->depth > 1) {
	$genPerlTk_highlight = 'yellow';
    } else {
	$genPerlTk_highlight = 'white';
    }
}
$genPerlTk_replace = $genPerlTk_mw->Dialog(
    -title   => 'Replace?',
    -buttons => ['Yes', 'No'],				 
);
$genPerlTk_undo_all = 'Undo All';

reset_parameters;
$genPerlTk_command = update_command;

# BEGIN application specific command line processing.
# END   application specific command line processing.

end_of_template
    $my_xcommand = 'x' . $my_command;
    print OUT <<"end_of_template";
\$genPerlTk_mw->title('$my_xcommand');
\$genPerlTk_mw->iconname('$my_xcommand');
end_of_template
    print OUT <<'end_of_template';
$genPerlTk_mw->geometry('+400+50');

# File, Edit and Help menubuttons, with the Do It button stuffed in between.

my $mb = $genPerlTk_mw->Frame(-borderwidth => 1, -relief => 'raised');
$mb->pack(qw(-side top -fill both -expand yes));

my $mbf = $mb->Menubutton(qw(-text File -underline 0 -relief raised));
my $fs = $genPerlTk_mw->FileSelect;
$mbf->command(
    -label     => 'Open ...', 
    -underline => 0,
end_of_template
    my $state = $enable_file_menu ? 'normal' : 'disabled';
    print OUT "    -state     => '$state',\n";
    print OUT <<'end_of_template';
    -command   => [sub {
	my($fs) = @_;
	$trailing_file_list = $fs->Show;
	update_command;
    }, $fs],
);
$mbf->separator;
$mbf->command(
    -label     => 'Close',
    -underline => 0,
    -command   => [$genPerlTk_mw => 'iconify'],
);
$mbf->separator;
$mbf->command(
    -label     => 'Quit',
    -underline => 0,
    -command   => sub {exit},
);
$mbf->pack(-side => 'left');

my $mbe = $mb->Menubutton(qw(-text Edit -underline 0 -relief raised));
$mbe->command(
     -label     => $genPerlTk_undo_all,
     -underline => 0,
);
$mbe->pack(-side => 'left');

my $doit = $mb->Button;
$doit->pack(-side => 'left', -expand => 'yes');
my $doit_bg = ($doit->configure(-background))[4];
reset_doit_button($doit, $doit_bg);

my $filler = $mb->Menubutton(-text => '          ', -state => 'disabled');
$filler->pack(-side => 'left');

my $mbh = $mb->Menubutton(qw(-text Help -underline 0 -relief raised));
$mbh->pack(-side => 'left');

my $about = $genPerlTk_mw->Dialog(
    -title  => 'About',
end_of_template
    print OUT "    -text   => \"This Perl/Tk X11 GUI wrapper for program `$my_command' created by version $genPerlTk_version of generate_PerlTk_program.\\n\\n$genPerlTk_date\\n\\nStephen.O.Lidie\\\@Lehigh.EDU\",\n";
    print OUT <<'end_of_template';
#    -bitmap => "\@${genPerlTk_aux_files}/SOL.xbm",
     -wraplength => '4i',
);
$mbh->command(
    -label     => 'About', 
    -underline => 0, 
    -command   => [$about => 'Show'],
);
$mbh->command(
    -label     => 'Usage', 
    -underline => 0, 
end_of_template
    print OUT "    -command   => [\\&display_usage, '$genPerlTk_version'],\n";
    print OUT <<'end_of_template';
);

# Full command help from Evaluate Parameters Message Module.

my $h = $genPerlTk_mw->Frame;
$h->pack(qw(-fill x -expand 1));
my $help = $h->Text(
    qw(-relief raised -bd 1 -setgrid 1 -height 10 -font fixed -width 100),
);
$help->pack(qw(-expand yes -fill both));
$h->AddScrollbars($help);
$h->configure(-scrollbars => 'e');

# Configure Undo All now that $help has been defined.

$mbe->entryconfigure($genPerlTk_undo_all, -command => [sub {
        shift->yview('0.0');
        reset_parameters;
        update_command;
    }, $help],
);

# Scrollable text widget to contain command line parameter widgets.

my $wf = $genPerlTk_mw->Frame;
$wf->pack(qw(-fill x -expand yes));
my $widgets = $wf->Text(qw(-relief raised -bd 1 -setgrid true -height 11));
$widgets->pack(qw(-fill x -expand yes));
$wf->AddScrollbars($widgets);
$wf->configure(-scrollbars => 'se');

# Populate help window with Evaluate Parameters -full_help.

foreach (<DATA>) {
    $help->insert('end', $_);
}
$help->configure(-state => 'disabled');

# Establish marks and tags for quickly positioning the help information.