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

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