chiark - git - mdw - fwd/blob - make-manpage

   1 #! /usr/bin/perl
   2
   3 %ch = ();
   4 %ord = ();
   5 $chunk = undef;
   6 $mode = $ARGV[0] || die "mode?";
   7 shift;
   8
   9 sub setup {
  10   my $r = \%{$ch{$_[0]}};
  11   if (exists $r->{$1}) {
  12     $r->{$1} .= ".br\n";
  13   } else {
  14     push @{$ord{$_[0]}}, $1;
  15   }
  16   $chunk = \$r->{$1};
  17 }
  18 while (<>) {
  19   if (/^\.GS (.*)$/) {
  20     setup('grammar');
  21   } elsif (/^\.OS (.*)$/) {
  22     setup('option');
  23   } elsif (/^\.GE/ || /^\.OD/) {
  24     $chunk = undef;
  25   } elsif (/^\.GL (.*)$/) {
  26     $ch{'grammar'}{$1} .= ".PP\n";
  27     next;
  28   } elsif (/^\.OL (.*)$/) {
  29     $ch{'option'}{$1} .= ".PP\n";
  30     next;
  31   } elsif (/^@@@ (\w+)$/) {
  32     if ($mode eq 'man') {
  33       foreach $head (@{$ord{$1}}) {
  34         print ".SS $head\n";
  35         print $ch{$1}{$head};
  36       }
  37     }
  38     next;
  39   } else {
  40     $$chunk .= $_ if $chunk;
  41   }
  42   print if $mode eq 'man';
  43 }
  44
  45 sub ital { uc($_[0]); }
  46 sub bold { $head eq 'option' ? $_[0] : "`$_[0]'"; }
  47 sub rom { $_[0]; }
  48
  49 sub deroff {
  50   $head = $_[0];
  51   my $chsep = "";
  52   my $out = "";
  53   for my $chunk (@{$ord{$head}}) {
  54     (my $chh = $chunk) =~ s/^"(.*)"$/$1/;
  55     $out .= "$chsep$chh\n";
  56     $chsep = "\n";
  57     $sep = "\t";
  58     for (split /\n/, $ch{$head}{$chunk}) {
  59       s/\s$//; s/\\\&//g; s/\\-/-/g;
  60       if (/^\.I (.*)$/) {
  61         $out .= $sep . ital($1);
  62         $sep = " ";
  63       } elsif (/^\.B (.*)$/) {
  64         $out .= $sep . bold($1);
  65         $sep = " ";
  66       } elsif (/^\.RB (.*)/) {
  67         my $i = 1; $out .= $sep; $sep = " ";
  68         for my $w (split ' ', $1) {
  69           if ($w eq "\\c") {
  70             $sep = ""; last;
  71           }
  72           $out .= ($i++%2 ? rom($w) : bold($w));
  73         }
  74       } elsif (/^\.BR (.*)/) {
  75         my $i = 1; $out .= $sep; $sep = " ";
  76         for my $w (split ' ', $1) {
  77           if ($w eq "\\c") {
  78             $sep = ""; last;
  79           }
  80           $out .= ($i++%2 ? bold($w) : rom($w));
  81         }
  82       } elsif (/^\.IR (.*)/) {
  83         my $i = 1; $out .= $sep; $sep = " ";
  84         for my $w (split ' ', $1) {
  85           if ($w eq "\\c") {
  86             $sep = ""; last;
  87           }
  88           $out .= ($i++%2 ? ital($w) : rom($w));
  89         }
  90       } elsif (/^\.RI (.*)/) {
  91         my $i = 1; $out .= $sep; $sep = " ";
  92         for my $w (split ' ', $1) {
  93           if ($w eq "\\c") {
  94             $sep = ""; last;
  95           }
  96           $out .= ($i++%2 ? rom($w) : ital($w));
  97         }
  98       } elsif (/^\.BI (.*)/) {
  99         my $i = 1; $out .= $sep; $sep = " ";
 100         for my $w (split ' ', $1) {
 101           if ($w eq "\\c") {
 102             $sep = ""; last;
 103           }
 104           $out .= ($i++%2 ? bold($w) : ital($w));
 105         }
 106       } elsif (/^\.IB (.*)/) {
 107         my $i = 1; $out .= $sep; $sep = " ";
 108         for my $w (split ' ', $1) {
 109           if ($w eq "\\c") {
 110             $sep = ""; last;
 111           }
 112           $out .= ($i++%2 ? ital($w) : bold($w));
 113         }
 114       } elsif (/^\.$/) {
 115         # foo
 116       } elsif (/^[^.]/) {
 117         $out .= $sep . $_;
 118         $sep = " ";
 119       } elsif (/^\.br$/ || /^\.PP$/) {
 120         $out .= "\n";
 121         $sep = "\t";
 122       }
 123     }
 124     $out .= "\n";
 125   }
 126   return $out;
 127 }
 128
 129 if ($mode eq 'c') {
 130   print <<EOF;
 131 /* -*-c-*-
 132  *
 133  * Generated grammar and options summary
 134  */
 135
 136 #include "mantext.h"
 137
 138 EOF
 139   for $head (keys %ch) {
 140     print "const char ${head}_text[] = \"\\\n";
 141     $text = deroff($head);
 142     $text =~ s/\n/\\n\\\n/g;
 143     print $text;
 144     print "\";\n\n";
 145   }
 146 } elsif ($mode eq 'text') {
 147   my $sep = "";
 148   for $head (keys %ch) {
 149     print $sep, deroff($head);
 150     $sep = "\n";
 151   }
 152 }