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