view release on metacpan or  search on metacpan

GUI/woevap.ptk  view on Meta::CPAN

use subs qw(sub execute_command flash_widget kill_stdout pipe_window
	    read_stdout reset_doit_button reset_parameters save_window
	    see_view update_command);

# Subroutines.

sub execute_command {

    # 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.

    foreach (qw(millisecond_update_interval)) {
        no strict qw(refs);
        if ($$_ eq '$REQUIRED' or $$_ eq '$required' or $$_ eq '') {
            $genPerlTk_required_dialog->configure(-text => "Parameter \"$_\" requires a value.");
            $genPerlTk_required_dialog->Show;
            reset_doit_button $doit, $doit_bg;
            return;
        }
    }
    
    my($t);
    if (Exists($genPerlTk_runme)) {
	$t = $genPerlTk_text;
	$genPerlTk_runme->deiconify;
    } else{
	$genPerlTk_runme = $genPerlTk_mw->Toplevel;
	my $e = $genPerlTk_runme;
	$e->title('xwoevap output');
	$e->iconname('xwoevap');

	# 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 {
    

GUI/woevap.ptk  view on Meta::CPAN

$number0 = ['123'];
$verbose0 = 'NOT_verbose';
$command0 = ['"ps -el"'];
$scale_factor0 = ['1.2340896e-1'];
$millisecond_update_interval0 = ['$required'];
$ignore_output_file_column_one0 = ['TRUE'];
$output0 = ['stdout'];
$queue0 = ['printer'];
$destination0 = ['`hostname`'];
$tty0 = ['/dev/console', '/dev/tty0', '/dev/tty1'];
$trailing_file_list0 = [''];

# Initialize global generate_PerlTk_program variables.

$genPerlTk_doit_once = 0;
$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.

$genPerlTk_mw->title('xwoevap');
$genPerlTk_mw->iconname('xwoevap');
$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,
    -state     => 'normal',
    -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',
    -text   => "This Perl/Tk X11 GUI wrapper for program `woevap' created by version 2.3.5 of generate_PerlTk_program.\n\nWed Jul 29 20:28:35 EDT 1998\n\nStephen.O.Lidie\@Lehigh.EDU",
#    -bitmap => "\@${genPerlTk_aux_files}/SOL.xbm",
     -wraplength => '4i',
);
$mbh->command(
    -label     => 'About', 
    -underline => 0, 
    -command   => [$about => 'Show'],
);
$mbh->command(
    -label     => 'Usage', 
    -underline => 0, 
    -command   => [\&display_usage, '2.3.5'],
);

# 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.

$help->mark('set', 'mark_woevap_number', '29.0');
$help->tag('add', 'tag_woevap_number', '30.0', '33.0');