contrib/groff/src/roff/grog/grog.pl

   1 #! /usr/bin/env 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 # Source file position: <groff-source>/src/roff/grog/grog.pl
   7 # Installed position: <prefix>/bin/grog
   8
   9 # Copyright (C) 1993, 2006, 2009 Free Software Foundation, Inc.
  10 # Written by James Clark, maintained by Werner Lemberg.
  11 # Rewritten and put under GPL by Bernd Warken.
  12
  13 # This file is part of `grog', which is part of `groff'.
  14
  15 # `groff' is free software; you can redistribute it and/or modify it
  16 # under the terms of the GNU General Public License (GPL) as published
  17 # by the Free Software Foundation, either version 3 of the License, or
  18 # (at your option) any later version.
  19
  20 # `groff' is distributed in the hope that it will be useful, but
  21 # WITHOUT ANY WARRANTY; without even the implied warranty of
  22 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  23 # General Public License for more details.
  24
  25 # You should have received a copy of the GNU General Public License
  26 # along with this program. If not, see <http://www.gnu.org/licenses/>.
  27
  28 ########################################################################
  29 my $Last_Update = '5 Jan 2009';
  30 ########################################################################
  31
  32 require v5.6;
  33
  34 use warnings;
  35 use strict;
  36 use File::Spec;
  37
  38 my $Prog = $0;
  39 {
  40   my ($v, $d, $f) = File::Spec->splitpath($Prog);
  41   $Prog = $f;
  42 }
  43
  44 #my $Sp = "[\\s\\n]";
  45 my $Sp = qr([\s\n]);
  46
  47 my @Command;                    # stores the final output
  48 my @Mparams;                    # stores the options -m*
  49 my %Groff;
  50
  51 {
  52   my @filespec = ();
  53   my $double_minus = 0;
  54   my $was_minus = 0;
  55   my $had_filespec = 0;
  56
  57   foreach my $arg (@ARGV) {
  58     next unless $arg;
  59     if ($double_minus) {
  60       $had_filespec = 1;
  61       if (-f $arg && -r $arg) {
  62         push @filespec, $arg;
  63       } else {
  64         print STDERR "grog: $arg is not a readable file.\n";
  65       }
  66       next;
  67     }
  68
  69     if ($arg eq '--') {
  70       $double_minus = 1;
  71       push(@Command, $arg);
  72       next;
  73     }
  74     if ($arg eq '-') {
  75       unless ($was_minus) {
  76         push @filespec, $arg;
  77         $was_minus = 1;
  78       }
  79       next;
  80     }
  81
  82     &version(0) if $arg eq '-v' || '--version' =~ /^$arg/;
  83     &help() if $arg eq '-h' || '--help' =~ /^$arg/;
  84     print STDERR "grog: wrong option $arg.\n" if $arg =~ /^--/;
  85
  86     if ($arg =~ /^-m/) {
  87       push @Mparams, $arg;
  88       next;
  89     }
  90     $Sp = '' if $arg eq '-C';
  91
  92     if ($arg =~ /^-/) {
  93       push(@Command, $arg);
  94       next;
  95     } else {
  96       $had_filespec = 1;
  97       if (-f $arg && -r $arg) {
  98         push @filespec, $arg;
  99       } else {
 100         print STDERR "grog: $arg is not a readable file.\n";
 101       }
 102       next;
 103     }
 104   }
 105   @filespec = ('-') if ! @filespec && ! $had_filespec;
 106   exit 1 unless @filespec;
 107   @ARGV = @filespec;
 108 }
 109
 110 foreach my $arg (@ARGV) {
 111   &process($arg, 0);
 112 }
 113
 114 sub process {
 115   my ($filename, $level) = @_;
 116   local(*FILE);
 117
 118   if (!open(FILE, $filename eq "-" ? $filename : "< $filename")) {
 119     print STDERR "$Prog: can't open \`$filename': $!\n";
 120     exit 1 unless $level;
 121     return;
 122   }
 123   while (<FILE>) {
 124     chomp;
 125     s/^[.']\s*/./;
 126     s/^\s+|\s+$//g;
 127     s/$/\n/;
 128
 129     if (/^(.cstart)|(begin\s+chem)$/) {
 130       $Groff{'chem'}++;
 131       $Groff{'pic'}++;
 132     } elsif (/^\.TS$Sp/) {
 133       $_ = <FILE>;
 134       if (!/^\./) {
 135         $Groff{'tbl'}++;
 136         $Groff{'soelim'}++ if $level;
 137       }
 138     } elsif (/^\.EQ$Sp/) {
 139       $_ = <FILE>;
 140       if (!/^\./ || /^\.[0-9]/) {
 141         $Groff{'eqn'}++;
 142         $Groff{'soelim'}++ if $level;
 143       }
 144     } elsif (/^\.GS$Sp/) {
 145       $_ = <FILE>;
 146       if (!/^\./) {
 147         $Groff{'grn'}++;
 148         $Groff{'soelim'}++ if $level;
 149       }
 150     } elsif (/^\.G1$Sp/) {
 151       $_ = <FILE>;
 152       if (!/^\./) {
 153         $Groff{'grap'}++;
 154         $Groff{'pic'}++;
 155         $Groff{'soelim'}++ if $level;
 156       }
 157 #    } elsif (/^\.PS\Sp([ 0-9.<].*)?$/) {
 158 #      if (/^\.PS\s*<\s*(\S+)/) {
 159 #       $Groff{'pic'}++;
 160 #       $Groff{'soelim'}++ if $level;
 161 #       &process($1, $level);
 162 #      } else {
 163 #       $_ = <FILE>;
 164 #       if (!/^\./ || /^\.ps/) {
 165 #         $Groff{'pic'}++;
 166 #         $Groff{'soelim'}++ if $level;
 167 #       }
 168 #      }
 169     } elsif (/^\.PS[\s\n<]/) {
 170       $Groff{'pic'}++;
 171       $Groff{'soelim'}++ if $level;
 172       if (/^\.PS\s*<\s*(\S+)/) {
 173         &process($1, $level);
 174       }
 175     } elsif (/^\.R1$Sp/) {
 176       $Groff{'refer'}++;
 177       $Groff{'soelim'}++ if $level;
 178     } elsif (/^\.\[/) {
 179       $Groff{'refer_open'}++;
 180       $Groff{'soelim'}++ if $level;
 181     } elsif (/^\.\]/) {
 182       $Groff{'refer_close'}++;
 183       $Groff{'soelim'}++ if $level;
 184     } elsif (/^\.NH$Sp/) {
 185       $Groff{'NH'}++;           # for ms
 186     } elsif (/^\.TL$Sp/) {
 187       $Groff{'TL'}++;           # for mm and ms
 188     } elsif (/^\.PP$Sp/) {
 189       $Groff{'PP'}++;           # for mom and ms
 190     } elsif (/^\.[IL]P$Sp/) {
 191       $Groff{'ILP'}++;          # for man and ms
 192     } elsif (/^\.P$/) {
 193       $Groff{'P'}++;
 194     } elsif (/^\.(PH|SA)$Sp/) {
 195       $Groff{'mm'}++;
 196     } elsif (/^\.TH$Sp/) {
 197       $Groff{'TH'}++;
 198     } elsif (/^\.SH$Sp/) {
 199       $Groff{'SH'}++;
 200     } elsif (/^\.([pnil]p|sh)$Sp/) {
 201       $Groff{'me'}++;
 202     } elsif (/^\.Dd$Sp/) {
 203       $Groff{'mdoc'}++;
 204     } elsif (/^\.(Tp|Dp|De|Cx|Cl)$Sp/) {
 205       $Groff{'mdoc_old'} = 1;
 206     }
 207     # In the old version of -mdoc `Oo' is a toggle, in the new it's
 208     # closed by `Oc'.
 209     elsif (/^\.Oo$Sp/) {
 210       $Groff{'Oo'}++;
 211       s/^\.Oo/\. /;
 212       redo;
 213     }
 214     # The test for `Oo' and `Oc' not starting a line (as allowed by the
 215     # new implementation of -mdoc) is not complete; it assumes that
 216     # macro arguments are well behaved, i.e., "" is used within "..." to
 217     # indicate a doublequote as a string element, and weird features
 218     # like `.foo a"b' are not used.
 219     elsif (/^\..* Oo( |$)/) {
 220       s/\\\".*//;
 221       s/\"[^\"]*\"//g;
 222       s/\".*//;
 223       if (s/ Oo( |$)/ /) {
 224         $Groff{'Oo'}++;
 225       }
 226       redo;
 227     } elsif (/^\.Oc$Sp/) {
 228       $Groff{'Oo'}--;
 229       s/^\.Oc/\. /;
 230       redo;
 231     } elsif (/^\..* Oc( |$)/) {
 232       s/\\\".*//;
 233       s/\"[^\"]*\"//g;
 234       s/\".*//;
 235       if (s/ Oc( |$)/ /) {
 236         $Groff{'Oo'}--;
 237       }
 238       redo;
 239     } elsif (/^\.(PRINTSTYLE|START)$Sp/) {
 240       $Groff{'mom'}++;
 241     }
 242     if (/^\.so$Sp/) {
 243       chop;
 244       s/^.so *//;
 245       s/\\\".*//;
 246       s/ .*$//;
 247       &process($_, $level + 1) unless /\\/ || $_ eq "";
 248     }
 249   }
 250   close(FILE);
 251 }
 252
 253 sub help {
 254   print <<EOF;
 255 usage: grog [option]... [--] [filespec]...
 256
 257 "filespec" is either the name of an existing, readable file or "-" for
 258 standard input.  If no "filespec" is specified, standard input is
 259 assumed automatically.
 260
 261 "option" is either a "groff" option or one of these:
 262
 263 -C            compatibility mode
 264 -h --help     print this uasge message
 265 -v --version  print version information
 266
 267 "groff" options are appended to the output, "-m" options are checked.
 268
 269 EOF
 270   exit 0;
 271 }
 272
 273 sub version {
 274   my ($exit_status) = @_;
 275   print "Perl version of GNU $Prog of $Last_Update " .
 276     "in groff version @VERSION@\n";
 277   exit $exit_status;
 278 }
 279
 280 {
 281   my @m = ();
 282   my $is_man = 0;
 283   my $is_mm = 0;
 284   my $is_mom = 0;
 285
 286   $Groff{'refer'} ||= $Groff{'refer_open'} && $Groff{'refer_close'};
 287
 288   if ( $Groff{'pic'} || $Groff{'tbl'} || $Groff{'eqn'} ||
 289        $Groff{'grn'} || $Groff{'grap'} || $Groff{'refer'} ) {
 290     my $s = "-";
 291     $s .= "s" if $Groff{'soelim'};
 292     $s .= "R" if $Groff{'refer'};
 293     # grap must be run before pic
 294     $s .= "G" if $Groff{'grap'};
 295     $s .= "p" if $Groff{'pic'};
 296     $s .= "g" if $Groff{'grn'};
 297     $s .= "t" if $Groff{'tbl'};
 298     $s .= "e" if $Groff{'eqn'};
 299     push(@Command, $s);
 300   }
 301
 302   if ( $Groff{'me'} ) {
 303     push(@m, '-me');
 304     push(@Command, '-me');
 305   }
 306   if ( $Groff{'SH'} && $Groff{'TH'} ) {
 307     push(@m, '-man');
 308     push(@Command, '-man');
 309     $is_man = 1;
 310   }
 311   if ( $Groff{'mom'} ) {
 312     push(@m, '-mom');
 313     push(@Command, '-mom');
 314     $is_mom = 1;
 315   }
 316   if ( $Groff{'mm'} || ($Groff{'P'} && ! $is_man) ) {
 317     push(@m, '-mm');
 318     push(@Command, '-mm');
 319     $is_mm = 1;
 320   }
 321   if ( $Groff{'NH'} || ($Groff{'TL'} && ! $is_mm) ||
 322        ($Groff{'ILP'} && ! $is_man) ||
 323        ($Groff{'PP'} && ! $is_mom && ! $is_man) ) {
 324     # .PP occurs in -mom, -man and -ms, .IP and .LP occur in -man and -ms
 325     push(@m, '-ms');
 326     push(@Command, '-ms');
 327   }
 328   if ( $Groff{'mdoc'} ) {
 329     my $s = ( $Groff{'mdoc_old'} || $Groff{'Oo'} ) ? '-mdoc-old' : '-mdoc';
 330     push(@m, $s);
 331     push(@Command, $s);
 332   }
 333
 334   if ($Groff{'chem'}) {
 335     my @chem = ('chem', @ARGV, '|', 'groff');
 336     unshift(@Command, @chem);
 337   } else {
 338     unshift @Command, 'groff';
 339     push(@Command, @ARGV);
 340   }
 341
 342   foreach (@Command) {
 343     next unless /\s/;
 344     $_ = "'" . $_ . "'";
 345   }
 346
 347   # We could implement an option to execute the command here.
 348
 349 #  foreach (@Command) {
 350 #    next unless /[\$\\\"\';&()|<> \t\n]/;
 351 #    s/\'/\'\\\'\'/;
 352 #    $_ = "'" . $_ . "'";
 353 #  }
 354
 355   my $n = scalar @m;
 356   my $np = scalar @Mparams;
 357   print STDERR "$Prog: more than 1 `-m' argument: @Mparams" if $np > 1;
 358   if ($n == 0) {
 359     unshift @Command, $Mparams[0] if $np == 1;
 360   } elsif ($n == 1) {
 361     if ($np == 1) {
 362       print STDERR "$Prog: wrong `-m' argument: $Mparams[0]\n"
 363         if $m[0] ne $Mparams[0];
 364     }
 365   } else {
 366     print STDERR "$Prog: error: there are several macro packages: @m\n";
 367   }
 368
 369   print "@Command\n";
 370
 371   exit $n if $n > 1;
 372   exit 0;
 373 }
 374
 375 ########################################################################
 376 ### Emacs settings
 377 # Local Variables:
 378 # mode: CPerl
 379 # End: