Commit | Line | Data |
4633a7c4 |
1 | #!/usr/local/bin/perl |
2 | |
3 | use Config; |
4 | use File::Basename qw(&basename &dirname); |
5 | |
6 | # List explicitly here the variables you want Configure to |
7 | # generate. Metaconfig only looks for shell variables, so you |
8 | # have to mention them as if they were shell variables, not |
9 | # %Config entries. Thus you write |
10 | # $startperl |
2e4a4f55 |
11 | # $man3ext |
4633a7c4 |
12 | # to ensure Configure will look for $Config{startperl}. |
13 | |
b233458b |
14 | $file = basename($0); |
15 | $file =~ s/\.PL$//i; |
774d564b |
16 | $file .= '.com' if $^O eq 'VMS'; |
4633a7c4 |
17 | |
b233458b |
18 | chdir("pod") or die "Can't chdir to pod: $!"; |
4633a7c4 |
19 | open OUT,">$file" or die "Can't create $file: $!"; |
20 | |
21 | print "Extracting $file (with variable substitutions)\n"; |
22 | |
23 | # In this section, perl variables will be expanded during extraction. |
24 | # You can use $Config{...} to use Configure variables. |
25 | |
26 | print OUT <<"!GROK!THIS!"; |
5f05dabc |
27 | $Config{startperl} |
28 | eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' |
29 | if \$running_under_some_shell; |
2e4a4f55 |
30 | |
31 | \$DEF_PM_SECTION = '$Config{man3ext}' || '3'; |
5d94fbed |
32 | !GROK!THIS! |
33 | |
4633a7c4 |
34 | # In the following, perl variables are not expanded during extraction. |
35 | |
36 | print OUT <<'!NO!SUBS!'; |
cb1a09d0 |
37 | |
38 | =head1 NAME |
39 | |
40 | pod2man - translate embedded Perl pod directives into man pages |
41 | |
42 | =head1 SYNOPSIS |
43 | |
44 | B<pod2man> |
45 | [ B<--section=>I<manext> ] |
46 | [ B<--release=>I<relpatch> ] |
47 | [ B<--center=>I<string> ] |
48 | [ B<--date=>I<string> ] |
49 | [ B<--fixed=>I<font> ] |
50 | [ B<--official> ] |
1e422769 |
51 | [ B<--lax> ] |
cb1a09d0 |
52 | I<inputfile> |
53 | |
54 | =head1 DESCRIPTION |
55 | |
56 | B<pod2man> converts its input file containing embedded pod directives (see |
57 | L<perlpod>) into nroff source suitable for viewing with nroff(1) or |
58 | troff(1) using the man(7) macro set. |
59 | |
60 | Besides the obvious pod conversions, B<pod2man> also takes care of |
61 | func(), func(n), and simple variable references like $foo or @bar so |
62 | you don't have to use code escapes for them; complex expressions like |
63 | C<$fred{'stuff'}> will still need to be escaped, though. Other nagging |
64 | little roffish things that it catches include translating the minus in |
65 | something like foo-bar, making a long dash--like this--into a real em |
66 | dash, fixing up "paired quotes", putting a little space after the |
67 | parens in something like func(), making C++ and PI look right, making |
68 | double underbars have a little tiny space between them, making ALLCAPS |
69 | a teeny bit smaller in troff(1), and escaping backslashes so you don't |
70 | have to. |
71 | |
72 | =head1 OPTIONS |
73 | |
74 | =over 8 |
75 | |
76 | =item center |
77 | |
78 | Set the centered header to a specific string. The default is |
79 | "User Contributed Perl Documentation", unless the C<--official> flag is |
80 | given, in which case the default is "Perl Programmers Reference Guide". |
81 | |
82 | =item date |
83 | |
84 | Set the left-hand footer string to this value. By default, |
85 | the modification date of the input file will be used. |
86 | |
87 | =item fixed |
88 | |
89 | The fixed font to use for code refs. Defaults to CW. |
90 | |
91 | =item official |
92 | |
93 | Set the default header to indicate that this page is of |
94 | the standard release in case C<--center> is not given. |
95 | |
96 | =item release |
97 | |
98 | Set the centered footer. By default, this is the current |
99 | perl release. |
100 | |
101 | =item section |
102 | |
103 | Set the section for the C<.TH> macro. The standard conventions on |
104 | sections are to use 1 for user commands, 2 for system calls, 3 for |
105 | functions, 4 for devices, 5 for file formats, 6 for games, 7 for |
106 | miscellaneous information, and 8 for administrator commands. This works |
107 | best if you put your Perl man pages in a separate tree, like |
108 | F</usr/local/perl/man/>. By default, section 1 will be used |
109 | unless the file ends in F<.pm> in which case section 3 will be selected. |
110 | |
1e422769 |
111 | =item lax |
112 | |
113 | Don't complain when required sections aren't present. |
114 | |
cb1a09d0 |
115 | =back |
116 | |
117 | =head1 Anatomy of a Proper Man Page |
118 | |
119 | For those not sure of the proper layout of a man page, here's |
120 | an example of the skeleton of a proper man page. Head of the |
121 | major headers should be setout as a C<=head1> directive, and |
122 | are historically written in the rather startling ALL UPPER CASE |
123 | format, although this is not mandatory. |
124 | Minor headers may be included using C<=head2>, and are |
125 | typically in mixed case. |
126 | |
127 | =over 10 |
128 | |
129 | =item NAME |
130 | |
131 | Mandatory section; should be a comma-separated list of programs or |
132 | functions documented by this podpage, such as: |
133 | |
134 | foo, bar - programs to do something |
135 | |
136 | =item SYNOPSIS |
137 | |
138 | A short usage summary for programs and functions, which |
139 | may someday be deemed mandatory. |
140 | |
141 | =item DESCRIPTION |
142 | |
143 | Long drawn out discussion of the program. It's a good idea to break this |
144 | up into subsections using the C<=head2> directives, like |
145 | |
146 | =head2 A Sample Subection |
147 | |
148 | =head2 Yet Another Sample Subection |
149 | |
150 | =item OPTIONS |
151 | |
152 | Some people make this separate from the description. |
153 | |
154 | =item RETURN VALUE |
155 | |
156 | What the program or function returns if successful. |
157 | |
158 | =item ERRORS |
159 | |
160 | Exceptions, return codes, exit stati, and errno settings. |
161 | |
162 | =item EXAMPLES |
163 | |
164 | Give some example uses of the program. |
165 | |
166 | =item ENVIRONMENT |
167 | |
168 | Envariables this program might care about. |
169 | |
170 | =item FILES |
171 | |
172 | All files used by the program. You should probably use the FE<lt>E<gt> |
173 | for these. |
174 | |
175 | =item SEE ALSO |
176 | |
177 | Other man pages to check out, like man(1), man(7), makewhatis(8), or catman(8). |
178 | |
179 | =item NOTES |
180 | |
181 | Miscellaneous commentary. |
182 | |
183 | =item CAVEATS |
184 | |
185 | Things to take special care with; sometimes called WARNINGS. |
186 | |
187 | =item DIAGNOSTICS |
188 | |
189 | All possible messages the program can print out--and |
190 | what they mean. |
191 | |
192 | =item BUGS |
193 | |
194 | Things that are broken or just don't work quite right. |
195 | |
196 | =item RESTRICTIONS |
197 | |
198 | Bugs you don't plan to fix :-) |
199 | |
200 | =item AUTHOR |
201 | |
202 | Who wrote it (or AUTHORS if multiple). |
203 | |
204 | =item HISTORY |
205 | |
206 | Programs derived from other sources sometimes have this, or |
e52f39a2 |
207 | you might keep a modification log here. |
cb1a09d0 |
208 | |
209 | =back |
210 | |
211 | =head1 EXAMPLES |
212 | |
213 | pod2man program > program.1 |
214 | pod2man some_module.pm > /usr/perl/man/man3/some_module.3 |
215 | pod2man --section=7 note.pod > note.7 |
216 | |
217 | =head1 DIAGNOSTICS |
218 | |
219 | The following diagnostics are generated by B<pod2man>. Items |
220 | marked "(W)" are non-fatal, whereas the "(F)" errors will cause |
221 | B<pod2man> to immediately exit with a non-zero status. |
222 | |
223 | =over 4 |
224 | |
225 | =item bad option in paragraph %d of %s: ``%s'' should be [%s]<%s> |
226 | |
227 | (W) If you start include an option, you should set it off |
228 | as bold, italic, or code. |
229 | |
230 | =item can't open %s: %s |
231 | |
232 | (F) The input file wasn't available for the given reason. |
233 | |
cb1a09d0 |
234 | =item Improper man page - no dash in NAME header in paragraph %d of %s |
235 | |
236 | (W) The NAME header did not have an isolated dash in it. This is |
237 | considered important. |
238 | |
239 | =item Invalid man page - no NAME line in %s |
240 | |
241 | (F) You did not include a NAME header, which is essential. |
242 | |
243 | =item roff font should be 1 or 2 chars, not `%s' (F) |
244 | |
245 | (F) The font specified with the C<--fixed> option was not |
246 | a one- or two-digit roff font. |
247 | |
248 | =item %s is missing required section: %s |
249 | |
250 | (W) Required sections include NAME, DESCRIPTION, and if you're |
251 | using a section starting with a 3, also a SYNOPSIS. Actually, |
252 | not having a NAME is a fatal. |
253 | |
254 | =item Unknown escape: %s in %s |
255 | |
256 | (W) An unknown HTML entity (probably for an 8-bit character) was given via |
e52f39a2 |
257 | a C<EE<lt>E<gt>> directive. Besides amp, lt, gt, and quot, recognized |
cb1a09d0 |
258 | entities are Aacute, aacute, Acirc, acirc, AElig, aelig, Agrave, agrave, |
259 | Aring, aring, Atilde, atilde, Auml, auml, Ccedil, ccedil, Eacute, eacute, |
260 | Ecirc, ecirc, Egrave, egrave, ETH, eth, Euml, euml, Iacute, iacute, Icirc, |
261 | icirc, Igrave, igrave, Iuml, iuml, Ntilde, ntilde, Oacute, oacute, Ocirc, |
262 | ocirc, Ograve, ograve, Oslash, oslash, Otilde, otilde, Ouml, ouml, szlig, |
263 | THORN, thorn, Uacute, uacute, Ucirc, ucirc, Ugrave, ugrave, Uuml, uuml, |
264 | Yacute, yacute, and yuml. |
265 | |
266 | =item Unmatched =back |
267 | |
268 | (W) You have a C<=back> without a corresponding C<=over>. |
269 | |
270 | =item Unrecognized pod directive: %s |
271 | |
272 | (W) You specified a pod directive that isn't in the known list of |
273 | C<=head1>, C<=head2>, C<=item>, C<=over>, C<=back>, or C<=cut>. |
274 | |
275 | |
276 | =back |
277 | |
278 | =head1 NOTES |
279 | |
280 | If you would like to print out a lot of man page continuously, you |
281 | probably want to set the C and D registers to set contiguous page |
e52f39a2 |
282 | numbering and even/odd paging, at least on some versions of man(7). |
cb1a09d0 |
283 | Settting the F register will get you some additional experimental |
284 | indexing: |
285 | |
286 | troff -man -rC1 -rD1 -rF1 perl.1 perldata.1 perlsyn.1 ... |
287 | |
288 | The indexing merely outputs messages via C<.tm> for each |
289 | major page, section, subsection, item, and any C<XE<lt>E<gt>> |
290 | directives. |
291 | |
292 | |
293 | =head1 RESTRICTIONS |
294 | |
3dd51965 |
295 | None at this time. |
cb1a09d0 |
296 | |
297 | =head1 BUGS |
298 | |
299 | The =over and =back directives don't really work right. They |
300 | take absolute positions instead of offsets, don't nest well, and |
301 | making people count is suboptimal in any event. |
302 | |
303 | =head1 AUTHORS |
304 | |
305 | Original prototype by Larry Wall, but so massively hacked over by |
306 | Tom Christiansen such that Larry probably doesn't recognize it anymore. |
307 | |
308 | =cut |
a0d0e21e |
309 | |
310 | $/ = ""; |
311 | $cutting = 1; |
1c98b8f6 |
312 | @Indices = (); |
a0d0e21e |
313 | |
3dd51965 |
314 | # We try first to get the version number from a local binary, in case we're |
315 | # running an installed version of Perl to produce documentation from an |
316 | # uninstalled newer version's pod files. |
491527d0 |
317 | if ($^O ne 'plan9' and $^O ne 'dos' and $^O ne 'os2' and $^O ne 'MSWin32') { |
206c6dae |
318 | my $perl = (-x './perl' && -f './perl' ) ? |
319 | './perl' : |
320 | ((-x '../perl' && -f '../perl') ? |
321 | '../perl' : |
322 | ''); |
39e216bc |
323 | ($version,$patch) = `$perl -e 'print $]'` =~ /^(\d\.\d{3})(\d{2})?/ if $perl; |
3dd51965 |
324 | } |
325 | # No luck; we'll just go with the running Perl's version |
326 | ($version,$patch) = $] =~ /^(.{5})(\d{2})?/ unless $version; |
cb1a09d0 |
327 | $DEF_RELEASE = "perl $version"; |
328 | $DEF_RELEASE .= ", patch $patch" if $patch; |
329 | |
330 | |
331 | sub makedate { |
332 | my $secs = shift; |
333 | my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($secs); |
334 | my $mname = (qw{Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec})[$mon]; |
10d20342 |
335 | $year += 1900; |
cb1a09d0 |
336 | return "$mday/$mname/$year"; |
a0d0e21e |
337 | } |
338 | |
cb1a09d0 |
339 | use Getopt::Long; |
340 | |
341 | $DEF_SECTION = 1; |
342 | $DEF_CENTER = "User Contributed Perl Documentation"; |
343 | $STD_CENTER = "Perl Programmers Reference Guide"; |
344 | $DEF_FIXED = 'CW'; |
1e422769 |
345 | $DEF_LAX = 0; |
cb1a09d0 |
346 | |
347 | sub usage { |
348 | warn "$0: @_\n" if @_; |
349 | die <<EOF; |
350 | usage: $0 [options] podpage |
351 | Options are: |
352 | --section=manext (default "$DEF_SECTION") |
353 | --release=relpatch (default "$DEF_RELEASE") |
354 | --center=string (default "$DEF_CENTER") |
355 | --date=string (default "$DEF_DATE") |
356 | --fixed=font (default "$DEF_FIXED") |
357 | --official (default NOT) |
1e422769 |
358 | --lax (default NOT) |
cb1a09d0 |
359 | EOF |
360 | } |
361 | |
362 | $uok = GetOptions( qw( |
363 | section=s |
364 | release=s |
365 | center=s |
366 | date=s |
367 | fixed=s |
368 | official |
1e422769 |
369 | lax |
cb1a09d0 |
370 | help)); |
371 | |
372 | $DEF_DATE = makedate((stat($ARGV[0]))[9] || time()); |
373 | |
374 | usage("Usage error!") unless $uok; |
375 | usage() if $opt_help; |
376 | usage("Need one and only one podpage argument") unless @ARGV == 1; |
377 | |
2e4a4f55 |
378 | $section = $opt_section || ($ARGV[0] =~ /\.pm$/ |
379 | ? $DEF_PM_SECTION : $DEF_SECTION); |
cb1a09d0 |
380 | $RP = $opt_release || $DEF_RELEASE; |
381 | $center = $opt_center || ($opt_official ? $STD_CENTER : $DEF_CENTER); |
1e422769 |
382 | $lax = $opt_lax || $DEF_LAX; |
cb1a09d0 |
383 | |
384 | $CFont = $opt_fixed || $DEF_FIXED; |
385 | |
a0d0e21e |
386 | if (length($CFont) == 2) { |
387 | $CFont_embed = "\\f($CFont"; |
cb1a09d0 |
388 | } |
a0d0e21e |
389 | elsif (length($CFont) == 1) { |
390 | $CFont_embed = "\\f$CFont"; |
cb1a09d0 |
391 | } |
a0d0e21e |
392 | else { |
cb1a09d0 |
393 | die "roff font should be 1 or 2 chars, not `$CFont_embed'"; |
394 | } |
395 | |
cb1a09d0 |
396 | $date = $opt_date || $DEF_DATE; |
397 | |
398 | for (qw{NAME DESCRIPTION}) { |
399 | # for (qw{NAME DESCRIPTION AUTHOR}) { |
400 | $wanna_see{$_}++; |
401 | } |
402 | $wanna_see{SYNOPSIS}++ if $section =~ /^3/; |
403 | |
a0d0e21e |
404 | |
cb1a09d0 |
405 | $name = @ARGV ? $ARGV[0] : "<STDIN>"; |
406 | $Filename = $name; |
55497cff |
407 | if ($section =~ /^1/) { |
408 | require File::Basename; |
409 | $name = uc File::Basename::basename($name); |
410 | } |
411 | $name =~ s/\.(pod|p[lm])$//i; |
bbc6b0c7 |
412 | |
413 | # Lose everything up to the first of |
414 | # */lib/*perl* standard or site_perl module |
415 | # */*perl*/lib from -D prefix=/opt/perl |
416 | # */*perl*/ random module hierarchy |
417 | # which works. |
418 | $name =~ s-//+-/-g; |
419 | if ($name =~ s-^.*?/lib/[^/]*perl[^/]*/--i |
420 | or $name =~ s-^.*?/[^/]*perl[^/]*/lib/--i |
421 | or $name =~ s-^.*?/[^/]*perl[^/]*/--i) { |
2dde2d61 |
422 | # Lose ^site(_perl)?/. |
423 | $name =~ s-^site(_perl)?/--; |
424 | # Lose ^arch/. (XXX should we use Config? Just for archname?) |
425 | $name =~ s~^(.*-$^O|$^O-.*)/~~o; |
426 | # Lose ^version/. |
427 | $name =~ s-^\d+\.\d+/--; |
bbc6b0c7 |
428 | } |
429 | |
430 | # Translate Getopt/Long to Getopt::Long, etc. |
431 | $name =~ s(/)(::)g; |
a0d0e21e |
432 | |
cb1a09d0 |
433 | if ($name ne 'something') { |
434 | FCHECK: { |
435 | open(F, "< $ARGV[0]") || die "can't open $ARGV[0]: $!"; |
436 | while (<F>) { |
f360dba1 |
437 | next unless /^=\b/; |
cb1a09d0 |
438 | if (/^=head1\s+NAME\s*$/) { # an /m would forgive mistakes |
439 | $_ = <F>; |
440 | unless (/\s*-+\s+/) { |
441 | $oops++; |
f360dba1 |
442 | warn "$0: Improper man page - no dash in NAME header in paragraph $. of $ARGV[0]\n" |
d714cd28 |
443 | } else { |
444 | my @n = split /\s+-+\s+/; |
445 | if (@n != 2) { |
446 | $oops++; |
447 | warn "$0: Improper man page - malformed NAME header in paragraph $. of $ARGV[0]\n" |
448 | } |
449 | else { |
450 | %namedesc = @n; |
451 | } |
452 | } |
cb1a09d0 |
453 | last FCHECK; |
454 | } |
f360dba1 |
455 | next if /^=cut\b/; # DB_File and Net::Ping have =cut before NAME |
a8aaa22c |
456 | next if /^=pod\b/; # It is OK to have =pod before NAME |
1e422769 |
457 | die "$0: Invalid man page - 1st pod line is not NAME in $ARGV[0]\n" unless $lax; |
cb1a09d0 |
458 | } |
1e422769 |
459 | die "$0: Invalid man page - no documentation in $ARGV[0]\n" unless $lax; |
cb1a09d0 |
460 | } |
461 | close F; |
462 | } |
463 | |
a0d0e21e |
464 | print <<"END"; |
465 | .rn '' }` |
466 | ''' \$RCSfile\$\$Revision\$\$Date\$ |
cb1a09d0 |
467 | ''' |
a0d0e21e |
468 | ''' \$Log\$ |
cb1a09d0 |
469 | ''' |
a0d0e21e |
470 | .de Sh |
471 | .br |
472 | .if t .Sp |
473 | .ne 5 |
474 | .PP |
475 | \\fB\\\\\$1\\fR |
476 | .PP |
477 | .. |
478 | .de Sp |
479 | .if t .sp .5v |
480 | .if n .sp |
481 | .. |
482 | .de Ip |
483 | .br |
484 | .ie \\\\n(.\$>=3 .ne \\\\\$3 |
485 | .el .ne 3 |
486 | .IP "\\\\\$1" \\\\\$2 |
487 | .. |
488 | .de Vb |
489 | .ft $CFont |
490 | .nf |
491 | .ne \\\\\$1 |
492 | .. |
493 | .de Ve |
494 | .ft R |
495 | |
496 | .fi |
497 | .. |
498 | ''' |
499 | ''' |
500 | ''' Set up \\*(-- to give an unbreakable dash; |
501 | ''' string Tr holds user defined translation string. |
502 | ''' Bell System Logo is used as a dummy character. |
503 | ''' |
504 | .tr \\(*W-|\\(bv\\*(Tr |
505 | .ie n \\{\\ |
506 | .ds -- \\(*W- |
cb1a09d0 |
507 | .ds PI pi |
a0d0e21e |
508 | .if (\\n(.H=4u)&(1m=24u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-12u'-\\" diablo 10 pitch |
509 | .if (\\n(.H=4u)&(1m=20u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-8u'-\\" diablo 12 pitch |
510 | .ds L" "" |
511 | .ds R" "" |
3e3baf6d |
512 | ''' \\*(M", \\*(S", \\*(N" and \\*(T" are the equivalent of |
513 | ''' \\*(L" and \\*(R", except that they are used on ".xx" lines, |
514 | ''' such as .IP and .SH, which do another additional levels of |
515 | ''' double-quote interpretation |
516 | .ds M" """ |
517 | .ds S" """ |
518 | .ds N" """"" |
519 | .ds T" """"" |
a0d0e21e |
520 | .ds L' ' |
521 | .ds R' ' |
3e3baf6d |
522 | .ds M' ' |
523 | .ds S' ' |
524 | .ds N' ' |
525 | .ds T' ' |
a0d0e21e |
526 | 'br\\} |
527 | .el\\{\\ |
528 | .ds -- \\(em\\| |
529 | .tr \\*(Tr |
530 | .ds L" `` |
531 | .ds R" '' |
3e3baf6d |
532 | .ds M" `` |
533 | .ds S" '' |
534 | .ds N" `` |
535 | .ds T" '' |
a0d0e21e |
536 | .ds L' ` |
537 | .ds R' ' |
3e3baf6d |
538 | .ds M' ` |
539 | .ds S' ' |
540 | .ds N' ` |
541 | .ds T' ' |
cb1a09d0 |
542 | .ds PI \\(*p |
a0d0e21e |
543 | 'br\\} |
cb1a09d0 |
544 | END |
545 | |
546 | print <<'END'; |
547 | .\" If the F register is turned on, we'll generate |
548 | .\" index entries out stderr for the following things: |
549 | .\" TH Title |
550 | .\" SH Header |
551 | .\" Sh Subsection |
552 | .\" Ip Item |
553 | .\" X<> Xref (embedded |
554 | .\" Of course, you have to process the output yourself |
555 | .\" in some meaninful fashion. |
556 | .if \nF \{ |
557 | .de IX |
558 | .tm Index:\\$1\t\\n%\t"\\$2" |
559 | .. |
560 | .nr % 0 |
561 | .rr F |
562 | .\} |
563 | END |
564 | |
565 | print <<"END"; |
0fd7581c |
566 | .TH $name $section "$date" "$RP" "$center" |
a0d0e21e |
567 | .UC |
568 | END |
569 | |
1c98b8f6 |
570 | push(@Indices, qq{.IX Title "$name $section"}); |
571 | |
cb1a09d0 |
572 | while (($name, $desc) = each %namedesc) { |
573 | for ($name, $desc) { s/^\s+//; s/\s+$//; } |
1c98b8f6 |
574 | push(@Indices, qq(.IX Name "$name - $desc"\n)); |
cb1a09d0 |
575 | } |
576 | |
a0d0e21e |
577 | print <<'END'; |
cb1a09d0 |
578 | .if n .hy 0 |
a0d0e21e |
579 | .if n .na |
580 | .ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' |
581 | .de CQ \" put $1 in typewriter font |
582 | END |
583 | print ".ft $CFont\n"; |
584 | print <<'END'; |
585 | 'if n "\c |
748a9306 |
586 | 'if t \\&\\$1\c |
587 | 'if n \\&\\$1\c |
a0d0e21e |
588 | 'if n \&" |
748a9306 |
589 | \\&\\$2 \\$3 \\$4 \\$5 \\$6 \\$7 |
a0d0e21e |
590 | '.ft R |
591 | .. |
592 | .\" @(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2 |
593 | . \" AM - accent mark definitions |
9430eed9 |
594 | .bd B 3 |
a0d0e21e |
595 | . \" fudge factors for nroff and troff |
596 | .if n \{\ |
597 | . ds #H 0 |
598 | . ds #V .8m |
599 | . ds #F .3m |
600 | . ds #[ \f1 |
601 | . ds #] \fP |
602 | .\} |
603 | .if t \{\ |
748a9306 |
604 | . ds #H ((1u-(\\\\n(.fu%2u))*.13m) |
a0d0e21e |
605 | . ds #V .6m |
606 | . ds #F 0 |
607 | . ds #[ \& |
608 | . ds #] \& |
609 | .\} |
610 | . \" simple accents for nroff and troff |
611 | .if n \{\ |
612 | . ds ' \& |
613 | . ds ` \& |
614 | . ds ^ \& |
615 | . ds , \& |
616 | . ds ~ ~ |
617 | . ds ? ? |
618 | . ds ! ! |
cb1a09d0 |
619 | . ds / |
620 | . ds q |
a0d0e21e |
621 | .\} |
622 | .if t \{\ |
748a9306 |
623 | . ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" |
624 | . ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' |
625 | . ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' |
626 | . ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' |
627 | . ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' |
a0d0e21e |
628 | . ds ? \s-2c\h'-\w'c'u*7/10'\u\h'\*(#H'\zi\d\s+2\h'\w'c'u*8/10' |
629 | . ds ! \s-2\(or\s+2\h'-\w'\(or'u'\v'-.8m'.\v'.8m' |
748a9306 |
630 | . ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' |
a0d0e21e |
631 | . ds q o\h'-\w'o'u*8/10'\s-4\v'.4m'\z\(*i\v'-.4m'\s+4\h'\w'o'u*8/10' |
632 | .\} |
633 | . \" troff and (daisy-wheel) nroff accents |
748a9306 |
634 | .ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' |
a0d0e21e |
635 | .ds 8 \h'\*(#H'\(*b\h'-\*(#H' |
748a9306 |
636 | .ds v \\k:\h'-(\\n(.wu*9/10-\*(#H)'\v'-\*(#V'\*(#[\s-4v\s0\v'\*(#V'\h'|\\n:u'\*(#] |
637 | .ds _ \\k:\h'-(\\n(.wu*9/10-\*(#H+(\*(#F*2/3))'\v'-.4m'\z\(hy\v'.4m'\h'|\\n:u' |
638 | .ds . \\k:\h'-(\\n(.wu*8/10)'\v'\*(#V*4/10'\z.\v'-\*(#V*4/10'\h'|\\n:u' |
a0d0e21e |
639 | .ds 3 \*(#[\v'.2m'\s-2\&3\s0\v'-.2m'\*(#] |
748a9306 |
640 | .ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] |
a0d0e21e |
641 | .ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' |
748a9306 |
642 | .ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' |
a0d0e21e |
643 | .ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] |
644 | .ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] |
645 | .ds ae a\h'-(\w'a'u*4/10)'e |
646 | .ds Ae A\h'-(\w'A'u*4/10)'E |
647 | .ds oe o\h'-(\w'o'u*4/10)'e |
648 | .ds Oe O\h'-(\w'O'u*4/10)'E |
649 | . \" corrections for vroff |
748a9306 |
650 | .if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' |
651 | .if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' |
a0d0e21e |
652 | . \" for low resolution devices (crt and lpr) |
653 | .if \n(.H>23 .if \n(.V>19 \ |
654 | \{\ |
655 | . ds : e |
656 | . ds 8 ss |
657 | . ds v \h'-1'\o'\(aa\(ga' |
658 | . ds _ \h'-1'^ |
659 | . ds . \h'-1'. |
660 | . ds 3 3 |
661 | . ds o a |
662 | . ds d- d\h'-1'\(ga |
663 | . ds D- D\h'-1'\(hy |
664 | . ds th \o'bp' |
665 | . ds Th \o'LP' |
666 | . ds ae ae |
667 | . ds Ae AE |
668 | . ds oe oe |
669 | . ds Oe OE |
670 | .\} |
671 | .rm #[ #] #H #V #F C |
672 | END |
673 | |
674 | $indent = 0; |
675 | |
8c634b6e |
676 | $begun = ""; |
677 | |
31873dd1 |
678 | # Unrolling [^-=A-Z>]|[A-Z](?!<)|[-=](?![A-Z]<)[\x00-\xFF] gives: // MRE pp 165. |
258f629a |
679 | my $nonest = q{(?x) # Turn on /x mode. |
31873dd1 |
680 | (?: # Group |
681 | [^-=A-Z>]* # Anything that isn't a dash, equal sign or |
682 | # closing hook isn't special. Eat as much as |
683 | # we can. |
684 | (?: # Group. |
685 | (?: # Group. |
686 | [-=] # We want to recognize -> and =>. |
687 | (?![A-Z]<) # So, as long as it isn't followed by markup |
688 | [\x00-\xFF] # anything may follow - and = |
689 | | |
690 | [A-Z] # Capitals are fine too, |
691 | (?!<) # But not if they start markup. |
692 | ) # End of special sequences. |
693 | [^-=A-Z>]* # Followed by zero or more non-special chars. |
694 | )* # And we can repeat this as often as we can. |
258f629a |
695 | )}; # That's all folks. |
c16f2413 |
696 | |
a0d0e21e |
697 | while (<>) { |
698 | if ($cutting) { |
699 | next unless /^=/; |
700 | $cutting = 0; |
701 | } |
8c634b6e |
702 | if ($begun) { |
703 | if (/^=end\s+$begun/) { |
704 | $begun = ""; |
705 | } |
706 | elsif ($begun =~ /^(roff|man)$/) { |
707 | print STDOUT $_; |
708 | } |
709 | next; |
710 | } |
a0d0e21e |
711 | chomp; |
712 | |
713 | # Translate verbatim paragraph |
714 | |
715 | if (/^\s/) { |
716 | @lines = split(/\n/); |
717 | for (@lines) { |
718 | 1 while s |
719 | {^( [^\t]* ) \t ( \t* ) } |
720 | { $1 . ' ' x (8 - (length($1)%8) + 8 * (length($2))) }ex; |
721 | s/\\/\\e/g; |
722 | s/\A/\\&/s; |
723 | } |
724 | $lines = @lines; |
725 | makespace() unless $verbatim++; |
726 | print ".Vb $lines\n"; |
727 | print join("\n", @lines), "\n"; |
728 | print ".Ve\n"; |
729 | $needspace = 0; |
730 | next; |
731 | } |
732 | |
733 | $verbatim = 0; |
734 | |
8c634b6e |
735 | if (/^=for\s+(\S+)\s*/s) { |
736 | if ($1 eq "man" or $1 eq "roff") { |
737 | print STDOUT $',"\n\n"; |
738 | } else { |
739 | # ignore unknown for |
740 | } |
741 | next; |
742 | } |
743 | elsif (/^=begin\s+(\S+)\s*/s) { |
744 | $begun = $1; |
745 | if ($1 eq "man" or $1 eq "roff") { |
746 | print STDOUT $'."\n\n"; |
747 | } |
748 | next; |
749 | } |
750 | |
a0d0e21e |
751 | # check for things that'll hosed our noremap scheme; affects $_ |
752 | init_noremap(); |
753 | |
754 | if (!/^=item/) { |
755 | |
756 | # trofficate backslashes; must do it before what happens below |
757 | s/\\/noremap('\\e')/ge; |
758 | |
5b4ebf24 |
759 | # protect leading periods and quotes against *roff |
760 | # mistaking them for directives |
761 | s/^(?:[A-Z]<)?[.']/\\&$&/gm; |
a0d0e21e |
762 | |
cb1a09d0 |
763 | # first hide the escapes in case we need to |
a0d0e21e |
764 | # intuit something and get it wrong due to fmting |
765 | |
c16f2413 |
766 | 1 while s/([A-Z]<$nonest>)/noremap($1)/ge; |
a0d0e21e |
767 | |
768 | # func() is a reference to a perl function |
769 | s{ |
770 | \b |
771 | ( |
772 | [:\w]+ \(\) |
773 | ) |
774 | } {I<$1>}gx; |
775 | |
1e2391a5 |
776 | # func(n) is a reference to a perl function or a man page |
a0d0e21e |
777 | s{ |
1e2391a5 |
778 | ([:\w]+) |
a0d0e21e |
779 | ( |
1e2391a5 |
780 | \( [^\051]+ \) |
a0d0e21e |
781 | ) |
782 | } {I<$1>\\|$2}gx; |
783 | |
784 | # convert simple variable references |
19799a22 |
785 | s/(\s+)([\$\@%&*][\w:]+)(?!\()/${1}C<$2>/g; |
a0d0e21e |
786 | |
787 | if (m{ ( |
788 | [\-\w]+ |
789 | \( |
790 | [^\051]*? |
791 | [\@\$,] |
792 | [^\051]*? |
793 | \) |
794 | ) |
cb1a09d0 |
795 | }x && $` !~ /([LCI]<[^<>]*|-)$/ && !/^=\w/) |
a0d0e21e |
796 | { |
cb1a09d0 |
797 | warn "$0: bad option in paragraph $. of $ARGV: ``$1'' should be [LCI]<$1>\n"; |
798 | $oops++; |
799 | } |
a0d0e21e |
800 | |
801 | while (/(-[a-zA-Z])\b/g && $` !~ /[\w\-]$/) { |
cb1a09d0 |
802 | warn "$0: bad option in paragraph $. of $ARGV: ``$1'' should be [CB]<$1>\n"; |
803 | $oops++; |
804 | } |
a0d0e21e |
805 | |
806 | # put it back so we get the <> processed again; |
807 | clear_noremap(0); # 0 means leave the E's |
808 | |
809 | } else { |
810 | # trofficate backslashes |
811 | s/\\/noremap('\\e')/ge; |
812 | |
cb1a09d0 |
813 | } |
a0d0e21e |
814 | |
815 | # need to hide E<> first; they're processed in clear_noremap |
816 | s/(E<[^<>]+>)/noremap($1)/ge; |
817 | |
818 | |
819 | $maxnest = 10; |
820 | while ($maxnest-- && /[A-Z]</) { |
821 | |
822 | # can't do C font here |
c16f2413 |
823 | s/([BI])<($nonest)>/font($1) . $2 . font('R')/eg; |
a0d0e21e |
824 | |
825 | # files and filelike refs in italics |
c16f2413 |
826 | s/F<($nonest)>/I<$1>/g; |
a0d0e21e |
827 | |
828 | # no break -- usually we want C<> for this |
c16f2413 |
829 | s/S<($nonest)>/nobreak($1)/eg; |
a0d0e21e |
830 | |
b74bceb9 |
831 | # LREF: a la HREF L<show this text|man/section> |
832 | s:L<([^|>]+)\|[^>]+>:$1:g; |
833 | |
cb1a09d0 |
834 | # LREF: a manpage(3f) |
a0d0e21e |
835 | s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))?>:the I<$1>$2 manpage:g; |
836 | |
837 | # LREF: an =item on another manpage |
838 | s{ |
839 | L< |
840 | ([^/]+) |
841 | / |
842 | ( |
843 | [:\w]+ |
844 | (\(\))? |
845 | ) |
846 | > |
847 | } {the C<$2> entry in the I<$1> manpage}gx; |
848 | |
849 | # LREF: an =item on this manpage |
850 | s{ |
851 | ((?: |
852 | L< |
853 | / |
854 | ( |
855 | [:\w]+ |
856 | (\(\))? |
857 | ) |
858 | > |
859 | (,?\s+(and\s+)?)? |
860 | )+) |
861 | } { internal_lrefs($1) }gex; |
862 | |
863 | # LREF: a =head2 (head1?), maybe on a manpage, maybe right here |
864 | # the "func" can disambiguate |
865 | s{ |
866 | L< |
867 | (?: |
cb1a09d0 |
868 | ([a-zA-Z]\S+?) / |
a0d0e21e |
869 | )? |
870 | "?(.*?)"? |
871 | > |
872 | }{ |
873 | do { |
874 | $1 # if no $1, assume it means on this page. |
875 | ? "the section on I<$2> in the I<$1> manpage" |
876 | : "the section on I<$2>" |
cb1a09d0 |
877 | } |
e52f39a2 |
878 | }gesx; # s in case it goes over multiple lines, so . matches \n |
a0d0e21e |
879 | |
880 | s/Z<>/\\&/g; |
881 | |
882 | # comes last because not subject to reprocessing |
c16f2413 |
883 | s/C<($nonest)>/noremap("${CFont_embed}${1}\\fR")/eg; |
a0d0e21e |
884 | } |
885 | |
886 | if (s/^=//) { |
887 | $needspace = 0; # Assume this. |
888 | |
889 | s/\n/ /g; |
890 | |
891 | ($Cmd, $_) = split(' ', $_, 2); |
892 | |
3e3baf6d |
893 | $dotlevel = 1; |
894 | if ($Cmd eq 'head1') { |
895 | $dotlevel = 1; |
896 | } |
897 | elsif ($Cmd eq 'head2') { |
898 | $dotlevel = 1; |
899 | } |
900 | elsif ($Cmd eq 'item') { |
901 | $dotlevel = 2; |
902 | } |
903 | |
a0d0e21e |
904 | if (defined $_) { |
3e3baf6d |
905 | &escapes($dotlevel); |
a0d0e21e |
906 | s/"/""/g; |
907 | } |
908 | |
909 | clear_noremap(1); |
910 | |
911 | if ($Cmd eq 'cut') { |
912 | $cutting = 1; |
913 | } |
914 | elsif ($Cmd eq 'head1') { |
cb1a09d0 |
915 | s/\s+$//; |
916 | delete $wanna_see{$_} if exists $wanna_see{$_}; |
917 | print qq{.SH "$_"\n}; |
1c98b8f6 |
918 | push(@Indices, qq{.IX Header "$_"\n}); |
a0d0e21e |
919 | } |
920 | elsif ($Cmd eq 'head2') { |
cb1a09d0 |
921 | print qq{.Sh "$_"\n}; |
1c98b8f6 |
922 | push(@Indices, qq{.IX Subsection "$_"\n}); |
a0d0e21e |
923 | } |
924 | elsif ($Cmd eq 'over') { |
925 | push(@indent,$indent); |
cb1a09d0 |
926 | $indent += ($_ + 0) || 5; |
a0d0e21e |
927 | } |
928 | elsif ($Cmd eq 'back') { |
929 | $indent = pop(@indent); |
f360dba1 |
930 | warn "$0: Unmatched =back in paragraph $. of $ARGV\n" unless defined $indent; |
a0d0e21e |
931 | $needspace = 1; |
932 | } |
933 | elsif ($Cmd eq 'item') { |
934 | s/^\*( |$)/\\(bu$1/g; |
6ea29bdc |
935 | # if you know how to get ":s please do |
936 | s/\\\*\(L"([^"]+?)\\\*\(R"/'$1'/g; |
937 | s/\\\*\(L"([^"]+?)""/'$1'/g; |
938 | s/[^"]""([^"]+?)""[^"]/'$1'/g; |
939 | # here do something about the $" in perlvar? |
a0d0e21e |
940 | print STDOUT qq{.Ip "$_" $indent\n}; |
1c98b8f6 |
941 | push(@Indices, qq{.IX Item "$_"\n}); |
a0d0e21e |
942 | } |
cb1a09d0 |
943 | elsif ($Cmd eq 'pod') { |
944 | # this is just a comment |
945 | } |
a0d0e21e |
946 | else { |
f360dba1 |
947 | warn "$0: Unrecognized pod directive in paragraph $. of $ARGV: $Cmd\n"; |
a0d0e21e |
948 | } |
949 | } |
950 | else { |
951 | if ($needspace) { |
952 | &makespace; |
953 | } |
3e3baf6d |
954 | &escapes(0); |
a0d0e21e |
955 | clear_noremap(1); |
956 | print $_, "\n"; |
957 | $needspace = 1; |
958 | } |
959 | } |
960 | |
961 | print <<"END"; |
962 | |
963 | .rn }` '' |
964 | END |
965 | |
1e422769 |
966 | if (%wanna_see && !$lax) { |
cb1a09d0 |
967 | @missing = keys %wanna_see; |
968 | warn "$0: $Filename is missing required section" |
969 | . (@missing > 1 && "s") |
970 | . ": @missing\n"; |
971 | $oops++; |
972 | } |
973 | |
1c98b8f6 |
974 | foreach (@Indices) { print "$_\n"; } |
975 | |
cb1a09d0 |
976 | exit; |
977 | #exit ($oops != 0); |
978 | |
a0d0e21e |
979 | ######################################################################### |
980 | |
981 | sub nobreak { |
982 | my $string = shift; |
983 | $string =~ s/ /\\ /g; |
984 | $string; |
985 | } |
986 | |
987 | sub escapes { |
3e3baf6d |
988 | my $indot = shift; |
a0d0e21e |
989 | |
cb1a09d0 |
990 | s/X<(.*?)>/mkindex($1)/ge; |
991 | |
a0d0e21e |
992 | # translate the minus in foo-bar into foo\-bar for roff |
993 | s/([^0-9a-z-])-([^-])/$1\\-$2/g; |
994 | |
995 | # make -- into the string version \*(-- (defined above) |
996 | s/\b--\b/\\*(--/g; |
997 | s/"--([^"])/"\\*(--$1/g; # should be a better way |
998 | s/([^"])--"/$1\\*(--"/g; |
999 | |
1000 | # fix up quotes; this is somewhat tricky |
3e3baf6d |
1001 | my $dotmacroL = 'L'; |
1002 | my $dotmacroR = 'R'; |
1003 | if ( $indot == 1 ) { |
1004 | $dotmacroL = 'M'; |
1005 | $dotmacroR = 'S'; |
1006 | } |
1007 | elsif ( $indot >= 2 ) { |
1008 | $dotmacroL = 'N'; |
1009 | $dotmacroR = 'T'; |
1010 | } |
a0d0e21e |
1011 | if (!/""/) { |
3e3baf6d |
1012 | s/(^|\s)(['"])/noremap("$1\\*($dotmacroL$2")/ge; |
1013 | s/(['"])($|[\-\s,;\\!?.])/noremap("\\*($dotmacroR$1$2")/ge; |
a0d0e21e |
1014 | } |
1015 | |
1016 | #s/(?!")(?:.)--(?!")(?:.)/\\*(--/g; |
1017 | #s/(?:(?!")(?:.)--(?:"))|(?:(?:")--(?!")(?:.))/\\*(--/g; |
cb1a09d0 |
1018 | |
a0d0e21e |
1019 | |
1020 | # make sure that func() keeps a bit a space tween the parens |
1021 | ### s/\b\(\)/\\|()/g; |
1022 | ### s/\b\(\)/(\\|)/g; |
1023 | |
1024 | # make C++ into \*C+, which is a squinched version (defined above) |
1025 | s/\bC\+\+/\\*(C+/g; |
1026 | |
1027 | # make double underbars have a little tiny space between them |
1028 | s/__/_\\|_/g; |
1029 | |
cb1a09d0 |
1030 | # PI goes to \*(PI (defined above) |
a0d0e21e |
1031 | s/\bPI\b/noremap('\\*(PI')/ge; |
1032 | |
1033 | # make all caps a teeny bit smaller, but don't muck with embedded code literals |
1034 | my $hidCFont = font('C'); |
1035 | if ($Cmd !~ /^head1/) { # SH already makes smaller |
1036 | # /g isn't enough; 1 while or we'll be off |
1037 | |
1038 | # 1 while s{ |
1039 | # (?!$hidCFont)(..|^.|^) |
1040 | # \b |
1041 | # ( |
1042 | # [A-Z][\/A-Z+:\-\d_$.]+ |
1043 | # ) |
1044 | # (s?) |
1045 | # \b |
1046 | # } {$1\\s-1$2\\s0}gmox; |
1047 | |
1048 | 1 while s{ |
1049 | (?!$hidCFont)(..|^.|^) |
1050 | ( |
1051 | \b[A-Z]{2,}[\/A-Z+:\-\d_\$]*\b |
1052 | ) |
cb1a09d0 |
1053 | } { |
a0d0e21e |
1054 | $1 . noremap( '\\s-1' . $2 . '\\s0' ) |
1055 | }egmox; |
1056 | |
1057 | } |
1058 | } |
1059 | |
1060 | # make troff just be normal, but make small nroff get quoted |
1061 | # decided to just put the quotes in the text; sigh; |
1062 | sub ccvt { |
1e422769 |
1063 | local($_,$prev) = @_; |
a0d0e21e |
1064 | noremap(qq{.CQ "$_" \n\\&}); |
cb1a09d0 |
1065 | } |
a0d0e21e |
1066 | |
1067 | sub makespace { |
1068 | if ($indent) { |
1069 | print ".Sp\n"; |
1070 | } |
1071 | else { |
1072 | print ".PP\n"; |
1073 | } |
1074 | } |
1075 | |
cb1a09d0 |
1076 | sub mkindex { |
1077 | my ($entry) = @_; |
1078 | my @entries = split m:\s*/\s*:, $entry; |
1c98b8f6 |
1079 | push @Indices, ".IX Xref " . join ' ', map {qq("$_")} @entries; |
cb1a09d0 |
1080 | return ''; |
1081 | } |
1082 | |
a0d0e21e |
1083 | sub font { |
1084 | local($font) = shift; |
1085 | return '\\f' . noremap($font); |
cb1a09d0 |
1086 | } |
a0d0e21e |
1087 | |
1088 | sub noremap { |
1089 | local($thing_to_hide) = shift; |
1090 | $thing_to_hide =~ tr/\000-\177/\200-\377/; |
1091 | return $thing_to_hide; |
cb1a09d0 |
1092 | } |
a0d0e21e |
1093 | |
1094 | sub init_noremap { |
3dd51965 |
1095 | # escape high bit characters in input stream |
1096 | s/([\200-\377])/"E<".ord($1).">"/ge; |
cb1a09d0 |
1097 | } |
a0d0e21e |
1098 | |
1099 | sub clear_noremap { |
1100 | my $ready_to_print = $_[0]; |
1101 | |
1102 | tr/\200-\377/\000-\177/; |
1103 | |
1104 | # trofficate backslashes |
1105 | # s/(?!\\e)(?:..|^.|^)\\/\\e/g; |
1106 | |
1107 | # now for the E<>s, which have been hidden until now |
1108 | # otherwise the interative \w<> processing would have |
1109 | # been hosed by the E<gt> |
1110 | s { |
3dd51965 |
1111 | E< |
1112 | ( |
1113 | ( \d + ) |
1114 | | ( [A-Za-z]+ ) |
1115 | ) |
a0d0e21e |
1116 | > |
cb1a09d0 |
1117 | } { |
3dd51965 |
1118 | do { |
1119 | defined $2 |
1120 | ? chr($2) |
1121 | : |
1122 | exists $HTML_Escapes{$3} |
1123 | ? do { $HTML_Escapes{$3} } |
a0d0e21e |
1124 | : do { |
f360dba1 |
1125 | warn "$0: Unknown escape in paragraph $. of $ARGV: ``$&''\n"; |
a0d0e21e |
1126 | "E<$1>"; |
cb1a09d0 |
1127 | } |
1128 | } |
a0d0e21e |
1129 | }egx if $ready_to_print; |
cb1a09d0 |
1130 | } |
a0d0e21e |
1131 | |
1132 | sub internal_lrefs { |
1133 | local($_) = shift; |
5b4ebf24 |
1134 | local $trailing_and = s/and\s+$// ? "and " : ""; |
a0d0e21e |
1135 | |
1136 | s{L</([^>]+)>}{$1}g; |
1137 | my(@items) = split( /(?:,?\s+(?:and\s+)?)/ ); |
1138 | my $retstr = "the "; |
1139 | my $i; |
1140 | for ($i = 0; $i <= $#items; $i++) { |
1141 | $retstr .= "C<$items[$i]>"; |
1142 | $retstr .= ", " if @items > 2 && $i != $#items; |
1143 | $retstr .= " and " if $i+2 == @items; |
cb1a09d0 |
1144 | } |
a0d0e21e |
1145 | |
1146 | $retstr .= " entr" . ( @items > 1 ? "ies" : "y" ) |
7427f721 |
1147 | . " elsewhere in this document"; |
1148 | # terminal space to avoid words running together (pattern used |
1149 | # strips terminal spaces) |
1150 | $retstr .= " " if length $trailing_and; |
5b4ebf24 |
1151 | $retstr .= $trailing_and; |
a0d0e21e |
1152 | |
1153 | return $retstr; |
1154 | |
cb1a09d0 |
1155 | } |
a0d0e21e |
1156 | |
1157 | BEGIN { |
1158 | %HTML_Escapes = ( |
1159 | 'amp' => '&', # ampersand |
1160 | 'lt' => '<', # left chevron, less-than |
1161 | 'gt' => '>', # right chevron, greater-than |
1162 | 'quot' => '"', # double quote |
1163 | |
1164 | "Aacute" => "A\\*'", # capital A, acute accent |
1165 | "aacute" => "a\\*'", # small a, acute accent |
1166 | "Acirc" => "A\\*^", # capital A, circumflex accent |
1167 | "acirc" => "a\\*^", # small a, circumflex accent |
1168 | "AElig" => '\*(AE', # capital AE diphthong (ligature) |
1169 | "aelig" => '\*(ae', # small ae diphthong (ligature) |
1170 | "Agrave" => "A\\*`", # capital A, grave accent |
1171 | "agrave" => "A\\*`", # small a, grave accent |
1172 | "Aring" => 'A\\*o', # capital A, ring |
1173 | "aring" => 'a\\*o', # small a, ring |
1174 | "Atilde" => 'A\\*~', # capital A, tilde |
1175 | "atilde" => 'a\\*~', # small a, tilde |
1176 | "Auml" => 'A\\*:', # capital A, dieresis or umlaut mark |
1177 | "auml" => 'a\\*:', # small a, dieresis or umlaut mark |
1178 | "Ccedil" => 'C\\*,', # capital C, cedilla |
1179 | "ccedil" => 'c\\*,', # small c, cedilla |
1180 | "Eacute" => "E\\*'", # capital E, acute accent |
1181 | "eacute" => "e\\*'", # small e, acute accent |
1182 | "Ecirc" => "E\\*^", # capital E, circumflex accent |
1183 | "ecirc" => "e\\*^", # small e, circumflex accent |
1184 | "Egrave" => "E\\*`", # capital E, grave accent |
1185 | "egrave" => "e\\*`", # small e, grave accent |
1186 | "ETH" => '\\*(D-', # capital Eth, Icelandic |
1187 | "eth" => '\\*(d-', # small eth, Icelandic |
1188 | "Euml" => "E\\*:", # capital E, dieresis or umlaut mark |
1189 | "euml" => "e\\*:", # small e, dieresis or umlaut mark |
1190 | "Iacute" => "I\\*'", # capital I, acute accent |
1191 | "iacute" => "i\\*'", # small i, acute accent |
1192 | "Icirc" => "I\\*^", # capital I, circumflex accent |
1193 | "icirc" => "i\\*^", # small i, circumflex accent |
1194 | "Igrave" => "I\\*`", # capital I, grave accent |
1195 | "igrave" => "i\\*`", # small i, grave accent |
1196 | "Iuml" => "I\\*:", # capital I, dieresis or umlaut mark |
1197 | "iuml" => "i\\*:", # small i, dieresis or umlaut mark |
1198 | "Ntilde" => 'N\*~', # capital N, tilde |
1199 | "ntilde" => 'n\*~', # small n, tilde |
1200 | "Oacute" => "O\\*'", # capital O, acute accent |
1201 | "oacute" => "o\\*'", # small o, acute accent |
1202 | "Ocirc" => "O\\*^", # capital O, circumflex accent |
1203 | "ocirc" => "o\\*^", # small o, circumflex accent |
1204 | "Ograve" => "O\\*`", # capital O, grave accent |
1205 | "ograve" => "o\\*`", # small o, grave accent |
1206 | "Oslash" => "O\\*/", # capital O, slash |
1207 | "oslash" => "o\\*/", # small o, slash |
1208 | "Otilde" => "O\\*~", # capital O, tilde |
1209 | "otilde" => "o\\*~", # small o, tilde |
1210 | "Ouml" => "O\\*:", # capital O, dieresis or umlaut mark |
1211 | "ouml" => "o\\*:", # small o, dieresis or umlaut mark |
1212 | "szlig" => '\*8', # small sharp s, German (sz ligature) |
1213 | "THORN" => '\\*(Th', # capital THORN, Icelandic |
1214 | "thorn" => '\\*(th',, # small thorn, Icelandic |
1215 | "Uacute" => "U\\*'", # capital U, acute accent |
1216 | "uacute" => "u\\*'", # small u, acute accent |
1217 | "Ucirc" => "U\\*^", # capital U, circumflex accent |
1218 | "ucirc" => "u\\*^", # small u, circumflex accent |
1219 | "Ugrave" => "U\\*`", # capital U, grave accent |
1220 | "ugrave" => "u\\*`", # small u, grave accent |
1221 | "Uuml" => "U\\*:", # capital U, dieresis or umlaut mark |
1222 | "uuml" => "u\\*:", # small u, dieresis or umlaut mark |
1223 | "Yacute" => "Y\\*'", # capital Y, acute accent |
1224 | "yacute" => "y\\*'", # small y, acute accent |
1225 | "yuml" => "y\\*:", # small y, dieresis or umlaut mark |
1226 | ); |
1227 | } |
cb1a09d0 |
1228 | |
5d94fbed |
1229 | !NO!SUBS! |
4633a7c4 |
1230 | |
1231 | close OUT or die "Can't close $file: $!"; |
1232 | chmod 0755, $file or die "Can't reset permissions for $file: $!\n"; |
1233 | exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':'; |