#
#	Copyright (c) 1995, 1996, 1997, Sun Microsystems, Inc.
#
# This software is provided by Sun ``AS IS'' and any express or implied
# warranties, including but not limited to, the implied warranties of
# merchantability and fitness for a particular purpose are disclaimed.
# In not event shall Sun Microsystems be liable for any direct, indirect,
# incidental, special, exemplary, or consequential damages.
#
# This software may not be resold without the express permission of Sun
# Microsystems.
#
# Feedback on this tool may be sent to packet-shell-owner@sunroof.eng.sun.com.
#
# Packet Shell
#
# @(#)pbuild.tk	1.4
#

proc copyPackets {} {
	global base


	pbuild_4_ui [toplevel .child3]
	wm title .child3 "Packet Shell GUI Builder - Copy Packets"
	menu .child3.menubutton#1.p1 
	menu .child3.menubutton#2.p1
	focus .child3.entry#1
	foreach i [pinfo pshpackets] {
		.child3.menubutton#1.p1 add radiobutton -label $i \
			-variable src1pkt -value $i -command {
				.child3.listbox#3 delete 0 end
				ptbl $src1pkt
				foreach j [pinfo pshptbl] {
					.child3.listbox#3 insert end $j
				}
			}
		.child3.menubutton#2.p1 add radiobutton -label $i \
			-variable src2pkt -value $i -command {
				.child3.listbox#4 delete 0 end
				ptbl $src2pkt
				foreach j [pinfo pshptbl] {
					.child3.listbox#4 insert end $j
				}
			}
	}
	.child3.listbox#5 insert end end
	bind .child3.listbox#3 <Button-1> {
		global layer Packet

		if {$Packet(0) == ""} {
			.child3.label#1 configure -text "Enter the destination packet name before selecting source packets."
			return
		}
		
		set y %y
		set x [lindex [.child3.listbox#3 get [.child3.listbox#3 nearest $y]] 0]
		set endlayer [expr $layer + 1]
		set Packet($endlayer) end
		set Packet($layer) $x
		set layer [expr $layer + 1]
		.child3.listbox#5 delete 0 end 
		set j 1
		while {$j <= $layer} {
			.child3.listbox#5 insert end $Packet($j)
			set j [expr $j + 1]
		}
	}
	bind .child3.listbox#4 <Button-1> {
		global layer Packet
		set y %y
		set x [lindex [.child3.listbox#4 get [.child3.listbox#4 nearest $y]] 0]
		set endlayer [expr $layer + 1]
		set Packet($endlayer) end
		set Packet($layer) $x
		set layer [expr $layer + 1]
		.child3.listbox#5 delete 0 end
		set j 1
		while {$j <= $layer} {
			.child3.listbox#5 insert end $Packet($j)
			set j [expr $j + 1]
		}
	}
	bind .child3.entry#1 <Return> {
		set Packet(0) $dstpkt
		focus .child3
	}
}

proc deletePacket {} {

	tk_dialog .warning Warning "Not implemented yet." warning 0 OK
}

proc savetoFile {} {

	if {[.output.text#1 get 1.0] == ""} {
		tk_dialog .error Error "Nothing to save yet." error 0 OK
		return
	}
	set file_select_types {
	 {"Packet Shell Scripts"	{.pst}	{TEXT}}
	}
	while {[set filename [tk_getSaveFile -filetypes $file_select_types -initialdir /opt/psh/scripts]] != {}} {
		set f [open $filename w+]
		puts $f [.output.text#1 get 1.0 end]
		flush $f
		close $f
		break
	}
}

proc pbuildHelp {} {

	tk_dialog .warning Warning "Not implemented yet." warning 0 OK
}

proc createPacket {} {
	global base protocols protocolInfo

	pbuild_1_ui [toplevel .child1]
	wm title .child1 "Packet Shell GUI Builder - Create Packet"
	menu .child1.menubutton#2.p1
	
	foreach i [pinfo protocols] {
		.child1.menubutton#2.p1 add radiobutton -label \
			[concat $i - $protocolInfo($i)] \
			-variable protocolName -value $i 
	}
	bind .child1 <Return> {
	 if {[info exists newpkt_args] && $newpkt_args != ""} {
	   pinit $protocolName $newpkt $newpkt_args
	   .output.text#1 insert end "pinit $protocolName $newpkt $newpkt_args\n"
	   unset newpkt newpkt_args
	 } else {
	   pinit $protocolName $newpkt
	   .output.text#1 insert end "pinit $protocolName $newpkt\n"
	   unset newpkt
	 }
	 $base.listbox#1 delete 0 end
	 foreach i [pinfo pshpackets] {
		$base.listbox#1 insert end $i
	 }
	}
}

proc selectPacket {x y} {
	global base pktName

	set x [lindex [$base.listbox#1 get [$base.listbox#1 nearest $y]] 0]
	set pktName $x
	$base.label#1 configure -text "Selected: $x"
	$base.listbox#2 delete 0 end
	ptbl $x
	foreach i $pshptbl {
		$base.listbox#2 insert end $i
	}
}

proc selectProtocol {x y} {
	global base protocolName

	set x [lindex [$base.listbox#2 get [$base.listbox#2 nearest $y]] 0]
	set protocolName $x
	$base.label#2 configure -text "Selected: $x"
	$base.listbox#3 delete 0 end
	global pset_$x
	foreach i [pinfo $x pset] {
		$base.listbox#3 insert end $i
	}
}

proc selectField {x y} {
	global base protocolName fieldName pktName fValue

	set x [lindex [$base.listbox#3 get [$base.listbox#3 nearest $y]] 0]
        if {$x == "end"} {
		tk_dialog .error Error "This is a marker for the end of the protocol layers in a packet, not a protocol" error 0 OK
	} else {
	set fieldName $x
	$base.label#3 configure -text "Selected: $x"
	pbuild_2_ui [toplevel .child2]
	wm title .child2 "Packet Shell GUI Builder - Get/Set Field Values"
	set tmp [pget $pktName $protocolName $fieldName]
	.child2.text#1 delete end
	.child2.text#1 insert end [pinfo $protocolName pset $fieldName]
	.child2.message#1 configure -justify center -text $tmp
	bind .child2.entry#3 <Return> {
		pset $pktName $protocolName $fieldName $fValue
		.output.text#1 insert end "pset $pktName $protocolName $fieldName $fValue"
		destroy .child2
		unset fValue
	}
	}
}

# Global Variables

set base ""
set fieldName ""
set fValue ""
set layer 1
set Packet(0) noname

# Tk Library Routines

Source $tk_library/dialog.tcl
Source $tk_library/bgerror.tcl
Source $tk_library/tearoff.tcl
Source $tk_library/text.tcl
Source $tk_library/comdlg.tcl
Source $tk_library/optMenu.tcl
Source $tk_library/tkfbox.tcl

proc pbuild {} {

global base tk_version baseDir PSH_TCLLIB

# Check for correct versions

if {$tk_version < 4.2} {
	wm withdraw .
	if {[catch {tk_dialog .err "Wrong version" "Requires Tcl7.6/Tk4.2 or \
		later, both available from http://playground.sun.com/psh/" \
		error 0 "I'll go get it!"}]} {
		puts stderr "Apparently the Tk library isn't installed \
			properly. Requires Tcl7.6/Tk4.2 or later, both \
			available from http://playground.sun.com/psh/"
		exit
	} else {
		exit
	}
}

catch {tk_dialog}
if {[info command tk_dialog] == {}} {
	puts stderr "Couldn't find Tk libraries. Exiting."
	exit
}

if {[info exists PSH_TCLLIB]} {
	set baseDir $PSH_TCLLIB
} else {
	puts stderr "Couldn't set some config parameters, still trying to run"
}

# Configuration

wm geometry . {}
wm minsize . 50 50
tk appname pbuild
wm title . "Packet Shell GUI Builder"

# Load in all of the procedures
Source pbuild/pbuild.ui.tcl
Source pbuild/pbuild_1.ui.tcl
Source pbuild/pbuild_2.ui.tcl
Source pbuild/pbuild_3.ui.tcl
Source pbuild/pbuild_4.ui.tcl

pbuild_ui .
pbuild_3_ui [toplevel .output]
wm title .output "Output Window"

catch {
	foreach i [pinfo pshpackets] {
		$base.listbox#1 insert end $i
	}
}

bind $base.listbox#1 <Button-1> {selectPacket %W %y}
bind $base.listbox#2 <Button-1> {selectProtocol %W %y} 
bind $base.listbox#3 <Button-1> {selectField %W %y}

}

# Allow pbuild to be run "stand-alone" for testing

catch {
	if {$argv0 == [info script]} {
		pbuild
	}
}
