#!/usr/local/bin/perl
#
# Generate a Tcl/Tk X11 GUI wrapper program for any evaluate_parameters-compliant program.
#
# SOL, 93/09/28.  LUCC
#
# Stephen O. Lidie, lusol@Lehigh.EDU.
#
# Copyright (C) 1993 - 1994.  Stephen O. Lidie and Lehigh University.
#
# $Id: gentkp.pl,v 2.1.0.2 1994/05/04 15:53:29 lusol Exp $
#

$gentkp_version = '2.1';	# gentkp version (same as evaluate_parameters)
$gentkp_aux_files_path = '/usr/local/lib/tcl+tk_lucc'; # other required files

#
# General capabilities:
#
# . Command line parameters are specified via a form.  Most are Entry widgets,
#   except for parameters of type key, switch and boolean which are
#   Radiobutton widgets.
#
# . For 'list of' command line parameters we make these widget distinctions:
#
#	key		Checkbutton widget
#	switch		not allowed
#	other types	Entry widget with multiple space-separated items
#
# . Complete command and parameter help (from the evaluate_parameters Message
#   Module) displayed in a scrollable Text widget.
#
# . A scrollable Entry widget dynamically displays the command to be executed.
#
# . After execution the command's standard output is captured in a separate
#   Toplevel window.  This window can be saved to a file or directed to a
#   command pipeline.
#
# . Parameters are labelled with Button widgets rather than Label widgets so
#   clicking on a command line parameter Button positions the help window
#   automatically to the help text for that parameter.  The scrollable Entry
#   widget is also repositioned to show the specified parameter.
#
# . Important items that should be highlighted for the user to see are
#   displayed in a configurable background color using the X11 resource name
#   `name.highlight : color'.       	
#
# . An Undo selection to reset all command line parameters to their original
#   values.
#
# . Usage help explaining the characteristics of applications generated by
#   generate_tk_program, and details of evaluate_parameters.
#
# . The generated program dynamically determines if your Tk has the AddInput
#   extension, and uses non-blocking reads of standard output so that the
#   command can be cancelled.  Without AddInput, the application will hang if
#   the Unix program never completes.
#
#
# Caveats:
#
# . Command names can't have dot characters since dots are used in tk window
#   names.
#
# . No support for evaluate_parameters default environment variables.
#
# . Parameters of type "key" may extend past the right window margin and thus
#   distort the toplevel window's Y dimension.  Re-pack manually, please!
#   Create two or more subframes within the $c.parameter.subframe frame and pack
#   them inside the $c.parameter.subframe frame.  Examine this example:
#   
#     Original:
#
#       frame $c.data_type ...
#	label $c.data_type.label ...
#	frame $c.data_type.subframe
#       pack  $c.data_type.label -in $c.data_type -side left -anchor nw
#	pack  $c.data_type.subframe    -in $c.data_type -side left
#       radiobutton $c.date_type.ansi ...
#	pack $c.data_type.ansi -in $c.data_type.subframe -side left
#	radiobutton $c.data-type.ascii ...
#	pack $c.data_type.ansi -in $c.data_type.subframe -side left
#
#    Repacked:
#
#	frame $c.data_type ...
#	label $c.data_type.label ...
#	frame $c.data_type.subframe
#	pack $c.data_type.label -in $c.data_type -side left -anchor nw
#	pack $c.data_type.subframe -in $c.data_type -side left
#	frame $c.data_type.subframe.f1
#	frame $c.data_type.subframe.f2
#	pack $c.data_type.subframe.f1 -in $c.data_type.subframe -side top -fill x
#	pack $c.data_type.subframe.f2 -in $c.data_type.subframe -side top -fill x
#	radiobutton $c.data_type.ansi ...
#	pack $c.data_type.ansi -in $c.data_type.subframe.f1 -side left
#	radiobutton $c.data_type.ascii ...
#	pack $c.data_type.ascii -in $c.data_type.subframe.f2 -side left
#


require "evap.pl";		# evaluate_parameters




sub evap_PDT_error {

    local( $msg ) = @_;

    print STDERR "$msg";
    $error++;

} # end evap_PDT_error
   



sub evap_set_value {
    
    #
    # Store a parameter's value; some parameter types require special type
    # conversion.
    #
    # Handle list syntax (item1, item2, ...) for 'list of' types.
    #
    # Lists are a little weird as they may already have default values from the
    # PDT declaration. The first time a list parameter is specified on the
    # command line we must first empty the list of its default values.  The
    # P_INFO list flag thus can be in one of three states: 1 = the list has
    # possible default values from the PDT, 2 = first time for this command
    # line parameter so empty the list and THEN push the parameter's value, and
    # 3 = from now just keep pushing new command line values on the list.
    #
    
    local( $type, $list, $v, *parameter ) = @_;
    local( $value, @values );
    local( $pdt_reg_exp2 ) = '^TRUE$|^YES$|^1$';
    local( $pdt_reg_exp3 ) = '^FALSE$|^NO$|^0$';

    @parameter = () if $list =~ /^2$/; # empty list of default values

    if ( $list && $v =~ /^\(+[^\)]*\)+$/ ) { # check for list
	    
        # If a string type then values are already quoted and eval can
	# handle the situation.  Otherwise just split on whitespace after
	# removing the comma list separators and the left/right parens.

	if ( $type =~ /^s$/ ) {
	    @values = eval "$v"; # let Perl do the walking
        } else {
	    $v =~ s/(,)//g;
	    $v =~ s/([()])//g;
	    @values = split( ' ', $v );
	}
    } else {
	@values = $v;		# a simple scalar	
    } # ifend initialize list of values

    foreach $value (@values) {

	$value =~ s/["](.*)["]/\\\"$1\\\"/; # quote any bounding quotes
	$value =~ s/(\$)/\\$1/; # quote any dollar signs

        if ( $type =~ /^b$/ ) {
            $value =~ tr/a-z/A-Z/;
	    $value = 'TRUE' if $value =~ /$pdt_reg_exp2/;
	    $value = 'FALSE' if $value =~ /$pdt_reg_exp3/;
        } # ifend boolean type

        if ( $list ) {
	    push( @parameter, $value );
        } else {
	    $parameter = $value;
        }

    } # forend
	
} # end evap_set_value




sub finish {

    close( IN );
    close( OUT );

} # end finish




sub gentkp {

    # Process a Parameter Description Table (PDT).  Some lines are command line parameter information,
    # one may be trailing file name information - all lines are help information for the user.  When
    # all the input has been read then create the Tcl/Tk X11 R5 GUI wrapper program, with wish's help!
    
    while ( ($line = <IN>) ) {

	push( @command_help, $line ); # save for tk help window
	$help_index++;		# keep track of Text widget mark position

	&process_command_line_widget if substr( $line, 0, 1 ) eq '-';
	if ( $line =~ / required by this command/ ) {
	    push( @P_ENTRY, 'files' ); # update list of entry widgets
	    push( @help_index, "\$c.w_${my_command}_command.t mark set mark_${my_command}_trailing_files ${help_index}.0\n" );
	    $optional_files = ($line =~/ optionally required by this command/); # save optional/required trailing file list
	    $enable_file_menu = 1;
	    print W "\n# $line";
	    print W "\nframe \$c.w_files -bd 1 -relief sunken\n";
	    print W "entry \$c.w_files.entry -relief sunken -width 40 -textvariable files -bg \$gentkp_highlight\n";
	    if ( $optional_files ) {
		print W "button \$c.w_files.label -text \"File Name(s)", ' ' x (44 - 12), "\" -bd 0 -font $my_font",
		    " -command \"\$c.w_${my_command}_command.t yview -pickplace mark_${my_command}_trailing_files;",
		    " See_View end_of_MM\"\n";
	    } else {
		print W "button \$c.w_files.label -text \"Required File Name(s)", ' ' x (44 - 21), "\" -bd 0 -font $my_font",
		    " -command \"\$c.w_${my_command}_command.t yview -pickplace mark_${my_command}_trailing_files;",
		    " See_View end_of_MM\"\n";
	    }
	    print W "pack \$c.w_files.entry -side right\n";
	    print W "pack \$c.w_files.label -side left\n";
	    print W "bind \$c.w_files.entry <KeyPress-Tab> {Tab \$tabList; set gentkp_command [ Update ]}\n";
	    print W "bind \$c.w_files.entry <KeyPress-Return> {Tab \$tabList; set gentkp_command [ Update ]}\n";
	}

    } # whilend next input line

    close( W );			# close widget file so we can read it later
    $focus = "focus [ lindex \$tabList 0 ]\n" if $focus eq '';

    # Now generate the tk program.

    print OUT "#!/usr/local/bin/wish -f\n";
    chop( $date = `date` );
    print OUT "\n#  This Tcl/Tk Motif GUI wrapper for program `$my_command' created by version $gentkp_version\n";
    print OUT "#  of generate_tk_program.\n#\n";
    print OUT "#  Stephen O. Lidie, Lehigh University.  $date\n";
    print OUT "#\n#  lusol@Lehigh.EDU\n";
    print OUT "\nsource ${gentkp_aux_files_path}/FSBox.tcl\n";

    print OUT <<'end_of_highlight';

set gentkp_highlight [ option get . highlight Highlight ]
if { $gentkp_highlight == "" } {
	if { [ tk colormodel . ] == "monochrome" } {
		set gentkp_highlight "white"
	} else {
		set gentkp_highlight "azure"
	}
}
end_of_highlight

    # Initialize global variables.

    print OUT "\n# Initialize global variables.\n\n";
    &initialize_global_variables( 0 );

    # Generate Reset_Paramaters procedure.

    print OUT "\n\n\nproc Reset_Parameters {} {\n";
    print OUT "\n\t# Restore all command line parameter values to their default values.\n\n";
    &initialize_global_variables( 1 );
    print OUT "\n}\n";
    print OUT "\nReset_Parameters\n";

    print OUT "\nset gentkp_command \"$my_command\"\n";
    print OUT "set c \".main\"\n";
    print OUT "set gentkp_fini 0\n";
    print OUT "set gentkp_ok_background \"white\"\n";

    # Application command line defaults.

    print OUT "\n# Application command line defaults.\n\n\t# Maybe something here?\n";

    # The Update procedure.

    print OUT "\n\n\n\nproc Update {} {\n";
    print OUT "\n\t# Create the command to execute.\n\n";

    if ( $enable_file_menu ) {
	print OUT "\n\t# Handle trailing file_name(s).\n\n";
	$gentkp_files = "\$${my_command}_files";
	print OUT "\tupvar #0 files file_list\n";
	print OUT "\tset ${my_command}_files \$file_list\n";
	print OUT "\tif { \$file_list == \"stdin\" } {\n";
	print OUT "\t\tset ${my_command}_files \"\"\n";
	print OUT "\t}\n";
    } else {
	$gentkp_files = "";
    }

    print OUT "\n\t# Perform application specific command line argument processing here.\n\n\t\t# Maybe something here?\n";

    print OUT "\n\tset gentkp_command \"$my_command\"\n";
    print OUT "\n\t# Build all non-switch parameters that have been specified.\n\n";
    print OUT "\tforeach parameter \{";
    foreach $parameter (@P_PARAMETER) {
        ($required, $type, $list) = ( $P_INFO{$parameter} =~ /(.)(.)(.?)/ );
	if ( $type =~ /i|s|r|n|a|b|k|f/ ) {
	    print OUT " \"$parameter\"";
	} # ifend
    }
    print OUT " } {\n";
    print OUT "\t\tupvar #0 \$parameter p\n";
    print OUT "\t\tupvar #0 \${parameter}0 p0\n";
    print OUT "\t\tfor { set i 0 } { \$i < [ llength \$p ] } { incr i } {\n";
    print OUT "\t\t\tif { [ lrange \$p 0 end ] != [ lrange \$p0 0 end ] } {\n";
    print OUT "\t\t\t\tset value [ lindex \$p \$i ]\n";
    print OUT "\t\t\t\tset gentkp_command \"\$gentkp_command -\$parameter \\\"\$value\\\"\"\n";
    print OUT "\t\t\t}\n";
    print OUT "\t\t}\n";
    print OUT "\t}\n";

    print OUT "\n\t# Build all switch parameters that have been specified.\n\n";
    print OUT "\tforeach parameter \{";
    foreach $parameter (@P_SWITCH) {
	print OUT " \"$parameter\"";
    }
    print OUT " } {\n";
    print OUT "\t\tupvar #0 \$parameter p\n";
    print OUT "\t\tupvar #0 \${parameter}0 p0\n";
    print OUT "\t\tif { [ lrange \$p 0 end ] != [ lrange \$p0 0 end ] } {\n";
    print OUT "\t\t\tif { \$p != \"-not_\${parameter}\" } {\n";
    print OUT "\t\t\t\tset gentkp_command \"\$gentkp_command -\${parameter}\"\n";
    print OUT "\t\t\t}\n";
    print OUT "\t\t}\n";
    print OUT "\t}\n";

    print OUT "\tset gentkp_command \"\$gentkp_command $gentkp_files\"\n";
    print OUT "\treturn \$gentkp_command\n}\n";

    # The Update_Parameter, Tab, Pipe_Window, Save_Window and See_View procedures.

    print OUT <<'end_of_Tab_Save_Window';




proc Update_Parameter { p v } {

	# Insert 'v' into list 'p' unless it's already there, in which case remove it!

        upvar #0 $p list		# pass by name

	set cofp  [ lrange $list 0 end ]
	set is_it_there [ lsearch -exact $list $v ]
	if { $is_it_there >= 0 } {
		set cofp [ lreplace $list $is_it_there $is_it_there ]
	} else {
		set cofp [ lappend list $v ]
	}

	return $cofp
}



proc Tab {list} {

	# Move the focus to the next window in the tab list.

	set i [ lsearch $list [ focus ] ]

	if {$i < 0} {
		set i 0
	} else {
		incr i
		if {$i >= [ llength $list ]} {
		    set i 0
		}
	}
	focus [ lindex $list $i ]
}




proc Pipe_Window {which} {

	# Create a modal dialog entry toplevel window divided into an upper message widget, a middle entry widget and a lower
	# frame with OK and Cancel button widgets.  Make OK the default button.  Center the window, make a local grab, wait
	# for the pipeline string to be entered, destroy the window and perform the exec.

	global gentkp_pipeline

	set pipe ""	
	set gentkp_pipeline ""

	catch { destroy .pipe }
        toplevel .pipe -class dialog
	wm title .pipe "Pipe"
	wm iconname .pipe "Pipe"
	frame .pipe.f1 -bd 1 -relief raised
	frame .pipe.f2 -bd 1 -relief raised
	frame .pipe.f3 -bd 1 -relief raised
	pack .pipe.f1 .pipe.f2 .pipe.f3 -side top -fill both
	message .pipe.msg -aspect 200 -text \
	  "Enter command pipeline.  Separate all tokens by whitespace, even I/O redirection symbols, or else the exec will fail."
	pack .pipe.msg -in .pipe.f1 -side top -expand yes -fill both -padx 5m -pady 5m
	entry .pipe.entry -relief sunken -width 40 -textvariable pipe
	focus .pipe.entry
	bind .pipe.entry <KeyPress-Return> "set gentkp_pipeline \$pipe"
	pack .pipe.entry -in .pipe.f2 -side top -expand yes -fill both -padx 5m -pady 5m
	button .pipe.ok -text OK -command "set gentkp_pipeline \$pipe"
	frame .pipe.default -relief sunken -bd 1
	raise .pipe.ok .pipe.default
	pack .pipe.default -in .pipe.f3 -side left -expand yes -padx 3m -pady 2m
	pack .pipe.ok -in .pipe.default -padx 2m -pady 2m -ipadx 2m -ipady 2m
	button .pipe.cancel -text Cancel -command "set gentkp_pipeline \"\""
	pack .pipe.cancel -in .pipe.f3 -side left -expand yes -padx 3m -pady 3m -ipadx 2m -ipady 1m

	wm withdraw .pipe
	update idletasks
	set x [expr [winfo screenwidth .pipe]/2 - [winfo reqwidth .pipe]/2 - [winfo vrootx [winfo parent .pipe]]]
	set y [expr [winfo screenheight .pipe]/2 - [winfo reqheight .pipe]/2 - [winfo vrooty [winfo parent .pipe]]]
	wm geom .pipe +$x+$y
	wm deiconify .pipe

	grab .pipe
	tkwait variable gentkp_pipeline
	destroy .pipe

	if { $gentkp_pipeline != "" } {
		set text_window_contents [$which get 1.0 end]
		set p [ open "| $gentkp_pipeline" w ]
		puts $p $text_window_contents
		close $p
	}

}




proc Save_Window {which} {

        # Open a file selection window.

	global fsBox
end_of_Tab_Save_Window
    print OUT "\tset o \"x${my_command}.output\"\n";
    print OUT <<'end_of_Tab_Save_Window';
	set o [ FSBox "Select file:" $o ];
	if { $o != "" } {
		set replace 1
		if [ file exists $o ] {
			set replace [ tk_dialog .replace "Alert" "Replace existing \"$fsBox(name)\"?" \
				warning 0 Cancel Replace ]
		}
		if { $replace == 1 } {
			set text_window_contents [ $which get 1.0 end ]
			set p [ open "| cat > $o" w ]
			puts $p $text_window_contents
			close $p
		}
	}

}




proc See_View { parameter } {

        # Position view of the command Entry widget to this command line parameter.

        global c gentkp_command
	if { $parameter == "end_of_MM" } {
	        set index [ $c.see.e index end ]
	} else {
        	set index [ string first $parameter $gentkp_command ] 
	}
        $c.see.e view [ expr $index - 10 ]

}




end_of_Tab_Save_Window

    print OUT "proc Display_About {} {\n";
    print OUT "\n\ttk_dialog .help_version About \"This Tcl/Tk Motif GUI wrapper for program `$my_command'",
	" created by version $gentkp_version ";
    print OUT "of generate_tk_program.\\n\\n";
    print OUT "Stephen O. Lidie, Lehigh University.  $date\\n\\n";
    print OUT "lusol@Lehigh.EDU\" \"@${gentkp_aux_files_path}/SOL.xbm\" 0 OK\n";
    print OUT "\n}\n";

    print OUT "source $gentkp_aux_files_path/DisU.tcl\n";

    print OUT <<'end_of_addinput';




proc Execute_Command { } {

	# Open a Toplevel Output window, exec the Unix command and capture stdout/stderr.
	# If AddInput is available then use it, else just do stupid blocking reads.

	global gentkp_command runme_num c gentkp_fini gentkp_highlight

	set gentkp_command [Update]
	set execute 1
end_of_addinput
    if ( $enable_file_menu ) {
	print OUT <<'end_of_addinput';
        global files
	if { $files == "stdin" } {
		set execute [ tk_dialog .stdin "Alert" "Is standard input really the file you want to process?" \
			warning 0 Cancel OK ]
	} else {
		foreach file "$files" {
			if { ! [ file exists $file ] } {
###				tk_dialog .required "Alert" "File $file doesn't exist." warning 0 Cancel
###				Reset_OK_Button
###				return
			}
		}
	}
	if { $execute == 0 } {
		Reset_OK_Button
		return
	}
end_of_addinput
    }
    print OUT "\tif { \$execute == 1 } {\n";
    if ( @P_REQUIRED ) {
	print OUT "\n\t\t# Special case \$required parameters.\n\n";
	foreach $gentkp_required (@P_REQUIRED) {
	    print OUT "\t\tglobal $gentkp_required\n";
	    print OUT "\t\tif { \$${gentkp_required} == \"\\\$required\" || \$${gentkp_required} == \"\" } {\n";
	    print OUT "\t\t\ttk_dialog .required \"Alert\" \"Parameter \\\"${gentkp_required}\\\" requires a value.\"",
	        " warning 0 Cancel\n";
	    print OUT "\t\t\tReset_OK_Button\n";
	    print OUT "\t\t\treturn\n";
	    print OUT "\t\t}\n";
	}
    }

    print OUT <<'end_of_addinput';
		catch { destroy .runme$runme_num }    
		toplevel .runme$runme_num
		wm title .runme$runme_num "xoq output $runme_num"
		wm iconname .runme$runme_num "xoq$runme_num"
		#wm iconbitmap .runme$runme_num @/usr/local/lib/tcl+tk_lucc/sqtp_out.xbm
		frame .runme$runme_num.menu -bd 1 -relief raised
		menubutton .runme$runme_num.menu.file -text File -menu .runme$runme_num.menu.file.m -underline 0
		menu .runme$runme_num.menu.file.m
		.runme$runme_num.menu.file.m add command -label "Save As ..." -command "Save_Window .runme$runme_num.text" \
			-underline 0
		.runme$runme_num.menu.file.m add command -label "Pipe To ..." -command "Pipe_Window .runme$runme_num.text" \
			-underline 0
		.runme$runme_num.menu.file.m add separator
		.runme$runme_num.menu.file.m add command -label Close -command "destroy .runme$runme_num" -underline 0
		pack .runme$runme_num.menu.file -side left
		text .runme$runme_num.text -relief raised -bd 2 -yscrollcommand ".runme$runme_num.s set" -setgrid true -font fixed
		scrollbar .runme$runme_num.s -relief flat -command ".runme$runme_num.text yview"
		pack .runme$runme_num.menu -side top -fill x -expand yes
		pack .runme$runme_num.s -side right -fill y
		pack .runme$runme_num.text -expand yes -fill both
		.runme$runme_num.text mark set insert 0.0
		bind .runme$runme_num <Any-Enter> "focus .runme$runme_num.text"
		update

		# Open the pipe.  The OK button has been disabled until now to prevent a race condition.

		set f [ open "| $gentkp_command |& cat"  r ]
		set gentkp_have_addinput [ catch { addinput $f "Read_STDOUT %% %E %F" } ]
		if { $gentkp_have_addinput == 0 } {
	
			$c.menu.ok configure -text "Cancel" -relief raised -command "Kill_STDOUT $f" -state normal
			Flash_Button $c.menu.ok -background $gentkp_highlight [lindex [ $c.menu.ok configure -background ] 4] 500

		} else {

			$c.menu.ok configure -state normal
			while { [ gets $f line ] >= 0 } {
				if { $line == "" } {
					.runme$runme_num.text insert end \n
				} else {
					set lines [ split $line "\r" ]
					foreach line $lines {
						if { $line == "" } {
							continue
						}
						.runme$runme_num.text insert end $line\n
						}
				}
			}
			catch { close $f }
			set runme_num [ expr $runme_num + 1 ]
                        Reset_OK_Button

		}
	}
}




proc Flash_Button { w option val1 val2 interval } {

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

	global gentkp_fini

	if { $gentkp_fini == 0 } {
	        $w configure $option $val1
		after $interval [ list Flash_Button $w $option $val2 $val1 $interval ]
	}

}




proc Kill_STDOUT { fileid } {

	# With AddInput, a click on the blinking Cancel Button resumes normal operations.
	#
	# Bug Note:  can't close the pipe without first killing all its processes since
	# it too hangs on, say, TCP/IP operations without a timeout.  This leaves stray
	# processes around (at least on AIX).

	global gentkp_fini c

	set gentkp_fini 1
	removeinput $fileid
	exec kill [ pid $fileid ]
	catch { close $fileid }
	Reset_OK_Button

}




proc Read_STDOUT {token events fileid } {

	# With AddInput, called when input is available for the Output window.  Also checks
	# the global gentkp_fini to see if the user has clicked the Cancel Button.

	global gentkp_fini runme_num c

	if { $gentkp_fini } {
		Kill_STDOUT $fileid
	} else {
		if { [ gets $fileid line ] >= 0 } {
			if { $line == "" } {
				.runme$runme_num.text insert end \n
			} else {
				set lines [ split $line "\r" ]
				foreach line $lines {
					if { $line == "" } {
						continue
					}
					.runme$runme_num.text insert end $line\n
				}
			}
		} else {
			set gentkp_fini 1
			removeinput $fileid
			catch { close $fileid }
			set runme_num [ expr $runme_num + 1 ]	
			Reset_OK_Button
		}
	}
	
}




proc Reset_OK_Button {} {

	# Establish normal OK Button parameters.

	global gentkp_fini c gentkp_ok_background

	$c.menu.ok configure -text "Do It" -relief raised -background $gentkp_ok_background -state normal -command \
		{ set gentkp_fini 0; $c.menu.ok configure -text "Working ..." -relief sunken -state disabled; Execute_Command }

}
end_of_addinput

    # Start the main code.

    print OUT "\n\n\n\nset runme_num 1\n";
    print OUT "\nwm title . \"x$my_command\"\n";
    print OUT "wm iconname . \"x$my_command\"\n";
    print OUT "#wm iconbitmap . \@${gentkp_aux_files_path}/sqtp.xbm\n";
    print OUT "wm geometry . +400+50\n";
    print OUT "\nset realize \"pack \$c \$c.menu \$c.w_${my_command}_command";
    foreach $parameter (@P_PARAMETER) {
	print OUT " \$c.w_$parameter";
    }
    print OUT " \$c.w_files" if $enable_file_menu;
    print OUT " \$c.see -side top -fill x\"\n";
    print OUT "set tabs \"set tabList \\\"";
    foreach $entry (@P_ENTRY) {
	print OUT " \$c.w_${entry}.entry";
    }
    print OUT "\\\"\"\n";

    # Toplevel frame.

    print OUT "\n\n# Toplevel frame.\n";
    print OUT "\ncatch { destroy \$c }\n";
    print OUT "frame \$c -bd 1\n";
    print OUT "pack \$c -side top -fill both -expand yes\n";

    # Define scrollable entry widget to hold the command to execute.

    print OUT "\n# Command to execute.\n";
    print OUT "\nframe \$c.see\n";
    print OUT "entry \$c.see.e -relief ridge -scroll \"\$c.see.s set\" -textvariable gentkp_command\n";
    print OUT "scrollbar \$c.see.s -relief sunken -orient horiz -command \"\$c.see.e view\"\n";
    print OUT "pack \$c.see.e -pady 1m -padx 1m -side top -fill x\n";
    print OUT "pack \$c.see.s -side top -fill x\n";

    # Menu selections.

    print OUT <<'end_of_menus';

# Menu selections.

frame $c.menu -bd 1

menubutton $c.menu.file -text File -menu $c.menu.file.m -underline 0
menu $c.menu.file.m
end_of_menus
    $gentkp_state = $enable_file_menu ? "" : "-state disabled";
    print OUT "\$c.menu.file.m add command -label \"Open ...\" -underline 0 $gentkp_state -command {\n";
    print OUT <<'end_of_menus';
	set tmp_files [FSBox]
	if { $tmp_files != "" } {
		set files $tmp_files
		set gentkp_command [ Update ]    
	}
}
$c.menu.file.m add separator
$c.menu.file.m add command -label "Quit" -underline 0 -command  "destroy ."

menubutton $c.menu.edit -text Edit -menu $c.menu.edit.m -underline 0
menu $c.menu.edit.m
$c.menu.edit.m add command -label "Undo All" -underline 0 \
end_of_menus
    print OUT "    -command \{ \$c.w_${my_command}_command.t yview 0.0; Reset_Parameters; set gentkp_command [ Update ] \}\n";
    print OUT <<'end_of_menus';

menubutton $c.menu.filler -text "          " -state disabled

menubutton $c.menu.help -text Help -menu $c.menu.help.m -underline 0
menu $c.menu.help.m
$c.menu.help.m add command -label "About" -underline 0 -command "Display_About"
end_of_menus
    print OUT "\$c.menu.help.m add command -label \"Usage\" -underline 0 -command \"Display_Usage $gentkp_version\"\n";
    print OUT <<'end_of_menus';

button $c.menu.ok
set gentkp_ok_background [ lindex [ $c.menu.ok configure -background ] 4 ]
Reset_OK_Button

pack $c.menu.file $c.menu.edit -side left
pack $c.menu.ok -side left -expand yes
pack $c.menu.help $c.menu.filler -side right
end_of_menus

    # Command help window with Message Module contents.

    print OUT "\n# Full command help from evaluate_parameters Message Module.\n";
    print OUT "\nframe \$c.w_${my_command}_command\n";
    print OUT "text \$c.w_${my_command}_command.t -relief raised -bd 1 -yscrollcommand \"\$c.w_${my_command}_command.s set\"",
        " -setgrid true -height 10 -font fixed\n";
    print OUT "scrollbar \$c.w_${my_command}_command.s -relief flat -command \"\$c.w_${my_command}_command.t yview\"\n";
    print OUT "pack \$c.w_${my_command}_command.s -side right -fill y\n";
    print OUT "pack \$c.w_${my_command}_command.t -expand yes -fill both\n";
    print OUT "\$c.w_${my_command}_command.t insert 0.0 \\\n{";
    print OUT @command_help;
    print OUT "}\n";
    print OUT "\$c.w_${my_command}_command.t configure -state disabled\n";
    print OUT "\n", @help_index;

    # Append all the the command line widget definitons.

    open( W, "<$widgets" ) || die( "Cannot open widget scracth file: $!" );
    print OUT <W>;
    close( W );

    # Fire things up.

    print OUT "\nset gentkp_command [ Update ]\n";
    print OUT "\neval \$realize\neval \$tabs\n";
    print OUT "\n$focus\n";

} # end gentkp



sub initialize {

    $PDT =<<'end_of_PDT';
        command, c: application = $required
	output, o: file = stdout
        no_file_list
end_of_PDT

    $MM = <<'end_of_MM';
generate_tk_program, genptkp

	Generates a Tcl/Tk program to create an X11 R5 Motif GUI
	wrapper	around any program using evaluate_parameters as
	its command line interface.
	
	Interprets the command's -full_help output and builds the
	necessary windows and widgets.  The resulting application
	can capture its	standard output in a window; the output can
	be saved to a file or directed to a pipeline.  Complete help
	is also provided.

	General capabilities:

	 . Command line parameters are specified via a form.  Most
	   are Entry widgets, except for parameters of type key,
	   switch and boolean which are Radiobutton widgets.
	
	 . For 'list of' command line parameters we make these
	   widget distinctions:  key parameters use Checkbuttons
	   and other types use Entry widgets with multiple items.

	 . Complete command and parameter help (from the
	   evaluate_parameters Message Module) displayed in a
	   scrollable Text widget.

	 . A scrollable Entry widget dynamically displays the
	   command to be executed.

	 . After execution the command's standard output is captured
	   in a separate Toplevel window.  This window can be saved
	   to file or directed to a command pipeline.

	 . Parameters are labelled with Button widgets rather than
	   Label widgets so clicking on a command line parameter
	   Button positions the help window automatically to the
	   help text for that parameter.  The scrollable Entry
	   widget is also repositioned to show the specified
	   parameter.

	 . Important items that should be highlighted for the user
	   to see are displayed in a configurable background color
	   using the X11 resource name `name.highlight : color'.       	

	 . An Undo selection to reset all command line parameters to
	   their original values.

	 . Usage help explaining the characteristics of applications
	   generated by generate_tk_program, and details of
	   evaluate_parameters.

	 . The generated program dynamically determines if your Tk
	   has the AddInput extension, and uses non-blocking reads
	   of standard output so that the command can be cancelled.
	   Without AddInput, the application will hang if the Unix
	   program never completes.

          Examples:

            gentkp -c op -o xop

            genpdt -c op > xop

	In the last example note that since the gentkp output
	file defaults to stdout	normal I/O redirection can be
	used.
.command
	Specifies the name of the command - the command MUST
	use evaluate_parameters as its user interface.
.output
	Specifies the name of the generate_tk_program output file.
end_of_MM
    
    @PDT = split( /\n/, $PDT );
    @MM = split( /\n/, $MM );
    &evap( *PDT, *MM );		# evaluate_parameters

    $my_command = $opt_command;	# save just in case the command has identical parameters
    $my_output = $opt_output;	# save just in case the command has identical parameters

    open( OUT, ">$my_output" ) || die( "Cannot open output file: $!" );
    open( IN, "$my_command -full_help |" ) || 
	die( "Cannot execute command: $!" );
    $widgets = "/tmp/gentkp_widgets";
    open( W, ">$widgets" ) || die( "Cannot open widget scracth file: $!" );

    $enable_file_menu = 0;	# 1 IFF a toplevel "Select File" menu
    $error = 0;			# no PDT parsing errors
    $focus = '';		# focus on first $required parameter
    $help_index = -1;		# for recording marks in the help Text widget
    $my_font = "fixed";
    $opt_command = "";		# no command
    $opt_output = "";		# no output filename

    @P_PARAMETER = ();		# no parameter names
    %P_INFO = ();		# no encoded parameter information
    %P_ALIAS = ();		# no aliases
    @P_REQUIRED = ();		# no required parameters
    %P_VALID_VALUES = ();	# no keywords
    %P_ENV = ();		# no default environment variables
    @P_SWITCH = ();		# no switch type parameters
    @P_ENTRY = ();		# no entry widgets

    
} # end initialize




sub initialize_global_variables {

    local( $frog ) = @_;

    $tab = $frog ? "\t" : "";

    foreach $parameter (@P_PARAMETER) {
	print OUT "${tab}global $parameter ${parameter}0\n" if $frog;
        ($required, $type, $list) = ( $P_INFO{$parameter} =~ /(.)(.)(.?)/ );
	if ( $list eq '1' ) { # if 'list of'
	    @values = eval "\@opt_$parameter";
	    if ( $type =~ /s/ && $values[0] ne "\\\$required" ) {
		print OUT "${tab}set $parameter \"\\\"", join( '\\" \\"', @values ), "\\\"\"\n";
	    } else {
		print OUT "${tab}set $parameter \"", join( ' ', @values ), "\"\n";
	    }
	    print OUT "${tab}set ${parameter}0 \"\$$parameter\"\n";
	    if ( $type =~ /k/ ) {
		foreach $value0 (split( ' ', $P_VALID_VALUES{$parameter} )) {
		    $value = "";
		    foreach $v (eval "\@opt_$parameter") {
			if ( $v eq $value0 ) {
			    $value = $v;
			    last;
			}
		    }
		    print OUT "${tab}global ${parameter}_${value0}\n" if $frog;
		    print OUT "${tab}set ${parameter}_${value0} \"${value}\"\n";
		}
	    }
	} else {
	    $value = eval "\$opt_$parameter";
	    print OUT "${tab}set $parameter \"$value\"\n";
	    print OUT "${tab}set ${parameter}0 \"\$$parameter\"\n";
	}
    }
    if ( $enable_file_menu ) {
	print OUT "${tab}global files files0\n" if $frog;
	if ( $optional_files ) {
	    print OUT "${tab}set files \"stdin\"\n";
	} else {
	    print OUT "${tab}set files \"\"\n";
	}
	print OUT "${tab}set files0 \"\$files\"\n";
    }

} # end initialize_global_variables




sub process_command_line_widget {

    # Parse the psuedo-PDT line from evaluate_parameters.

    return if substr( $line, 0, 5 ) eq '-help';

    $option = substr( $line, 1 );
	
    ($parameter, $alias, $_) = ($option =~ /^\s*(\S*)\s*,\s*(\S*)\s*:\s*(.*)$/);
    push( @help_index, "\$c.w_${my_command}_command.t mark set mark_${my_command}_${parameter} ${help_index}.0\n" );
    &evap_PDT_error( "Error in an evaluate_parameters 'parameter, alias: type' option specification:  \"$option\".\n" )
	unless defined( $parameter ) && defined( $alias ) && defined( $_ );
    &evap_PDT_error( "Duplicate parameter $parameter:  \"$option\".\n" ) if defined( $P_INFO{$parameter} );
    push( @P_PARAMETER, $parameter ); # update the ordered list of parameter names

    /(\bswitch\b|\binteger\b|\bstring\b|\breal\b|\bfile\b|\bboolean\b|\bkey\b|\bname\b|\bapplication\b)/; # type/list
    ($list, $type, $_)=($`, $1, $');
    &evap_PDT_error( "Parameter $parameter has an undefined type:  \"$option\".\n" ) unless defined( $type );
    &evap_PDT_error( "Expecting 'list of', found:  \"$list\".\n") if $list ne '' && $list !~ /\s*list\s+of\s+/;
    $list = '1' if $list;	# list state = 1, possible default PDT values
    $type = 'w' if $type =~ /^switch$/;
    $type = substr( $type, 0, 1 );

    ($_, $default_value) = /\s*=\s*/ ? ($`, $') : ('', ''); # get possible default value
    if ( $default_value =~ /^([^\(]{1})(\w*)\s*,\s*(.*)/ ) { # if environment variable AND not a list
	$default_value = $3;
	$P_ENV{$parameter} = $1 . $2;
    }
    $required = ($default_value eq '$required') ? 'R' : 'O';
    $P_INFO{$parameter} = defined $type ? $required . $type . $list : "";
    push( @P_REQUIRED, $parameter ) if $required =~ /^R$/; # update the list of $required parameters

    if ( $type =~ /^k$/ ) {
	$_ =~ s/,/ /g;
	@keys = split( ' ' );
	pop( @keys );	# remove 'keyend'
	$P_VALID_VALUES{$parameter} = join( ' ', @keys );
    } #ifend keyword type
	
    foreach $value (keys %P_ALIAS) {
	&evap_PDT_error( "Duplicate alias $alias:  \"$option\".\n" ) if $alias eq $P_ALIAS{$value};
    }
    $P_ALIAS{$parameter} = $alias; # remember alias
	
    &evap_PDT_error( "Cannot have 'list of switch':  \"$option\".\n" ) if $P_INFO{$parameter} =~ /^.w@$/;

    $default_value = "-not_${parameter}" if $type =~ /w/;
    $default_value = "stdin" if $type =~ /f/ && $default_value eq '-';	
    $default_value = "stdout" if $type =~ /f/ && $default_value eq '>-';	
    $default_value = "" if $default_value eq "\$optional" || $default_value eq "";

    if ( $default_value ne '' ) {
	$default_value = $ENV{$P_ENV{$parameter}} if $P_ENV{$parameter} && $ENV{$P_ENV{$parameter}};
	&evap_set_value( $type, $list, $default_value, 'opt_'."$parameter" ); # initialize with default value
    }

    # Line parsed - create the widget based upon the parameter's type.  Set focus to first $required parameter
    # that has an Entry box.  Small bug - no focus for $required list of boolean - I'm too lazy right now.

    $focus = "focus [ lindex \$tabList [ lsearch \$tabList \"\$c.w_$parameter.entry\" ] ]" if $focus eq '' &&
	$default_value eq '$required' && $type !~ /k|b|w/;

    $indicator = '(' . $type . ($list ? 'l' : ' ') . ') ';
    $indicator = '(sw) ' if $indicator eq '(w ) ';	

    if ( $type =~ /i|s|r|f|n|a/ ) { # integer, string, real, file, name and application

	push( @P_ENTRY, $parameter ); # update list of entry widgets
	print W "\n# -$option\n";
	print W "frame \$c.w_$parameter -bd 1 -relief sunken\n";
	print W "entry \$c.w_$parameter.entry -relief sunken -width 40 -textvariable $parameter";
	print W " -bg \$gentkp_highlight" if $default_value eq '$required';
	print W "\n";
	print W "button \$c.w_$parameter.label -text \"$parameter", ' ' x (39- length( $parameter )), $indicator,
	    "\" -bd 0 -font $my_font",
	    " -command \"\$c.w_${my_command}_command.t yview mark_${my_command}_${parameter};",
	    " See_View \\\"-${parameter}\\\"\"\n";
	print W "pack \$c.w_$parameter.entry -side right\n";
	print W "pack \$c.w_$parameter.label -side left\n";
	print W "bind \$c.w_$parameter.entry <KeyPress-Tab> {Tab \$tabList; set gentkp_command [ Update ]}\n";
	print W "bind \$c.w_$parameter.entry <KeyPress-Return> {Tab \$tabList; set gentkp_command [ Update ]}\n";

    } elsif ( $type =~ /b/ ) {	# boolean

	print W "\n# -$option\n";
	print W "frame \$c.w_$parameter -bd 1 -relief sunken\n";
	print W "button \$c.w_$parameter.label -text \"$parameter", ' ' x (39- length( $parameter )), $indicator,
	    "\" -bd 0 -font $my_font",
	    " -command \"\$c.w_${my_command}_command.t yview mark_${my_command}_${parameter};",
	    " See_View \\\"-${parameter}\\\"\"\n";
	if ( $list ) {
	    push( @P_ENTRY, $parameter ); # update list of entry widgets
	    print W "entry \$c.w_$parameter.entry -relief sunken -width 40 -textvariable $parameter";
	    print W " -bg \$gentkp_highlight" if $default_value eq '$required';
	    print W "\n";
	    print W "pack \$c.w_$parameter.entry -side right\n";
	    print W "pack \$c.w_$parameter.label -side left\n";
	    print W "bind \$c.w_$parameter.entry <KeyPress-Tab> {Tab \$tabList; set gentkp_command [ Update ]}\n";
	    print W "bind \$c.w_$parameter.entry <KeyPress-Return> {Tab \$tabList; set gentkp_command [ Update ]}\n";
	} else {
	    print W "frame \$c.w_$parameter.subframe\n";
	    print W "pack \$c.w_$parameter.label -in \$c.w_$parameter -side left -anchor nw\n";
	    print W "pack \$c.w_$parameter.subframe -in \$c.w_$parameter -side left\n";
	    print W "radiobutton \$c.w_$parameter.true -text yes -variable $parameter -relief flat -value TRUE",
                " -command {set gentkp_command [ Update ]}\n";
	    print W "radiobutton \$c.w_$parameter.false -text no -variable $parameter -relief flat -value FALSE",
                " -command {set gentkp_command [ Update ]}\n";
            print W "pack \$c.w_$parameter.true \$c.w_$parameter.false -side left\n";
        }

    } elsif ( $type =~ /w/ ) {	# switch

	push( @P_SWITCH, $parameter ); # update the ordered list of switch type parameters
	print W "\n# -$option\n";
	print W "frame \$c.w_$parameter -bd 1 -relief sunken\n";
	print W "button \$c.w_$parameter.label -text \"$parameter", ' ' x (39 - length( $parameter )), $indicator,
	    "\" -bd 0 -font $my_font",
	    " -command \"\$c.w_${my_command}_command.t yview -pickplace mark_${my_command}_${parameter};",
	    " See_View \\\"-${parameter}\\\"\"\n";
	print W "frame \$c.w_$parameter.subframe\n";
	print W "pack \$c.w_$parameter.label -in \$c.w_$parameter -side left -anchor nw\n";
	print W "pack \$c.w_$parameter.subframe -in \$c.w_$parameter -side left\n";
	print W "radiobutton \$c.w_$parameter.true -text yes -variable $parameter -relief flat -value \"-${parameter}\"",
	    " -command {set gentkp_command [ Update ]}\n";
	print W "radiobutton \$c.w_$parameter.false -text no -variable $parameter -relief flat -value \"-not_${parameter}\"",
	    " -command {set gentkp_command [ Update ]}\n";
	print W "pack \$c.w_$parameter.true \$c.w_$parameter.false -side left\n";

    } elsif ( $type =~ /k/ ) {	# keyword

	print W "\n# -$option\n";
	print W "frame \$c.w_$parameter -bd 1 -relief sunken\n";
	print W "button \$c.w_$parameter.label -text \"$parameter", ' ' x (39 - length( $parameter )), $indicator,
            "\" -bd 0 -font $my_font",
	    " -command \"\$c.w_${my_command}_command.t yview -pickplace mark_${my_command}_${parameter};",
	    " See_View \\\"-${parameter}\\\"\"\n";
	print W "frame \$c.w_$parameter.subframe\n";
	print W "pack \$c.w_$parameter.label -in \$c.w_$parameter -side left -anchor nw\n";
	print W "pack \$c.w_$parameter.subframe -in \$c.w_$parameter -side left\n";
	foreach $value (split( ' ', $P_VALID_VALUES{$parameter} )) {
	    if ( $list ) {
		print W "checkbutton \$c.w_$parameter.$value -text $value -variable ${parameter}_${value} -relief flat",
		    " -onvalue $value -offvalue \"\"",
	            " -command {set $parameter [ Update_Parameter $parameter $value ]; set gentkp_command [ Update ]}\n";
	    } else {
		print W "radiobutton \$c.w_$parameter.$value -text $value -variable $parameter -relief flat -value $value",
	            " -command {set gentkp_command [ Update ]}\n";
	    }
	    print W "pack \$c.w_$parameter.$value -in \$c.w_$parameter.subframe -side left\n";
	} # forend

    } # ifend case type

} # end process_command_line_widget




&initialize;

&gentkp;

&finish;
