home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / Add-Ons / MPW / MPW noweb 2.7 / src / perl / nountangle < prev    next >
Encoding:
Text File  |  1995-10-04  |  3.0 KB  |  155 lines  |  [TEXT/MPS ]
  1. Perl -Sx "{0}" {"Parameters"}>"{TempFolder}"noweb.run
  2. "{TempFolder}"noweb.run
  3. Exit
  4.  
  5. #!perl
  6. # Copyright 1991 by Norman Ramsey.  All rights reserved.
  7. # See file COPYRIGHT for more information.
  8. # set -x
  9.  
  10. $markup = "markup";
  11. $width    = 72;
  12. $subst    = '$s =~ s|\\*/|* /|g;';
  13. $format = '/* %%-%ds */';
  14.  
  15. while ($arg = shift @ARGV) {
  16.     if ($arg =~ /^-(ml|m3)$/) {
  17.         $format    = '(* %%-%ds *)';
  18.         $subst    = '$s =~ s|\\*([()])|* $1|g;';
  19.     } elsif ($arg =~ /^-(awk|perl|icn|icon|make)$/) {
  20.         $format    = '# %%-%ds';
  21.         $subst    = '';
  22.     } elsif ($arg =~ /^-(lisp|scm)$/) {
  23.         $format    = ';;; %%-%ds';
  24.         $subst    = '';
  25.     } elsif ($arg =~ /^-c\+\+$/) {
  26.         $format    = '// %%-%ds';
  27.         $subst    = '';
  28.     } elsif ($arg =~ /^-f77$/) {
  29.         $format    = 'C %%-%ds';
  30.         $subst    = '';
  31.     } elsif ($arg =~ /^-f90$/) {
  32.         $format    = '! %%-%ds';
  33.         $subst    = '';
  34.     } elsif ($arg =~ /^-tex$/) {
  35.         $format    = '%%%% %%-%ds';
  36.         $subst    = '';
  37.     } elsif ($arg =~ /^-c$/) {
  38.         $format = '/* %%-%ds */';
  39.         $subst    = '$s =~ s|\\*/|* /|g;';
  40.     } elsif ($arg =~ /^-pascal$/) {
  41.         $format = '{ %%-%ds }';
  42.         $subst    = '$s =~ s|{}|-|g;';
  43.     } elsif ($arg =~ /^-L/) {
  44.         # deliberately ignore requests for #line
  45.     } elsif ($arg =~ /^-w(\d+)$/) {
  46.         $width = $1;
  47.     } elsif ($arg eq "-filter) {
  48.         $filters .= "| " . shift @ARGV;
  49.     } elsif ($arg eq "-markup) {
  50.         $markup = shift @ARGV;
  51.     } elsif ($arg =~ /^-t/) {
  52.         $opt .= " '$arg'";
  53.         $args .= " '-t'";
  54.     } elsif ($arg eq "-") {
  55.         $args .= " '$arg'";
  56.     } elsif ($arg =~ /^-/) {
  57.         $opt .= " '$arg'";
  58.     } else {
  59.         $args .= " '$arg'";
  60.     }
  61. }
  62.  
  63. print "Set Commands \"||LIB||," . $ENV{"Commands"} . "\"; Export Commands\n";
  64. print "$markup $args $filters | Perl -Sx \"{0}\" | nt $opt; Exit\n\n";
  65. $format = sprintf($format, $width);
  66.  
  67. print <<PERL_SCRIPT_DYNAMIC;
  68. #!perl
  69.  
  70. \$line        = 0; 
  71. \$capture    = 0; 
  72.  
  73. sub comment {
  74.     local(\$s) = \@_;
  75.     
  76.     $subst
  77.     return sprintf("$format",\$s)
  78. }
  79. PERL_SCRIPT_DYNAMIC
  80.  
  81. print <<'PERL_SCRIPT_STATIC';
  82. $[ = 1;            # set array base to 1
  83. $, = ' ';        # set output field separator
  84. $\ = "\n";        # set output record separator
  85.  
  86. line: while (<>) {
  87.     chop;    # strip record separator
  88.  
  89.     if (/^\@end doc/) {
  90.     $capture = 0;
  91.     $holding{++$line} = '';
  92.     next line;
  93.     }
  94.     if (/^\@begin doc/) {
  95.     $capture = 1;
  96.     next line;
  97.     }
  98.  
  99.     if (/^\@text /) {
  100.     &grab(substr($_, 7, 999999));
  101.     next line;
  102.     }
  103.     if (/^\@quote$/) {
  104.     &grab('[[');
  105.     next line;
  106.     }
  107.     if (/^\@endquote$/) {
  108.     &grab(']]');
  109.     next line;
  110.     }
  111.  
  112.     if (/^\@nl$/) {
  113.     if ($capture != 0) {
  114.         $holding{++$line} = '';
  115.     }
  116.     elsif ($defn_pending != 0) {
  117.         print '@nl';
  118.         for ($i = 0; $i <= $line && $holding{$i} =~ /^ *$/; $i++) {
  119.         $i = $i;
  120.         }
  121.         for (; $i <= $line; $i++) {
  122.         printf "\@text %s\n\@nl\n", &comment($holding{$i});
  123.         }
  124.         $line = 0;
  125.         $holding{0} = '';
  126.         $defn_pending = 0;
  127.     }
  128.     else {
  129.         print $_;
  130.     }
  131.     next line;
  132.     }
  133.  
  134.     if (/^\@defn /) {
  135.     $holding{$line} = $holding{$line} . '<' . substr($_, 7,
  136.  
  137.       999999) . '>=';# (line should be blank)
  138.     print $_;
  139.     $defn_pending = 1;
  140.     next line;
  141.     }
  142.     print $_;
  143. }
  144.  
  145. sub grab {
  146.     local($S) = @_;
  147.     if ($capture == 0) {
  148.     print $_;
  149.     }
  150.     else {
  151.     $holding{$line} = $holding{$line} . $S;
  152.     }
  153. }
  154. PERL_SCRIPT_STATIC
  155.