be defensive about setting {host,group,pass}cat (from Andy Dougherty)
[p5sagit/p5-mst-13.2.git] / pod / pod2latex.PL
1 #!/usr/local/bin/perl
2
3 use Config;
4 use File::Basename qw(&basename &dirname);
5 use Cwd;
6
7 # List explicitly here the variables you want Configure to
8 # generate.  Metaconfig only looks for shell variables, so you
9 # have to mention them as if they were shell variables, not
10 # %Config entries.  Thus you write
11 #  $startperl
12 # to ensure Configure will look for $Config{startperl}.
13
14 # This forces PL files to create target in same directory as PL file.
15 # This is so that make depend always knows where to find PL derivatives.
16 $origdir = cwd;
17 chdir dirname($0);
18 $file = basename($0, '.PL');
19 $file .= '.com' if $^O eq 'VMS';
20
21 open OUT,">$file" or die "Can't create $file: $!";
22
23 print "Extracting $file (with variable substitutions)\n";
24
25 # In this section, perl variables will be expanded during extraction.
26 # You can use $Config{...} to use Configure variables.
27
28 print OUT <<"!GROK!THIS!";
29 $Config{startperl}
30     eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
31         if \$running_under_some_shell;
32 !GROK!THIS!
33
34 # In the following, perl variables are not expanded during extraction.
35
36 print OUT <<'!NO!SUBS!';
37 #
38 # pod2latex, version 1.1
39 # by Taro Kawagish (kawagish@imslab.co.jp),  Jan 11, 1995.
40 #
41 # pod2latex filters Perl pod documents to LaTeX documents.
42 #
43 # What pod2latex does:
44 # 1. Pod file 'perl_doc_entry.pod' is filtered to 'perl_doc_entry.tex'.
45 # 2. Indented paragraphs are translated into
46 #    '\begin{verbatim} ... \end{verbatim}'.
47 # 3. '=head1 heading' command is translated into '\section{heading}'
48 # 4. '=head2 heading' command is translated into '\subsection*{heading}'
49 # 5. '=over N' command is translated into
50 #        '\begin{itemize}'      if following =item starts with *,
51 #        '\begin{enumerate}'    if following =item starts with 1.,
52 #        '\begin{description}'  if else.
53 #      (indentation level N is ignored.)
54 # 6. '=item * heading' command is translated into '\item heading',
55 #    '=item 1. heading' command is translated into '\item heading',
56 #    '=item heading' command(other) is translated into '\item[heading]'.
57 # 7. '=back' command is translated into
58 #        '\end{itemize}'        if started with '\begin{itemize}',
59 #        '\end{enumerate}'      if started with '\begin{enumerate}',
60 #        '\end{description}'    if started with '\begin{description}'.
61 # 8. other paragraphs are translated into strings with TeX special characters
62 #    escaped.
63 # 9. In heading text, and other paragraphs, the following translation of pod
64 #    quotes are done, and then TeX special characters are escaped after that.
65 #      I<text> to {\em text\/},
66 #      B<text> to {\bf text},
67 #      S<text> to text1,
68 #        where text1 is a string with blank characters replaced with ~,
69 #      C<text> to {\tt text2},
70 #        where text2 is a string with TeX special characters escaped to
71 #        obtain a literal printout,
72 #      E<text> (HTML escape) to TeX escaped string,
73 #      L<text> to referencing string as is done by pod2man,
74 #      F<file> to {\em file\/},
75 #      Z<> to a null string,
76 # 10. those headings are indexed:
77 #       '=head1 heading'   =>  \section{heading}\index{heading}
78 #       '=head2 heading'   =>  \subsection*{heading}\index{heading}
79 #                 only when heading does not match frequent patterns such as
80 #                 DESCRIPTION, DIAGNOSTICS,...
81 #       '=item heading'   =>  \item{heading}\index{heading}
82 #
83 # Usage:
84 #     pod2latex perl_doc_entry.pod
85 # this will write to a file 'perl_doc_entry.tex'.
86 #
87 # To LaTeX:
88 # The following commands need to be defined in the preamble of the LaTeX
89 # document:
90 # \def\C++{{\rm C\kern-.05em\raise.3ex\hbox{\footnotesize ++}}}
91 # \def\underscore{\leavevmode\kern.04em\vbox{\hrule width 0.4em height 0.3pt}}
92 # and \parindent should be set zero:
93 # \setlength{\parindent}{0pt}
94 #
95 # Note:
96 # This script was written modifing pod2man.
97 #
98 # Bug:
99 # If HTML escapes E<text> other than E<amp>,E<lt>,E<gt>,E<quot> are used
100 # in C<>, translation will produce wrong character strings.
101 # Translation of HTML escapes of various European accents might be wrong.
102
103
104 $/ = "";                        # record separator is blank lines
105 # TeX special characters.
106 ##$tt_ables = "!@*()-=+|;:'\"`,./?<>";
107 $backslash_escapables = "#\$%&{}_";
108 $backslash_escapables2 = "#\$%&{}";     # except _
109 ##$nonverbables = "^\\~";
110 ##$bracketesc = "[]";
111 ##@tex_verb_fences = unpack("aaaaaaaaa","|#@!*+?:;");
112
113 @head1_freq_patterns            # =head1 patterns which need not be index'ed
114     = ("AUTHOR","Author","BUGS","DATE","DESCRIPTION","DIAGNOSTICS",
115        "ENVIRONMENT","EXAMPLES","FILES","INTRODUCTION","NAME","NOTE",
116        "SEE ALSO","SYNOPSIS","WARNING");
117
118 $indent = 0;
119
120 # parse the pods, produce LaTeX.
121
122 open(POD,"<$ARGV[0]") || die "cant open $ARGV[0]";
123 ($pod=$ARGV[0]) =~ s/\.pod$//;
124 open(LATEX,">$pod.tex");
125 &do_hdr();
126
127 $cutting = 1;
128 $begun = "";
129 while (<POD>) {
130     if ($cutting) {
131         next unless /^=/;
132         $cutting = 0;
133     }
134     if ($begun) {
135        if (/^=end\s+$begun/) {
136            $begun = "";
137        }
138        elsif ($begun =~ /^(tex|latex)$/) {
139            print LATEX $_;
140        }
141        next;
142     }
143     chop;
144     length || (print LATEX  "\n") && next;
145
146     # translate indented lines as a verabatim paragraph
147     if (/^\s/) {
148         @lines = split(/\n/);
149         print LATEX  "\\begin{verbatim}\n";
150         for (@lines) {
151             1 while s
152                 {^( [^\t]* ) \t ( \t* ) }
153                 { $1 . ' ' x (8 - (length($1)%8) + 8*(length($2))) }ex;
154             print LATEX  $_,"\n";
155         }
156         print LATEX  "\\end{verbatim}\n";
157         next;
158     }
159
160     if (/^=for\s+(\S+)\s*/s) {
161         if ($1 eq "tex" or $1 eq "latex") {
162             print LATEX $',"\n";
163         } else {
164             # ignore unknown for
165         }
166         next;
167     }
168     elsif (/^=begin\s+(\S+)\s*/s) {
169         $begun = $1;
170         if ($1 eq "tex" or $1 eq "latex") {
171             print LATEX $'."\n";
172         }
173         next;
174     }
175
176     # preserve '=item' line with pod quotes as they are.
177     if (/^=item/) {
178         ($bareitem = $_) =~ s/^=item\s*//;
179     }
180
181     # check for things that'll hosed our noremap scheme; affects $_
182     &init_noremap();
183
184     # expand strings "func()" as pod quotes.
185     if (!/^=item/) {
186         # first hide pod escapes.
187         # escaped strings are mapped into the ones with the MSB's on.
188         s/([A-Z]<[^<>]*>)/noremap($1)/ge;
189
190         # func() is a reference to a perl function
191         s{\b([:\w]+\(\))}{I<$1>}g;
192         # func(n) is a reference to a man page
193         s{(\w+)(\([^\s,\051]+\))}{I<$1>$2}g;
194         # convert simple variable references
195 #       s/([\$\@%][\w:]+)/C<$1>/g;
196 #       s/\$[\w:]+\[[0-9]+\]/C<$&>/g;
197
198         if (m{ ([\-\w]+\([^\051]*?[\@\$,][^\051]*?\))
199                }x && $` !~ /([LCI]<[^<>]*|-)$/ && !/^=\w/)
200         {
201             warn "``$1'' should be a [LCI]<$1> ref";
202         }
203         while (/(-[a-zA-Z])\b/g && $` !~ /[\w\-]$/) {
204             warn "``$1'' should be [CB]<$1> ref";
205         }
206
207         # put back pod quotes so we get the inside of <> processed;
208         $_ = &clear_noremap($_);
209     }
210
211
212     # process TeX special characters
213
214     # First hide HTML quotes E<> since they can be included in C<>.
215     s/(E<[^<>]+>)/noremap($1)/ge;
216
217     # Then hide C<> type literal quotes.
218     # String inside of C<> will later be expanded into {\tt ..} strings
219     # with TeX special characters escaped as needed.
220     s/(C<[^<>]*>)/&noremap($1)/ge;
221
222     # Next escape TeX special characters including other pod quotes B< >,...
223     #
224     # NOTE: s/re/&func($str)/e evaluates $str just once in perl5.
225     # (in perl4 evaluation takes place twice before getting passed to func().)
226
227     # - hyphen => ---
228     s/(\S+)(\s+)-+(\s+)(\S+)/"$1".&noremap(" --- ")."$4"/ge;
229     # '-', '--', "-"  =>  '{\tt -}', '{\tt --}', "{\tt -}"
230 ##    s/("|')(\s*)(-+)(\s*)\1/&noremap("$1$2\{\\tt $3\}$4$1")/ge;
231 ## changed Wed Jan 25 15:26:39 JST 1995
232     # '-', '--', "-"  =>  '$-$', '$--$', "$-$"
233     s/(\s+)(['"])(-+)([^'"\-]*)\2(\s+|[,.])/"$1$2".&noremap("\$$3\$")."$4$2$5"/ge;
234     s/(\s+)(['"])([^'"\-]*)(-+)(\s*)\2(\s+|[,.])/"$1$2$3".&noremap("\$$4\$")."$5$2$6"/ge;
235     # (--|-)  =>  ($--$|$-$)
236     s/(\s+)\((-+)([=@%\$\+\\\|\w]*)(-*)([=@%\$\+\\\|\w]*)\)(\s+|[,.])/"$1\(".&noremap("\$$2\$")."$3".&noremap("\$$4\$")."$5\)$6"/ge;
237     # numeral -  =>  $-$
238     s/(\(|[0-9]+|\s+)-(\s*\(?\s*[0-9]+)/&noremap("$1\$-\$$2")/ge;
239     # -- in quotes  =>  two separate -
240     s/B<([^<>]*)--([^<>]*)>/&noremap("B<$1\{\\tt --\}$2>")/ge;
241
242     # backslash escapable characters except _.
243     s/([$backslash_escapables2])/&noremap("\\$1")/ge;
244     s/_/&noremap("\\underscore{}")/ge;          # a litle thicker than \_.
245     # quote TeX special characters |, ^, ~, \.
246     s/\|/&noremap("\$|\$")/ge;
247     s/\^/&noremap("\$\\hat{\\hspace{0.4em}}\$")/ge;
248     s/\~/&noremap("\$\\tilde{\\hspace{0.4em}}\$")/ge;
249     s/\\/&noremap("\$\\backslash{}\$")/ge;
250     # quote [ and ] to be used in \item[]
251     s/([\[\]])/&noremap("{\\tt $1}")/ge;
252     # characters need to be treated differently in TeX
253     # keep * if an item heading
254     s/^(=item[ \t]+)[*]((.|\n)*)/"$1" . &noremap("*") . "$2"/ge;
255     s/[*]/&noremap("\$\\ast\$")/ge;     # other *
256
257     # hide other pod quotes.
258     s/([ABD-Z]<[^<>]*>)/&noremap($1)/ge;
259
260     # escape < and > as math strings,
261     # now that we are done with hiding pod <> quotes.
262     s/</&noremap("\$<\$")/ge;
263     s/>/&noremap("\$>\$")/ge;
264
265     # put it back so we get the <> processed again;
266     $_ = &clear_noremap($_);
267
268
269     # Expand pod quotes recursively:
270     # (1) type face directives [BIFS]<[^<>]*> to appropriate TeX commands,
271     # (2) L<[^<>]*> to reference strings,
272     # (3) C<[^<>]*> to TeX literal quotes,
273     # (4) HTML quotes E<> inside of C<> quotes.
274
275     # Hide E<> again since they can be included in C<>.
276     s/(E<[^<>]+>)/noremap($1)/ge;
277
278     $maxnest = 10;
279     while ($maxnest-- && /[A-Z]</) {
280
281         # bold and italic quotes
282         s/B<([^<>]*)>/"{\\bf $1}"/eg;
283         s#I<([^<>]*)>#"{\\em $1\\/}"#eg;
284
285         # files and filelike refs in italics
286         s#F<([^<>]*)>#"{\\em $1\\/}"#eg;
287
288         # no break quote -- usually we want C<> for this
289         s/S<([^<>]*)>/&nobreak($1)/eg;
290
291         # LREF: a manpage(3f)
292         s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))?>:the {\\em $1\\/}$2 manpage:g;
293
294         # LREF: an =item on another manpage
295         s{
296             L<([^/]+)/([:\w]+(\(\))?)>
297         } {the C<$2> entry in the I<$1> manpage}gx;
298
299         # LREF: an =item on this manpage
300         s{
301            ((?:L</([:\w]+(\(\))?)>
302             (,?\s+(and\s+)?)?)+)
303         } { &internal_lrefs($1) }gex;
304
305         # LREF: a =head2 (head1?), maybe on a manpage, maybe right here
306         # the "func" can disambiguate
307         s{
308             L<(?:([a-zA-Z]\S+?) /)?"?(.*?)"?>
309         }{
310             do {
311                 $1      # if no $1, assume it means on this page.
312                     ?  "the section on I<$2> in the I<$1> manpage"
313                     :  "the section on I<$2>"
314             } 
315         }gex;
316
317         s/Z<>/\\&/g;            # the "don't format me" thing
318
319         # comes last because not subject to reprocessing
320         s{
321             C<([^<>]*)>
322         }{
323             do {
324                 ($str = $1) =~ tr/\200-\377/\000-\177/; #normalize hidden stuff
325                 # expand HTML escapes if any;
326                 # WARNING: if HTML escapes other than E<amp>,E<lt>,E<gt>,
327                 # E<quot> are in C<>, they will not be printed correctly.
328                 $str = &expand_HTML_escapes($str);
329                 $strverb = &alltt($str);    # Tex verbatim escape of a string.
330                 &noremap("$strverb");
331             }
332         }gex;
333
334 #       if ( /C<([^<>]*)/ ) {
335 #           $str = $1;
336 #           if ($str !~ /\|/) {         # if includes |
337 #               s/C<([^<>]*)>/&noremap("\\verb|$str|")/eg;
338 #           } else {
339 #               print STDERR "found \| in C<.*> at paragraph $.\n";
340 #               # find a character not contained in $str to use it as a
341 #               # separator of the \verb
342 #               ($chars = $str) =~ s/(\W)/\\$1/g;
343 #               ## ($chars = $str) =~ s/([\$<>,\|"'\-^{}()*+?\\])/\\$1/g;
344 #               @fence = grep(!/[ $chars]/,@tex_verb_fences);
345 #               s/C<([^<>]*)>/&noremap("\\verb$fence[0]$str$fence[0]")/eg;
346 #           }
347 #       }
348     }
349
350
351     # process each pod command
352     if (s/^=//) {                               # if a command
353         s/\n/ /g;
354         ($cmd, $rest) = split(' ', $_, 2);
355         $rest =~ s/^\s*//;
356         $rest =~ s/\s*$//;
357
358         if (defined $rest) {
359             &escapes;
360         }
361
362         $rest = &clear_noremap($rest);
363         $rest = &expand_HTML_escapes($rest);
364
365         if ($cmd eq 'cut') {
366             $cutting = 1;
367             $lastcmd = 'cut';
368         }
369         elsif ($cmd eq 'head1') {       # heading type 1
370             $rest =~ s/^\s*//; $rest =~ s/\s*$//;
371             print LATEX  "\n\\subsection*{$rest}";
372             # put index entry
373             ($index = $rest) =~ s/^(An?\s+|The\s+)//i;  # remove 'A' and 'The'
374             # index only those heads not matching the frequent patterns.
375             foreach $pat (@head1_freq_patterns) {
376                 if ($index =~ /^$pat/) {
377                     goto freqpatt;
378                 }
379             }
380             print LATEX  "%\n\\index{$index}\n" if ($index);
381           freqpatt:
382             $lastcmd = 'head1';
383         }
384         elsif ($cmd eq 'head2') {       # heading type 2
385             $rest =~ s/^\s*//; $rest =~ s/\s*$//;
386             print LATEX  "\n\\subsubsection*{$rest}";
387             # put index entry
388             ($index = $rest) =~ s/^(An?\s+|The\s+)//i;  # remove 'A' and 'The'
389             $index =~ s/^Example\s*[1-9][0-9]*\s*:\s*//; # remove 'Example :'
390             print LATEX  "%\n\\index{$index}\n"  if ($index);
391             $lastcmd = 'head2';
392         }
393         elsif ($cmd eq 'over') {        # 1 level within a listing environment
394             push(@indent,$indent);
395             $indent = $rest + 0;
396             $lastcmd = 'over';
397         }
398         elsif ($cmd eq 'back') {        # 1 level out of a listing environment
399             $indent = pop(@indent);
400             warn "Unmatched =back\n" unless defined $indent;
401             $listingcmd = pop(@listingcmd);
402             print LATEX  "\n\\end{$listingcmd}\n"  if ($listingcmd);
403             $lastcmd = 'back';
404         }
405         elsif ($cmd eq 'item') {        # an item paragraph starts
406             if ($lastcmd eq 'over') {   # if we have just entered listing env
407                 # see what type of list environment we are in.
408                 if ($rest =~ /^[0-9]\.?/) {     # if numeral heading
409                     $listingcmd = 'enumerate';
410                 } elsif ($rest =~ /^\*\s*/) {   # if * heading
411                     $listingcmd = 'itemize';
412                 } elsif ($rest =~ /^[^*]/) {    # if other headings
413                     $listingcmd = 'description';
414                 } else {
415                     warn "unknown list type for item $rest";
416                 }
417                 print LATEX  "\n\\begin{$listingcmd}\n";
418                 push(@listingcmd,$listingcmd);
419             } elsif ($lastcmd ne 'item') {
420                 warn "Illegal '=item' command without preceding 'over':";
421                 warn "=item $bareitem";
422             }
423
424             if ($listingcmd eq 'enumerate') {
425                 $rest =~ s/^[0-9]+\.?\s*//;     # remove numeral heading
426                 print LATEX  "\n\\item";
427                 print LATEX  "{\\bf $rest}" if $rest;
428             } elsif ($listingcmd eq 'itemize') {
429                 $rest =~ s/^\*\s*//;            # remove * heading
430                 print LATEX  "\n\\item";
431                 print LATEX  "{\\bf $rest}" if $rest;
432             } else {                            # description item
433                 print LATEX  "\n\\item[$rest]";
434             }
435             $lastcmd = 'item';
436             $rightafter_item = 'yes';
437
438             # check if the item heading is short or long.
439             ($itemhead = $rest) =~ s/{\\bf (\S*)}/$1/g;
440             if (length($itemhead) < 4) {
441                 $itemshort = "yes";
442             } else {
443                 $itemshort = "no";
444             }
445             # write index entry
446             if ($pod =~ "perldiag") {                   # skip 'perldiag.pod'
447                 goto noindex;
448             }
449             # strip out the item of pod quotes and get a plain text entry
450             $bareitem =~ s/\n/ /g;                      # remove newlines
451             $bareitem =~ s/\s*$//;                      # remove trailing space
452             $bareitem =~ s/[A-Z]<([^<>]*)>/$1/g;        # remove <> quotes
453             ($index = $bareitem) =~ s/^\*\s+//;         # remove leading '*'
454             $index =~ s/^(An?\s+|The\s+)//i;            # remove 'A' and 'The'
455             $index =~ s/^\s*[1-9][0-9]*\s*[.]\s*$//; # remove numeral only
456             $index =~ s/^\s*\w\s*$//;                   # remove 1 char only's
457                 # quote ", @ and ! with " to be used in makeindex.
458             $index =~ s/"/""/g;                         # quote "
459             $index =~ s/@/"@/g;                         # quote @
460             $index =~ s/!/"!/g;                         # quote !
461             ($rest2=$rest) =~ s/^\*\s+//;       # remove *
462             $rest2 =~ s/"/""/g;                         # quote "
463             $rest2 =~ s/@/"@/g;                         # quote @
464             $rest2 =~ s/!/"!/g;                         # quote !
465             if ($pod =~ "(perlfunc|perlvar)") { # when doc is perlfunc,perlvar
466                 # take only the 1st word of item heading
467                 $index =~ s/^([^{}\s]*)({.*})?([^{}\s]*)\s+.*/\1\2\3/;
468                 $rest2 =~ s/^([^{}\s]*)({.*})?([^{}\s]*)\s+.*/\1\2\3/;
469             }
470             if ($index =~ /[A-Za-z\$@%]/) {
471                     #  write  \index{plain_text_entry@TeX_string_entry}
472                 print LATEX  "%\n\\index{$index\@$rest2}%\n";
473             }
474           noindex:
475             ;
476         }
477         elsif ($cmd eq 'pod') {
478             ;   # recognise the pod directive, as no op (hs)
479         }
480         elsif ($cmd eq 'pod') {
481             ;    # recognise the pod directive, as no op (hs)
482         }
483         else {
484             warn "Unrecognized directive: $cmd\n";
485         }
486     }
487     else {                                      # if not command
488         &escapes;
489         $_ = &clear_noremap($_);
490         $_ = &expand_HTML_escapes($_);
491
492         # if the present paragraphs follows an =item declaration,
493         # put a line break.
494         if ($lastcmd eq 'item' &&
495             $rightafter_item eq 'yes' && $itemshort eq "no") {
496             print LATEX  "\\hfil\\\\";
497             $rightafter_item = 'no';
498         }
499         print LATEX  "\n",$_;
500     }
501 }
502
503 print LATEX  "\n";
504 close(POD);
505 close(LATEX);
506
507
508 #########################################################################
509
510 sub do_hdr {
511     print LATEX "% LaTeX document produced by pod2latex from \"$pod.pod\".\n";
512     print LATEX "% The followings need be defined in the preamble of this document:\n";
513     print LATEX "%\\def\\C++{{\\rm C\\kern-.05em\\raise.3ex\\hbox{\\footnotesize ++}}}\n";
514     print LATEX "%\\def\\underscore{\\leavevmode\\kern.04em\\vbox{\\hrule width 0.4em height 0.3pt}}\n";
515     print LATEX "%\\setlength{\\parindent}{0pt}\n";
516     print LATEX "\n";
517     $podq = &escape_tex_specials("\U$pod\E");
518     print LATEX "\\section{$podq}%\n";
519     print LATEX "\\index{$podq}";
520     print LATEX "\n";
521 }
522
523 sub nobreak {
524     my $string = shift;
525     $string =~ s/ +/~/g;                # TeX no line break
526     $string;
527 }
528
529 sub noremap {
530     local($thing_to_hide) = shift;
531     $thing_to_hide =~ tr/\000-\177/\200-\377/;
532     return $thing_to_hide;
533 }
534
535 sub init_noremap {
536         # escape high bit characters in input stream
537         s/([\200-\377])/"E<".ord($1).">"/ge;
538 }
539
540 sub clear_noremap {
541     local($tmp) = shift;
542     $tmp =~ tr/\200-\377/\000-\177/;
543     return $tmp;
544 }
545
546 sub expand_HTML_escapes {
547     local($s) = $_[0];
548     $s =~ s { E<((\d+)|([A-Za-z]+))> }
549     {
550         do {
551                 defined($2) 
552                 ? do { chr($2) }
553                 : 
554             exists $HTML_Escapes{$3}
555             ? do { $HTML_Escapes{$3} }
556             : do {
557                 warn "Unknown escape: $& in $_";
558                 "E<$1>";
559             }
560         }
561     }egx;
562     return $s;
563 }
564
565 sub escapes {
566     # make C++ into \C++, which is to be defined as
567     # \def\C++{{\rm C\kern-.05em\raise.3ex\hbox{\footnotesize ++}}}
568     s/\bC\+\+/\\C++{}/g;
569 }
570
571 # Translate a string into a TeX \tt string to obtain a verbatim print out.
572 # TeX special characters are escaped by \.
573 # This can be used inside of LaTeX command arguments.
574 # We don't use LaTeX \verb since it doesn't work inside of command arguments.
575 sub alltt {
576     local($str) = shift;
577         # other chars than #,\,$,%,&,{,},_,\,^,~ ([ and ] included).
578     $str =~ s/([^${backslash_escapables}\\\^\~]+)/&noremap("$&")/eg;
579         # chars #,\,$,%,&,{,}  =>  \# , ...
580     $str =~ s/([$backslash_escapables2])/&noremap("\\$&")/eg;
581         # chars _,\,^,~  =>  \char`\_ , ...
582     $str =~ s/_/&noremap("\\char`\\_")/eg;
583     $str =~ s/\\/&noremap("\\char`\\\\")/ge;
584     $str =~ s/\^/\\char`\\^/g;
585     $str =~ s/\~/\\char`\\~/g;
586
587     $str =~ tr/\200-\377/\000-\177/;            # put back
588     $str = "{\\tt ".$str."}";                   # make it a \tt string
589     return $str;
590 }
591
592 sub escape_tex_specials {
593     local($str) = shift;
594         # other chars than #,\,$,%,&,{,},  _,\,^,~ ([ and ] included).
595     # backslash escapable characters #,\,$,%,&,{,} except _.
596     $str =~ s/([$backslash_escapables2])/&noremap("\\$1")/ge;
597     $str =~ s/_/&noremap("\\underscore{}")/ge;  # \_ is too thin.
598     # quote TeX special characters |, ^, ~, \.
599     $str =~ s/\|/&noremap("\$|\$")/ge;
600     $str =~ s/\^/&noremap("\$\\hat{\\hspace{0.4em}}\$")/ge;
601     $str =~ s/\~/&noremap("\$\\tilde{\\hspace{0.4em}}\$")/ge;
602     $str =~ s/\\/&noremap("\$\\backslash{}\$")/ge;
603     # characters need to be treated differently in TeX
604     # *
605     $str =~ s/[*]/&noremap("\$\\ast\$")/ge;
606     # escape < and > as math string,
607     $str =~ s/</&noremap("\$<\$")/ge;
608     $str =~ s/>/&noremap("\$>\$")/ge;
609     $str =~ tr/\200-\377/\000-\177/;            # put back
610     return $str;
611 }
612
613 sub internal_lrefs {
614     local($_) = shift;
615
616     s{L</([^>]+)>}{$1}g;
617     my(@items) = split( /(?:,?\s+(?:and\s+)?)/ );
618     my $retstr = "the ";
619     my $i;
620     for ($i = 0; $i <= $#items; $i++) {
621         $retstr .= "C<$items[$i]>";
622         $retstr .= ", " if @items > 2 && $i != $#items;
623         $retstr .= " and " if $i+2 == @items;
624     }
625     $retstr .= " entr" . ( @items > 1  ? "ies" : "y" )
626             .  " elsewhere in this document";
627
628     return $retstr;
629 }
630
631 # map of HTML escapes to TeX escapes.
632 BEGIN {
633 %HTML_Escapes = (
634     'amp'       =>      '&',    #   ampersand
635     'lt'        =>      '<',    #   left chevron, less-than
636     'gt'        =>      '>',    #   right chevron, greater-than
637     'quot'      =>      '"',    #   double quote
638
639     "Aacute"    =>      "\\'{A}",       #   capital A, acute accent
640     "aacute"    =>      "\\'{a}",       #   small a, acute accent
641     "Acirc"     =>      "\\^{A}",       #   capital A, circumflex accent
642     "acirc"     =>      "\\^{a}",       #   small a, circumflex accent
643     "AElig"     =>      '\\AE',         #   capital AE diphthong (ligature)
644     "aelig"     =>      '\\ae',         #   small ae diphthong (ligature)
645     "Agrave"    =>      "\\`{A}",       #   capital A, grave accent
646     "agrave"    =>      "\\`{a}",       #   small a, grave accent
647     "Aring"     =>      '\\u{A}',       #   capital A, ring
648     "aring"     =>      '\\u{a}',       #   small a, ring
649     "Atilde"    =>      '\\~{A}',       #   capital A, tilde
650     "atilde"    =>      '\\~{a}',       #   small a, tilde
651     "Auml"      =>      '\\"{A}',       #   capital A, dieresis or umlaut mark
652     "auml"      =>      '\\"{a}',       #   small a, dieresis or umlaut mark
653     "Ccedil"    =>      '\\c{C}',       #   capital C, cedilla
654     "ccedil"    =>      '\\c{c}',       #   small c, cedilla
655     "Eacute"    =>      "\\'{E}",       #   capital E, acute accent
656     "eacute"    =>      "\\'{e}",       #   small e, acute accent
657     "Ecirc"     =>      "\\^{E}",       #   capital E, circumflex accent
658     "ecirc"     =>      "\\^{e}",       #   small e, circumflex accent
659     "Egrave"    =>      "\\`{E}",       #   capital E, grave accent
660     "egrave"    =>      "\\`{e}",       #   small e, grave accent
661     "ETH"       =>      '\\OE',         #   capital Eth, Icelandic
662     "eth"       =>      '\\oe',         #   small eth, Icelandic
663     "Euml"      =>      '\\"{E}',       #   capital E, dieresis or umlaut mark
664     "euml"      =>      '\\"{e}',       #   small e, dieresis or umlaut mark
665     "Iacute"    =>      "\\'{I}",       #   capital I, acute accent
666     "iacute"    =>      "\\'{i}",       #   small i, acute accent
667     "Icirc"     =>      "\\^{I}",       #   capital I, circumflex accent
668     "icirc"     =>      "\\^{i}",       #   small i, circumflex accent
669     "Igrave"    =>      "\\`{I}",       #   capital I, grave accent
670     "igrave"    =>      "\\`{i}",       #   small i, grave accent
671     "Iuml"      =>      '\\"{I}',       #   capital I, dieresis or umlaut mark
672     "iuml"      =>      '\\"{i}',       #   small i, dieresis or umlaut mark
673     "Ntilde"    =>      '\\~{N}',       #   capital N, tilde
674     "ntilde"    =>      '\\~{n}',       #   small n, tilde
675     "Oacute"    =>      "\\'{O}",       #   capital O, acute accent
676     "oacute"    =>      "\\'{o}",       #   small o, acute accent
677     "Ocirc"     =>      "\\^{O}",       #   capital O, circumflex accent
678     "ocirc"     =>      "\\^{o}",       #   small o, circumflex accent
679     "Ograve"    =>      "\\`{O}",       #   capital O, grave accent
680     "ograve"    =>      "\\`{o}",       #   small o, grave accent
681     "Oslash"    =>      "\\O",          #   capital O, slash
682     "oslash"    =>      "\\o",          #   small o, slash
683     "Otilde"    =>      "\\~{O}",       #   capital O, tilde
684     "otilde"    =>      "\\~{o}",       #   small o, tilde
685     "Ouml"      =>      '\\"{O}',       #   capital O, dieresis or umlaut mark
686     "ouml"      =>      '\\"{o}',       #   small o, dieresis or umlaut mark
687     "szlig"     =>      '\\ss{}',       #   small sharp s, German (sz ligature)
688     "THORN"     =>      '\\L',          #   capital THORN, Icelandic
689     "thorn"     =>      '\\l',,         #   small thorn, Icelandic
690     "Uacute"    =>      "\\'{U}",       #   capital U, acute accent
691     "uacute"    =>      "\\'{u}",       #   small u, acute accent
692     "Ucirc"     =>      "\\^{U}",       #   capital U, circumflex accent
693     "ucirc"     =>      "\\^{u}",       #   small u, circumflex accent
694     "Ugrave"    =>      "\\`{U}",       #   capital U, grave accent
695     "ugrave"    =>      "\\`{u}",       #   small u, grave accent
696     "Uuml"      =>      '\\"{U}',       #   capital U, dieresis or umlaut mark
697     "uuml"      =>      '\\"{u}',       #   small u, dieresis or umlaut mark
698     "Yacute"    =>      "\\'{Y}",       #   capital Y, acute accent
699     "yacute"    =>      "\\'{y}",       #   small y, acute accent
700     "yuml"      =>      '\\"{y}',       #   small y, dieresis or umlaut mark
701 );
702 }
703 !NO!SUBS!
704
705 close OUT or die "Can't close $file: $!";
706 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
707 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
708 chdir $origdir;