home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / C / Applications / MacPerl 5.0.3 / MacPerl Source ƒ / MacPerl5 / pod / pod2how < prev    next >
Encoding:
Text File  |  1995-01-15  |  8.3 KB  |  399 lines  |  [TEXT/MPS ]
  1. miniperl -Sx "{0}" {"Parameters"}
  2. Exit 0
  3.  
  4. #!/usr/bin/perl
  5.  
  6. $/ = "";
  7. $cutting = 1;
  8. $tcon = 0;
  9.  
  10. $name = @ARGV ? $ARGV[0] : "something";
  11. $name =~ s/\..*//;
  12.  
  13. while (<>) {
  14.     if ($cutting) {
  15.     next unless /^=/;
  16.     $cutting = 0;
  17.     }
  18.     chomp;
  19.  
  20.     # Translate verbatim paragraph
  21.  
  22.     if (/^\s/) {
  23.     @lines = split(/\n/);
  24.     for (@lines) {
  25.         1 while s
  26.         {^( [^\t]* ) \t ( \t* ) }
  27.         { $1 . ' ' x (8 - (length($1)%8) + 8 * (length($2))) }ex;
  28.     }
  29.     $lines = @lines;
  30.     &makespace;
  31.     emit(join("\n", @lines) . "\n");
  32.     &endpar;
  33.     next;
  34.     }
  35.  
  36.     if (!/^=item/) {
  37.  
  38.     # trofficate backslashes; must do it before what happens below
  39.     s/\\/noremap('\\e')/ge;
  40.  
  41.     # first hide the escapes in case we need to 
  42.     # intuit something and get it wrong due to fmting
  43.  
  44.     s/([A-Z]<[^<>]*>)/noremap($1)/ge;
  45.  
  46.     # func() is a reference to a perl function
  47.     s{
  48.         \b
  49.         (
  50.         [:\w]+ \(\)
  51.         )
  52.     } {I<$1>}gx;
  53.  
  54.     # func(n) is a reference to a man page
  55.     s{
  56.         (\w+)
  57.         (
  58.         \(
  59.             [^\s,\051]+
  60.         \)
  61.         )
  62.     } {I<$1>($2)}gx;
  63.  
  64.     # convert simple variable references
  65.     s/([\$\@%][\w:]+)/C<$1>/g;
  66.  
  67.     if (m{ (
  68.             [\-\w]+
  69.             \(
  70.             [^\051]*?
  71.             [\@\$,]
  72.             [^\051]*?
  73.             \)
  74.         )
  75.         }x && $` !~ /([LCI]<[^<>]*|-)$/ && !/^=\w/) 
  76.     {
  77.         warn "``$1'' should be a [LCI]<$1> ref";
  78.     } 
  79.  
  80.     while (/(-[a-zA-Z])\b/g && $` !~ /[\w\-]$/) {
  81.         warn "``$1'' should be [CB]<$1> ref";
  82.     } 
  83.  
  84.     # put it back so we get the <> processed again;
  85.     clear_noremap(0); # 0 means leave the E's
  86.  
  87.     } else {
  88.     # trofficate backslashes
  89.     s/\\/noremap('\\e')/ge;
  90.  
  91.     } 
  92.  
  93.     # need to hide E<> first; they're processed in clear_noremap
  94.     s/(E<[^<>]+>)/noremap($1)/ge;
  95.  
  96.  
  97.     $maxnest = 10;
  98.     while ($maxnest-- && /[A-Z]</) {
  99.  
  100.     # can't do C font here
  101.     s/([BI])<([^<>]*)>/$2/g;
  102.  
  103.     # files and filelike refs in italics
  104.     s/F<([^<>]*)>/I<$1>/g;
  105.  
  106.     # no break -- usually we want C<> for this
  107.     s/S<([^<>]*)>/nobreak($1)/eg;
  108.  
  109.     # LREF: a manpage(3f) 
  110.     s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))?>:the I<$1>$2 manpage:g;
  111.  
  112.     # LREF: an =item on another manpage
  113.     s{
  114.         L<
  115.         ([^/]+)
  116.         /
  117.         (
  118.             [:\w]+
  119.             (\(\))?
  120.         )
  121.         >
  122.     } {the C<$2> entry in the I<$1> manpage}gx;
  123.  
  124.     # LREF: an =item on this manpage
  125.     s{
  126.        ((?:
  127.         L<
  128.         /
  129.         (
  130.             [:\w]+
  131.             (\(\))?
  132.         )
  133.         >
  134.         (,?\s+(and\s+)?)?
  135.       )+)
  136.     } { internal_lrefs($1) }gex;
  137.  
  138.     # LREF: a =head2 (head1?), maybe on a manpage, maybe right here
  139.     # the "func" can disambiguate
  140.     s{
  141.         L<
  142.         (?:
  143.             ([a-zA-Z]\S+?) / 
  144.         )?
  145.         "?(.*?)"?
  146.         >
  147.     }{
  148.         do {
  149.         $1     # if no $1, assume it means on this page.
  150.             ?  "the section on I<$2> in the I<$1> manpage"
  151.             :  "the section on I<$2>"
  152.         } 
  153.     }gex;
  154.  
  155.     s/Z<>/\\&/g;
  156.  
  157.     # comes last because not subject to reprocessing
  158.     s/C<([^<>]*)>/noremap("${1}")/eg;
  159.     }
  160.  
  161.     if (s/^=//) {
  162.     $needspace = 0;        # Assume this.
  163.  
  164.     s/\n/ /g;
  165.  
  166.     ($Cmd, $_) = split(' ', $_, 2);
  167.  
  168.     if (defined $_) {
  169.         &escapes;
  170.     }
  171.  
  172.     clear_noremap(1);
  173.  
  174.     if ($Cmd eq 'cut') {
  175.         $cutting = 1;
  176.     }
  177.     elsif ($Cmd eq 'head1') {
  178.         emit("\\str#\n");
  179.         emit("\\keep\n") unless $keep++;
  180.         emittoc("\\tcon $_\n\n");
  181.         emit("\\style bold\n\\size 140\n$_\n\n");
  182.     }
  183.     elsif ($Cmd eq 'head2') {
  184.         emit("\\keep\n") unless $keep++;
  185.         emittoc("\\tcon    $_\n\n");
  186.         emit("\\style bold\n\\size 120\n$_\n");
  187.     }
  188.     elsif ($Cmd eq 'over') {
  189.         push(@indent,$indent);
  190.         $indent = $_ + 0;
  191.     }
  192.     elsif ($Cmd eq 'back') {
  193.         $indent = pop(@indent);
  194.         warn "Unmatched =back\n" unless defined $indent;
  195.         $needspace = 1;
  196.     }
  197.     elsif ($Cmd eq 'item') {
  198.         if (/\*.\s*(\S)/) {
  199.             emit("• $1$'");
  200.         } elsif (/\*/) {
  201.             $bullet = "• ";
  202.         } elsif (/\S/) {
  203.             emit("$_");
  204.         }
  205.     }
  206.     else {
  207.         warn "Unrecognized directive: $Cmd\n";
  208.     }
  209.     } else {
  210.     s/\n/ /g;
  211.     &makespace;
  212.     &escapes;
  213.     clear_noremap(1);
  214.     emit("$bullet$_\n");
  215.     $bullet = "";
  216.     &endpar;
  217.     $needspace = 1;
  218.     }
  219. }
  220.  
  221. &eject;
  222.  
  223. #########################################################################
  224.  
  225. sub nobreak {
  226.     my $string = shift;
  227.     $string =~ s/ /\\ /g;
  228.     $string;
  229. }
  230.  
  231. sub escapes {
  232. }
  233.  
  234.  
  235. sub makespace {
  236.     emit("\n");
  237. }
  238.  
  239. sub noremap {
  240.     local($thing_to_hide) = shift;
  241.     $thing_to_hide =~ tr/\000-\177/\200-\377/;
  242.     return $thing_to_hide;
  243. } 
  244.  
  245. sub init_noremap {
  246.     if ( /[\200-\377]/ ) {
  247.     warn "hit bit char in input stream";
  248.     } 
  249. } 
  250.  
  251. sub clear_noremap {
  252.     my $ready_to_print = $_[0];
  253.  
  254.     tr/\200-\377/\000-\177/;
  255.  
  256.     s/\\ /\312/;
  257.     
  258.     # now for the E<>s, which have been hidden until now
  259.     # otherwise the interative \w<> processing would have
  260.     # been hosed by the E<gt>
  261.     s {
  262.         E<    
  263.         ( [A-Za-z]+ )    
  264.         >    
  265.     } { 
  266.      do {    
  267.          exists $HTML_Escapes{$1}
  268.         ? do { $HTML_Escapes{$1} }
  269.         : do {
  270.             warn "Unknown escape: $& in $_";
  271.             "E<$1>";
  272.         } 
  273.      } 
  274.     }egx if $ready_to_print;
  275. } 
  276.  
  277. sub internal_lrefs {
  278.     local($_) = shift;
  279.  
  280.     s{L</([^>]+)>}{$1}g;
  281.     my(@items) = split( /(?:,?\s+(?:and\s+)?)/ );
  282.     my $retstr = "the ";
  283.     my $i;
  284.     for ($i = 0; $i <= $#items; $i++) {
  285.     $retstr .= "C<$items[$i]>";
  286.     $retstr .= ", " if @items > 2 && $i != $#items;
  287.     $retstr .= " and " if $i+2 == @items;
  288.     } 
  289.  
  290.     $retstr .= " entr" . ( @items > 1  ? "ies" : "y" )
  291.         .  " elsewhere in this document";
  292.  
  293.     return $retstr;
  294.  
  295. } 
  296.  
  297. BEGIN {
  298. %HTML_Escapes = (
  299.     'amp'    =>    '&',    #   ampersand
  300.     'lt'    =>    '<',    #   left chevron, less-than
  301.     'gt'    =>    '>',    #   right chevron, greater-than
  302.     'quot'    =>    '"',    #   double quote
  303.  
  304.     "Aacute"    =>    "A",    #   capital A, acute accent
  305.     "aacute"    =>    "á",    #   small a, acute accent
  306.     "Acirc"    =>    "A",    #   capital A, circumflex accent
  307.     "acirc"    =>    "â",    #   small a, circumflex accent
  308.     "AElig"    =>    "Æ",    #   capital AE diphthong (ligature)
  309.     "aelig"    =>    "æ",    #   small ae diphthong (ligature)
  310.     "Agrave"    =>    "A",    #   capital A, grave accent
  311.     "agrave"    =>    "à",    #   small a, grave accent
  312.     "Aring"    =>    "Å",    #   capital A, ring
  313.     "aring"    =>    'å',    #   small a, ring
  314.     "Atilde"    =>    'Ã',    #   capital A, tilde
  315.     "atilde"    =>    'ã',    #   small a, tilde
  316.     "Auml"    =>    'Ä',    #   capital A, dieresis or umlaut mark
  317.     "auml"    =>    'ä',    #   small a, dieresis or umlaut mark
  318.     "Ccedil"    =>    'Ç',    #   capital C, cedilla
  319.     "ccedil"    =>    'ç',    #   small c, cedilla
  320.     "Eacute"    =>    "É",    #   capital E, acute accent
  321.     "eacute"    =>    "é",    #   small e, acute accent
  322.     "Ecirc"    =>    "E",    #   capital E, circumflex accent
  323.     "ecirc"    =>    "ê",    #   small e, circumflex accent
  324.     "Egrave"    =>    "E",    #   capital E, grave accent
  325.     "egrave"    =>    "è",    #   small e, grave accent
  326.     "Euml"    =>    "E",    #   capital E, dieresis or umlaut mark
  327.     "euml"    =>    "ë",    #   small e, dieresis or umlaut mark
  328.     "Iacute"    =>    "I",    #   capital I, acute accent
  329.     "iacute"    =>    "í",    #   small i, acute accent
  330.     "Icirc"    =>    "I",    #   capital I, circumflex accent
  331.     "icirc"    =>    "î",    #   small i, circumflex accent
  332.     "Igrave"    =>    "I",    #   capital I, grave accent
  333.     "igrave"    =>    "ì",    #   small i, grave accent
  334.     "Iuml"    =>    "I",    #   capital I, dieresis or umlaut mark
  335.     "iuml"    =>    "ï",    #   small i, dieresis or umlaut mark
  336.     "Ntilde"    =>    'Ñ',    #   capital N, tilde
  337.     "ntilde"    =>    'ñ',    #   small n, tilde
  338.     "Oacute"    =>    "O",    #   capital O, acute accent
  339.     "oacute"    =>    "ó",    #   small o, acute accent
  340.     "Ocirc"    =>    "O",    #   capital O, circumflex accent
  341.     "ocirc"    =>    "ô",    #   small o, circumflex accent
  342.     "Ograve"    =>    "O",    #   capital O, grave accent
  343.     "ograve"    =>    "ò",    #   small o, grave accent
  344.     "Oslash"    =>    "Ø",    #   capital O, slash
  345.     "oslash"    =>    "ø",    #   small o, slash
  346.     "Otilde"    =>    "Õ",    #   capital O, tilde
  347.     "otilde"    =>    "õ",    #   small o, tilde
  348.     "Ouml"    =>    "Ö",    #   capital O, dieresis or umlaut mark
  349.     "ouml"    =>    "ö",    #   small o, dieresis or umlaut mark
  350.     "szlig"    =>    'ß',    #   small sharp s, German (sz ligature)
  351.     "Uacute"    =>    "U",    #   capital U, acute accent
  352.     "uacute"    =>    "ú",    #   small u, acute accent
  353.     "Ucirc"    =>    "U",    #   capital U, circumflex accent
  354.     "ucirc"    =>    "û",    #   small u, circumflex accent
  355.     "Ugrave"    =>    "U",    #   capital U, grave accent
  356.     "ugrave"    =>    "ù",    #   small u, grave accent
  357.     "Uuml"    =>    "Ü",    #   capital U, dieresis or umlaut mark
  358.     "uuml"    =>    "ü",    #   small u, dieresis or umlaut mark
  359.     "Yacute"    =>    "Y",    #   capital Y, acute accent
  360.     "yacute"    =>    "y",    #   small y, acute accent
  361.     "yuml"    =>    "ÿ",    #   small y, dieresis or umlaut mark
  362. );
  363. }
  364.  
  365. sub emit {
  366.    my($str) = @_;
  367.    
  368.    $body .= $str;
  369. }
  370.  
  371. sub emittoc {
  372.    my($str) = @_;
  373.    
  374.    $body .= $str;
  375.    ++$ntoc;
  376. }
  377.  
  378. sub eject {
  379.     print <<END;
  380. \\only print
  381. \\style bold
  382. \\just center
  383. \\size 140
  384. Table of Contents
  385. \\only print
  386.  
  387. \\itcon $ntoc
  388.  
  389. \\page
  390. $body
  391. END
  392. }
  393.  
  394. sub endpar {
  395.     if ($keep) {
  396.        emit("\\endkeep\n\n");
  397.        $keep = 0;
  398.     }
  399. }