/contrib/groff/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
 11push(@command, "groff");
 12
 13while ($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;
 23foreach $arg (@ARGV) {
 24    &process($arg, 0);
 25}
 26
 27sub 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
165sub usage {
166    local($exit_status) = $_;
167    print "GNU grog (groff) version @VERSION@\n";
168    exit $exit_status;
169}
170
171sub help {
172    print "usage: grog [ option ...] [files...]\n";
173    exit 0;
174}
175
176$refer ||= $refer_open && $refer_close;
177
178if ($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
191if ($me > 0) {
192    push(@command, "-me");
193}
194elsif ($SH > 0 && $TH > 0) {
195    push(@command, "-man");
196}
197else ($mom > 0) {
198    push(@command, "-mom");
199}
200elsif ($PP > 0) {
201    push(@command, "-ms");
202}
203elsif ($P > 0 || $mm > 0) {
204    push(@command, "-mm");
205}
206elsif ($mdoc > 0) {
207    push(@command, ($mdoc_old || $Oo > 0) ? "-mdoc-old" : "-mdoc");
208}
209
210push(@command, "--") if @ARGV && $ARGV[0] =~ /^-./;
211
212push(@command, @ARGV);
213
214# We could implement an option to execute the command here.
215
216foreach (@command) {
217    next unless /[\$\\\"\';&()|<> \t\n]/;
218    s/\'/\'\\\'\'/;
219    $_ = "'" . $_ . "'";
220}
221
222print join(' ', @command), "\n";