#! /usr/bin/perl

%ch = ();
%ord = ();
$chunk = undef;
$mode = $ARGV[0] || die "mode?";
shift;

sub setup {
  my $r = \%{$ch{$_[0]}};
  if (exists $r->{$1}) {
    $r->{$1} .= ".br\n";
  } else {
    push @{$ord{$_[0]}}, $1;
  }
  $chunk = \$r->{$1};
}
while (<>) {
  if (/^\.GS (.*)$/) {
    setup('grammar');
  } elsif (/^\.OS (.*)$/) {
    setup('option');
  } elsif (/^\.GE/ || /^\.OD/) {
    $chunk = undef;
  } elsif (/^\.GL (.*)$/) {
    $ch{'grammar'}{$1} .= ".PP\n";
    next;
  } elsif (/^\.OL (.*)$/) {
    $ch{'option'}{$1} .= ".PP\n";
    next;
  } elsif (/^@@@ (\w+)$/) {
    if ($mode eq 'man') {
      foreach $head (@{$ord{$1}}) {
	print ".SS $head\n";
	print $ch{$1}{$head};
      }
    }
    next;
  } else {
    $$chunk .= $_ if $chunk;
  }
  print if $mode eq 'man';
}

sub ital { uc($_[0]); }
sub bold { $head eq 'option' ? $_[0] : "`$_[0]'"; }
sub rom { $_[0]; }

sub deroff {
  $head = $_[0];
  my $chsep = "";
  my $out = "";
  for my $chunk (@{$ord{$head}}) {
    (my $chh = $chunk) =~ s/^"(.*)"$/$1/;
    $out .= "$chsep$chh\n";
    $chsep = "\n";
    $sep = "\t";
    for (split /\n/, $ch{$head}{$chunk}) {
      s/\s$//; s/\\\&//g; s/\\-/-/g;
      if (/^\.I (.*)$/) {
	$out .= $sep . ital($1);
	$sep = " ";
      } elsif (/^\.B (.*)$/) {
	$out .= $sep . bold($1);
	$sep = " ";
      } elsif (/^\.RB (.*)/) {
	my $i = 1; $out .= $sep; $sep = " ";
	for my $w (split ' ', $1) {
	  if ($w eq "\\c") {
	    $sep = ""; last;
	  }
	  $out .= ($i++%2 ? rom($w) : bold($w));
	}
      } elsif (/^\.BR (.*)/) {
	my $i = 1; $out .= $sep; $sep = " ";
	for my $w (split ' ', $1) {
	  if ($w eq "\\c") {
	    $sep = ""; last;
	  }
	  $out .= ($i++%2 ? bold($w) : rom($w));
	}
      } elsif (/^\.IR (.*)/) {
	my $i = 1; $out .= $sep; $sep = " ";
	for my $w (split ' ', $1) {
	  if ($w eq "\\c") {
	    $sep = ""; last;
	  }
	  $out .= ($i++%2 ? ital($w) : rom($w));
	}
      } elsif (/^\.RI (.*)/) {
	my $i = 1; $out .= $sep; $sep = " ";
	for my $w (split ' ', $1) {
	  if ($w eq "\\c") {
	    $sep = ""; last;
	  }
	  $out .= ($i++%2 ? rom($w) : ital($w));
	}
      } elsif (/^\.BI (.*)/) {
	my $i = 1; $out .= $sep; $sep = " ";
	for my $w (split ' ', $1) {
	  if ($w eq "\\c") {
	    $sep = ""; last;
	  }
	  $out .= ($i++%2 ? bold($w) : ital($w));
	}
      } elsif (/^\.IB (.*)/) {
	my $i = 1; $out .= $sep; $sep = " ";
	for my $w (split ' ', $1) {
	  if ($w eq "\\c") {
	    $sep = ""; last;
	  }
	  $out .= ($i++%2 ? ital($w) : bold($w));
	}
      } elsif (/^\.$/) {
	# foo
      } elsif (/^[^.]/) {
	$out .= $sep . $_;
	$sep = " ";
      } elsif (/^\.br$/ || /^\.PP$/) {
	$out .= "\n";
	$sep = "\t";
      }
    }
    $out .= "\n";
  }
  return $out;
}

if ($mode eq 'c') {
  print <<EOF;
/* -*-c-*-
 *
 * Generated grammar and options summary
 */

#include "fwd.h"

EOF
  for $head (keys %ch) {
    print "const char ${head}_text[] = \"\\\n";
    $text = deroff($head);
    $text =~ s/\n/\\n\\\n/g;
    print $text;
    print "\";\n\n";
  }
} elsif ($mode eq 'text') {
  my $sep = "";
  for $head (keys %ch) {
    print $sep, deroff($head);
    $sep = "\n";
  }
}