#!/usr/local/bin/wish -f

#  This Tcl/Tk Motif GUI wrapper for program `gentkp' created by version 2.1
#  of generate_tk_program.
#
#  Stephen O. Lidie, Lehigh University.  Wed May  4 11:17:12 EDT 1994
#
#  lusol@Lehigh.EDU

source /usr/local/lib/tcl+tk_lucc/FSBox.tcl

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

# Initialize global variables.

set command "\$required"
set command0 "$command"
set output "stdout"
set output0 "$output"



proc Reset_Parameters {} {

	# Restore all command line parameter values to their default values.

	global command command0
	set command "\$required"
	set command0 "$command"
	global output output0
	set output "stdout"
	set output0 "$output"

}

Reset_Parameters

set gentkp_command "gentkp"
set c ".main"
set gentkp_fini 0
set gentkp_ok_background "white"

# Application command line defaults.

	# Maybe something here?




proc Update {} {

	# Create the command to execute.


	# Perform application specific command line argument processing here.

		# Maybe something here?

	set gentkp_command "gentkp"

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

	foreach parameter { "command" "output" } {
		upvar #0 $parameter p
		upvar #0 ${parameter}0 p0
		for { set i 0 } { $i < [ llength $p ] } { incr i } {
			if { [ lrange $p 0 end ] != [ lrange $p0 0 end ] } {
				set value [ lindex $p $i ]
				set gentkp_command "$gentkp_command -$parameter \"$value\""
			}
		}
	}

	# Build all switch parameters that have been specified.

	foreach parameter { } {
		upvar #0 $parameter p
		upvar #0 ${parameter}0 p0
		if { [ lrange $p 0 end ] != [ lrange $p0 0 end ] } {
			if { $p != "-not_${parameter}" } {
				set gentkp_command "$gentkp_command -${parameter}"
			}
		}
	}
	set gentkp_command "$gentkp_command "
	return $gentkp_command
}




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
	set o "xgentkp.output"
	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 ]

}




proc Display_About {} {

	tk_dialog .help_version About "This Tcl/Tk Motif GUI wrapper for program `gentkp' created by version 2.1 of generate_tk_program.\n\nStephen O. Lidie, Lehigh University.  Wed May  4 11:17:12 EDT 1994\n\nlusol@Lehigh.EDU" "@/usr/local/lib/tcl+tk_lucc/SOL.xbm" 0 OK

}
source /usr/local/lib/tcl+tk_lucc/DisU.tcl




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
	if { $execute == 1 } {

		# Special case $required parameters.

		global command
		if { $command == "\$required" || $command == "" } {
			tk_dialog .required "Alert" "Parameter \"command\" requires a value." warning 0 Cancel
			Reset_OK_Button
			return
		}
		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 }

}




set runme_num 1

wm title . "xgentkp"
wm iconname . "xgentkp"
#wm iconbitmap . @/usr/local/lib/tcl+tk_lucc/sqtp.xbm
wm geometry . +400+50

set realize "pack $c $c.menu $c.w_gentkp_command $c.w_command $c.w_output $c.see -side top -fill x"
set tabs "set tabList \" $c.w_command.entry $c.w_output.entry\""


# Toplevel frame.

catch { destroy $c }
frame $c -bd 1
pack $c -side top -fill both -expand yes

# Command to execute.

frame $c.see
entry $c.see.e -relief ridge -scroll "$c.see.s set" -textvariable gentkp_command
scrollbar $c.see.s -relief sunken -orient horiz -command "$c.see.e view"
pack $c.see.e -pady 1m -padx 1m -side top -fill x
pack $c.see.s -side top -fill x

# 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
$c.menu.file.m add command -label "Open ..." -underline 0 -state disabled -command {
	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 \
    -command { $c.w_gentkp_command.t yview 0.0; Reset_Parameters; set gentkp_command [ Update ] }

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"
$c.menu.help.m add command -label "Usage" -underline 0 -command "Display_Usage 2.1"

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

# Full command help from evaluate_parameters Message Module.

frame $c.w_gentkp_command
text $c.w_gentkp_command.t -relief raised -bd 1 -yscrollcommand "$c.w_gentkp_command.s set" -setgrid true -height 10 -font fixed
scrollbar $c.w_gentkp_command.s -relief flat -command "$c.w_gentkp_command.t yview"
pack $c.w_gentkp_command.s -side right -fill y
pack $c.w_gentkp_command.t -expand yes -fill both
$c.w_gentkp_command.t insert 0.0 \
{Command Source:  /usr/local/bin/gentkp



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.

Parameters:

-help, ?, usage_help, full_help: Display Command Information

	Display information about this command, which includes
	a command description with examples, plus a synopsis of
	the command line parameters.  If you specify -full_help
	rather than -help complete parameter help is displayed
	if it's available.

-command, c: application = $required

	Specifies the name of the command - the command MUST
	use evaluate_parameters as its user interface.

-output, o: file = stdout

	Specifies the name of the generate_tk_program output file.

}
$c.w_gentkp_command.t configure -state disabled

$c.w_gentkp_command.t mark set mark_gentkp_command 81.0
$c.w_gentkp_command.t mark set mark_gentkp_output 86.0

# -command, c: application = $required

frame $c.w_command -bd 1 -relief sunken
entry $c.w_command.entry -relief sunken -width 40 -textvariable command -bg $gentkp_highlight
button $c.w_command.label -text "command                                (a ) " -bd 0 -font fixed -command "$c.w_gentkp_command.t yview mark_gentkp_command; See_View \"-command\""
pack $c.w_command.entry -side right
pack $c.w_command.label -side left
bind $c.w_command.entry <KeyPress-Tab> {Tab $tabList; set gentkp_command [ Update ]}
bind $c.w_command.entry <KeyPress-Return> {Tab $tabList; set gentkp_command [ Update ]}

# -output, o: file = stdout

frame $c.w_output -bd 1 -relief sunken
entry $c.w_output.entry -relief sunken -width 40 -textvariable output
button $c.w_output.label -text "output                                 (f ) " -bd 0 -font fixed -command "$c.w_gentkp_command.t yview mark_gentkp_output; See_View \"-output\""
pack $c.w_output.entry -side right
pack $c.w_output.label -side left
bind $c.w_output.entry <KeyPress-Tab> {Tab $tabList; set gentkp_command [ Update ]}
bind $c.w_output.entry <KeyPress-Return> {Tab $tabList; set gentkp_command [ Update ]}

set gentkp_command [ Update ]

eval $realize
eval $tabs

focus [ lindex $tabList [ lsearch $tabList "$c.w_command.entry" ] ]
