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