git.pond.sub.org Git - empserver/blob - info/emp2html.pl

   1 #!/usr/local/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 my $esc="\\";
   7 my @a;
   8
   9 line: while (<>) {
  10     chomp;                      # strip record separator
  11     s/([^\\](\\\\)*)\\\".*/$1/g; # strip comments
  12
  13     @a = req($_);
  14
  15     if (!@a) {
  16         print htmlify($_), "\n";
  17         next line;
  18     }
  19
  20     # requests
  21
  22     if ($a[1] eq "TH") {
  23         @a = checkarg(2, @a);
  24         $a[3] = htmlify($a[3]);
  25         print "<title>$a[2] : $a[3]</title><h1>$a[2] : $a[3]</h1>\n";
  26         next line;
  27     }
  28
  29     if ($a[1] eq "SY") {
  30         @a = checkarg(1, @a);
  31         $a[2] = htmlify($a[2]);
  32         print "<samp>[##:##] Command : </samp><KBD>$a[2]</KBD><p>\n";
  33         next line;
  34     }
  35
  36     if ($a[1] eq "EX") {
  37         my $str = htmlify(join(' ',@a[2..$#a]));
  38         print "<br><samp>[##:##] Command : </samp><kbd>$str</kbd><p>\n";
  39         next line;
  40     }
  41
  42     if ($a[1] =~ /^LV?$/) {
  43         @a = checkarg(1, @a);
  44         $a[2] = htmlify($a[2]);
  45         print "<h2>$a[2]</h2>\n";
  46         next line;
  47     }
  48
  49     if ($a[1] =~ "eo") { $esc = 0; next line; }
  50     if ($a[1] =~ "ec") { $esc = $#a == 1 ? "\\" : $a[2]; next line; }
  51
  52     if (/^\.(NF|nf)/) { printf (("<p><pre>\n")); next line; }
  53     if (/^\.(FI|fi)/) { printf (("</pre><p>\n")); next line; }
  54     if (/^\.s3/) { printf (("<p>\n"));  next line; }
  55     if (/^\.s1/) { printf (("<hr> \n")); next line; }
  56     if (/^\.br/) { printf "<br>\n"; next line; }
  57
  58     if ($a[1] eq "SA") {
  59         @a = checkarg(1, @a);
  60         @a = split(/[\: \"\,\.]+/, $a[2]);
  61         for my $a (@a) {
  62             $a = anchor($a);
  63         }
  64         print "<p>See also : ", join("\n, ", @a), "\n";
  65     }
  66
  67     # ignore unknown request
  68 }
  69
  70 sub req {
  71     local ($_) = @_;
  72     if (/^([\.\'])[ \t]*([^ ]+) *(.*)/) {
  73         my @a = ($1, $2);
  74         $_ = $3;
  75         while (/(\"((\\.|[^\\\"])*)(\"|\Z))|(([^ ]|\\.)+) */g) {
  76             push(@a, $2 || $5);
  77         }
  78         return @a;
  79     }
  80     return ();
  81 }
  82
  83 sub checkarg {
  84     my ($n, @a) = @_;
  85     warn "extra arguments for $a[1] ignored" if $#a > $n+1;
  86     warn "missing arguments for $a[1] supplied" if $#a < $n+1;
  87     while ($#a < $n+1) {
  88         push @a, "";
  89     }
  90     return @a;
  91 }
  92
  93 sub anchor {
  94     local ($_) = @_;
  95     # FIXME don't create dangling links here
  96     return "<a href=\"$_.html\">$_</a>";
  97 }
  98
  99 # Translate HTML special characters into escape sequences
 100 sub htmlify {
 101     local ($_) = @_;
 102     die "funny escape character `$esc' not supported"
 103         if $esc && $esc ne "\\";
 104     # translate some troff escapes
 105     s/\\&//g if $esc;           # zero width space character
 106     # escape HTML special characters
 107     s/\&/&amp;/g;
 108     s/\</&lt;/g;
 109     s/\>/&gt;/g;
 110     return $_ unless $esc;
 111     # translate more troff escapes
 112     s/\\e/&\#92;/g;             # escape character
 113     # turn quoted strings that look like info names into links
 114     # tacky...
 115     while (/(\\\*Q)([A-Za-z0-9\-\.]+)(\\\*U)/) {
 116         $_ = $` . anchor($2) . "$'";
 117     }
 118     while (/(\"info )([A-Za-z0-9\-\.]+)/) {
 119         $_ = "$`\"info " . anchor($2) . "$'";
 120     }
 121     # tranlate more troff escapes and strings
 122     s/\\\*Q/<em>/g;
 123     s/\\\*U/<\/em>/g;
 124     s/\\fI/<em>/g;
 125     s/\\fR/<\/em><\/em>/g;
 126     s/\\fB/<strong>/g;
 127     s/\\fP/<\/strong><\/em>/g;
 128     s/\\\*\(bF/<strong>/g;      # bold font
 129     s/\\\*\(pF/<\/strong><\/em>/g; # pica font
 130     s/\\\*\(nF/<\/strong><\/em>/g; # normal font
 131     s/\\\*\(iF/<em>/g;          # italic font
 132     s/\\\(mu/x/g;               # multiply symbol
 133     s/\\ /&nbsp;/g;             # non breaking space
 134     return $_;
 135 }