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

https://bitbucket.org/freebsd/freebsd-head/ · Perl · 222 lines · 192 code · 17 blank · 13 comment · 52 complexity · 5db626462fa72bc4ea2de28b2a63b26e MD5 · raw file

  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. $prog = $0;
  6. $prog =~ s@.*/@@;
  7. $sp = "[\\s\\n]";
  8. push(@command, "groff");
  9. while ($ARGV[0] =~ /^-./) {
  10. $arg = shift(@ARGV);
  11. $sp = "" if $arg eq "-C";
  12. &usage(0) if $arg eq "-v" || $arg eq "--version";
  13. &help() if $arg eq "--help";
  14. last if $arg eq "--";
  15. push(@command, $arg);
  16. }
  17. @ARGV = ('-') unless @ARGV;
  18. foreach $arg (@ARGV) {
  19. &process($arg, 0);
  20. }
  21. sub process {
  22. local($filename, $level) = @_;
  23. local(*FILE);
  24. if (!open(FILE, $filename eq "-" ? $filename : "< $filename")) {
  25. print STDERR "$prog: can't open \`$filename': $!\n";
  26. exit 1 unless $level;
  27. return;
  28. }
  29. while (<FILE>) {
  30. if (/^\.TS$sp/) {
  31. $_ = <FILE>;
  32. if (!/^\./) {
  33. $tbl++;
  34. $soelim++ if $level;
  35. }
  36. }
  37. elsif (/^\.EQ$sp/) {
  38. $_ = <FILE>;
  39. if (!/^\./ || /^\.[0-9]/) {
  40. $eqn++;
  41. $soelim++ if $level;
  42. }
  43. }
  44. elsif (/^\.GS$sp/) {
  45. $_ = <FILE>;
  46. if (!/^\./) {
  47. $grn++;
  48. $soelim++ if $level;
  49. }
  50. }
  51. elsif (/^\.G1$sp/) {
  52. $_ = <FILE>;
  53. if (!/^\./) {
  54. $grap++;
  55. $pic++;
  56. $soelim++ if $level;
  57. }
  58. }
  59. elsif (/^\.PS$sp([ 0-9.<].*)?$/) {
  60. if (/^\.PS\s*<\s*(\S+)/) {
  61. $pic++;
  62. $soelim++ if $level;
  63. &process($1, $level);
  64. }
  65. else {
  66. $_ = <FILE>;
  67. if (!/^\./ || /^\.ps/) {
  68. $pic++;
  69. $soelim++ if $level;
  70. }
  71. }
  72. }
  73. elsif (/^\.R1$sp/) {
  74. $refer++;
  75. $soelim++ if $level;
  76. }
  77. elsif (/^\.\[/) {
  78. $refer_open++;
  79. $soelim++ if $level;
  80. }
  81. elsif (/^\.\]/) {
  82. $refer_close++;
  83. $soelim++ if $level;
  84. }
  85. elsif (/^\.[PLI]P$sp/) {
  86. $PP++;
  87. }
  88. elsif (/^\.P$/) {
  89. $P++;
  90. }
  91. elsif (/^\.(PH|SA)$sp/) {
  92. $mm++;
  93. }
  94. elsif (/^\.TH$sp/) {
  95. $TH++;
  96. }
  97. elsif (/^\.SH$sp/) {
  98. $SH++;
  99. }
  100. elsif (/^\.([pnil]p|sh)$sp/) {
  101. $me++;
  102. }
  103. elsif (/^\.Dd$sp/) {
  104. $mdoc++;
  105. }
  106. elsif (/^\.(Tp|Dp|De|Cx|Cl)$sp/) {
  107. $mdoc_old = 1;
  108. }
  109. # In the old version of -mdoc `Oo' is a toggle, in the new it's
  110. # closed by `Oc'.
  111. elsif (/^\.Oo$sp/) {
  112. $Oo++;
  113. s/^\.Oo/\. /;
  114. redo;
  115. }
  116. # The test for `Oo' and `Oc' not starting a line (as allowed by the
  117. # new implementation of -mdoc) is not complete; it assumes that
  118. # macro arguments are well behaved, i.e., "" is used within "..." to
  119. # indicate a doublequote as a string element, and weird features
  120. # like `.foo a"b' are not used.
  121. elsif (/^\..* Oo( |$)/) {
  122. s/\\\".*//;
  123. s/\"[^\"]*\"//g;
  124. s/\".*//;
  125. if (s/ Oo( |$)/ /) {
  126. $Oo++;
  127. }
  128. redo;
  129. }
  130. elsif (/^\.Oc$sp/) {
  131. $Oo--;
  132. s/^\.Oc/\. /;
  133. redo;
  134. }
  135. elsif (/^\..* Oc( |$)/) {
  136. s/\\\".*//;
  137. s/\"[^\"]*\"//g;
  138. s/\".*//;
  139. if (s/ Oc( |$)/ /) {
  140. $Oo--;
  141. }
  142. redo;
  143. }
  144. elsif (/^\.(PRINTSTYLE|START)$sp/) {
  145. $mom++;
  146. }
  147. if (/^\.so$sp/) {
  148. chop;
  149. s/^.so *//;
  150. s/\\\".*//;
  151. s/ .*$//;
  152. &process($_, $level + 1) unless /\\/ || $_ eq "";
  153. }
  154. }
  155. close(FILE);
  156. }
  157. sub usage {
  158. local($exit_status) = $_;
  159. print "GNU grog (groff) version @VERSION@\n";
  160. exit $exit_status;
  161. }
  162. sub help {
  163. print "usage: grog [ option ...] [files...]\n";
  164. exit 0;
  165. }
  166. $refer ||= $refer_open && $refer_close;
  167. if ($pic || $tbl || $eqn || $grn || $grap || $refer) {
  168. $s = "-";
  169. $s .= "s" if $soelim;
  170. $s .= "R" if $refer;
  171. # grap must be run before pic
  172. $s .= "G" if $grap;
  173. $s .= "p" if $pic;
  174. $s .= "g" if $grn;
  175. $s .= "t" if $tbl;
  176. $s .= "e" if $eqn;
  177. push(@command, $s);
  178. }
  179. if ($me > 0) {
  180. push(@command, "-me");
  181. }
  182. elsif ($SH > 0 && $TH > 0) {
  183. push(@command, "-man");
  184. }
  185. else ($mom > 0) {
  186. push(@command, "-mom");
  187. }
  188. elsif ($PP > 0) {
  189. push(@command, "-ms");
  190. }
  191. elsif ($P > 0 || $mm > 0) {
  192. push(@command, "-mm");
  193. }
  194. elsif ($mdoc > 0) {
  195. push(@command, ($mdoc_old || $Oo > 0) ? "-mdoc-old" : "-mdoc");
  196. }
  197. push(@command, "--") if @ARGV && $ARGV[0] =~ /^-./;
  198. push(@command, @ARGV);
  199. # We could implement an option to execute the command here.
  200. foreach (@command) {
  201. next unless /[\$\\\"\';&()|<> \t\n]/;
  202. s/\'/\'\\\'\'/;
  203. $_ = "'" . $_ . "'";
  204. }
  205. print join(' ', @command), "\n";