+#! /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 "mantext.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";
+ }
+}
~mdw / fwd / commitdiff