contrib/groff/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 (/^\.PS([ 0-9.<].*)?$/) {
  51             if (/^\.PS\s*<\s*(\S+)/) {
  52                 $pic++;
  53                 $soelim++ if $level;
  54                 &process($1, $level);
  55             }
  56             else {
  57                 $_ = <FILE>;
  58                 if (!/^\./ || /^\.ps/) {
  59                     $pic++;
  60                     $soelim++ if $level;
  61                 }
  62             }
  63         }
  64         elsif (/^\.R1/ || /^\.\[/) {
  65             $refer++;
  66             $soelim++ if $level;
  67         }
  68         elsif (/^\.[PLI]P/) {
  69             $PP++;
  70         }
  71         elsif (/^\.P$/) {
  72             $P++;
  73         }
  74         elsif (/^\.(PH|SA)/) {
  75             $mm++;
  76         }
  77         elsif (/^\.TH/) {
  78             $TH++;
  79         }
  80         elsif (/^\.SH/) {
  81             $SH++;
  82         }
  83         elsif (/^\.([pnil]p|sh)/) {
  84             $me++;
  85         }
  86         elsif (/^\.Dd/) {
  87             $mdoc++;
  88         }
  89         elsif (/^\.(Tp|Dp|De|Cx|Cl)/) {
  90             $mdoc_old = 1;
  91         }
  92         # In the old version of -mdoc `Oo' is a toggle, in the new it's
  93         # closed by `Oc'.
  94         elsif (/^\.Oo/) {
  95             $Oo++;
  96         }
  97         elsif (/^\.Oc/) {
  98             $Oo--;
  99         }
 100         if (/^\.so/) {
 101             chop;
 102             s/^.so *//;
 103             s/\\\".*//;
 104             s/ .*$//;
 105             &process($_, $level + 1) unless /\\/ || $_ eq "";
 106         }
 107     }
 108     close(FILE);
 109 }
 110
 111 if ($pic || $tbl || $eqn || $refer) {
 112     $s = "-";
 113     $s .= "s" if $soelim;
 114     $s .= "R" if $refer;
 115     $s .= "p" if $pic;
 116     $s .= "t" if $tbl;
 117     $s .= "e" if $eqn;
 118     push(@command, $s);
 119 }
 120
 121 if ($me > 0) {
 122     push(@command, "-me");
 123 }
 124 elsif ($SH > 0 && $TH > 0) {
 125     push(@command, "-man");
 126 }
 127 elsif ($PP > 0) {
 128     push(@command, "-ms");
 129 }
 130 elsif ($P > 0 || $mm > 0) {
 131     push(@command, "-mm");
 132 }
 133 elsif ($mdoc > 0) {
 134     push(@command, ($mdoc_old || $Oo > 0) ? "-mdoc.old" : "-mdoc");
 135 }
 136
 137 push(@command, "--") if @ARGV && $ARGV[0] =~ /^-./;
 138
 139 push(@command, @ARGV);
 140
 141 # We could implement an option to execute the command here.
 142
 143 foreach (@command) {
 144     next unless /[\$\\\"\';&()|<> \t\n]/;
 145     s/\'/\'\\\'\'/;
 146     $_ = "'" . $_ . "'";
 147 }
 148
 149 print join(' ', @command), "\n";