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

#  This Tcl/Tk Motif GUI wrapper for program `genpdt' created by version 2.1
#  of generate_tk_program.
#
#  Stephen O. Lidie, Lehigh University.  Wed Jun  1 09:32:41 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 input "stdin"
set input0 "$input"
set output "stdout"
set output0 "$output"
set qualifier "\"\""
set qualifier0 "$qualifier"



proc Reset_Parameters {} {

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

	global input input0
	set input "stdin"
	set input0 "$input"
	global output output0
	set output "stdout"
	set output0 "$output"
	global qualifier qualifier0
	set qualifier "\"\""
	set qualifier0 "$qualifier"

}

Reset_Parameters

set gentkp_command "genpdt"
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 "genpdt"

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

	foreach parameter { "input" "output" "qualifier" } {
		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 "xgenpdt.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 `genpdt' created by version 2.1 of generate_tk_program.\n\nStephen O. Lidie, Lehigh University.  Wed Jun  1 09:32:41 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 } {
		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 . "xgenpdt"
wm iconname . "xgenpdt"
#wm iconbitmap . @/usr/local/lib/tcl+tk_lucc/sqtp.xbm
wm geometry . +400+50

set realize "pack $c $c.menu $c.w_genpdt_command $c.w_input $c.w_output $c.w_qualifier $c.see -side top -fill x"
set tabs "set tabList \" $c.w_input.entry $c.w_output.entry $c.w_qualifier.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_genpdt_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_genpdt_command
text $c.w_genpdt_command.t -relief raised -bd 1 -yscrollcommand "$c.w_genpdt_command.s set" -setgrid true -height 10 -font fixed
scrollbar $c.w_genpdt_command.s -relief flat -command "$c.w_genpdt_command.t yview"
pack $c.w_genpdt_command.s -side right -fill y
pack $c.w_genpdt_command.t -expand yes -fill both
$c.w_genpdt_command.t insert 0.0 \
{Command Source:  /usr/local/bin/genpdt

Message Module Name:  genpdt.mm

generate_pdt, genpdt

	Interprets a PDT declaration and generates C statements that
	declare and initialize a PDT.  The command line	parser routine
        evaluate_parameters uses the PDT to scan a command line for
        parameters and to display help information about the command.

          Examples:

            genpdt -i pdt_in -o pdt_out

            genpdt <pdt_in >pdt_out

	In the last example note that since the genpdt input and
	output files default to stdin and stdout, respectively,
	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.

-input, i: file = stdin

	Specifies the name of the input file containing a
	command's Parameter Description Table.  The PDT describes
	the names, aliases, types and default values of all the
	command's command line parameters, as well as the path
	name of the ar message module archive file containing
	help text for the command and its parameters.  

-output, o: file = stdout

	Specifies the name of the generate_pdt output file.  This
	file contains C language statements that are typically
	included in the source of your C application.  You then
	call the procedure evaluate_parameters, passing the PDT
	and the user's command line string; the command line is
	parsed and the results of the evaluation stored in the
	PDT.

-qualifier, q: string = ""

	Specifies a qualifying string that uniquely identifies
	this PDT.  By default the C statements created by
	generate_pdt define the symbols pdt and pvt to be used
	by your application, which point to the results of the
	evaluation of the user's command line input.  Some C
	applications support 'multiple entry points'; that is,
	the same C module acts as more than one user program.
	And typically these 'multiple programs' accept different
	command line arguments.  So, there is a requirement that
	multiple instances of the pdt/pvt symbols be defined.

	Another reason to qualify the pdt/pvt symbols is when
	embedding evaluate_parameters into an application.  Each
	application command processor requires its own instance
	of these variables to keep parameter names and values
	distinct.

	The value of the qualifier parameter is thus prepended
	to the names pdt/pvt, as well as the `P_' ordinals that
	index into the pvt.  Therefore if -quailier = "OQ_" the
	symbols OQ_pdt and OQ_pvt would be defined.

}
$c.w_genpdt_command.t configure -state disabled

$c.w_genpdt_command.t mark set mark_genpdt_input 31.0
$c.w_genpdt_command.t mark set mark_genpdt_output 40.0
$c.w_genpdt_command.t mark set mark_genpdt_qualifier 50.0

# -input, i: file = stdin

frame $c.w_input -bd 1 -relief sunken
entry $c.w_input.entry -relief sunken -width 40 -textvariable input
button $c.w_input.label -text "input                                  (f ) " -bd 0 -font fixed -command "$c.w_genpdt_command.t yview mark_genpdt_input; See_View \"-input\""
pack $c.w_input.entry -side right
pack $c.w_input.label -side left
bind $c.w_input.entry <KeyPress-Tab> {Tab $tabList; set gentkp_command [ Update ]}
bind $c.w_input.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_genpdt_command.t yview mark_genpdt_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 ]}

# -qualifier, q: string = ""

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

set gentkp_command [ Update ]

eval $realize
eval $tabs

focus [ lindex $tabList 0 ]

