#!/usr/bin/perl

#$linelen = 72;
$linelen = 80;
$output = "";
$cut_at_blanks = 0;

while ($#ARGV >= 0) {
  $_ = $ARGV[0];
  last unless (/^-/);
  $linelen = $ARGV[1], shift, shift, next    if (/^-n$/);
  $output  = $ARGV[1], shift, shift, next    if (/^-o$/);
  $cut_at_blanks = 1, shift, next            if (/^-w$/);
  printf STDERR ("Unknown option '%s', ignored\n", $_);
  shift;
}

# First pass: extract the Caml phrases to evaluate

open(ML, "> .input.ml") || die("Cannot create .input.ml : $!");

foreach $infile (@ARGV) {
  open(IN, $infile) || die("Cannot open $infile : $!");
  while(<IN>) {
    if (m/^\s*\\begin{caml_(example|example\*|eval)}\s*$/) {
      while(<IN>) {
        last if m/^\s*\\end{caml_(example|example\*|eval)}\s*$/;
        print ML $_;
      }
    }
  }
  close(IN);
}

close(ML);

# Feed the phrases to a ocaml toplevel

open(TOPLEVEL, "ocaml 2>&1 < .input.ml |") ||
       die("Cannot start ocaml : $!");

<TOPLEVEL>; <TOPLEVEL>;		# skip the banner
$lastread = <TOPLEVEL>;
$lastread =~ s/^#//;

# Second pass: shuffle the TeX source and the output of the toplevel

if ($output) {
  if ($output eq "-") {
    open(OUT, ">&STDOUT");
  } else {
    open(OUT, ">$output") || die("Cannot create $output: $!");
  }
}

foreach $infile (@ARGV) {
  open(IN, $infile) || die("Cannot open $infile: $!");
  if (! $output) {
    $outfile = $infile;
    $outfile =~ s/\.tex$//;
    open(OUT, "> $outfile.ml.tex") || die("Cannot create $outfile.ml.tex: $!");
  }

  while(<IN>) {
    if (m/^\s*\\begin{caml_example(\*?)}\s*$/) {
      $omit_answer = $1;     # true if caml_example*, false if caml_example
      print OUT "\\begin\{caml\}\n";
      $severalphrases = 0;
      while(<IN>) {
        last if m/\s*\\end{caml_example\*?}\s*$/;
        print OUT "\\;" if ($severalphrases);
        while(1) {
          s/\}/\\\}/g;
          s/\{/\\\{/g;

#FV          s/\\/\\camlbslash\{\}/g; 
          s/\n//g;
          print OUT "\\?\{", $_, "\}\n";
          last if m/;;\s*$/;
          $_ = <IN>;
        }
#	print STDERR "\nOUT2=\n";
#	print STDERR $lastread;
#	print STDERR "\n=========================\n";
        $inunderline = 0;
        while($lastread) {
          last if $lastread =~ s/^#//;
          print $lastread unless ($output eq "-");
          if (! $omit_answer) {
            while (length($lastread) > $linelen) {
              if ($cut_at_blanks) {
                $cutpos = rindex($lastread, ' ', $linelen);
                if ($cutpos == -1) { $cutpos = $linelen; } else { $cutpos++; }
              } else {
                $cutpos = $linelen;
              }
              $line = substr($lastread, 0, $cutpos);
#1              $line =~ s/\{/\\\{/g;
#1              $line =~ s/\}/\\\}/g;
	    if ($inunderline == 1) 
	      {#We are in an underline
		$line = "\\underline\{" . $line; #We add an underline at the beginning of the line
		if ($line =~ /\\[24m/)           
		  {#The line contains an underline stop
		    $line =~ s/\\[24m/\}/g; #We close the underline
		    $inunderline = 0; #We no more are in an underline 
		  }
		else
		  {
		    $line = $line . "\}"; #We close the underline
		  }
	      }
	    else
	      {
		#If the line contains an underline start
		if ($line =~ /\\[4m/) 
		  {
		    $line =~ s/\\[4m/\\underline\{/g; #We replace the start signal
		    if ($line =~ /\\[24m/)
		      {#The line contains an underline stop
			$line =~ s/\\[24m/\}/g; #We close the underline
		      }
		    else
		      {
			$inunderline = 1; #We memorize it
			$line = $line . "\}"; #We close the underline
		      }
		  } 
	      }

            $line =~ s/\\[24m//g;

#FV              $line =~ s/\\/\\camlbslash\{\}/g;
              $line =~ s/^ *//;
              print OUT "\\:\{", $line, "\}\n";
              $lastread = substr($lastread, $cutpos,
                                 length($lastread) - $cutpos);
            }
#1            $lastread =~ s/\{/\\\{/g;
#1            $lastread =~ s/\}/\\\}/g;

            $lastread =~ s/\\[A//g;
#	    print STDERR "\nOUT=",$lastread, "\n";
	    if ($inunderline == 1) 
	      {#We are in an underline
		$lastread = "\\underline\{" . $lastread; #We add an underline at the beginning of the line
		if ($lastread =~ /\\[24m/)           
		  {#The line contains an underline stop
		    $lastread =~ s/\\[24m/\}/g; #We close the underline
		    $inunderline = 0; #We no more are in an underline 
		  }
		else
		  {
		    $lastread = $lastread . "\}"; #We close the underline
		  }
	      }
	    else
	      {
		#If the line contains an underline start
		if ($lastread =~ /\\[4m/) 
		  {
		    $lastread =~ s/\\[4m/\\underline\{/g; #We replace the start signal
		    if ($lastread =~ /\\[24m/)
		      {#The line contains an underline stop
			$lastread =~ s/\\[24m/\}/g; #We close the underline
		      }
		    else
		      {
			$inunderline = 1; #We memorize it
			$lastread = $lastread . "\}"; #We close the underline
		      }
		  } 
	      }

            $lastread =~ s/\\[24m//g;


#FV            $lastread =~ s/\\/\\camlbslash\{\}/g;
            $lastread =~ s/\n//g;
            $lastread =~ s/^ *//;
            print OUT "\\:\{", $lastread, "\}\n";
          }
          $lastread = <TOPLEVEL>;
        }
        $severalphrases = 1;
      }
      print OUT "\\end\{caml\}\n";
    }
    elsif (m/^\s*\\begin{caml_eval}\s*$/) {
      while(<IN>) {
        last if m/^\s*\\end{caml_eval}\s*$/;
        if (m/;;\s*$/) {
          while($lastread) {
            last if $lastread =~ s/^#//;
            print $lastread;
            $lastread = <TOPLEVEL>;
          }
        }
      }
    }
    else {
      print OUT $_;
    }
  }
  close(IN);
}

close(TOPLEVEL);
unlink(".input.ml");