home *** CD-ROM | disk | FTP | other *** search
- #! /usr/bin/env perl
- # grog - guess options for groff command
- # Inspired by doctype script in Kernighan & Pike, Unix Programming
- # Environment, pp 306-8.
-
- # Source file position: <groff-source>/src/roff/grog/grog.pl
- # Installed position: <prefix>/bin/grog
-
- # Copyright (C) 1993, 2006, 2009 Free Software Foundation, Inc.
- # Written by James Clark, maintained by Werner Lemberg.
- # Rewritten and put under GPL by Bernd Warken.
-
- # This file is part of `grog', which is part of `groff'.
-
- # `groff' is free software; you can redistribute it and/or modify it
- # under the terms of the GNU General Public License (GPL) as published
- # by the Free Software Foundation, either version 3 of the License, or
- # (at your option) any later version.
-
- # `groff' is distributed in the hope that it will be useful, but
- # WITHOUT ANY WARRANTY; without even the implied warranty of
- # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- # General Public License for more details.
-
- # You should have received a copy of the GNU General Public License
- # along with this program. If not, see <http://www.gnu.org/licenses/>.
-
- ########################################################################
- my $Last_Update = '5 Jan 2009';
- ########################################################################
-
- require v5.6;
-
- use warnings;
- use strict;
- use File::Spec;
-
- my $Prog = $0;
- {
- my ($v, $d, $f) = File::Spec->splitpath($Prog);
- $Prog = $f;
- }
-
- #my $Sp = "[\\s\\n]";
- my $Sp = qr([\s\n]);
-
- my @Command; # stores the final output
- my @Mparams; # stores the options -m*
- my %Groff;
-
- {
- my @filespec = ();
- my $double_minus = 0;
- my $was_minus = 0;
- my $had_filespec = 0;
-
- foreach my $arg (@ARGV) {
- next unless $arg;
- if ($double_minus) {
- $had_filespec = 1;
- if (-f $arg && -r $arg) {
- push @filespec, $arg;
- } else {
- print STDERR "grog: $arg is not a readable file.\n";
- }
- next;
- }
-
- if ($arg eq '--') {
- $double_minus = 1;
- push(@Command, $arg);
- next;
- }
- if ($arg eq '-') {
- unless ($was_minus) {
- push @filespec, $arg;
- $was_minus = 1;
- }
- next;
- }
-
- &version(0) if $arg eq '-v' || '--version' =~ /^$arg/;
- &help() if $arg eq '-h' || '--help' =~ /^$arg/;
- print STDERR "grog: wrong option $arg.\n" if $arg =~ /^--/;
-
- if ($arg =~ /^-m/) {
- push @Mparams, $arg;
- next;
- }
- $Sp = '' if $arg eq '-C';
-
- if ($arg =~ /^-/) {
- push(@Command, $arg);
- next;
- } else {
- $had_filespec = 1;
- if (-f $arg && -r $arg) {
- push @filespec, $arg;
- } else {
- print STDERR "grog: $arg is not a readable file.\n";
- }
- next;
- }
- }
- @filespec = ('-') if ! @filespec && ! $had_filespec;
- exit 1 unless @filespec;
- @ARGV = @filespec;
- }
-
- foreach my $arg (@ARGV) {
- &process($arg, 0);
- }
-
- sub process {
- my ($filename, $level) = @_;
- local(*FILE);
-
- if (!open(FILE, $filename eq "-" ? $filename : "< $filename")) {
- print STDERR "$Prog: can't open \`$filename': $!\n";
- exit 1 unless $level;
- return;
- }
- while (<FILE>) {
- chomp;
- s/^[.']\s*/./;
- s/^\s+|\s+$//g;
- s/$/\n/;
-
- if (/^(.cstart)|(begin\s+chem)$/) {
- $Groff{'chem'}++;
- $Groff{'pic'}++;
- } elsif (/^\.TS$Sp/) {
- $_ = <FILE>;
- if (!/^\./) {
- $Groff{'tbl'}++;
- $Groff{'soelim'}++ if $level;
- }
- } elsif (/^\.EQ$Sp/) {
- $_ = <FILE>;
- if (!/^\./ || /^\.[0-9]/) {
- $Groff{'eqn'}++;
- $Groff{'soelim'}++ if $level;
- }
- } elsif (/^\.GS$Sp/) {
- $_ = <FILE>;
- if (!/^\./) {
- $Groff{'grn'}++;
- $Groff{'soelim'}++ if $level;
- }
- } elsif (/^\.G1$Sp/) {
- $_ = <FILE>;
- if (!/^\./) {
- $Groff{'grap'}++;
- $Groff{'pic'}++;
- $Groff{'soelim'}++ if $level;
- }
- # } elsif (/^\.PS\Sp([ 0-9.<].*)?$/) {
- # if (/^\.PS\s*<\s*(\S+)/) {
- # $Groff{'pic'}++;
- # $Groff{'soelim'}++ if $level;
- # &process($1, $level);
- # } else {
- # $_ = <FILE>;
- # if (!/^\./ || /^\.ps/) {
- # $Groff{'pic'}++;
- # $Groff{'soelim'}++ if $level;
- # }
- # }
- } elsif (/^\.PS[\s\n<]/) {
- $Groff{'pic'}++;
- $Groff{'soelim'}++ if $level;
- if (/^\.PS\s*<\s*(\S+)/) {
- &process($1, $level);
- }
- } elsif (/^\.R1$Sp/) {
- $Groff{'refer'}++;
- $Groff{'soelim'}++ if $level;
- } elsif (/^\.\[/) {
- $Groff{'refer_open'}++;
- $Groff{'soelim'}++ if $level;
- } elsif (/^\.\]/) {
- $Groff{'refer_close'}++;
- $Groff{'soelim'}++ if $level;
- } elsif (/^\.NH$Sp/) {
- $Groff{'NH'}++; # for ms
- } elsif (/^\.TL$Sp/) {
- $Groff{'TL'}++; # for mm and ms
- } elsif (/^\.PP$Sp/) {
- $Groff{'PP'}++; # for mom and ms
- } elsif (/^\.[IL]P$Sp/) {
- $Groff{'ILP'}++; # for man and ms
- } elsif (/^\.P$/) {
- $Groff{'P'}++;
- } elsif (/^\.(PH|SA)$Sp/) {
- $Groff{'mm'}++;
- } elsif (/^\.TH$Sp/) {
- $Groff{'TH'}++;
- } elsif (/^\.SH$Sp/) {
- $Groff{'SH'}++;
- } elsif (/^\.([pnil]p|sh)$Sp/) {
- $Groff{'me'}++;
- } elsif (/^\.Dd$Sp/) {
- $Groff{'mdoc'}++;
- } elsif (/^\.(Tp|Dp|De|Cx|Cl)$Sp/) {
- $Groff{'mdoc_old'} = 1;
- }
- # In the old version of -mdoc `Oo' is a toggle, in the new it's
- # closed by `Oc'.
- elsif (/^\.Oo$Sp/) {
- $Groff{'Oo'}++;
- s/^\.Oo/\. /;
- redo;
- }
- # The test for `Oo' and `Oc' not starting a line (as allowed by the
- # new implementation of -mdoc) is not complete; it assumes that
- # macro arguments are well behaved, i.e., "" is used within "..." to
- # indicate a doublequote as a string element, and weird features
- # like `.foo a"b' are not used.
- elsif (/^\..* Oo( |$)/) {
- s/\\\".*//;
- s/\"[^\"]*\"//g;
- s/\".*//;
- if (s/ Oo( |$)/ /) {
- $Groff{'Oo'}++;
- }
- redo;
- } elsif (/^\.Oc$Sp/) {
- $Groff{'Oo'}--;
- s/^\.Oc/\. /;
- redo;
- } elsif (/^\..* Oc( |$)/) {
- s/\\\".*//;
- s/\"[^\"]*\"//g;
- s/\".*//;
- if (s/ Oc( |$)/ /) {
- $Groff{'Oo'}--;
- }
- redo;
- } elsif (/^\.(PRINTSTYLE|START)$Sp/) {
- $Groff{'mom'}++;
- }
- if (/^\.so$Sp/) {
- chop;
- s/^.so *//;
- s/\\\".*//;
- s/ .*$//;
- &process($_, $level + 1) unless /\\/ || $_ eq "";
- }
- }
- close(FILE);
- }
-
- sub help {
- print <<EOF;
- usage: grog [option]... [--] [filespec]...
-
- "filespec" is either the name of an existing, readable file or "-" for
- standard input. If no "filespec" is specified, standard input is
- assumed automatically.
-
- "option" is either a "groff" option or one of these:
-
- -C compatibility mode
- -h --help print this uasge message
- -v --version print version information
-
- "groff" options are appended to the output, "-m" options are checked.
-
- EOF
- exit 0;
- }
-
- sub version {
- my ($exit_status) = @_;
- print "Perl version of GNU $Prog of $Last_Update " .
- "in groff version 1.20.1\n";
- exit $exit_status;
- }
-
- {
- my @m = ();
- my $is_man = 0;
- my $is_mm = 0;
- my $is_mom = 0;
-
- $Groff{'refer'} ||= $Groff{'refer_open'} && $Groff{'refer_close'};
-
- if ( $Groff{'pic'} || $Groff{'tbl'} || $Groff{'eqn'} ||
- $Groff{'grn'} || $Groff{'grap'} || $Groff{'refer'} ) {
- my $s = "-";
- $s .= "s" if $Groff{'soelim'};
- $s .= "R" if $Groff{'refer'};
- # grap must be run before pic
- $s .= "G" if $Groff{'grap'};
- $s .= "p" if $Groff{'pic'};
- $s .= "g" if $Groff{'grn'};
- $s .= "t" if $Groff{'tbl'};
- $s .= "e" if $Groff{'eqn'};
- push(@Command, $s);
- }
-
- if ( $Groff{'me'} ) {
- push(@m, '-me');
- push(@Command, '-me');
- }
- if ( $Groff{'SH'} && $Groff{'TH'} ) {
- push(@m, '-man');
- push(@Command, '-man');
- $is_man = 1;
- }
- if ( $Groff{'mom'} ) {
- push(@m, '-mom');
- push(@Command, '-mom');
- $is_mom = 1;
- }
- if ( $Groff{'mm'} || ($Groff{'P'} && ! $is_man) ) {
- push(@m, '-mm');
- push(@Command, '-mm');
- $is_mm = 1;
- }
- if ( $Groff{'NH'} || ($Groff{'TL'} && ! $is_mm) ||
- ($Groff{'ILP'} && ! $is_man) ||
- ($Groff{'PP'} && ! $is_mom && ! $is_man) ) {
- # .PP occurs in -mom, -man and -ms, .IP and .LP occur in -man and -ms
- push(@m, '-ms');
- push(@Command, '-ms');
- }
- if ( $Groff{'mdoc'} ) {
- my $s = ( $Groff{'mdoc_old'} || $Groff{'Oo'} ) ? '-mdoc-old' : '-mdoc';
- push(@m, $s);
- push(@Command, $s);
- }
-
- if ($Groff{'chem'}) {
- my @chem = ('chem', @ARGV, '|', 'groff');
- unshift(@Command, @chem);
- } else {
- unshift @Command, 'groff';
- push(@Command, @ARGV);
- }
-
- foreach (@Command) {
- next unless /\s/;
- $_ = "'" . $_ . "'";
- }
-
- # We could implement an option to execute the command here.
-
- # foreach (@Command) {
- # next unless /[\$\\\"\';&()|<> \t\n]/;
- # s/\'/\'\\\'\'/;
- # $_ = "'" . $_ . "'";
- # }
-
- my $n = scalar @m;
- my $np = scalar @Mparams;
- print STDERR "$Prog: more than 1 `-m' argument: @Mparams" if $np > 1;
- if ($n == 0) {
- unshift @Command, $Mparams[0] if $np == 1;
- } elsif ($n == 1) {
- if ($np == 1) {
- print STDERR "$Prog: wrong `-m' argument: $Mparams[0]\n"
- if $m[0] ne $Mparams[0];
- }
- } else {
- print STDERR "$Prog: error: there are several macro packages: @m\n";
- }
-
- print "@Command\n";
-
- exit $n if $n > 1;
- exit 0;
- }
-
- ########################################################################
- ### Emacs settings
- # Local Variables:
- # mode: CPerl
- # End:
-