src/roff/grog/grog.pl

   1 #!/usr/bin/perl
   2 # grog -- guess options for groff command
   3 # Inspired by doctype script in Kernighan & Pike, Unix Programming
   4 # Environment, pp 306-8.
   5
   6 $prog = $0;
   7 $prog =~ s@.*/@@;
   8
   9 push(@command, "groff");
  10
  11 while ($ARGV[0] =~ /^-./) {
  12     $arg = shift(@ARGV);
  13     last if $arg eq "--";
  14     push(@command, $arg);
  15 }
  16
  17 if (@ARGV) {
  18     foreach $arg (@ARGV) {
  19         &process($arg, 0);
  20     }
  21 }
  22 else {
  23     &process("-", 0);
  24 }
  25
  26 sub process {
  27     local($filename, $level) = @_;
  28     local(*FILE);
  29
  30     if (!open(FILE, $filename eq "-" ? $filename : "< $filename")) {
  31         print STDERR "$prog: can't open \`$filename': $!\n";
  32         exit 1 unless $level;
  33         return;
  34     }
  35     while (<FILE>) {
  36         if (/^\.TS/) {
  37             $_ = <FILE>;
  38             if (!/^\./) {
  39                 $tbl++;
  40                 $soelim++ if $level;
  41             }
  42         }
  43         elsif (/^\.EQ/) {
  44             $_ = <FILE>;
  45             if (!/^\./ || /^\.[0-9]/) {
  46                 $eqn++;
  47                 $soelim++ if $level;
  48             }
  49         }
  50         elsif (/^\.GS/) {
  51             $_ = <FILE>;
  52             if (!/^\./) {
  53                 $grn++;
  54                 $soelim++ if $level;
  55         }
  56         elsif (/^\.PS([ 0-9.<].*)?$/) {
  57             if (/^\.PS\s*<\s*(\S+)/) {
  58                 $pic++;
  59                 $soelim++ if $level;
  60                 &process($1, $level);
  61             }
  62             else {
  63                 $_ = <FILE>;
  64                 if (!/^\./ || /^\.ps/) {
  65                     $pic++;
  66                     $soelim++ if $level;
  67                 }
  68             }
  69         }
  70         elsif (/^\.R1/ || /^\.\[/) {
  71             $refer++;
  72             $soelim++ if $level;
  73         }
  74         elsif (/^\.[PLI]P/) {
  75             $PP++;
  76         }
  77         elsif (/^\.P$/) {
  78             $P++;
  79         }
  80         elsif (/^\.(PH|SA)/) {
  81             $mm++;
  82         }
  83         elsif (/^\.TH/) {
  84             $TH++;
  85         }
  86         elsif (/^\.SH/) {
  87             $SH++;
  88         }
  89         elsif (/^\.([pnil]p|sh)/) {
  90             $me++;
  91         }
  92         elsif (/^\.Dd/) {
  93             $mdoc++;
  94         }
  95         elsif (/^\.(Tp|Dp|De|Cx|Cl)/) {
  96             $mdoc_old = 1;
  97         }
  98         # In the old version of -mdoc `Oo' is a toggle, in the new it's
  99         # closed by `Oc'.
 100         elsif (/^\.Oo/) {
 101             $Oo++;
 102         }
 103         elsif (/^\.Oc/) {
 104             $Oo--;
 105         }
 106         if (/^\.so/) {
 107             chop;
 108             s/^.so *//;
 109             s/\\\".*//;
 110             s/ .*$//;
 111             &process($_, $level + 1) unless /\\/ || $_ eq "";
 112         }
 113     }
 114     close(FILE);
 115 }
 116
 117 if ($pic || $tbl || $eqn || $grn || $refer) {
 118     $s = "-";
 119     $s .= "s" if $soelim;
 120     $s .= "R" if $refer;
 121     $s .= "p" if $pic;
 122     $s .= "h" if $grn;
 123     $s .= "t" if $tbl;
 124     $s .= "e" if $eqn;
 125     push(@command, $s);
 126 }
 127
 128 if ($me > 0) {
 129     push(@command, "-me");
 130 }
 131 elsif ($SH > 0 && $TH > 0) {
 132     push(@command, "-man");
 133 }
 134 elsif ($PP > 0) {
 135     push(@command, "-ms");
 136 }
 137 elsif ($P > 0 || $mm > 0) {
 138     push(@command, "-mm");
 139 }
 140 elsif ($mdoc > 0) {
 141     push(@command, ($mdoc_old || $Oo > 0) ? "-mdoc.old" : "-mdoc");
 142 }
 143
 144 push(@command, "--") if @ARGV && $ARGV[0] =~ /^-./;
 145
 146 push(@command, @ARGV);
 147
 148 # We could implement an option to execute the command here.
 149
 150 foreach (@command) {
 151     next unless /[\$\\\"\';&()|<> \t\n]/;
 152     s/\'/\'\\\'\'/;
 153     $_ = "'" . $_ . "'";
 154 }
 155
 156 print join(' ', @command), "\n";