code.delx.au - gnu-emacs/blob - test/manual/etags/perl-src/htlmify-cystic

   1 #! /uns/bin/perl -w
   2
   3 # htmlify-cystic-l-faq:  turn text version of cystic-l faq into html
   4 # run like this:   htmlify-cystic-l-faq < cystic-l-faq-all
   5
   6 # Ron Trueworthy should put the date on the FAQ.
   7
   8 use English;
   9 use Carp;
  10 use strict;
  11
  12 my @section_name;
  13 my @appendix_name;
  14
  15 my @section_toc;
  16 my @appendix_toc;
  17
  18 my $new_tag = "[NEW]";
  19
  20 if (! -d "faq")
  21 { die "Can't find faq directory"; }
  22
  23 # Initially undefined
  24 my $appendix;
  25 my $section;
  26 my $subsection;
  27 my $subsubsection;
  28
  29 my $this_file_toc = "";
  30 my %file_tocs;
  31
  32 my @output_files = ();
  33 my $file_index = 0;
  34
  35 my $output_file;
  36
  37 my $line;
  38 while (defined($line = <>))
  39 {
  40   ### Message headers
  41   if ($line =~ /^From /)
  42     { while ($line ne "\n")
  43         { $line = <>; } }
  44
  45   if ($line =~ /^See PART ONE of this FAQ for/)
  46     { while (defined($line = <>) && ($line ne "\n"))
  47         { }
  48       next; }
  49
  50   if ($line =~ /^\s*[-+]+$/)
  51     { next; }
  52
  53   ### File headers
  54   if ($line =~ /^\s*CYSTIC-L Frequently Asked Questions - PART (.*)\n$/)
  55     { # print "part $1\n";
  56       if ($1 ne "ONE")
  57         { next; }
  58       if ($output_file)
  59         { die "output_file shouldn't have been set yet: $output_file"; }
  60       $output_file = "faq/index.html";
  61       open(OUTPUT, ">$output_file") || die "Couldn't open $output_file";
  62       select OUTPUT;
  63       print "<HEAD>
  64 <TITLE>CYSTIC-L FAQ Table of Contents
  65 </TITLE>
  66 </HEAD>
  67 <BODY>
  68 <H1>CYSTIC-L Frequently Asked Questions</H1>
  69 <h2>Knowledge Is Power</h2>
  70 ";
  71       next; }
  72
  73   if ($line =~ /^\s*~ Knowledge Is Power ~$/)
  74     { next; }
  75
  76   ### Table of contents
  77   if ($line =~ /^\s*~ FAQ Table of Contents ~$/)
  78       { read_toc();
  79         print "<hr><a href=\"../\">Info-Zone</a> <a href=\"../../\">CF-WEB</a>\n";
  80         close(OUTPUT);
  81         next;
  82       }
  83
  84   if ($line =~ /^PART /)
  85     { next; }
  86
  87   if ($line =~ s/^>?APPENDIX ([A-Z])\.\s*//)
  88     { if (!defined($appendix))
  89         { if ($1 ne "A")
  90             { die "First appendix is $1"; } }
  91       elsif ($1 ne chr(ord($appendix)+1))
  92         { die "Appendix $1 follows Appendix $appendix"; }
  93
  94       file_end();
  95       close(OUTPUT);
  96       $appendix = $1;
  97       $section = undef;
  98       $subsection = undef;
  99       $subsubsection = undef;
 100       $output_file = section_url_base();
 101       open(OUTPUT, "> faq/$output_file") || die "Can't open faq/$output_file";
 102       select OUTPUT;
 103
 104       chomp($line);
 105       print "<title>$line</title>\n<h1>$line</h1>\n";
 106       if (defined($file_tocs{$output_file}) && $file_tocs{$output_file})
 107         { print "Contents: $file_tocs{$output_file}\n"; }
 108       next; }
 109
 110   if (($line =~ /^>?([0-9]+)\.\s+/) && (!defined($section) || ($1 == $section+1)))
 111     { $line =~ s/^>?([0-9]+)\.\s+//;
 112       if (!defined($appendix))
 113         { # should do some more here
 114           if (defined($section))
 115             { file_end(); }
 116           close(OUTPUT); }
 117       $section = $1;
 118       $subsection = undef;
 119       $subsubsection = undef;
 120       $output_file = section_url_base();
 121       if (!defined($appendix))
 122         { open(OUTPUT, "> faq/$output_file") || die "Can't open faq/$output_file";
 123           select OUTPUT;
 124           chomp($line);
 125           print "<title>$line</title>\n<h1>$line</h1>\n";
 126           if (defined($file_tocs{$output_file}) && $file_tocs{$output_file})
 127             { print "Contents: $file_tocs{$output_file}\n"; }
 128           next; }
 129     }
 130
 131   if ($line =~ s/^>?o\s+//)
 132     { $line =~ s/^>//;          # sometimes the > follows the itemization
 133       if (!defined($subsection))
 134         { $subsection = 1; }
 135       else
 136         { $subsection++; }
 137       $subsubsection = undef;
 138       print "<h2>", section_name($line), "</h2>\n";
 139       next; }
 140
 141   if ($line =~ s/^>?-\s+//)
 142     { $line =~ s/^>//;          # sometimes the > follows the itemization
 143       if (!defined($subsubsection))
 144         { $subsubsection = 1; }
 145       else
 146         { $subsubsection++; }
 147       print "<h3>", section_name($line), "</h3>\n";
 148       next; }
 149
 150   ### A paragraph of ordinary text
 151   if ($line !~ /^\s*$/)
 152     { print "<p>$line";
 153       while (defined($line = <>) && ($line ne "\n"))
 154         { print $line; }
 155       print "</p>\n";
 156     }
 157
 158 }
 159 file_end();
 160
 161 my $subsection_marker;
 162
 163 my $new;
 164
 165 sub read_toc ()
 166 { # These variables are initially undefined
 167   if (defined($appendix)
 168       || defined($section)
 169       || defined($subsection)
 170       || defined($subsubsection))
 171     { die "some value should have been undefined when calling read_toc: `$appendix' `$section' `$subsection' `$subsubsection'"; }
 172
 173   while (defined($line = <>) && $line)
 174     { if ($line =~ /^\s*$/)
 175         { next; }
 176       if ($line =~ /^\s*\((Portions updated since.*)>\)\n/)
 177         { print "$1$new_tag<p>\n";
 178           next; }
 179       if ($line =~ /^PART (.*)$/)
 180         #       { if ($MATCH eq "ONE")
 181         #           { print ... }
 182         { next; }
 183       if ($line eq "APPENDICES\n")
 184         { next; }
 185       if ($line =~ /^\s*INDEX/)
 186         { next; }
 187
 188       if ($line =~ /^\s*[-+]+$/)
 189         { finish_appendices();
 190           if (defined($appendix)
 191               || defined($section)
 192               || defined($subsection)
 193               || defined($subsubsection))
 194             { die "some value should have been undefined when exiting read_toc: `$appendix' `$section' `$subsection' `$subsubsection'"; }
 195           return; }
 196
 197       $new = ($line =~ s/>//);
 198
 199       # # Not sure if this is the right place to do this.
 200       # if (($line !~ /^\s*([-o]|[0-9A-Z]+\.|APPENDIX [A-Z]\.)/)
 201       #           && ($line !~ /[ .]*[0-9]+$/))
 202       #         { die "What line? $line"; }
 203       while (!($line =~ s/[ .]*[0-9]+$//))
 204         { $line .= <>; }
 205       chomp($line);
 206
 207       if ($line =~ s/^\s*APPENDIX ([A-Z])\.\s*//)
 208         { finish_sections();
 209           if (!defined($appendix))
 210             { if ($1 ne "A")
 211                 { die "First appendix is $1"; }
 212               print "Appendices\n";
 213               print "<ol type=\"A\" start=\"$1\">\n"; }
 214           elsif ($1 ne chr(ord($appendix)+1))
 215             { die "Appendix $1 follows Appendix $appendix"; }
 216           $appendix = $1;
 217           $appendix_name[ord($appendix)-ord('A')+1] = $line;
 218           my $entry = toc_line($line);
 219           print $entry;
 220           push(@output_files,section_url_base());
 221           next; }
 222
 223       if ($line =~ s/^\s*([0-9]+)\.\s*//)
 224         { finish_subsections();
 225           if (!defined($section))
 226             { my $entry = "<ol start=$1>\n";
 227               print $entry;
 228               if (defined($appendix))
 229                 { $this_file_toc .= $entry; } }
 230           elsif ($1 != $section+1)
 231             { die "Section $1 follows section $section"; }
 232           $section = $1;
 233           $section_name[$section] = $line;
 234           my $entry = "  " . toc_line($line);
 235           print $entry;
 236           if (defined($appendix))
 237             { $this_file_toc .= $entry; }
 238           else
 239             { push(@output_files,section_url_base()); }
 240           next; }
 241
 242       if ($line =~ s/^\s*o\s+//)
 243         { if (!defined($subsection))
 244             { $subsection = 1;
 245               my $entry = "  <ul>\n";
 246               print $entry;
 247               $this_file_toc .= $entry;
 248               $subsection_marker = "ul"; }
 249           else
 250             { finish_subsubsections();
 251               $subsection++; }
 252           my $entry = "    " . toc_line($line);
 253           print $entry;
 254           $this_file_toc .= $entry;
 255           next; }
 256
 257       if ($line =~ s/^\s*([A-Z])\.\s+//)
 258         { finish_subsubsections();
 259           if (!defined($subsection))
 260             { my $entry = "  <ol type=\"A\" start=\"$1\">\n";
 261               print $entry;
 262               $this_file_toc .= $entry;
 263               $subsection_marker = "ol"; }
 264           else
 265             { if ($1 ne chr(ord($subsection)+1))
 266                 { die "Subsection $1 follows subsection $subsection"; } }
 267           $subsection = $1;
 268           my $entry = "      " . toc_line($line);
 269           print $entry;
 270           $this_file_toc .= $entry;
 271           next; }
 272
 273       if ($line =~ s/^\s*-\s+//)
 274         { if (!defined($subsubsection))
 275             { $subsubsection = 1;
 276               my $entry = "    <ul>\n";
 277               print $entry;
 278               $this_file_toc .= $entry; }
 279           else
 280             { $subsubsection++; }
 281           my $entry = "        " . toc_line($line);
 282           print $entry;
 283           $this_file_toc .= $entry;
 284           next; }
 285
 286       # Itemized line without leading "o" (grrr).
 287        if (!defined($subsection))
 288           { my $entry = "  <ul>\n";
 289             print $entry;
 290             $this_file_toc .= $entry;
 291             $subsection = 1;
 292             $subsection_marker = "ul"; }
 293         else
 294           { $subsection++; }
 295         $line =~ s/^\s*//;
 296       my $entry = "      " . toc_line($line);
 297       $this_file_toc .= $entry;
 298       print $entry;
 299     }
 300 }
 301
 302 sub finish_subsubsections ()
 303 { if (defined($subsubsection))
 304     { my $entry = "      </ul>\n";
 305       print $entry;
 306       $this_file_toc .= $entry;
 307       $subsubsection = undef; } }
 308
 309 sub finish_subsections ()
 310 { finish_subsubsections();
 311   if (defined($subsection))
 312     { my $entry = "    </$subsection_marker>\n";
 313       print $entry;
 314       $this_file_toc .= $entry;
 315       $subsection = undef;
 316       if (!defined($appendix))
 317         { $file_tocs{section_url_base()} = $this_file_toc;
 318           $this_file_toc = ""; } } }
 319
 320 sub finish_sections ()
 321 { finish_subsections();
 322   if (defined($section))
 323     { my $entry = "  </ol>\n";
 324       print $entry;
 325       if (defined($appendix))
 326         { $this_file_toc .= $entry;
 327           $file_tocs{section_url_base()} = $this_file_toc;
 328           $this_file_toc = ""; }
 329       $section = undef; } }
 330
 331 sub finish_appendices ()
 332 { finish_sections();
 333   if (defined($appendix))
 334     { print "</ol>\n";
 335       $appendix = undef; } }
 336
 337 sub section_url_base ()
 338 { if (!defined($appendix) && !defined($section))
 339     { die "undefined appendix and section"; }
 340   return (defined($appendix) ? "app-$appendix.html" : "sec-$section.html"); }
 341
 342 sub section_url_name ()
 343 { my $sans_subsubsection
 344     = (defined($appendix)
 345        ? (defined($section)
 346           ? "sec-$section" . (defined($subsection)
 347                                 ? "-$subsection" : "")
 348           : "")
 349        : (defined($subsection) ? "ssec-$subsection" : ""));
 350   if (defined($subsubsection))
 351     { $sans_subsubsection . "-$subsubsection"; }
 352   else
 353     { $sans_subsubsection; } }
 354
 355 sub section_url ()
 356 { my $base = section_url_base();
 357   my $name = section_url_name();
 358   if ($name)
 359     { return $base . "\#" . $name; }
 360   else
 361     { return $base; } }
 362
 363
 364 sub section_href ($)
 365 { my ($text) = @_;
 366   return "<a href=\"" . section_url() . "\">$text</a>"; }
 367
 368 sub section_name ($)
 369 { my ($text) = @_;
 370   return "<a name=\"" . section_url_name() . "\">$text</a>"; }
 371
 372 sub toc_line ($)
 373 { return " <LI>" . section_href($line) . ($new ? " $new_tag" : "") . "\n"; }
 374
 375 sub file_end ()
 376 { print "\n\n<hr>\n"
 377     . (($file_index < $#output_files)
 378        ? "<a href=\"$output_files[$file_index+1]\">Next</a> " : "")
 379       . (($file_index > 0)
 380          ? "<a href=\"$output_files[$file_index-1]\">Previous</a> " : "")
 381         . "<a href=\"./\">FAQ</a> <a href=\"../\">Info-Zone</a> <a href=\"../../\">CF-WEB</a>\n";
 382   $file_index++; }