#!/usr/bin/perl
#
# mcweave 2.1  - C pretty printer
# by T.Sato <VEF00200@nifty.ne.jp>, 2000-05-14 (2.1), 2001-06-01
#
# Usage:
#   mcweave [ -k ] [ -o <outfile> ] <filename>
#
#   options:
#      -k            Do not remove intermediate files when exiting
#
#      -o <outfile>  Write output to <outfile>.
#                    <outfile> should end with ".web", ".tex" or ".dvi".
#                    The default output file is "texput.dvi".
#
# System Requirement:
#   - Perl 5.x
#   - CWEB (preferably version 3.5 or later)
#   - plain TeX, and related softwares

$CWEAVE = "cweave";
if (system("which $CWEAVE > /dev/null")) {
    print "Couldn't find \"$CWEAVE\" command.\n";
    print "Please install CWEB (preferably version 3.5 or later) on your system.\n";
    exit 1;
}
$TEX = "ptex";
if (system("which $TEX > /dev/null")) {
    $TEX = "jtex";
    if (system("which $TEX > /dev/null")) {
	$TEX = "tex";
	if (system("which $TEX > /dev/null")) {
	    print "Couldn't find TeX (ptex, jtex or tex).\n";
	    print "Please install TeX on your system.\n";
	    exit 1;
	}
    }    
}

$outfile = "texput.dvi";

while (@ARGV) {
    $file_c = $ARGV[0];
    shift(@ARGV);
    if ($file_c =~ /^-/) {
	if ($file_c eq "-k") {
	    $keep_files = 1;
	} elsif ($file_c eq "-o") {
	    $outfile = $ARGV[0];
	    shift(@ARGV);
	} else {
	    die "$0: unknown option: $file_c\n";
	}
	next;
    }

    ($basename = $outfile) =~ s/[.][^.]+$//;
    $outfile .= ".dvi" if ($basename eq $outfile);

    $file_web = "$basename.web";
    $file_tex = "$basename.tex";

    die "$0: can't read $file_c: $!\n" if (! -r $file_c);

    print STDERR "Processing $file_c to generate $outfile...\n";
    if (!open(OUT, "> $file_web")) {
	die "$0: can't open output file: $file_web: $!\n";
    }
    &generate_header($file_c);
    &c_to_cweb($file_c);
    close(OUT);
    if ($outfile eq $file_web) {
	print STDERR "Output written on $outfile\n";
	exit 0;
    }

    print STDERR "Running \"$CWEAVE $file_web\"...\n";
    if (system("$CWEAVE $file_web - $file_tex")) {
	print STDERR "\nError detected while executing \"$CWEAVE $file_web\"\n";
	&cleanup(1);
	exit 1;
    }
    if ($outfile eq $file_tex) {
	print STDERR "Output written on $outfile\n";
	&cleanup(0);
	exit 0;
    }

    print STDERR "Running \"$TEX $file_tex\"...\n";
    if (system("$TEX $file_tex") != 0) {
	print STDERR "\nError detected while executing \"$TEX $file_tex\"\n";
	&cleanup(1);
	exit 1;
    }
    print STDERR "Output written on $outfile\n";
    &cleanup(0);
    exit 0;
}

sub cleanup {
    ($clean_all) = @_;

    if (! $keep_files) {
	$first = 1;
	foreach $ext ( "web", "idx", "scn", "tex", "toc", "log", "dvi" ) {
	    $file = "$basename.$ext";
	    if (-f $file && ($clean_all || $file ne $outfile)) {
		print STDERR "\nIntermediate files removed:" if ($first);
		$first = 0;
		print STDERR " ", $file;
		unlink $file;
	    }
	}
	print STDERR "\n" if (! $first);

	print STDERR "(use -k option to keep there files)\n"
	    if (! $first && $clean_all);
    }
}

sub generate_header {
    ($srcfile) = @_;
    if (open(IN, "< $srcfile")) {
	print OUT "\\input mcwebmac\n";
	while (<IN>) {
	    if (/^ *[*;%\#]? *(title|author|date) *: *(.*)$/i) {
		$key = $1;
		$str = $2;
		print OUT "\\def\\title{$str}\n" if ($key =~ /title/i);
		print OUT "\\def\\author{$str}\n" if ($key =~ /author/i);
		print OUT "\\def\\date{$str}\n" if ($key =~ /date/i);
	    }
	}
	print OUT "\\maketitle\n";
	close(IN);
    } else {
	die "$0: can't open input file: $srcfile: $!\n";
    }
}

sub c_to_cweb {
    ($srcfile) = @_;

    $mode = "limbo";
    
    if (open(IN, "< $srcfile")) {
	while (<IN>) {
	    chop;
	    s/ +$//;;
	    s/([\"\']\@)/\1\@/g;
	    if (/^\/[*] *([*][*]+|--+)$/ .. /^ *([*][*]+|--+) *[*]\/$/) {
		$mode = "limbo";
		print OUT "\@ \n\\begintt\n" if (/^\/[*]/);
		print OUT "~$_\n";
		print OUT "\\endtt\n" if (/[*]\/$/);
		next;
	    }
	    if (/^\/[*]/ .. /[*]\/$/) {  # comment at section heading
		$mode = "limbo";
		$tt = 0 if /^\\endtt/;
		if (/^\/[*]/) {
		    s/^\/[*]+ *//;
		    s/[*]+\/$//;
		    if (/^%/) {
			print OUT "$_\n";
		    } else {
			print OUT "\@ ";
			print OUT "{\\bf $_\\qquad}\n" if ($_);
		    }
		} else {
		    s/[*]+\/$//;
		    s/^ *[*]//;
		    print OUT "~" if $tt;
		    print OUT $_, "\n";
		}
		$tt = 1 if /^\\begintt/;
		next;
	    }
	    &make_string_index($_) if (/\"/);

	    if (/^$/) {
		if ($mode eq "c") {
		    print OUT "\@\#\n";
		} else {
		    print OUT "\n";
		}
	    }
	    if ($mode eq "limbo") {
		$mode = "c";
		print OUT "\@c\n";
	    }
	    if (/\} *, *$/ || /;;$/) {
		s/;;$/;/;
		# print OUT $_, "@|\n";
		print OUT $_, "\n";
	    } else {
		print OUT $_, "\n";
	    }
	}
	print OUT "\@c\n" if ($mode ne "c");
	print OUT "\@ {\\bf INDEX}\\par\n";
	close(IN);
    } else {
	die "$0: can't open input file: $srcfile: $!\n";
    }
}


sub make_string_index {
    ($s) = @_;
    while ($s =~ /\"/) {   # while quoted string in line
	$s =~ s/^[^\"\']*//;
	if ($s =~ /^\"/) {
	    $s =~ s/^\"//;
	    $s2 = $s; $s2 =~ s/\".*$//; $s2 =~ s/^ *//g; $s2 =~ s/ *$//g;
	    while (30 < length($s2)) {
		$s2 =~ s/[. ]*[a-zA-Z0-9]*[^a-zA-Z0-9]*$/.../;
	    }
	    if (2 <= length($s2)) {
		$s2 =~ s/([\\\{\}\~\ \&\#\%\^_])/\\\1/g;
		$s2 =~ s/@/{\\AT}/g;
		print OUT "@.$s2@>\n";
	    }
	    $s =~ s/^[^\"]*\"//;
	} else {
	    $s =~ s/^\'[^\']*\'?//;
	}
    }
}