#!/usr/bin/perl -w

# Copyright (C) 2003 by Steve Litt
# Licensed with the GNU General Public License, Version 2
# ABSOLUTELY NO WARRANTY, USE AT YOUR OWN RISK
# See http://www.gnu.org/licenses/gpl.txt


#########################################################
# USAGE:
#    cat emdlfile | /full/directory/path/emdlparser.pl
#
# OUPUT:
#    outputs an entire set of UMENU .mnu files in the current directory
#
# INSTALLATION
#    First install the Node.pm tool, available at:
#      http://www.troubleshooters.com/projects/Node
#    Then untar the Emdl distribution into a directory, edit
#    the EMDL_CONFIG:
# CONFIGURATION:
#    By default, the configuration file, emdl.cnf, is contained
#    in the current directory. That file must
#    contain a line like this:
#       nodedir=/full/directory/path/toTheNodeDotPmProgram
#    
#    If it's impractical to run emdlparser.pl in the directory
#    containing emdlparser.pl (remember, it outputs tens or hundreds
#    of .mnu files), you may either use a shellscript to preserve that
#    filepath after switching away from the starting directory, or you
#    may set the EMDL_CONFIG environment variable to point to the
#    configuration file.
#########################################################

#########################################################
# emdlparser.pl by Steve Litt
# Version 0.7.1 Released 1/7/2008.
# 	Enabled multiletter top level letterstring
# 	with small changed to cbHandleNumbersLettersStrings()
# 	and sub adjustTopMenuNode($)
# Version 0.7.0a Released 7/9/2005 after May 18, 2004
#	Added preliminary icewm menu export
#
# This program is a complete rewrite of the former emdl2mnu.pl.
# The former was a horrendously complex and convoluted
# piece of code that happened to work. Regression testing
# of the new emdlparser.pl program shows that, for a given
# EMDL input, it outputs the same .mnu file set as the old
# emdl2mnu.pl.
#
# The emdlparser.pl program uses the Node.pm tool, and
# like every other program rewritten with Node.pm, it is
# an order of magnitude simpler than the original. As an
# added benefit, this version runs 7 times faster than
# the original
#
# The simplicity of this new program allows a level of 
# maintainability and flexibility impossible with the
# previous program. With this version, creating files
# for IceWm, KDE and other menu systems is fairly easy.
#
# The other benefit of this simplicity is reliability. 
# Although I never found a bug in the old program, because
# of its complexity I believed there were many bugs hiding
# out in the multitude of objects and nested loops. With
# Node.pm debugged to my satisfaction, and with the simplicity
# of this program, I have come to believe that there might
# be few if any bugs in this version.
#
# The future is equally bright. I know how to simplify this
# program even more, and will do so within the next couple
# years.
#########################################################


use strict;


package Callbacks;
sub new()
	{
	my($type) = $_[0];
	my($self) = {};
	bless($self, $type);
	$self->{'errors'} = 0;
	$self->{'warnings'} = 0;
	$self->{'ouf'} = 0;
	return($self);
	}

sub hasOuf($){return defined($_[0]->{'ouf'});}
sub getOuf($){return $_[0]->{'ouf'};}
sub setOuf($$){$_[0]->{'ouf'} = $_[1];}

sub getErrors($){return $_[0]->{'errors'};}
sub setErrors($$){$_[0]->{'errors'} = $_[1];}

sub getWarnings($){return $_[0]->{'warnings'};}
sub setWarnings($$){$_[0]->{'warnings'} = $_[1];}

sub printError
	{
	my($self, $checker) = @_;
	print "ERROR";
	if($checker->hasAttribute('_lineno'))
		{
		print " ON LINE ", $checker->getAttribute('_lineno');
		}
	if($checker->hasAttribute('_error'))
		{
		print ": ", $checker->getAttribute('_error');
		}
	print  "\n";
	}

sub cbdiaErrors($$$)
	{
	my($self, $checker, $level) = @_;
	if($checker->hasAttribute('_error'))
		{
		print "\n\ndiaError: ", $checker->getAttribute('_error'), "\n\n";
		}
	else
		{
		print ".";
		}
	}


sub cbPrintWarnings
	{
	my($self, $checker, $level) = @_;
	unless (defined($checker)) {return -999;}

	if($checker->hasType())
		{
		if($checker->getType() eq 'menu')
			{
			my $exitChoice = 0;
			my %choiceLetters = ();
			my $checker2 = $checker->getFirstChild();
			while(defined($checker2))
				{
				if($checker2->hasAttribute('L'))
					{
					my $letter = $checker2->getAttribute('L');
					if(defined($choiceLetters{$letter}))
						{
						$self->setWarnings($self->getWarnings() + 1);
						print "WARNING";
						if($checker->hasAttribute('_lineno'))
							{
							print " ON LINE ", $checker->getAttribute('_lineno');
							}
						print ": Menu item has multiple choices for letter $letter\n";
						$choiceLetters{$letter} += 1;
						}
					else
						{
						$choiceLetters{$letter} += 1;
						}
					}
				if($checker2->hasValue())
					{
					if($checker2->hasValue())
						{
						if($checker2->getValue() =~ m/^\s*\^/)
							{
							$exitChoice++;
							}
						elsif($checker2->getType() eq 'choice')
							{
							unless($checker2->hasAttribute('C'))
								{
								$self->setWarnings($self->getWarnings() + 1);
								print "WARNING";
								if($checker2->hasAttribute('_lineno'))
									{
									print " ON LINE ", $checker2->getAttribute('_lineno');
									}
								print ": Choice item has no associated command.\n";
								}
							}
						}
					}
				$checker2 = $checker2->getNextSibling();
				}
			if($exitChoice == 0)
				{
				$self->setWarnings($self->getWarnings() + 1);
				print "WARNING";
				if($checker->hasAttribute('_lineno'))
					{
					print " ON LINE ", $checker->getAttribute('_lineno');
					}
				print ": Menu item has no exit choice.\n";
				}
			}
		}
	}

sub cbCheckChoiceForErrors($$$)
	{
	my($self, $checker, $level) = @_;
	unless (defined($checker)) {return -999;}
	if($checker->hasType())
		{
		unless($checker->getType() eq 'choice') {return 0;}
		}
	else
		{
		return 0;
		}

	if(($checker->hasAttribute('L')) && ($checker->hasValue())) {return 0;}

	$self->{'errors'}++;
	my $msg = "Choice is missing ";
	unless($checker->hasAttribute('L'))
		{
		$msg .= "L param,"
		}
	unless($checker->hasValue())
		{
		$msg .= "a value,"
		}
	$msg =~ s/,$/./;
	$checker->setAttribute('_error', $msg);
	$self->printError($checker);
	}



sub cbFinishIceMenu($$$)
	{
	my($self, $checker, $level) = @_;

	return unless (defined($checker));
	return unless ($checker->getType() eq 'menu');
	return unless ($checker->hasFirstChild());
	die "cbFinishIceMenu has no output file\n" unless ($self->hasOuf());

	my $ouf = $self->getOuf();
	for(my $i=0; $i < $level; $i++) {print $ouf "\t";}
	print $ouf "}\n";
	}

sub cbWriteIceMenu($$$)
	{
	my($self, $checker, $level) = @_;

	return unless (defined($checker));
#	return unless (($checker->getType() eq 'menu') ||
#		($checker->getType() eq 'choice') ||
#		($checker->getType() eq 'top'));

	die "cbFinishIceMenu has no output file\n" unless ($self->hasOuf());

	my $ouf = $self->getOuf();


	for(my $i=0; $i < $level; $i++) {print $ouf "\t";}
	if($checker->getType() eq 'choice')
		{
		print  $ouf "prog ";
		
		# PRINT PROGRAM NAME
		print $ouf "\""; 
		print  $ouf $checker->getValue() if $checker->hasValue();
		print  $ouf "\" "; 
		print  $ouf "- ";		#icon name

		# PRINT COMMANDS
		print  $ouf "\"";
		if($checker->hasAttribute('D'))
			{
			print $ouf "cd " . $checker->getAttribute('D') . "; ";
			}
		if($checker->hasAttribute('P'))
			{
			print $ouf "PATH=" . $checker->getAttribute('P') . ":\$PATH; ";
			}
		if($checker->hasAttribute('E'))
			{
			foreach my $envstring (@{$checker->getAttribute('E')})
				{
				print $ouf $envstring . "; ";
				}
			}
		print  $ouf $checker->getAttribute('C') if $checker->hasAttribute('C');
		print  $ouf "\"";
		print $ouf "\n";

		}
	elsif ($checker->getType() eq 'menu')
		{
		print  $ouf "menu ";
		
		# PRINT MENU NAME
		print $ouf "\""; 
		print  $ouf $checker->getAttribute("_menutitle") if $checker->hasAttribute("_menutitle");
		print  $ouf "\" "; 
#		print  $ouf "- ";		#icon name
		print  $ouf "folder {";
		print  $ouf "}" unless $checker->hasFirstChild();
		print $ouf "\n";
		}
	}


sub cbWriteUmenuFiles
	{
	my($self, $checker, $level) = @_;

	unless (defined($checker)) {return -999;}
	unless($checker->getType() eq 'menu') {return -999;}

	my $filename = lc($checker->getAttribute('_letterstring')) . ".mnu";
	# print "$filename\n";


	open(OUF, ">" . $filename) or die "could not open $filename for output\n";

	print OUF "T_" . $checker->getAttribute('_menutitle') . "\n";
	print OUF "#___Menu created by EMDL to UMENU converter\n";
	print OUF "#___Filename=" . $filename . ", EMDL key=" . $checker->getAttribute('_numberstring') . ".\n";


	my $carat = 0;
	my $checker2 = $checker->getFirstChild();
	while(defined($checker2))
		{
		print OUF "\n";
		if($checker2->hasAttribute('L'))
			{
			print OUF "L_" . uc($checker2->getAttribute('L')) . "\n";
			}
		if($checker2->hasValue())
			{
			my $value = $checker2->getValue();
			if($value =~ m/^\s*\^(.*)/)
				{
				$value = $1;
				$carat = 1;
				}
			print OUF "T_" . $value . "\n";
			}
		if($checker2->hasAttribute('C'))
			{
			print OUF "C_" . $checker2->getAttribute('C') . "\n";
			}
		if($checker2->hasValue())
			{
			my $value = $checker2->getValue();
			}
		if($checker2->hasType())
			{
			if($checker2->getType() eq 'menu')
				{
				print OUF "C_~\n";
				}
			}
		if($carat > 0)
			{
			print OUF "C_^\n";
			$carat = -5;
			}
		if($checker2->hasAttribute('D'))
			{
			print OUF "D_" . $checker2->getAttribute('D') . "\n";
			}
		if($checker2->hasAttribute('P'))
			{
			print OUF "P_" . $checker2->getAttribute('P') . "\n";
			}
		if($checker2->hasAttribute('B'))
			{
			print OUF "B_" . $checker2->getAttribute('B') . "\n";
			}
		if($checker2->hasAttribute('S'))
			{
			print OUF "S_" . $checker2->getAttribute('S') . "\n";
			}
		if($checker2->hasAttribute('E'))
			{
			foreach my $envstring (@{$checker2->getAttribute('E')})
				{
				print OUF "E_" . $envstring . "\n";
				}
			}
		$checker2 = $checker2->getNextSibling();
		$carat = 0;
		}
	close(OUF);
	}

sub cbSetChoiceNumbers
	{
	my($self, $checker, $level) = @_;

	unless (defined($checker)) {return -999;}
	unless(($checker->getType() eq 'menu') || ($checker->getType() eq 'top')) {return 1;}

	my $number = 1;

	my $checker2 = $checker->getFirstChild();
	while(defined($checker2))
		{
		$checker2->setAttribute('_choicenumber', $number);
		$number++;
		$checker2 = $checker2->getNextSibling();
		}
	}

sub cbSetLetters
	{
	my($self, $checker, $level) = @_;

	unless (defined($checker)) {return -999;}

	######## DEDUCE THIS CHOICE'S LETTER
	#

	my $line = $checker->getValue();

	if($line =~ m/^_L(.)_(.*)$/)
		{
		$checker->setAttribute('L', $1);
		$checker->setValue($2);
		}
	elsif($line =~ m/^(.*)&(\S)(.*)\s*/)
		{
		$checker->setAttribute('L', $2);
		$checker->setValue($1 . $2 . $3);
		}
	elsif($line =~ m/([A-Z])/)
		{
		$checker->setAttribute('L', $1);
		}
	else
		{
		$line =~ m/^(.)/;
		$checker->setAttribute('L', $1);
		}
	}

sub cbHandleNumbersLettersStrings
	{
	my($self, $checker, $level) = @_;

	unless (defined($checker)) {return -999;}

	######## DEDUCE THIS CHOICE'S MENU STRING
	#
	my $parentLetterString;
	my $parent=$checker->getParent();
	if(defined($parent))
		{
		$parentLetterString = $parent->getAttribute('_letterstring');
		$checker->setAttribute('_letterstring', $parentLetterString . $checker->getAttribute('L'));
		}
	elsif(!defined($checker->getAttribute('_letterstring')))
		{
		$checker->setAttribute('_letterstring', $checker->getAttribute('L'));
		}

	######## DEDUCE THIS CHOICE'S MENU NUMBER
	#
	my $parentNumber = "";
	if(defined($parent))
		{
		$parentNumber = $parent->getAttribute('_numberstring');
		}
	my $choiceNumber;
	if($checker->hasAttribute('_choicenumber'))
		{
		$choiceNumber = $checker->getAttribute('_choicenumber');
		}
	else
		{
		$choiceNumber = 39;
		}
	my($temp) = "00000" . $choiceNumber;
	$temp =~ m/(..)$/;
	$checker->setAttribute('_numberstring', $parentNumber . $1);
	}

sub cbPrintNodes()
	{
	my($self, $checker, $level) = @_;
	$level--;
	if($level >= -50)
		{
		if($checker->hasAttribute('_error'))
			{
			print "\nERROR ERROR ERROR ERROR ERROR ERROR ERROR on next line...\n";
			print "ERROR=" . $checker->getAttribute('_error') . "\n";
			}
		if($checker->hasAttribute('_lineno'))
			{
			print $checker->getAttribute('_lineno');
			}
		my $lev = $level;
		while($lev > 0)
			{
			print "	";   #Tab character
			$lev--;
			}
		print $checker->getType() . " -- " . $checker->getName() . " -- " . $checker->getValue();
		print  "\n";
		my %attribs = $checker->getAttributes();
		foreach my $key (keys(%attribs))
			{
			my $lev = $level+1;
			while($lev > 0)
				{
				print "	";   #Tab character
				$lev--;
				}
			print "Attrib: $key<-->" . $attribs{$key} . "\n";

			}
		}
	}

sub cbTypeCheck
	{
	my($self, $checker, $level) = @_;

	unless (defined($checker)) {return -999;}

	my $daddy;
	if($checker->hasParent())
		{
		$daddy = $checker->getParent()->getType();
		}
	else
		{
		$daddy = 'undefined';
		}

	my $value = $checker->getValue();
	if($value =~ m/^\t*params?\s*$/i)
		{
		$checker->setType('parameterhead');
		unless ($daddy eq 'choice')
			{
			$self->{'errors'}++;
			$checker->setAttribute('_error', "Parameter head MUST have a choice as a parent");
			$self->printError($checker);
			}
		}
	elsif ($daddy eq 'parameterhead')
		{
		$checker->setType('parameter');
		}
	elsif ($daddy eq 'parameter')
		{
		$checker->setType('junk');
		$self->{'errors'}++;
		$checker->setAttribute('_error', "Parameters cannot have children");
		$self->printError($checker);
		}
	elsif($value =~ m/:::/)
		{
		$checker->setType('menu');
		unless (($daddy eq 'menu') || ($daddy eq 'top'))
			{
			$self->{'errors'}++;
			$checker->setAttribute('_error', "A menu cannot be a child of a " . $daddy . ".");
			$self->printError($checker);
			}
		}
	elsif($daddy eq 'undefined')
		{
		# should just be the top node
		}
	else
		{
		$checker->setType('choice');
		unless (($daddy eq 'menu') || ($daddy eq 'top'))
			{
			$self->{'errors'}++;
			$checker->setAttribute('_error', "A choices parent must be a menu -- not a " . $daddy . ".");
			$self->printError($checker);
			}
		}
	}

sub cbFixMenuAttributes()
	{
	my($self, $checker, $level) = @_;
	unless($checker->getType() eq 'menu') {return 1;}
	my $string = $checker->getValue();
	$string =~ m/(.*)\s*:::\s*(.*)/;
	$checker->setAttribute('_menutitle', $2);
	$checker->setValue($1);
	$checker->setAttribute('T', $1);
	$checker->setAttribute('_level', $level + 1);
	}

sub cbFixChoiceAttributes()
	{
	my($self, $checker, $level) = @_;
	unless($checker->getType() eq 'choice') {return 1;}

	my $paramhead = $checker->getFirstChild();
	my $attribNode;
	if(defined($paramhead))
		{
		$attribNode = $paramhead->getFirstChild();
		}
	while(defined($attribNode))
		{
		my $string = $attribNode->getValue();
		$string =~ m/(.)\s*:\s*(.*)/;
		my $key = $1;
		my $value = $2;
		if($key eq 'C')
			{
			if($checker->hasAttribute('C'))
				{
				$checker->setAttribute('C', $checker->getAttribute('C') . " " . $value);
				}
			else
				{
				$checker->setAttribute('C', $value);
				}
			}
		elsif($key eq 'E')
			{
			unless($checker->hasAttribute('E'))
				{
				$checker->setAttribute('E', [])
				}
			push(@{$checker->getAttribute('E')}, $value);
			}
		else
			{
			$checker->setAttribute($key, $value);
			}
		$attribNode = $attribNode->getNextSibling();
		}
	if(defined($paramhead))
		{
		$paramhead->deleteTree();
		}
	$checker->setAttribute('_level', $level + 1);
	if($checker->hasAttributes())
		{
		my %attribs = $checker->getAttributes();
		my @keys = keys(%attribs);
		foreach my $key (@keys)
			{
			# print "dia318 $key<==>" . $attribs{$key} . "\n";
			}
		}
	}

sub cbPrintNodeInfo()
	{
	my($self, $checker, $level) = @_;
	my $tabstring = "";
	for(my $i = 0; $i < $level; $i++) {$tabstring .= "\t";}
	print "\n\n" . $tabstring . "====================================\n";
	print $tabstring . "Type          =" . $checker->getType() . "\n";
	print $tabstring . "Name          =" . $checker->getName() . "\n";
	print $tabstring . "Value         =" . $checker->getValue() . "\n";
	print $tabstring . "Line          =";
	if($checker->hasAttribute('_lineno'))
		{
		print $checker->getAttribute('_lineno')
		}
	print  "\n";

	print $tabstring . "Level         =";
	if($checker->hasAttribute('_level'))
		{
		print $checker->getAttribute('_level');
		}
	print  "\n";

	print $tabstring . "Numberstring  =";
	if($checker->hasAttribute('_numberstring'))
		{
		print $checker->getAttribute('_numberstring');
		}
	print  "\n";

	print $tabstring . "L             =";
	if($checker->hasAttribute('L'))
		{
		print $checker->getAttribute('L');
		}
	print  "\n";

	print $tabstring . "Menutitle     =";
	if($checker->hasAttribute('_menutitle'))
		{
		print $checker->getAttribute('_menutitle');
		}
	print  "\n";

	print $tabstring . "Letterstring  =";
	if($checker->hasAttribute('_letterstring'))
		{
		print $checker->getAttribute('_letterstring');
		}
	print  "\n";

	print $tabstring . "Error         =";
	if($checker->hasAttribute('_error'))
		{
		print $checker->getAttribute('_error');
		}
	print  "\n";

	unless($checker->hasAttributes())
		{
		print $tabstring . "ERROR: NO DEFINED ATTRIBUTES\n";
		}
	if($checker->hasAttributes())
		{
		my %attribs = $checker->getAttributes();
		my @keys = keys(%attribs);
		foreach my $key (@keys)
			{
			# print "dia283 $key<==>" . $attribs{$key} . "\n";
			}
		}
	print "\n" . $tabstring . "====================================\n\n";
	}

sub cbPrintNodesDiagnostic()
	{
	my($self, $checker, $level) = @_;
	print $level;
	print " : ";
	print $checker->getName();
	print  " : ";
	print $checker->getType();
	print  " : ";
	print $checker->getValue();
	print  "\n";
	}

sub cbZapParams()
	{
	my($self, $checker, $level) = @_;
	my($val) = $checker->getValue();
	$val =~ m/\s*(\S+)/;
	$val = $1;
	if(($val eq "param") or ($val eq "params"))
		{
		$_[1] = $checker->getParent();
		$checker->deleteTree();		
		}
	}

package Main;

# #######################################################################
# The following BEGIN routine imports Node.pm, looking in the usual
# places after looking at any directories identified in umenu.cnf as
# nodedir=value. Multiple nodedir=value lines are prepended in the
# module path, in the order they appear in the conf file.
# #######################################################################
sub loadNodeModule()
	{
	my($conffile) = $ENV{'EMDL_CONFIG'};
	$conffile = "./emdl.cnf" unless defined($conffile);
	print "Seeking config file $conffile.\n";
	my $CONF;
	open $CONF, '<' . $conffile or $CONF = undef;
	if(defined($CONF))
		{
		print "Using config file $conffile.\n";
		my @lines = <$CONF>;
		close $CONF;
		foreach my $line (@lines)
			{
			chomp $line;
			if($line =~ m/^\s*nodedir\s*=\s*([^\s]*)/)
				{
				my $dir = $1;
				if($dir =~ m/(.*)\$HOME(.*)/)
					{
					$dir = $1 . $ENV{'HOME'} . $2;
					}
				push @main::nodedirs, ($dir);
				}
			}
		if(defined(@main::nodedirs))
			{
			unshift @INC, @main::nodedirs;
			}
		}
	require Node;
	import Node;
	}



sub loadNodes()
	{
	my($top) = Node->new("TOP", "Top", "Top Node");
	my($checker) = $top->insertFirstChild(Node->new("CH1", "Chapter","Intro"));
	$checker->setValue("Intro to this edit");
	$checker = $checker->insertSiblingAfterYou(Node->new("CH2", "Chapter","Installation"));
	$checker = $checker->insertFirstChild(Node->new("SEC1", "Section","Installing from the net"));
	$checker = $checker->getParent()->insertSiblingAfterYou(Node->new("CH3", "Chapter","Hellow World"));
	return($top);
	}


sub diaNode($)
	{
	print $_[0]-> getName() . "\n";
	print $_[0]-> getType()  . "\n";
	print $_[0]-> getValue()  . "\n";
	}

sub testJig()
	{
	my $level1 = Node->new("Level1 Node", "level1", "Level one");
	my $level2 = Node->new("Level2 Node", "level2", "Level two");
	$level1->insertFirstChild($level2);
	my $level3 = Node->new("Level3 Node", "level3", "Level three");
	$level2->insertFirstChild($level3);

	my $checker = $level1;
	diaNode($checker);
	$checker = $checker->getFirstChild();
	diaNode($checker);
	$checker = $checker->getFirstChild();
	diaNode($checker);
	}

sub testNodes($)
	{
	my $topNode  = shift;

	my $walker;
	my $callbacks = Callbacks->new();
	$walker = Walker->new($topNode, [\&Callbacks::cbPrintNodeInfo, $callbacks]);
	$walker->walk();
	}


sub makeNodeTree()
	{
	my($parser) = OutlineParser->new();
	$parser->setCommentChar('#');
	$parser->fromStdin();
	$parser->zapBlanks();
	my $topNode = $parser->parse();
	return($topNode);
	}

sub assignTypes($$)
	{
	my $topNode = shift;
	my $callbacks = shift;
	my $walker;
	$walker = Walker->new($topNode, [\&Callbacks::cbTypeCheck, $callbacks]);
	$walker->walk();
#	print "dia errors are " . $callbacks->getErrors() . "\n\n\n";
	}

sub assignAttributes($$)
	{
	my $topNode = shift;
	my $callbacks = shift;
	my $walker;
	$walker = Walker->new($topNode, [\&Callbacks::cbFixChoiceAttributes, $callbacks]);
	$walker->walk();
	}


sub fixMenus($$)
	{
	my $topNode = shift;
	my $callbacks = shift;
	my $walker;
	$walker = Walker->new($topNode, [\&Callbacks::cbFixMenuAttributes, $callbacks]);
	$walker->walk();
	}

sub setLetters($$)
	{
	my $topNode = shift;
	my $callbacks = shift;
	my $walker;
	$walker = Walker->new($topNode, [\&Callbacks::cbSetLetters, $callbacks]);
	$walker->walk();
	}

sub setChoiceNumbers($$)
	{
	my $topNode = shift;
	my $callbacks = shift;
	my $walker;
	$walker = Walker->new($topNode, [\&Callbacks::cbSetChoiceNumbers, $callbacks]);
	$walker->walk();
	}

sub handleNumbersLettersStrings($$)
	{
	my $topNode = shift;
	my $callbacks = shift;
	my $walker;
	$walker = Walker->new($topNode, [\&Callbacks::cbHandleNumbersLettersStrings, $callbacks]);
	$walker->walk();
	}


sub write
	{
	}


sub adjustTopMenuNode($)
	{
	my $topNode = shift;
	my $checker2 = $topNode->getFirstChild();
	my $systemLetter = "";
	my $systemLetterString = "";
	my $systemMenuName = "";
	while(defined($checker2))
		{
		if($checker2->getType() eq 'menu')
			{
			$checker2->getValue() =~ m/\s*(.)/;
			$systemLetter = $1;
			$systemLetterString = $checker2->getValue();
			$systemMenuName = $checker2->getValue();
			last;
			}
		$checker2 = $checker2->getNextSibling();
		}
	if(defined($checker2))
		{
#		$topNode->setType('menu');
		$topNode->setAttribute('_menutitle', $checker2->getAttribute('_menutitle'));
		$topNode->setType($checker2->getType());
		$topNode->setValue($checker2->getValue());
		$topNode->setName('menuroot');
		$topNode->setAttribute('_numberstring', '01');
		$topNode->setAttribute('_choicenumber', '1');
		$topNode->setAttribute('_letterstring', $systemLetterString);
		$topNode->setAttribute('_lineno', $checker2->getAttribute('_lineno'));
		$topNode->setAttribute('_level', $checker2->getAttribute('_level') - 1);
		$checker2->deleteSelf();
		}
	else
		{
		#### THIS IS AN ERROR CONDITION
		}
	}

sub writeUmenuFiles($$)
	{
	my $topNode = shift;
	my $callbacks = shift;
	my $walker;
	$walker = Walker->new($topNode, [\&Callbacks::cbWriteUmenuFiles, $callbacks]);
	$walker->walk();
	}

sub writeIceMenu($$)
	{
	my $topNode = shift;
	my $callbacks = shift;
	my $walker;
	my $filename = "icemenu";
	my $ouf;

	open($ouf, ">" . $filename) or die "could not open $filename for output\n";
	$callbacks->setOuf($ouf);

	$walker = Walker->new($topNode,
		[\&Callbacks::cbWriteIceMenu, $callbacks],
		[\&Callbacks::cbFinishIceMenu, $callbacks]
		);
	$walker->walk();
	close($ouf);
	}

sub checkForErrorsAndWarnings($$)
	{
	my $topNode = shift;
	my $callbacks = shift;
	my $walker;
	$walker = Walker->new($topNode, [\&Callbacks::cbCheckChoiceForErrors, $callbacks]);
	$walker->walk();
	if($callbacks->getErrors() == 0)
		{
		print "There are no errors.\n";
		}
	else
		{
		print "\nERRORS: There are ", $callbacks->getErrors(), " errors.\n\n";
		}
	print "\n";

	$walker = Walker->new($topNode, [\&Callbacks::cbPrintWarnings, $callbacks]);
	$walker->walk();
	print "\n";
	if($callbacks->getWarnings() == 0)
		{
		print "There are no warnings.\n";
		}
	else
		{
		print "Warnings: There are ", $callbacks->getWarnings(), " warnings.\n";
		}
	}

loadNodeModule();
my $topNode = makeNodeTree();

#testNodes($topNode);

$topNode->setType('top');

my $callbacks = Callbacks->new();
assignTypes($topNode, $callbacks);


assignAttributes($topNode, $callbacks);

fixMenus($topNode, $callbacks);

my $topMenuNode = adjustTopMenuNode($topNode);

setChoiceNumbers($topNode, $callbacks);

setLetters($topNode, $callbacks);

handleNumbersLettersStrings($topNode, $callbacks);

# testNodes($topNode);
checkForErrorsAndWarnings($topNode, $callbacks);

my $walker = Walker->new($topNode, [\&Callbacks::cbdiaErrors, $callbacks]);
#$walker->walk();

writeUmenuFiles($topNode, $callbacks);

writeIceMenu($topNode, $callbacks);
