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"; 223