# SpecTcl, by S. A. Uhler and Ken Corey
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
#
# See the file "license.txt" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# experimental version for generating java code

# compile a jui into a java program
#  file:  the unix file containing the ui description
#  out:	  The file to write the tk program to (defaults to stdout)
#  prefix: The procedure prefix
#  run:	  Invoke the generated procedure (not used)

set Boiler {
public static void main(String[] args) {
    %1$s win = new %1$s();
    win.setTitle("%1$s Test");
    win.addWindowListener(
       new WindowAdapter()
       {
             public void windowClosing(WindowEvent e)
             {
                 System.exit(0);
             }
        }
    );
    win.init();
    win.pack();
    win.setVisible(true);
}

private void reset(GridBagConstraints con) {
    con.gridx = GridBagConstraints.RELATIVE;
    con.gridy = GridBagConstraints.RELATIVE;
    con.gridwidth = 1;
    con.gridheight = 1;
 
    con.weightx = 0;
    con.weighty = 0;
    con.anchor = GridBagConstraints.CENTER;
    con.fill = GridBagConstraints.NONE;
 
    con.insets = new Insets(0, 0, 0, 0);
    con.ipadx = 0;
    con.ipady = 0;
}
}

array set Javamap {
	label		JLabel
	entry		JTextField
	text		JTextArea
	button		JButton
	scrollbar 	JScrollBar
	scale		JSlider
	message		JDialog
	frame		JPanel
	checkbutton	JCheckBox
	radiobutton	JRadioButton
    	menubutton  	JComboBox
	listbox 	JList
	canvas 		Canvas
	menu		JMenu
}
	
# Value is the
array set Javamap {
	label.text		$var.setText("$value");
	label.justify		{[do_justify $var $value]}
	entry.text		$var.setText("$value");	
	checkbutton.text 	$var.setText("$value");
	radiobutton.text 	$var.setText("$value");
	entry.width		$var.setColumns($value);
	button.text		$var.setText("$value");
    	menubutton.text 	{[choice_text $var $value]}
        *.bitmap	        {[do_icon $var $value]}
        *.image            	{[do_image_icon $var $value]}
	*.font			{$var.setFont([jfont $value]);}
	*.state			{[do_state $var $value]}
	*.help			{[do_help $var $value]}
	*.foreground		{$var.setForeground([jcolor $value]);}
	*.background		{$var.setBackground([jcolor $value]);}
	*.editable		{[do_editable $var $value]}
	*.comments		{[do_comments $value]}
}
# This used to be a part of Javamap, but what's it supposed
# to do?
#	entry.width		[entry_width]

array set Javaanchormap {
    sticky:nw   NORTHWEST
    sticky:n    NORTH
    sticky:ne   NORTHEAST
    sticky:new  NORTH
    sticky:w    WEST
    sticky:c    CENTER
    sticky:     CENTER
    sticky:e    EAST
    sticky:ew   CENTER
    sticky:sw   SOUTHWEST
    sticky:s    SOUTH
    sticky:es   SOUTHEAST
    sticky:esw  SOUTH
    sticky:nsw  WEST
    sticky:ns   CENTER
    sticky:nes  EAST
    sticky:nesw CENTER
}
array set Javafillmap {
    sticky:nw   NONE
    sticky:n    NONE
    sticky:ne   NONE
    sticky:new  HORIZONTAL
    sticky:w    NONE
    sticky:c    NONE
    sticky:     NONE
    sticky:e    NONE
    sticky:ew   HORIZONTAL
    sticky:sw   NONE
    sticky:s    NONE
    sticky:es   NONE
    sticky:esw  HORIZONTAL
    sticky:nsw  VERTICAL
    sticky:ns   VERTICAL
    sticky:nes  VERTICAL
    sticky:nesw BOTH
}

# set up some java specific preferences

set P(extends) JFrame
set P(implements) ActionListener

proc compile_jui {file {out ""} {prefix ""} {run ""}} {
	global Widget_data Format Masters Version Javamap Javaanchormap Javafillmap Boiler P
	global CB_Groups
	catch "unset CB_Groups"
	global CB_MenuBar
	catch "unset CB_MenuBar"
	set Id "WidGet file"
	catch "unset Masters"
	array set map {row height column width}
	set widget_names ""

	if {![file readable $file]} {
		set msg "$file does not exist, can't compile it."
		tk_dialog .open "Compile error" $msg "error" 0 OK
		return 1
	}
	set fd [open "$file" r]

	set line ""
	gets $fd line
	if {[string first $Id $line] != 0} {
		set msg "$file is not a UI file"
		tk_dialog .open "Open Error" $msg "error" 0 OK
		close $fd
		return 1
	}

	set out_fd [Jopen_out $out]
	if {$out_fd == ""} {
	    return 1
	}

	# Gather up all of the data for each widget.
	# Put it in the arrays __X_$name, generally used
	# under the alias "data"

	while {1} {
		gets $fd line
		if {[eof $fd]} break

		# gather entire line

		while {![info complete $line]} {
			append line "\n[gets $fd]"
			# puts stderr gulp
			}
		if {[string first Widget $line] == 0} {
			set name [lindex $line 1]
			lappend names $name
			upvar #0 __X_$name data
			# Set default attributes
			set data(geometry,fill) none
			set data(geometry,anchor) c
		    set data(geometry,sticky) c
		} else {
			set index -1
			foreach i {type option value} {
				set $i [lindex $line [incr index]]
			}

			if {$option == "master"} {
				set Masters([string trimleft [expr {$value=="" ? "f" : $value}] .]) 1
			}
			set data($type,$option) $value
		}
	}
	close $fd

	########################################################
	# end of pass 1

	# Prefix is the name of the project (and Applet class)
	if {$prefix == ""} {
		set prefix [file root [file tail $file]]
	}

	# Sort names:
	set names [lsort -command "frames_first" $names]

	# Rename all user-level item_names to use _ not #
	foreach name $names {
		upvar #0 __X_$name data
		regsub # $data(other,item_name) _ data(other,item_name)
	}
		

	############################################################
	# Output the info as Java code:
	#
	# $names is a list of all the internal names of the widgets
	# "f" is the top-level container.
	#
	# $data($type, $option) = $value for each specified
	# attribute of each element of the form, where "data"
	# is upleveled (one array for each widget)
	############################################################

	# Initial boilerplate and class declaration:
	puts $out_fd "// SpecTcl generated class $prefix, version $P(Version)\n"
	if {[info exists P(package)]} {
		if {![regexp $P(package) {^[ 	]*$}]} {
			puts $out_fd "package $P(package);"
		}
	}
	puts $out_fd "import java.awt.*;"
	puts $out_fd "import java.awt.event.*;"
	puts $out_fd "import javax.swing.*;"
	puts $out_fd "import javax.swing.event.*;"
	
	if {[info exists P(imports)]} {
		foreach import $P(imports) {
			puts $out_fd "import $import;"
		}
	}
	if {[info exists P(implements)]} {
		if {![regexp $P(implements) {^[ 	]*$}]} {
			set imp "implements $P(implements) "
		}
	}
	append imp {}

	puts $out_fd ""
	puts $out_fd "public class $prefix extends $P(extends) $imp\{		\n"

	# make a "client data" slot
	puts $out_fd "// a slot to hold an arbitrary object pointer that can"
	puts $out_fd "// be filled in by the app. and referenced in actions"

	set arg Object
	if {[info exists P(arg)]} {
		if {![regexp $P(arg) {^[ 	]*$}]} {
			set arg $P(arg)
		}
	}
	puts $out_fd "private $arg arg;\n"

	# Declare an instance variable for each widget:
	foreach name $names {
		upvar #0 __X_$name data
		if {$name == "f" } continue

		set var $data(other,item_name)
		set type $data(other,type)

		# allow user's to use subclass of awt widgets
		# look for:
		#   SubClass
		#   SubClass.init_method(args)

		set data(call) ""
		if {$data(other,subclass) != ""} {
			regexp {([^. ]+)(\.(.*))?} $data(other,subclass) x \
				data(actual) x data(call)
		} else {
			set data(actual) $Javamap($type)
		}
		catch {puts $out_fd "private $data(actual) $var;"}
		if {$type == "radiobutton"} {
			set group default_group
			catch {set group $data(configure,variable)}
			if {![info exists CB_Groups($group)]} {
				set CB_Groups($group) 1
				puts $out_fd "private ButtonGroup $group = new ButtonGroup();"
				append widget_names \"$group\",
			}
		}
		if {$type == "menu"} {
			set menubar defaultMenuBar
			catch {set group $data(configure,variable)}
			foreach {item options} $data(other,gadgets) {
                                set menu_name ""
                                foreach {option val} $options {
                                        if {"$option" == "-label"} {
                                                set menu_name [list $val]
                                                #delete all white space
                                                regsub -all " " $menu_name "" menu_name
                                                regsub -all "\'" $menu_name "" menu_name
                                                set menu_name [lindex $menu_name 0]
                                                set menu_name menuItm$menu_name
						puts $out_fd "private JMenuItem $menu_name;"			
                                                append widget_names \"$menu_name\",
					}
				}
			}
			if {![info exists CB_MenuBar($menubar)]} {
				set CB_MenuBar($menubar) 1
				puts $out_fd "private JMenuBar $menubar = new JMenuBar();"
				append widget_names \"$menubar\",
			}
		}
		append widget_names \"$var\",
		set name_map($var) $name
	}

	# make lists of widget pointers and names available to apps

	puts $out_fd "\n//methods to support form introspection"
	puts $out_fd "private static String names\[] = \{\n\t$widget_names\n\};"
	puts $out_fd "public String\[] getNames() \{\n\treturn names;\n\}"

	regsub -all {"} $widget_names {} widget_names
	regsub {,$} $widget_names {} widget_names
	set list [split $widget_names ,]
	puts $out_fd "\n//There should be an easier way to do this"
	puts $out_fd "public Object\[] getWidgets() \{\n\tObject\[] list = new Object\[[llength $list]];"
	set count -1
	foreach i $list {
		puts $out_fd "\tlist\[[incr count]] = $i;"
	}
	puts $out_fd "\treturn list;\n\}"

	# pass through application specific behvior

	if {[info exists P(export)]} {
		puts $out_fd "\n// Application specific widget data"
		foreach export $P(export) {
			puts $out_fd "private static String ${export}_private\[] = \{"
			set value ""
			foreach name $list {
				catch {upvar #0 __X_$name_map($name) data}
				if {![info exists data]} {
					append value "null, "
				} elseif {[info exists data(other,$export)]} {
					append value "\"$data(other,$export)\", "
				} else {
					append value "null, "
				}
			}
			puts $out_fd "\t$value\n\};"
			puts $out_fd "public String\[] ${export}() \{"
			puts $out_fd "\treturn ${export}_private;"
			puts $out_fd "\}\n"
		}
	}
	# More boilerplate
	puts $out_fd "\npublic void init() \{"

	# Now code to create the widgets
	set count -1
	foreach name $names {
		upvar #0 __X_$name data

		if {$name == "f" } {
			puts $out_fd "\n\t// main panel"
			puts $out_fd "	GridBagLayout grid = new GridBagLayout();"
			out_constraints f {} $out_fd
			continue
		}

		# Type is the widget type (not converted to Java)
		set type $data(other,type)
		if {![info exists Javamap($type)]} {
			puts stderr "No mapping for widget $data(other,type)"
			continue
		}

		# Var is the user variable name
		set var $data(other,item_name)

		if {[info exists data(other,min_row)]} {
			puts $out_fd "\n\t// container $var in [Jreal_master $name]"
			puts $out_fd "	GridBagLayout ${var}_grid = new GridBagLayout();"
			out_constraints $name ${var}_ $out_fd
		}

		# Generate special case initialization code.
		puts $out_fd ""
		if {$type == "entry"} {
			set width 20
			catch {set width $data(configure,width)}
			if {[info exists data(configure,show)]} {
				if {$data(configure,show)=="false"} {
					puts $out_fd "\t$var = new JPasswordField($width);"
				} else {
					puts $out_fd "\t$var = new JTextField($width);"
				}
			} else {
				puts $out_fd "\t$var = new JTextField($width);"
			}
			puts $out_fd "\t$var.addActionListener(this);"

		} elseif {$type == "scrollbar"} {
			set orient VERTICAL
			catch {
				if {[string match "h*" $data(configure,orient)]} {
					set orient HORIZONTAL
				}
			}
			puts $out_fd "\t$var = new JScrollBar(JScrollBar.$orient);"

		} elseif {$type == "message"} {
			puts $out_fd "\tJOptionPane.showMessageDialog(this,\"$data(configure,text)\");"

		} elseif {$type == "scale"} {
			set orient VERTICAL
			catch {
				if {[string match "h*" $data(configure,orient)]} {
					set orient HORIZONTAL
				}
			}

			if {![info exists data(configure,from)]} {
				#set to default if not configured
				set from 0
			} else {
				set from $data(configure,from)
			}

			if {![info exists data(configure,bigincrement)]} {
				#set to default if not configured
				set init_setting $from
			} else {
				set init_setting $data(configure,bigincrement)
			}
			
			if {![info exists data(configure,to)]} {
				#set to default if not configured
				set to 100
			} else {
				set to $data(configure,to)
			}
			
			puts $out_fd "\t$var = new JSlider(JSlider.$orient,(int)$from,(int)$to, (int)$init_setting);"
			puts $out_fd "\t$var.setMajorTickSpacing(10);"
			puts $out_fd "\t$var.setMinorTickSpacing(1);"
			puts $out_fd "\t$var.setPaintTicks(true);"
			puts $out_fd "\t$var.setPaintLabels(true);"
			puts $out_fd "\t$var.setBorder(BorderFactory.createEmptyBorder(0,0,10,0));"			

		} elseif {$type == "text"} {
			set rows 5; set cols 20 ; set scroll "Scroller"
			catch {set rows $data(configure,height)}
			catch {set cols $data(configure,width)}
			puts $out_fd "\t$var = new JTextArea($rows,$cols);"
			puts $out_fd "\tJScrollPane $var$scroll = new JScrollPane($var);" 
		} elseif {$type == "listbox"} {
			set rows 4; set multi false ; set scroll "Scroller"
			catch {set rows $data(configure,height)}
			catch {set multi [expr { \
					$data(configure,selectmode) == "multiple" ? "true" : "false"}]}
			if {$rows == 0} {set rows 4}
			puts $out_fd "\t$var = new JList();"
			puts $out_fd "\t$var.setVisibleRowCount($rows);"
			if {$multi == "true"} {
				set multi "true"
				puts $out_fd "\t$var.setSelectionMode(ListSelectionModel.MULTIPLE_INTERVAL_SELECTION);"					
			} else {
				puts $out_fd "\t$var.setSelectionMode(ListSelectionModel.SINGLE_SELECTION);"	
			}
			puts $out_fd "\tJScrollPane $var$scroll = new JScrollPane($var);"			

		} elseif {$type == "menubutton" } {
			puts $out_fd "\t$var = new $data(actual)();"
			if {$data(other,items) != ""} {				
				foreach i [split $data(other,items) ,] {
					puts $out_fd "\t$var.addItem(\"$i\");"
				}
			}
			puts $out_fd "\t$var.addActionListener(this);"
		 } elseif {$type == "menu" } {
                        puts $out_fd "\t$var = new JMenu(\"$var\");"
			#puts $out_fd "\t$var.addActionListener(this);"
                        foreach {item options} $data(other,gadgets) {
				#puts $out_fd "\tItem is now $item and other gadgets $data(other,gadgets)"
				# $item is what to check ie command is menuitem seperator is separator etc
				#puts $out_fd "\tOptions are now set to $options"
                                if {$options == ""} {
					puts $out_fd "\t$var.addSeparator();"
				}
				set accelerator ""
				set menu_name ""
				set background_colour ""
				set menu_bitmap ""
				set menu_image ""
				set foreground_colour ""
				#set active_background_colour ""
				#set active_foreground_colour ""				
				set menu_font ""
				set menu_icon_bitmap ""
				set action_menu ""
				foreach {option val} $options {
                                        if {"$option" == "-label"} {
						#example of Option is -label ie the options for this menu or menu item
						#puts $out_fd "\tOption $option and value $val"
						set menu_name [list $val]
						set menu_label [list $val]
						set menu_label [lindex $menu_label 0]									
						#delete all white space
						regsub -all " " $menu_name "" menu_name 
						regsub -all "\'" $menu_name "" menu_name 
						set menu_name [lindex $menu_name 0]			
						set menu_name menuItm$menu_name
						append widget_names \"$menu_name\",   
                                                puts $out_fd "\t$menu_name = new JMenuItem(\"$menu_label\");"						
                                        }
                                        if {"$option" == "-accelerator"} {
						set accelerator [list $val]
                                        }					
                                        if {"$option" == "-bitmap"} {
						set menu_bitmap [list $val]
                                        }					
                                        if {"$option" == "-image"} {
						set menu_image [list $val]
                                        }					
                                        if {"$option" == "-background"} {
						set background_colour [list $val]
                                        }					
                                        if {"$option" == "-foreground"} {
						set foreground_colour [list $val]
                                        }					
                                        #if {"$option" == "-activebackground"} {
					#	set active_background_colour [list $val]
                                        #}					
                                        #if {"$option" == "-activeforeground"} {
					#	set active_foreground_colour [list $val]
                                        #}					
                                        if {"$option" == "-bitmap"} {
						set menu_icon_bitmap [list $val]
                                        }					
                                        if {"$option" == "-command"} {
						set action_menu [list $val]
                                        }	
                                        if {"$option" == "-font"} {
						set menu_font [list $val]
                                        }	
                                }
				
				if {"$menu_name" != ""} {
					if {"$accelerator" != ""} {					
						puts $out_fd "\t$menu_name.setMnemonic(\'$accelerator\');"
					}
					if {"$menu_image" != ""} {					
						puts $out_fd \t[do_image_icon $menu_name $menu_image]
					}
					if {"$menu_bitmap" != ""} {					
						puts $out_fd \t[do_icon $menu_name $menu_bitmap]
					}
					if {"$background_colour" != ""} {					
						puts $out_fd "\t$menu_name.setBackground([jcolor $background_colour]);"
					}
					if {"$foreground_colour" != ""} {					
						puts $out_fd "\t$menu_name.setForeground([jcolor $foreground_colour]);"
					}
					#this functionality can not be acheived because selecting a menu item does
					#not allow it's color to be changed.  :(
					#if {"$active_background_colour" !="" || $active_foreground_colour != ""} {
					#	puts $out_fd "\t$menu_name.ChangeListener("
					#	puts $out_fd "\t\tnew ChangeListener() {"
					#	puts $out_fd "\t\t\tpublic void stateChanged( ChangeEvent e )"
					#	puts $out_fd "\t\t\t{"
					#	puts $out_fd "\t\t\t\tif ($menu_name.isArmed() )"
					#	puts $out_fd "\t\t\t\t{"
					#	if {$active_background_colour != ""} {	
					#		puts $out_fd "\t\t\t\t\t$menu_name.setBackground([jcolor $active_background_colour]);"
					#	}
					#	if {$active_foreground_colour != ""} {	
					#		puts $out_fd "\t\t\t\t\t$menu_name.setForeground([jcolor $active_foreground_colour]);"
					#	}						
					#	puts $out_fd "\t\t\t\t}"
					#	puts $out_fd "\t\t\t\telse"
					#	puts $out_fd "\t\t\t\t{"
					#	puts $out_fd "\t\t\t\t\t$menu_name.setBackground(Color.gray);"
					#	puts $out_fd "\t\t\t\t\t$menu_name.setForeground(Color.black);"
					#	puts $out_fd "\t\t\t\t}"
					#	puts $out_fd "\t\t\t}"
					#	puts $out_fd "\t\t}"
					#	puts $out_fd "\t);"
					#}
					if {"$menu_font" != ""} {		
						puts $out_fd "\t$menu_name.setFont([jmenufont $menu_font]);"
					}
					if {"$menu_icon_bitmap" != ""} {					
						puts $out_fd "\t[do_icon $menu_name $menu_icon_bitmap]"
					}
                                        puts $out_fd "\t$menu_name.addActionListener(this);"
                                        puts $out_fd "\t$var.add($menu_name);"
				}
                        }
			puts $out_fd "\t$menubar.add($var);"			
		} elseif {$type == "checkbutton" } {			
			puts $out_fd "\t$var = new JCheckBox();"
			
		} elseif {$type == "radiobutton" } {			
			puts $out_fd "\t$var = new JRadioButton();"
			puts $out_fd "\t$data(configure,variable).add($var);"					
		} elseif {$type =="button"} {
			puts $out_fd "\t$var = new $data(actual)();"
			puts $out_fd "\t$var.addActionListener(this);"			
		} else {
			puts $out_fd "\t$var = new $data(actual)();"
		}

		# do any sub-class initialization
		if {$data(call) != ""} {
			puts $out_fd "\t$var.$data(call);	// $data(actual) initialization"
		}

		# Set all specified "configure" options:
		set options [lsort [array names data configure,*]]
		append options  " " [lsort [array names data other,*]]
		set font ""
		foreach option $options {
			regsub configure, $option {} param
			regsub other, $param {} param
			set value $data($option)
			if {[info exists Javamap($type.$param)]} {
				set result [subst $Javamap($type.$param)]
				if {$result != {}} {
					puts $out_fd "\t$result"
				}
			} elseif {[info exists Javamap(*.$param)]} {
				set result [subst $Javamap(*.$param)]
				if {$result != {}} {
					puts $out_fd "\t$result"
				}
			}
			# puts "+++ ($option) $type.$param ($value) <$m1> <$m2>"
		}
		if {$type == "listbox" || $type == "text"} {
			#set type "listbox"
			if {[Jreal_master $name]=="this."} {
				puts $out_fd "	[Jreal_master $name]getContentPane().add($var$scroll);"			
			} else {
				puts $out_fd "	[Jreal_master $name]add($var$scroll);"	
			} 
		} elseif {$type == "menu"} {
			puts $out_fd "\tsetJMenuBar($menubar);"
			#puts $out_fd "	[Jreal_master $name]getContentPane().add($menubar);"								
		} elseif {$type != "frame" && $type != "message"} {
			set orange 0
			if {[Jreal_master $name]=="this."} {
				puts $out_fd "	[Jreal_master $name]getContentPane().add($var);"		
			} else {
				puts $out_fd "	[Jreal_master $name]add($var);"
			} 
			
		}
		# puts $out_fd "\twidgets\[[incr count]] = $var;\n"
                if {[info exists P(java_include_comments)] && $P(java_include_comments) != 0} {
                    puts $out_fd "\t$data(other,comments)"
                } 
	}
	#Add the frames last.
        foreach name $names {
                upvar #0 __X_$name data
                if {$name == "f" } continue
                set type $data(other,type)
                set var $data(other,item_name)
                if {$type == "frame"} {
                        puts $out_fd "\t[Jreal_master  $name]getContentPane().add($var);"
                }
        }

	# Create the geometry management commands:
	puts $out_fd "\n\t// Geometry management"
	puts $out_fd "	GridBagConstraints con = new GridBagConstraints();"
	foreach name $names {
		upvar #0 __X_$name data
		if {$name == "f" } continue

		set type $data(other,type)
		set var $data(other,item_name)		

		#don't set the geometry for menus or messages
                if {$type == "menu" || $type == "message"} continue
		
		puts  $out_fd "\treset(con);"
		puts  $out_fd "\tcon.gridx = $data(geometry,column);"
		puts  $out_fd "\tcon.gridy = $data(geometry,row);"
		catch {puts  $out_fd "\tcon.ipadx = $data(geometry,ipadx);"}
		catch {puts  $out_fd "\tcon.ipady = $data(geometry,ipady);"}
		catch {puts $out_fd "\tcon.gridwidth = $data(geometry,columnspan);"}
		catch {puts $out_fd "\tcon.gridheight = $data(geometry,rowspan);"}
		
		set t 0; set l 0
		catch {set t $data(geometry,pady)}
		catch {set l $data(geometry,padx)}
		if {$t || $l} {
			puts $out_fd "\tcon.insets = new Insets($t, $l, $t, $l);"
		}
		puts  $out_fd "\tcon.anchor = GridBagConstraints.$Javaanchormap(sticky:$data(geometry,sticky));"
		puts  $out_fd "\tcon.fill = GridBagConstraints.$Javafillmap(sticky:$data(geometry,sticky));"

		# FIX THIS
		if {$type == "listbox" || $type == "text"} {
			#set type "listbox"
			puts $out_fd "\t[Jreal_master2 $name]grid.setConstraints($var$scroll, con);"			
		} else {
			puts  $out_fd "\t[Jreal_master2 $name]grid.setConstraints($var, con);"
		}
		puts  $out_fd ""
	}

	# Now for the resize behavior.  This is only run for geometry masters.
	puts $out_fd "\n\t// Resize behavior management and parent heirarchy"
	foreach name [array names Masters] {
		upvar #0 __X_$name data

		if {$name == "f" } {set uname "this."; set vname ""} else {
		    set uname $data(other,item_name).
		    set vname $data(other,item_name)_
		}
		if {${uname}=="this."} {
			puts $out_fd "\t${uname}getContentPane().setLayout(${vname}grid);"	
		} else {
			puts $out_fd "\t${uname}setLayout(${vname}grid);"
		}
		
		puts $out_fd "\t//Set the Background Color"
		if {${uname}=="this."} {
			puts $out_fd "\t${uname}getContentPane().setBackground([jcolor $P(frame_bg)]);"		
		} else {
			puts $out_fd "\t${uname}setBackground([jcolor $P(frame_bg)]);"
		} 
		
	}
	
	#do some other event handling stuff	
	foreach name $names {
		upvar #0 __X_$name data
		if {$data(other,type)=="scrollbar"} {
			puts $out_fd "\t$data(other,item_name).addAdjustmentListener("
			puts $out_fd "\t\tnew AdjustmentListener() {"
			puts $out_fd "\t\t\tpublic void adjustmentValueChanged( AdjustmentEvent event )"
			puts $out_fd "\t\t\t{"
			if {[info exists data(other,action)]} {
				if {$data(other,action) != ""} {
					puts $out_fd "\t\t\t\t\t$data(other,action)"
				}
			}
			puts $out_fd "\t\t\t}"
			puts $out_fd "\t\t}"
			puts $out_fd "\t);"

		} elseif {$data(other,type)=="listbox"} {
			#time for some JList event handling with an inner class
			puts $out_fd "\t$data(other,item_name).addListSelectionListener("
			puts $out_fd "\t\tnew ListSelectionListener() {"
			puts $out_fd "\t\t\tpublic void valueChanged(ListSelectionEvent event)"
			puts $out_fd "\t\t\t{"
			if {[info exists data(other,action)]} {
				if {$data(other,action) != ""} {
					puts $out_fd "\t\t\t\t\t$data(other,action)"
				}
			}
			puts $out_fd "\t\t\t}"
			puts $out_fd "\t\t}"
			puts $out_fd "\t);"		
		} elseif {$data(other,type)=="checkbutton" || $data(other,type)=="radiobutton"} {
			puts $out_fd "\t$data(other,item_name).addItemListener("
			puts $out_fd "\t\tnew ItemListener() {"
			puts $out_fd "\t\t\tpublic void itemStateChanged( ItemEvent e )"
			puts $out_fd "\t\t\t{"
			puts $out_fd "\t\t\t\tif (e.getStateChange() == ItemEvent.SELECTED )"
			puts $out_fd "\t\t\t\t{"
			if {[info exists data(other,action)]} {
				if {$data(other,action) != ""} {
					puts $out_fd "\t\t\t\t\t$data(other,action)"
				}
			}
			puts $out_fd "\t\t\t\t}"
			puts $out_fd "\t\t\t}"
			puts $out_fd "\t\t}"
			puts $out_fd "\t);"

		} elseif {$data(other,type)=="scale"} {
			puts $out_fd "\t$data(other,item_name).addChangeListener("
			puts $out_fd "\t\tnew ChangeListener() {"
			puts $out_fd "\t\t\tpublic void stateChanged( ChangeEvent e )"
			puts $out_fd "\t\t\t{"
			puts $out_fd "\t\t\t\tJSlider source = (JSlider)e.getSource();"
			puts $out_fd "\t\t\t\tint sliderValue = (int)source.getValue();"
			if {[info exists data(other,action)]} {
				if {$data(other,action) != ""} {
					puts $out_fd "\t\t\t\t$data(other,action)"
				}
			}
			puts $out_fd "\t\t\t}"
			puts $out_fd "\t\t}"
			puts $out_fd "\t);"
		}
	}
	puts $out_fd "\n\t// Give the application a chance to do its initialization"
        set init ""
	catch {set init $P(init)}
	puts $out_fd "\t$init\n\}\n"	
	
	# write the actionPerformed event implementation method for actionEvents
	puts $out_fd "public void actionPerformed(ActionEvent event) \{"

	foreach name $names {
		upvar #0 __X_$name data
		if {$data(other,type)=="button" || $data(other,type)=="entry" || $data(other,type)=="text" || $data(other,type)=="menubutton"} {
			if {[info exists data(other,action)]} {
				if {$data(other,action) != ""} {
					puts $out_fd "\tif (event.getSource() == $data(other,item_name)) \{"
					if {$data(other,type)=="menubutton"} {
						puts $out_fd "\t\tString itemSelected = (String) $data(other,item_name).getSelectedItem();"
					}
					puts $out_fd "\t\t$data(other,action)"
					puts $out_fd "\t\}"
				}
			}
		}
		
		if {$data(other,type)=="menu"} {
                        foreach {item options} $data(other,gadgets) {
				set menu_name ""
                                set command ""
				foreach {option val} $options {
                                        if {"$option" == "-label"} {
                                                #example of Option is -label ie the options for this menu or menu item
                                                #puts $out_fd "\tOption $option and value $val"
                                                set menu_name [list $val]
                                                #delete all white space
                                                regsub -all " " $menu_name "" menu_name
                                                regsub -all "\'" $menu_name "" menu_name
                                                set menu_name [lindex $menu_name 0]
                                                set menu_name menuItm$menu_name
                                        }
                                        if {"$option" == "-command"} {
						set command [list $val]					
					}
                                }
				if {"$command" != ""} {
                                        set command [lindex $command 0]					
					puts $out_fd "\tif (event.getSource() == $menu_name) \{"
					puts $out_fd "\t\t$command"
					puts $out_fd "\t\}"
				}
                        }
		}	
	}


	# temporary escape to quit app.
	#puts $out_fd "\tif (event.id==event.KEY_ACTION && event.key==event.F4 && event.modifiers==event.ALT_MASK) \{  // Alt-F4 always exits"
	#puts $out_fd "\t\tSystem.exit(3);"
	#puts $out_fd "\t\} else"

	# call parent's event handler
	#puts $out_fd "\t\treturn super.handleEvent(event);\n\treturn true;"
	puts $out_fd "\}"

	# read in other methods from an external file

	if {[file readable $prefix.include.java]} {
		set fd [open "$prefix.include.java" r]
		set code [read $fd]
		close $fd
		puts $out_fd "\n// code sourced from $prefix.include.java"
		puts $out_fd $code
	}

	# Put out final boilerplate to end the "init" function
	# and the class:

	puts $out_fd [format $Boiler $prefix]
	puts $out_fd \}

	# Close any opened file.
	if {$out_fd != "stdout"} {
		close $out_fd
	}


	############################################################
	# Write <project_name>Data.java
	############################################################

	# Cleanup global data!!
	foreach i [info globals __X_*] {
		global $i
		unset $i
	}
}


############################################################################
# Utility functions
############################################################################

# Convert SpecTcl to Java fonts

proc jfont {value} {
	set font [split $value ,]
	set family [lindex $font) 0]
	set size [lindex $font 1]
	set style "Font.PLAIN "
	foreach i [lrange $font 2 end] {
		append style "+ Font.[string toupper $i] "
	}
	return "new Font(\"$family\",$style, $size)"
}

proc jmenufont {value} {
	set value [lindex $value 0]
	set font [split $value " "]
	set family [lindex $font) 0]
	set size [lindex $font 1]
	set style "Font.PLAIN "
	foreach i [lrange $font 2 end] {
		append style "+ Font.[string toupper $i] "
	}
	return "new Font(\"$family\",$style, $size)"
}

# convert colors

proc jcolor {value} {
	regsub -all " " "[winfo rgb . $value] " "/256 " new
	return "new Color([join $new ,])"
}

# figure out the resize behavior

proc get_resize {list} {
	set index 0
	set result ""
	foreach i $list {
		if {[lindex "x $list" [incr index]] > 1} {
			lappend result $index
		}
	}
	return $result
}

# Sort the widgets to generate the proper stacking order
# * Create all the frames first.  Make sure all outer frames are 
#   created before the inner ones
# * Create all widgets in the specified tabbing order.  If the tab order is the
#   same, then use row/col order based on the coordinates of the containing
#   table cell

# This version depends upon the running state of SpecTcl, and needs to be
# re-written to permit the compiler to be invoked as a separate app

proc frames_first {name1 name2} {
	upvar #0 __X_$name1 data1 __X_$name2 data2
	dputs "compare $name1 $name2"

	# both frames
	if {$data1(other,type) == "frame" && $data2(other,type) == "frame"} {
		dputs "  frames: $data2(other,level) - $data1(other,level)"
		return [expr $data1(other,level) - $data2(other,level)]
	}

	# 1 frame, 1 widget
	if {$data1(other,type) == "frame"} {
		return -1
	} elseif {$data2(other,type) == "frame"} {
		return 1
	}
 	
	# menus, widgets 
        if {$data1(other,type) == "menu"} {
                return -1
        } elseif {$data2(other,type) == "menu"} {
                return 1
        }

	# sort by explicit tabbing order field
	if {[set result [string compare $data1(other,tabbing) $data2(other,tabbing)]] != 0} {
		dputs "  order $result"
		return $result
	}

	# compute order based on cell coords

	set c1 [list $data1(geometry,row) $data1(geometry,column)]
	set c2 [list $data2(geometry,row) $data2(geometry,column)]

	foreach index {0 1} {
		set diff [expr [lindex $c1 $index] - [lindex $c2 $index]]
		dputs "  diff ($index) -> $diff"
		if {$diff != 0} {return $diff}
	}
	dputs "   equal??"
	return 0
}


# find the real master of this window, as the user may have changed its name.

proc Jreal_master {name} {
	upvar #0 __X_$name data
	
	if {$name == "f" } {return "this."}
	
	set master [string trimleft $data(other,master) .]
	if {$master == ""} {return "this."}
	if {$master == "f"} {return "this."}
	
	# the name of the master may have been changed!
	upvar #0 __X_$master m
	return $m(other,item_name).
}

proc Jreal_master2 {name} {
	upvar #0 __X_$name data
	
	if {$name == "f" } {return ""}
	
	set master [string trimleft $data(other,master) .]
	if {$master == ""} {return ""}
	if {$master == "f"} {return ""}
	
	# the name of the master may have been changed!
	upvar #0 __X_$master m
	return $m(other,item_name)_
}

proc Jopen_out {out} {
	if {$out == ""} {
	    return stdout
	} elseif {[catch {open "$out" w} out_fd]} {
	    tk_dialog .save "save error" $out_fd error 0 OK
	    return ""
	} else {
	    return $out_fd
	}
}	

proc out_constraints {frame prefix fd} {
		upvar #0 __X_$frame data

		puts -nonewline $fd "\tint ${prefix}rowHeights\[] = \{"
		puts $fd "0,[join $data(other,min_row) ,]\};"

		puts -nonewline $fd "\tint ${prefix}columnWidths\[] = \{"
		puts $fd "0,[join $data(other,min_column) ,]\};"

		foreach i {row column} {
			set weight $data(other,resize_$i)
			regsub -all {[01]} $weight 0.0 weight
			regsub -all {[23]} $weight 1.0 weight
			puts -nonewline $fd "\tdouble ${prefix}${i}Weights\[] = \{"
			puts $fd "0.0,[join $weight ,]\};"
		}

        puts $fd "\t${prefix}grid.rowHeights = ${prefix}rowHeights;"
        puts $fd "\t${prefix}grid.columnWidths = ${prefix}columnWidths;"
        puts $fd "\t${prefix}grid.rowWeights = ${prefix}rowWeights;"
        puts $fd "\t${prefix}grid.columnWeights = ${prefix}columnWeights;"
}

proc choice_text {var value} {
	if {$value == ""} {
		return {}
	} else {
		#place the name of the combo box in the top index.
		return $var.insertItemAt("$value",0)\;\n\t$var.setSelectedIndex(0)\;
	}
}

proc do_justify {var value} {
    switch -- $value {
    	left {
		return $var.setHorizontalAlignment(SwingConstants.LEFT)\;
	}
	right {
		return $var.setHorizontalAlignment(SwingConstants.RIGHT)\;
	}
	center {
		return $var.setHorizontalAlignment(SwingConstants.CENTER)\;
	}
	default {
		return {}
	}
   }
}

proc do_state {var value} {
    switch -- $value {
    	active {
		return $var.setSelected(true)\;
	} 
        normal {
		return $var.setEnabled(true)\;
	}
	disabled {
		return $var.setEnabled(false)\;
	}
	default {
		return {}
	}
    }
}


proc do_help {var value} {
	if {$value == ""} {
	    return {}
	} else {
	    return $var.setToolTipText("$value")\;
	}
}

#if {$value == "question" || $value=="grey25" || $value=="grey50" || $value=="info{

proc do_icon {var value} {
	set image_type ".gif"

	if {$value == ""} {
	    return {}
	} else {
	    return $var.setIcon(new\ ImageIcon("/usr/share/SpecTcl/images/$value$image_type"))\;
	}
}

proc do_image_icon {var value} {
        if {$value == ""} {
            return {}
        } else {
	    return $var.setIcon(new\ ImageIcon("/usr/share/SpecTcl/images/$value"))\;
        }
}



proc do_comments {value} {
	if {$value == ""} {
	    return {}
	} else {
	    return //$value
	}
}

proc do_editable {var value} {
    switch -- $value {
	0     -
	false -
	no {
	    return $var.setEditable(false)\;
	}
	default {
	    return {}
	}
    }
}
