#!/usr/bin/perl
#
# ezml2html
#
# George Ferguson, ferguson@cs.rochester.edu,  2 Oct 2004
# Time-stamp: <Thu Mar 31 11:05:03 EST 2005 ferguson>
#
# Converts a EZML document to an HTML document.
#

#
# Process cmd-line options
#
use Getopt::Long;

# Automatically number section titles (secnum always used for id of tag)
my $number_sections = 1;
# Name of stylesheet to which to link
my $stylesheet = "ezml.css";
# Print help msg and exit
my $help_please = 0;

if (!GetOptions("number-sections!" => \$number_sections,
		"stylesheet:s" => \$stylesheet,
		"help" => \$help_please,
	       ) || $help_please) {
    my $stream = $help_please ? STDOUT : STDERR;
    print $stream <<_EOF_;
usage: ezml2html [--[no]number-sections] [--stylesheet=URL] [files]
_EOF_
    exit($help_please ? 0 : -1);
}

#
# Process file(s)/stdin
#
while (<>) {
    if (/^\/\//) {
	next;
    } elsif (!$preamble) {
	if (/^$/) {
	    $preamble = 1;
	    start_document($title,$author,$date);
	} elsif (!$title) {
	    $title = $_;
	    chomp($title);
	} elsif (!$author) {
	    $author = $_;
	    chomp($author);
	} elsif (!$date) {
	    $date = $_;
	    chomp($date);
	}
    } elsif (/^$/ && !$code) {
	close_lists();
	if ($table) {
	    print "</table>\n";
	    $table = 0;
	}
	print "<p>\n";
    } elsif (/^(\$+)\s*(.*)$/) {
	my $depth = length($1)-1;
	my $title = inline($2);
	my $class = ('sub' x $depth) . 'section';
	# Increment counter for current level
	$secnum[$depth] += 1;
	# Zero counters deeper than this level
	for (my $i=$depth+1; $i <= $#secnum; $i++) {
	    $secnum[$i] = 0;
	}
	# Use counters up to and including this level
	my $label = "";
	for (my $i=0; $i <= $depth; $i++) {
	    $label .= '.' if ($label);
	    $label .= $secnum[$i];
	}
	my $id = "S" . $label;
	if ($number_sections) {
	    print "<h2 class=\"$class\" id=\"$id\">$label $title</h2>";
	} else {
	    print "<h2 class=\"$class\" id=\"$id\">$title</h2>";
	}
    } elsif (/^\[\+$/) {
	print "<pre class=\"code\">\n";
	$sq_bracket = 'code';
    } elsif (/^\[$/) {
	print "<blockquote>\n";
	$sq_bracket = 'quotation';
    } elsif (/^\]$/) {
	if ($sq_bracket eq 'code') {
	    print "</pre>\n";
	} else {
	    print "</blockquote>\n";
	}
    } elsif (/^<\/?([^\s\>]+)/) { # Allow (and ignore) leading slash
	my $tag = $1;
	my $start;
	my $end;
	if ($tag eq 'code') {
	    # Special case to get PRE
	    $start = "<pre class=\"code\">";
	    $end = "</pre>";
	} elsif ($tag eq 'quotation') {
	    # Another special case
	    $start = "<blockquote>";
	    $end = "</blockquote>";
	} elsif ($tag eq 'center') {
	    # Some blocks are in HTML
	    $start = "<$tag>";
	    $end = "</$tag>";
	} else {
	    # Others are handled in the stylesheet
	    my($class,$attrs) = /^<\/?([^\s\>]+)([^\>]*)/;
	    $start = "<div class=\"$class\"$attrs>";
	    $end = "</div>";
	}
	if (!$block{$tag}) {
	    print $start . "\n";
	} else {
	    print $end . "\n";
	}
	$block{$tag} = !$block{$tag};
    } elsif (/^(-+)\s*(.*)$/) {
	my $depth = length($1);
	my $text = inline($2);
	do_list('ul', $depth, $text);
    } elsif (/^(\#+)\s*(.*)$/) {
	my $depth = length($1);
	my $text = inline($2);
	do_list('ol', $depth, $text);
    } elsif (/^=\s*(.*)$/) {
	if (!$table) {
	    my $caption = inline($1);
	    print "<table>\n";
	    print " <caption>$caption</caption>\n";
	    $table = 1;
	    $table_row = 0;
	} else {
	    print "</table>\n";
	    $table = 0;
	}
    } elsif (/^\|/) {
	do_table();
    } elsif ($table) {
	# continuation of table entry...
	do_table();
    } else {
	print inline($_);
    }
}

finish_document();

exit 0;

#
# start_document(TITLE,AUTHOR,DATE): Outputs the HTML header
#
# This includes the link to the stylesheet.
#
sub start_document {
    my($title, $author, $date) = @_;
    print <<_EOF_;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
<!-- Generated by ezml2html by George Ferguson -->
<html>
<head>
<title>$title</title>
<link rel="stylesheet" href="$stylesheet" type="text/css">
</head>
<body>
<h1 class="title">$title</h1>
_EOF_
    if ($author) {
	print "<h1 class=\"author\">$author</h1>\n";
    }
    if ($date) {
	print "<h1 class=\"date\">$date</h1>\n";
    }
    print "<p>\n";
}

#
# finish_document(): Output the HTML trailer.
#
sub finish_document {
    print <<_EOF_;
</body>
</html>
_EOF_
}

#
# inline(STR): Process the inline elements in STR.
#
# Handles escapes with backslashes and elements whose open and close
# elements are on different lines.
# Also snarfles leading backslash, if any, that was used to prevent
# line-start elements from happening.
#
sub inline {
    my($str) = @_;
    my $result = '';
    my $ch = undef;
    for ($i=0; $i < length($str); $i++) {
	$lastch = $ch;
	$ch = substr($str, $i, 1);
	# Escape adds next char to result literally
	if ($ch eq '\\') {
	    $i += 1;
	    $result .= substr($str, $i, 1);
	    # Skip normal processing
	    next;
	}
	# Link hrefs are handled specially
	if ($doing_href && $ch ne ']') {
	    # The href content goes in literally
	    $result .= $ch;
	    # And we save the href for possible later reuse
	    $href_content .= $ch;
	    # Skip normal processing
	    next;
	}
	if ($seen_openbracket && $ch ne '[') {
	    # Saw one open bracket but next is not the second: must be literal
	    $result .= '[';
	    $seen_openbracket = 0;
	    # Continue with normal processing of non-bracket
	}
	# Now we'll process the char normally
	if ($ch eq '<') {
	    $result .= '&lt;';
	} elsif ($ch eq '>') {
	    $result .= '&gt;';
	} elsif ($ch eq '&') {
	    $result .= '&amp;';
	} elsif ($ch eq '*') {
	    $result .= '<' . ($seen_star ? '/' : '') . 'b>';
	    $seen_star = !$seen_star;
	} elsif ($ch eq '_') {
	    $result .= '<' . ($seen_underscore ? '/' : '') . 'em>';
	    $seen_underscore = !$seen_underscore;
	} elsif ($ch eq '+') {
	    $result .= '<' . ($seen_plus ? '/' : '') . 'tt>';
	    $seen_plus = !$seen_plus;
	} elsif ($ch eq '"') {
	    $result .= '<' . ($seen_quote ? '/' : '') . 'q>';
	    $seen_quote = !$seen_quote;
	} elsif ($ch eq '[') {
	    if (!$seen_openbracket) {
		# First open bracket
		$seen_openbracket = 1;
	    } else {
		# Second open bracket
		$result .= "<a href=\"";
		$seen_openbracket = 0;
		# Start link href
		$doing_href = 1;
		$href_content = '';
	    }
	} elsif ($ch eq ']') {
	    if ($doing_href || $seen_closebracket) {
		# If we're processing a link
		if (!$seen_closebracket) {
		    # First close bracket
		    $seen_closebracket = 1;
		    # End link href
		    $result .= "\">";
		    $doing_href = 0;
		    # Start link label
		    $inline_link = 1;
		} else {
		    # Second close bracket
		    $seen_closebracket = 0;
		    # If label was empty, use href content
		    if ($lastch eq ']') {
			$result .= $href_content;
		    }
		    # End link
		    $result .= "</a>";
		}
	    } else {
		# Non-link bracket
		$result .= $ch;
	    }
	} else {
	    $result .= $ch;
	}
    }
    return $result;
}

#
# do_table(): Process $_ while we're converting a table.
#
# The complication here is for elements (<td>'s) that straddle a
# line.
#
sub do_table {
    # Might start a table without the = sign...
    if (!$table) {
	print "<table>\n";
	$table = 1;
    }
    my $element = ($table_row == 0) ? 'th' : 'td';
    # Start of row?
    if (/^\|/) {
	print " <tr>\n";
	print "  <$element>";
	$_ = $';
    }
    # Row elements
    while (/([^\|]*)($|\|)/g) {
	my $text = inline($1);
	if ($text && $text ne "\n") {
	    print $text;
	}
	if ($2 eq '|') {
	    print "</$element>\n";
	    if ($' ne "\n") {
		print "  <$element>";
	    }
	}
    }
    # End of row?
    if (/\|$/) {
	print " </tr>\n";
	$table_row += 1;
    }
}

#
# do_list(TYPE,DEPTH,TEXT)
#
# Given a list of element of the given TYPE and DEPTH, do the right
# thing, including starting a new list and stopping any previously-
# nested lists.
#
sub do_list {
    my($type,$depth,$text) = @_;
    # Close deeper lists
    for (my $i=$depth+1; $i <= $#lists; $i++) {
	if ($lists[$i]) {
	    print "</" . $lists[$i] . ">\n";
	    undef($lists[$i]);
	}
    }
    # Switching type at this depth -> close old (and then open new)
    if ($lists[$depth] && $type ne $lists[$depth]) {
	print "</" . $lists[$depth] . ">\n";
	undef($lists[$depth]);
    }
    # Nothing at this depth yet: open new
    if (!$lists[$depth]) {
	print "<" . $type . ">\n";
	$lists[$depth] = $type;
    }
    print "<li>$text\n";
}

sub close_lists {
    for (my $i=1; $i <= $#lists; $i++) {
	if ($lists[$i]) {
	    print "</" . $lists[$i] . ">\n";
	    undef($lists[$i]);
	}
    }
}
