contrib/groff-1.19/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 $sp = "[\\s\\n]";
  10
  11 push(@command, "groff");
  12
  13 while ($ARGV[0] =~ /^-./) {
  14     $arg = shift(@ARGV);
  15     $sp = "" if $arg eq "-C";
  16     &usage(0) if $arg eq "-v" || $arg eq "--version";
  17     &help() if $arg eq "--help";
  18     last if $arg eq "--";
  19     push(@command, $arg);
  20 }
  21
  22 @ARGV = ('-') unless @ARGV;
  23 foreach $arg (@ARGV) {
  24     &process($arg, 0);
  25 }
  26
  27 sub process {
  28     local($filename, $level) = @_;
  29     local(*FILE);
  30
  31     if (!open(FILE, $filename eq "-" ? $filename : "< $filename")) {
  32         print STDERR "$prog: can't open \`$filename': $!\n";
  33         exit 1 unless $level;
  34         return;
  35     }
  36     while (<FILE>) {
  37         if (/^\.TS$sp/) {
  38             $_ = <FILE>;
  39             if (!/^\./) {
  40                 $tbl++;
  41                 $soelim++ if $level;
  42             }
  43         }
  44         elsif (/^\.EQ$sp/) {
  45             $_ = <FILE>;
  46             if (!/^\./ || /^\.[0-9]/) {
  47                 $eqn++;
  48                 $soelim++ if $level;
  49             }
  50         }
  51         elsif (/^\.GS$sp/) {
  52             $_ = <FILE>;
  53             if (!/^\./) {
  54                 $grn++;
  55                 $soelim++ if $level;
  56             }
  57         }
  58         elsif (/^\.G1$sp/) {
  59             $_ = <FILE>;
  60             if (!/^\./) {
  61                 $grap++;
  62                 $pic++;
  63                 $soelim++ if $level;
  64             }
  65         }
  66         elsif (/^\.PS$sp([ 0-9.<].*)?$/) {
  67             if (/^\.PS\s*<\s*(\S+)/) {
  68                 $pic++;
  69                 $soelim++ if $level;
  70                 &process($1, $level);
  71             }
  72             else {
  73                 $_ = <FILE>;
  74                 if (!/^\./ || /^\.ps/) {
  75                     $pic++;
  76                     $soelim++ if $level;
  77                 }
  78             }
  79         }
  80         elsif (/^\.R1$sp/) {
  81             $refer++;
  82             $soelim++ if $level;
  83         }
  84         elsif (/^\.\[/) {
  85             $refer_open++;
  86             $soelim++ if $level;
  87         }
  88         elsif (/^\.\]/) {
  89             $refer_close++;
  90             $soelim++ if $level;
  91         }
  92         elsif (/^\.[PLI]P$sp/) {
  93             $PP++;
  94         }
  95         elsif (/^\.P$/) {
  96             $P++;
  97         }
  98         elsif (/^\.(PH|SA)$sp/) {
  99             $mm++;
 100         }
 101         elsif (/^\.TH$sp/) {
 102             $TH++;
 103         }
 104         elsif (/^\.SH$sp/) {
 105             $SH++;
 106         }
 107         elsif (/^\.([pnil]p|sh)$sp/) {
 108             $me++;
 109         }
 110         elsif (/^\.Dd$sp/) {
 111             $mdoc++;
 112         }
 113         elsif (/^\.(Tp|Dp|De|Cx|Cl)$sp/) {
 114             $mdoc_old = 1;
 115         }
 116         # In the old version of -mdoc `Oo' is a toggle, in the new it's
 117         # closed by `Oc'.
 118         elsif (/^\.Oo$sp/) {
 119             $Oo++;
 120             s/^\.Oo/\. /;
 121             redo;
 122         }
 123         # The test for `Oo' and `Oc' not starting a line (as allowed by the
 124         # new implementation of -mdoc) is not complete; it assumes that
 125         # macro arguments are well behaved, i.e., "" is used within "..." to
 126         # indicate a doublequote as a string element, and weird features
 127         # like `.foo a"b' are not used.
 128         elsif (/^\..* Oo( |$)/) {
 129             s/\\\".*//;
 130             s/\"[^\"]*\"//g;
 131             s/\".*//;
 132             if (s/ Oo( |$)/ /) {
 133                 $Oo++;
 134             }
 135             redo;
 136         }
 137         elsif (/^\.Oc$sp/) {
 138             $Oo--;
 139             s/^\.Oc/\. /;
 140             redo;
 141         }
 142         elsif (/^\..* Oc( |$)/) {
 143             s/\\\".*//;
 144             s/\"[^\"]*\"//g;
 145             s/\".*//;
 146             if (s/ Oc( |$)/ /) {
 147                 $Oo--;
 148             }
 149             redo;
 150         }
 151         elsif (/^\.(PRINTSTYLE|START)$sp/) {
 152             $mom++;
 153         }
 154         if (/^\.so$sp/) {
 155             chop;
 156             s/^.so *//;
 157             s/\\\".*//;
 158             s/ .*$//;
 159             &process($_, $level + 1) unless /\\/ || $_ eq "";
 160         }
 161     }
 162     close(FILE);
 163 }
 164
 165 sub usage {
 166     local($exit_status) = $_;
 167     print "GNU grog (groff) version @VERSION@\n";
 168     exit $exit_status;
 169 }
 170
 171 sub help {
 172     print "usage: grog [ option ...] [files...]\n";
 173     exit 0;
 174 }
 175
 176 $refer ||= $refer_open && $refer_close;
 177
 178 if ($pic || $tbl || $eqn || $grn || $grap || $refer) {
 179     $s = "-";
 180     $s .= "s" if $soelim;
 181     $s .= "R" if $refer;
 182     # grap must be run before pic
 183     $s .= "G" if $grap;
 184     $s .= "p" if $pic;
 185     $s .= "g" if $grn;
 186     $s .= "t" if $tbl;
 187     $s .= "e" if $eqn;
 188     push(@command, $s);
 189 }
 190
 191 if ($me > 0) {
 192     push(@command, "-me");
 193 }
 194 elsif ($SH > 0 && $TH > 0) {
 195     push(@command, "-man");
 196 }
 197 else ($mom > 0) {
 198     push(@command, "-mom");
 199 }
 200 elsif ($PP > 0) {
 201     push(@command, "-ms");
 202 }
 203 elsif ($P > 0 || $mm > 0) {
 204     push(@command, "-mm");
 205 }
 206 elsif ($mdoc > 0) {
 207     push(@command, ($mdoc_old || $Oo > 0) ? "-mdoc-old" : "-mdoc");
 208 }
 209
 210 push(@command, "--") if @ARGV && $ARGV[0] =~ /^-./;
 211
 212 push(@command, @ARGV);
 213
 214 # We could implement an option to execute the command here.
 215
 216 foreach (@command) {
 217     next unless /[\$\\\"\';&()|<> \t\n]/;
 218     s/\'/\'\\\'\'/;
 219     $_ = "'" . $_ . "'";
 220 }
 221
 222 print join(' ', @command), "\n";