view release on metacpan or  search on metacpan

genpTk  view on Meta::CPAN

end_of_template
    initialize_global_variables 1;
    print OUT <<'end_of_template';

} # end reset_parameters

sub save_window {

    # Open a file selection window and save text widget $w.

    my($fs, $w) = @_;

end_of_template
    $my_xcommand = 'x' . $my_command;
    print OUT "    my \$o = '${my_xcommand}.out';\n";
print OUT <<'end_of_template';
    $o = $fs->Show;
    my $replace = 1;
    if ($o ne '') {
	if (-s $o) {
	    $genPerlTk_replace->configure(
                -text => "Replace existing $o?",
            );
	    my $answer = $genPerlTk_replace->Show;
	    $replace = $answer eq 'Yes';
	}
    }
    if ($replace == 1) {
	open(S, ">$o") or warn $OS_ERROR;
	print S $w->get('1.0', 'end');
	close S;
    }

} # end save_window

sub see_view {

    # Position view of the command widget to this command line parameter.
    # Position help window so help information for this parameter is visible
    # and highlighted for a few seconds.

    my ($p, $ce, $help, $index) = @_;

    if ($p =~ /^end$/) {
	    $ce->xview('end');
    } else {
        $ce->xview(index($genPerlTk_command, $p) - 10);
    }

    $help->yview(-pickplace, 'mark_' . $index);
    $help->tag('configure', 'tag_' . $index, 
        -background => $genPerlTk_highlight,
    );
    $help->after(4000, [$help => 'tag', 'configure', 'tag_' . $index,
        -background => ($help->configure(-background))[3]],
    );

} # end see_view

sub update_command {

    # Create the command to execute.

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

end_of_template
    print OUT "    \$genPerlTk_command = '$my_command';\n";
    print OUT <<'end_of_template';

    # Build all non-switch parameters that have been specified.

    my($parameter, @l0, @l1, @udi);
end_of_template
    print OUT '    foreach $parameter (qw(';
    my $parameter;
    foreach $parameter (@P_PARAMETER) {
	my($required, $type, $list) = ($P_INFO{$parameter} =~ /(.)(.)(.?)/);
	print OUT " $parameter" if $type !~ /w/;
    }
    print OUT ")) {\n";
print OUT <<'end_of_template';
	no strict qw(refs);
        @l0 = &shellwords($$parameter);
	next if join(' ', @l0) eq '';
	@l1 = @${"${parameter}0"};
        next if $$parameter eq join ' ', @l1;
        @udi = lunion [ldifference \@l0, \@l1], [lintersection \@l0, \@l1];
        $genPerlTk_command .=
            " -$parameter '" . join("' -$parameter '", @udi) . "'";
    }

    # Build all switch parameters that have been specified.

end_of_template
    print OUT '    foreach $parameter (qw(';
    foreach $parameter (@P_SWITCH) {
        print OUT " $parameter";
    }
    print OUT ")) {\n";
    print OUT <<'end_of_template';
	no strict qw(refs);
        next if $$parameter eq "NOT_${parameter}";
	$genPerlTk_command .= " -${parameter}";
    }

    $genPerlTk_command .= ' ' . $trailing_file_list if
        defined $trailing_file_list;

    return $genPerlTk_command;

} # end update_command

sub update_checkbutton_list {

    # Toggle $val in $var.

    my($var, $val) = @_;

    my @l = split ' ', $$var;
    my $i = lsearch $val, @l;
    if ($i >= 0) {
	splice @l, $i, 1;
    } else {
	push @l, $val;
    }
    $$var = join ' ', @l;
    update_command;

} # end update_check_button_list

# Signal handlers.

$SIG{PIPE} = 'IGNORE';

# Initialize global Evaluate Parameters variables.

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'],				 
);