4 use File::Basename qw(&basename &dirname);
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
11 # to ensure Configure will look for $Config{startperl}.
13 # This forces PL files to create target in same directory as PL file.
14 # This is so that make depend always knows where to find PL derivatives.
16 ($file = basename($0)) =~ s/\.PL$//;
18 if ($Config{'osname'} eq 'VMS' or
19 $Config{'osname'} eq 'OS2'); # "case-forgiving"
21 open OUT,">$file" or die "Can't create $file: $!";
23 print "Extracting $file (with variable substitutions)\n";
25 # In this section, perl variables will be expanded during extraction.
26 # You can use $Config{...} to use Configure variables.
28 print OUT <<"!GROK!THIS!";
30 eval 'exec perl -S \$0 "\$@"'
34 # In the following, perl variables are not expanded during extraction.
36 print OUT <<'!NO!SUBS!';
42 if ($ARGV[0] =~ s/-fc(.*)//) {
47 if (length($CFont) == 2) {
48 $CFont_embed = "\\f($CFont";
50 elsif (length($CFont) == 1) {
51 $CFont_embed = "\\f$CFont";
54 die "Roff font should be 1 or 2 chars, not `$CFont_embed'";
57 $name = @ARGV ? $ARGV[0] : "something";
62 ''' \$RCSfile\$\$Revision\$\$Date\$
80 .ie \\\\n(.\$>=3 .ne \\\\\$3
96 ''' Set up \\*(-- to give an unbreakable dash;
97 ''' string Tr holds user defined translation string.
98 ''' Bell System Logo is used as a dummy character.
100 .tr \\(*W-|\\(bv\\*(Tr
103 .if (\\n(.H=4u)&(1m=24u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-12u'-\\" diablo 10 pitch
104 .if (\\n(.H=4u)&(1m=20u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-8u'-\\" diablo 12 pitch
120 .TH \U$name\E 1 "\\*(RP"
127 .ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
128 .de CQ \" put $1 in typewriter font
130 print ".ft $CFont\n";
136 \\&\\$2 \\$3 \\$4 \\$5 \\$6 \\$7
139 .\" @(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2
140 . \" AM - accent mark definitions
142 . \" fudge factors for nroff and troff
151 . ds #H ((1u-(\\\\n(.fu%2u))*.13m)
157 . \" simple accents for nroff and troff
170 . ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
171 . ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
172 . ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
173 . ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
174 . ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
175 . ds ? \s-2c\h'-\w'c'u*7/10'\u\h'\*(#H'\zi\d\s+2\h'\w'c'u*8/10'
176 . ds ! \s-2\(or\s+2\h'-\w'\(or'u'\v'-.8m'.\v'.8m'
177 . ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
178 . 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'
180 . \" troff and (daisy-wheel) nroff accents
181 .ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
182 .ds 8 \h'\*(#H'\(*b\h'-\*(#H'
183 .ds v \\k:\h'-(\\n(.wu*9/10-\*(#H)'\v'-\*(#V'\*(#[\s-4v\s0\v'\*(#V'\h'|\\n:u'\*(#]
184 .ds _ \\k:\h'-(\\n(.wu*9/10-\*(#H+(\*(#F*2/3))'\v'-.4m'\z\(hy\v'.4m'\h'|\\n:u'
185 .ds . \\k:\h'-(\\n(.wu*8/10)'\v'\*(#V*4/10'\z.\v'-\*(#V*4/10'\h'|\\n:u'
186 .ds 3 \*(#[\v'.2m'\s-2\&3\s0\v'-.2m'\*(#]
187 .ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
188 .ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
189 .ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
190 .ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
191 .ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
192 .ds ae a\h'-(\w'a'u*4/10)'e
193 .ds Ae A\h'-(\w'A'u*4/10)'E
194 .ds oe o\h'-(\w'o'u*4/10)'e
195 .ds Oe O\h'-(\w'O'u*4/10)'E
196 . \" corrections for vroff
197 .if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
198 .if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
199 . \" for low resolution devices (crt and lpr)
200 .if \n(.H>23 .if \n(.V>19 \
204 . ds v \h'-1'\o'\(aa\(ga'
230 # Translate verbatim paragraph
233 @lines = split(/\n/);
236 {^( [^\t]* ) \t ( \t* ) }
237 { $1 . ' ' x (8 - (length($1)%8) + 8 * (length($2))) }ex;
242 makespace() unless $verbatim++;
243 print ".Vb $lines\n";
244 print join("\n", @lines), "\n";
252 # check for things that'll hosed our noremap scheme; affects $_
257 # trofficate backslashes; must do it before what happens below
258 s/\\/noremap('\\e')/ge;
260 # first hide the escapes in case we need to
261 # intuit something and get it wrong due to fmting
263 s/([A-Z]<[^<>]*>)/noremap($1)/ge;
265 # func() is a reference to a perl function
273 # func(n) is a reference to a man page
283 # convert simple variable references
284 s/(\s+)([\$\@%][\w:]+)/${1}C<$2>/g;
294 }x && $` !~ /([LCI]<[^<>]*|-)$/ && !/^=\w/)
296 warn "``$1'' should be a [LCI]<$1> ref";
299 while (/(-[a-zA-Z])\b/g && $` !~ /[\w\-]$/) {
300 warn "``$1'' should be [CB]<$1> ref";
303 # put it back so we get the <> processed again;
304 clear_noremap(0); # 0 means leave the E's
307 # trofficate backslashes
308 s/\\/noremap('\\e')/ge;
312 # need to hide E<> first; they're processed in clear_noremap
313 s/(E<[^<>]+>)/noremap($1)/ge;
317 while ($maxnest-- && /[A-Z]</) {
319 # can't do C font here
320 s/([BI])<([^<>]*)>/font($1) . $2 . font('R')/eg;
322 # files and filelike refs in italics
323 s/F<([^<>]*)>/I<$1>/g;
325 # no break -- usually we want C<> for this
326 s/S<([^<>]*)>/nobreak($1)/eg;
328 # LREF: a manpage(3f)
329 s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))?>:the I<$1>$2 manpage:g;
331 # LREF: an =item on another manpage
341 } {the C<$2> entry in the I<$1> manpage}gx;
343 # LREF: an =item on this manpage
355 } { internal_lrefs($1) }gex;
357 # LREF: a =head2 (head1?), maybe on a manpage, maybe right here
358 # the "func" can disambiguate
368 $1 # if no $1, assume it means on this page.
369 ? "the section on I<$2> in the I<$1> manpage"
370 : "the section on I<$2>"
376 # comes last because not subject to reprocessing
377 s/C<([^<>]*)>/noremap("${CFont_embed}${1}\\fR")/eg;
381 $needspace = 0; # Assume this.
385 ($Cmd, $_) = split(' ', $_, 2);
397 elsif ($Cmd eq 'head1') {
400 elsif ($Cmd eq 'head2') {
403 elsif ($Cmd eq 'over') {
404 push(@indent,$indent);
407 elsif ($Cmd eq 'back') {
408 $indent = pop(@indent);
409 warn "Unmatched =back\n" unless defined $indent;
412 elsif ($Cmd eq 'item') {
413 s/^\*( |$)/\\(bu$1/g;
414 print STDOUT qq{.Ip "$_" $indent\n};
417 warn "Unrecognized directive: $Cmd\n";
436 #########################################################################
440 $string =~ s/ /\\ /g;
446 # translate the minus in foo-bar into foo\-bar for roff
447 s/([^0-9a-z-])-([^-])/$1\\-$2/g;
449 # make -- into the string version \*(-- (defined above)
451 s/"--([^"])/"\\*(--$1/g; # should be a better way
452 s/([^"])--"/$1\\*(--"/g;
454 # fix up quotes; this is somewhat tricky
456 s/(^|\s)(['"])/noremap("$1\\*(L$2")/ge;
457 s/(['"])($|[\-\s,;\\!?.])/noremap("\\*(R$1$2")/ge;
460 #s/(?!")(?:.)--(?!")(?:.)/\\*(--/g;
461 #s/(?:(?!")(?:.)--(?:"))|(?:(?:")--(?!")(?:.))/\\*(--/g;
464 # make sure that func() keeps a bit a space tween the parens
465 ### s/\b\(\)/\\|()/g;
466 ### s/\b\(\)/(\\|)/g;
468 # make C++ into \*C+, which is a squinched version (defined above)
471 # make double underbars have a little tiny space between them
474 # PI goes to \*(-- (defined above)
475 s/\bPI\b/noremap('\\*(PI')/ge;
477 # make all caps a teeny bit smaller, but don't muck with embedded code literals
478 my $hidCFont = font('C');
479 if ($Cmd !~ /^head1/) { # SH already makes smaller
480 # /g isn't enough; 1 while or we'll be off
483 # (?!$hidCFont)(..|^.|^)
486 # [A-Z][\/A-Z+:\-\d_$.]+
490 # } {$1\\s-1$2\\s0}gmox;
493 (?!$hidCFont)(..|^.|^)
495 \b[A-Z]{2,}[\/A-Z+:\-\d_\$]*\b
498 $1 . noremap( '\\s-1' . $2 . '\\s0' )
504 # make troff just be normal, but make small nroff get quoted
505 # decided to just put the quotes in the text; sigh;
507 local($_,$prev) = @_;
508 if ( /^\W+$/ && !/^\$./ ) {
509 ($prev && "\n") . noremap(qq{.CQ $_ \n\\&});
512 noremap(qq{${CFont_embed}$_\\fR});
514 noremap(qq{.CQ "$_" \n\\&});
527 local($font) = shift;
528 return '\\f' . noremap($font);
532 local($thing_to_hide) = shift;
533 $thing_to_hide =~ tr/\000-\177/\200-\377/;
534 return $thing_to_hide;
538 if ( /[\200-\377]/ ) {
539 warn "hit bit char in input stream";
544 my $ready_to_print = $_[0];
546 tr/\200-\377/\000-\177/;
548 # trofficate backslashes
549 # s/(?!\\e)(?:..|^.|^)\\/\\e/g;
551 # now for the E<>s, which have been hidden until now
552 # otherwise the interative \w<> processing would have
553 # been hosed by the E<gt>
560 exists $HTML_Escapes{$1}
561 ? do { $HTML_Escapes{$1} }
563 warn "Unknown escape: $& in $_";
567 }egx if $ready_to_print;
574 my(@items) = split( /(?:,?\s+(?:and\s+)?)/ );
577 for ($i = 0; $i <= $#items; $i++) {
578 $retstr .= "C<$items[$i]>";
579 $retstr .= ", " if @items > 2 && $i != $#items;
580 $retstr .= " and " if $i+2 == @items;
583 $retstr .= " entr" . ( @items > 1 ? "ies" : "y" )
584 . " elsewhere in this document";
592 'amp' => '&', # ampersand
593 'lt' => '<', # left chevron, less-than
594 'gt' => '>', # right chevron, greater-than
595 'quot' => '"', # double quote
597 "Aacute" => "A\\*'", # capital A, acute accent
598 "aacute" => "a\\*'", # small a, acute accent
599 "Acirc" => "A\\*^", # capital A, circumflex accent
600 "acirc" => "a\\*^", # small a, circumflex accent
601 "AElig" => '\*(AE', # capital AE diphthong (ligature)
602 "aelig" => '\*(ae', # small ae diphthong (ligature)
603 "Agrave" => "A\\*`", # capital A, grave accent
604 "agrave" => "A\\*`", # small a, grave accent
605 "Aring" => 'A\\*o', # capital A, ring
606 "aring" => 'a\\*o', # small a, ring
607 "Atilde" => 'A\\*~', # capital A, tilde
608 "atilde" => 'a\\*~', # small a, tilde
609 "Auml" => 'A\\*:', # capital A, dieresis or umlaut mark
610 "auml" => 'a\\*:', # small a, dieresis or umlaut mark
611 "Ccedil" => 'C\\*,', # capital C, cedilla
612 "ccedil" => 'c\\*,', # small c, cedilla
613 "Eacute" => "E\\*'", # capital E, acute accent
614 "eacute" => "e\\*'", # small e, acute accent
615 "Ecirc" => "E\\*^", # capital E, circumflex accent
616 "ecirc" => "e\\*^", # small e, circumflex accent
617 "Egrave" => "E\\*`", # capital E, grave accent
618 "egrave" => "e\\*`", # small e, grave accent
619 "ETH" => '\\*(D-', # capital Eth, Icelandic
620 "eth" => '\\*(d-', # small eth, Icelandic
621 "Euml" => "E\\*:", # capital E, dieresis or umlaut mark
622 "euml" => "e\\*:", # small e, dieresis or umlaut mark
623 "Iacute" => "I\\*'", # capital I, acute accent
624 "iacute" => "i\\*'", # small i, acute accent
625 "Icirc" => "I\\*^", # capital I, circumflex accent
626 "icirc" => "i\\*^", # small i, circumflex accent
627 "Igrave" => "I\\*`", # capital I, grave accent
628 "igrave" => "i\\*`", # small i, grave accent
629 "Iuml" => "I\\*:", # capital I, dieresis or umlaut mark
630 "iuml" => "i\\*:", # small i, dieresis or umlaut mark
631 "Ntilde" => 'N\*~', # capital N, tilde
632 "ntilde" => 'n\*~', # small n, tilde
633 "Oacute" => "O\\*'", # capital O, acute accent
634 "oacute" => "o\\*'", # small o, acute accent
635 "Ocirc" => "O\\*^", # capital O, circumflex accent
636 "ocirc" => "o\\*^", # small o, circumflex accent
637 "Ograve" => "O\\*`", # capital O, grave accent
638 "ograve" => "o\\*`", # small o, grave accent
639 "Oslash" => "O\\*/", # capital O, slash
640 "oslash" => "o\\*/", # small o, slash
641 "Otilde" => "O\\*~", # capital O, tilde
642 "otilde" => "o\\*~", # small o, tilde
643 "Ouml" => "O\\*:", # capital O, dieresis or umlaut mark
644 "ouml" => "o\\*:", # small o, dieresis or umlaut mark
645 "szlig" => '\*8', # small sharp s, German (sz ligature)
646 "THORN" => '\\*(Th', # capital THORN, Icelandic
647 "thorn" => '\\*(th',, # small thorn, Icelandic
648 "Uacute" => "U\\*'", # capital U, acute accent
649 "uacute" => "u\\*'", # small u, acute accent
650 "Ucirc" => "U\\*^", # capital U, circumflex accent
651 "ucirc" => "u\\*^", # small u, circumflex accent
652 "Ugrave" => "U\\*`", # capital U, grave accent
653 "ugrave" => "u\\*`", # small u, grave accent
654 "Uuml" => "U\\*:", # capital U, dieresis or umlaut mark
655 "uuml" => "u\\*:", # small u, dieresis or umlaut mark
656 "Yacute" => "Y\\*'", # capital Y, acute accent
657 "yacute" => "y\\*'", # small y, acute accent
658 "yuml" => "y\\*:", # small y, dieresis or umlaut mark
663 close OUT or die "Can't close $file: $!";
664 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
665 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';