subs.pl 28 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266
  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. # Source file position: <groff-source>/src/roff/grog/subs.pl
  6. # Installed position: <prefix>/lib/grog/subs.pl
  7. # Copyright (C) 1993-2018 Free Software Foundation, Inc.
  8. # This file was split from grog.pl and put under GPL2 by
  9. # Bernd Warken <groff-bernd.warken-72@web.de>.
  10. # The macros for identifying the devices were taken from Ralph
  11. # Corderoy's 'grog.sh' of 2006.
  12. # Last update: 10 Sep 2015
  13. # This file is part of 'grog', which is part of 'groff'.
  14. # 'groff' is free software; you can redistribute it and/or modify it
  15. # under the terms of the GNU General Public License as published by
  16. # the Free Software Foundation, either version 2 of the License, or
  17. # (at your option) any later version.
  18. # 'groff' is distributed in the hope that it will be useful, but
  19. # WITHOUT ANY WARRANTY; without even the implied warranty of
  20. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  21. # General Public License for more details.
  22. # You can get the license text for the GNU General Public License
  23. # version 2 in the internet at
  24. # <http://www.gnu.org/licenses/gpl-2.0.html>.
  25. ########################################################################
  26. require v5.6;
  27. use warnings;
  28. use strict;
  29. use File::Spec;
  30. # printing of hashes: my %hash = ...; print Dumper(\%hash);
  31. use Data::Dumper;
  32. # for running shell based programs within Perl; use `` instead of
  33. # use IPC::System::Simple qw(capture capturex run runx system systemx);
  34. $\ = "\n";
  35. # my $Sp = "[\\s\\n]";
  36. # my $Sp = qr([\s\n]);
  37. # my $Sp = '' if $arg eq '-C';
  38. my $Sp = '';
  39. # from 'src/roff/groff/groff.cpp' near 'getopt_long'
  40. my $groff_opts =
  41. 'abcCd:D:eEf:F:gGhiI:jJkK:lL:m:M:n:No:pP:r:RsStT:UvVw:W:XzZ';
  42. my @Command = (); # stores the final output
  43. my @Mparams = (); # stores the options '-m*'
  44. my @devices = (); # stores -T
  45. my $do_run = 0; # run generated 'groff' command
  46. my $pdf_with_ligatures = 0; # '-P-y -PU' for 'pdf' device
  47. my $with_warnings = 0;
  48. my $Prog = $0;
  49. {
  50. my ($v, $d, $f) = File::Spec->splitpath($Prog);
  51. $Prog = $f;
  52. }
  53. my %macros;
  54. my %Groff =
  55. (
  56. # preprocessors
  57. 'chem' => 0,
  58. 'eqn' => 0,
  59. 'gperl' => 0,
  60. 'grap' => 0,
  61. 'grn' => 0,
  62. 'gideal' => 0,
  63. 'gpinyin' => 0,
  64. 'lilypond' => 0,
  65. 'pic' => 0,
  66. 'PS' => 0, # opening for pic
  67. 'PF' => 0, # alternative opening for pic
  68. 'PE' => 0, # closing for pic
  69. 'refer' => 0,
  70. 'refer_open' => 0,
  71. 'refer_close' => 0,
  72. 'soelim' => 0,
  73. 'tbl' => 0,
  74. # tmacs
  75. # 'man' => 0,
  76. # 'mandoc' => 0,
  77. # 'mdoc' => 0,
  78. # 'mdoc_old' => 0,
  79. # 'me' => 0,
  80. # 'mm' => 0,
  81. # 'mom' => 0,
  82. # 'ms' => 0,
  83. # requests
  84. 'AB' => 0, # ms
  85. 'AE' => 0, # ms
  86. 'AI' => 0, # ms
  87. 'AU' => 0, # ms
  88. 'NH' => 0, # ms
  89. 'TH_later' => 0, # TH not 1st command is ms
  90. 'TL' => 0, # ms
  91. 'UL' => 0, # ms
  92. 'XP' => 0, # ms
  93. 'IP' => 0, # man and ms
  94. 'LP' => 0, # man and ms
  95. 'P' => 0, # man and ms
  96. 'PP' => 0, # man and ms
  97. 'SH' => 0, # man and ms
  98. 'OP' => 0, # man
  99. 'SS' => 0, # man
  100. 'SY' => 0, # man
  101. 'TH_first' => 0, # TH as 1st command is man
  102. 'TP' => 0, # man
  103. 'UR' => 0, # man
  104. 'YS' => 0, # man
  105. # for mdoc and mdoc-old
  106. # .Oo and .Oc for modern mdoc, only .Oo for mdoc-old
  107. 'Oo' => 0, # mdoc and mdoc-old
  108. 'Oc' => 0, # mdoc
  109. 'Dd' => 0, # mdoc
  110. ); # end of %Groff
  111. # for first line check
  112. my %preprocs_tmacs =
  113. (
  114. 'chem' => 0,
  115. 'eqn' => 0,
  116. 'gideal' => 0,
  117. 'gpinyin' => 0,
  118. 'grap' => 0,
  119. 'grn' => 0,
  120. 'pic' => 0,
  121. 'refer' => 0,
  122. 'soelim' => 0,
  123. 'tbl' => 0,
  124. 'geqn' => 0,
  125. 'gpic' => 0,
  126. 'neqn' => 0,
  127. 'man' => 0,
  128. 'mandoc' => 0,
  129. 'mdoc' => 0,
  130. 'mdoc-old' => 0,
  131. 'me' => 0,
  132. 'mm' => 0,
  133. 'mom' => 0,
  134. 'ms' => 0,
  135. );
  136. my @filespec;
  137. my $tmac_ext = '';
  138. ########################################################################
  139. # err()
  140. ########################################################################
  141. sub err {
  142. my $text = shift;
  143. print STDERR $text;
  144. }
  145. ########################################################################
  146. # handle_args()
  147. ########################################################################
  148. sub handle_args {
  149. my $double_minus = 0;
  150. my $was_minus = 0;
  151. my $was_T = 0;
  152. my $optarg = 0;
  153. # globals: @filespec, @Command, @devices, @Mparams
  154. foreach my $arg (@ARGV) {
  155. if ( $optarg ) {
  156. push @Command, $arg;
  157. $optarg = 0;
  158. next;
  159. }
  160. if ( $double_minus ) {
  161. if (-f $arg && -r $arg) {
  162. push @filespec, $arg;
  163. } else {
  164. print STDERR __FILE__ . ' ' . __LINE__ . ': ' .
  165. "grog: $arg is not a readable file.";
  166. }
  167. next;
  168. }
  169. if ( $was_T ) {
  170. push @devices, $arg;
  171. $was_T = 0;
  172. next;
  173. }
  174. ####### handle_args()
  175. unless ( $arg =~ /^-/ ) { # file name, no opt, no optarg
  176. unless (-f $arg && -r $arg) {
  177. print 'unknown file name: ' . $arg;
  178. }
  179. push @filespec, $arg;
  180. next;
  181. }
  182. # now $arg starts with '-'
  183. if ($arg eq '-') {
  184. unless ($was_minus) {
  185. push @filespec, $arg;
  186. $was_minus = 1;
  187. }
  188. next;
  189. }
  190. if ($arg eq '--') {
  191. $double_minus = 1;
  192. push(@filespec, $arg);
  193. next;
  194. }
  195. &version() if $arg =~ /^--?v/; # --version, with exit
  196. &help() if $arg =~ /--?h/; # --help, with exit
  197. if ( $arg =~ /^--r/ ) { # --run, no exit
  198. $do_run = 1;
  199. next;
  200. }
  201. if ( $arg =~ /^--wa/ ) { # --warnings, no exit
  202. $with_warnings = 1;
  203. next;
  204. }
  205. ####### handle_args()
  206. if ( $arg =~ /^--(wi|l)/ ) { # --ligatures, no exit
  207. # the old --with_ligatures is only kept for compatibility
  208. $pdf_with_ligatures = 1;
  209. next;
  210. }
  211. if ($arg =~ /^-m/) {
  212. push @Mparams, $arg;
  213. next;
  214. }
  215. if ($arg =~ /^-T$/) {
  216. $was_T = 1;
  217. next;
  218. }
  219. if ($arg =~ s/^-T(\w+)$/$1/) {
  220. push @devices, $1;
  221. next;
  222. }
  223. if ($arg =~ /^-(\w)(\w*)$/) { # maybe a groff option
  224. my $opt_char = $1;
  225. my $opt_char_with_arg = $opt_char . ':';
  226. my $others = $2;
  227. if ( $groff_opts =~ /$opt_char_with_arg/ ) { # groff optarg
  228. if ( $others ) { # optarg is here
  229. push @Command, '-' . $opt_char;
  230. push @Command, '-' . $others;
  231. next;
  232. }
  233. # next arg is optarg
  234. $optarg = 1;
  235. next;
  236. ####### handle_args()
  237. } elsif ( $groff_opts =~ /$opt_char/ ) { # groff no optarg
  238. push @Command, '-' . $opt_char;
  239. if ( $others ) { # $others is now an opt collection
  240. $arg = '-' . $others;
  241. redo;
  242. }
  243. # arg finished
  244. next;
  245. } else { # not a groff opt
  246. print STDERR __FILE__ . ' ' . __LINE__ . ': ' .
  247. 'unknown argument ' . $arg;
  248. push(@Command, $arg);
  249. next;
  250. }
  251. }
  252. }
  253. @filespec = ('-') unless (@filespec);
  254. } # handle_args()
  255. ########################################################################
  256. # handle_file_ext()
  257. ########################################################################
  258. sub handle_file_ext {
  259. # get tmac from file name extension
  260. # output number of found single tmac
  261. # globals: @filespec, $tmac_ext;
  262. foreach my $file ( @filespec ) {
  263. # test for each file name in the arguments
  264. unless ( open(FILE, $file eq "-" ? $file : "< $file") ) {
  265. print STDERR __FILE__ . ' ' . __LINE__ . ': ' .
  266. "$Prog: can't open \'$file\': $!";
  267. next;
  268. }
  269. next unless ( $file =~ /\./ ); # file name has no dot '.'
  270. ##### handle_file_ext()
  271. # get extension
  272. my $ext = $file;
  273. $ext =~ s/^
  274. .*
  275. \.
  276. ([^.]*)
  277. $
  278. /$1/x;
  279. next unless ( $ext );
  280. ##### handle_file_ext()
  281. # these extensions are correct, but not based on a tmac
  282. next if ( $ext =~ /^(
  283. chem|
  284. eqn|
  285. g|
  286. grap|
  287. grn|
  288. groff|
  289. hdtbl|
  290. pdfroff|
  291. pic|
  292. pinyin|
  293. ref|
  294. roff|
  295. t|
  296. tbl|
  297. tr|
  298. www
  299. )$/x );
  300. ##### handle_file_ext()
  301. # extensions for man tmac
  302. if ( $ext =~ /^(
  303. [1-9lno]|
  304. man|
  305. n|
  306. 1b
  307. )$/x ) {
  308. # 'man|n' from 'groff' source
  309. # '1b' from 'heirloom'
  310. # '[1-9lno]' from man-pages
  311. if ( $tmac_ext && $tmac_ext ne 'man' ) {
  312. # found tmac is not 'man'
  313. print STDERR __FILE__ . ' ' . __LINE__ . ': ' .
  314. '2 different file name extensions found ' .
  315. $tmac_ext . ' and ' . $ext;
  316. $tmac_ext = '';
  317. next;
  318. }
  319. ##### handle_file_ext()
  320. $tmac_ext = 'man';
  321. next;
  322. }
  323. if ( $ext =~ /^(
  324. mandoc|
  325. mdoc|
  326. me|
  327. mm|
  328. mmse|
  329. mom|
  330. ms|
  331. $)/x ) {
  332. if ( $tmac_ext && $tmac_ext ne $ext ) {
  333. # found tmac is not identical to former found tmac
  334. ##### handle_file_ext()
  335. print STDERR __FILE__ . ' ' . __LINE__ . ': ' .
  336. '2 different file name extensions found ' .
  337. $tmac_ext . ' and ' . $ext;
  338. $tmac_ext = '';
  339. next;
  340. }
  341. $tmac_ext = $ext;
  342. next;
  343. }
  344. print STDERR __FILE__ . ' ' . __LINE__ . ': ' .
  345. 'Unknown file name extension '. $file . '.';
  346. next;
  347. } # end foreach file
  348. 1;
  349. } # handle_file_ext()
  350. ########################################################################
  351. # handle_whole_files()
  352. ########################################################################
  353. sub handle_whole_files {
  354. # globals: @filespec
  355. foreach my $file ( @filespec ) {
  356. unless ( open(FILE, $file eq "-" ? $file : "< $file") ) {
  357. print STDERR __FILE__ . ' ' . __LINE__ . ': ' .
  358. "$Prog: can't open \'$file\': $!";
  359. next;
  360. }
  361. my $line = <FILE>; # get single line
  362. unless ( defined($line) ) {
  363. # empty file, go to next filearg
  364. close (FILE);
  365. next;
  366. }
  367. if ( $line ) {
  368. chomp $line;
  369. unless ( &do_first_line( $line, $file ) ) {
  370. # not an option line
  371. &do_line( $line, $file );
  372. }
  373. } else { # empty line
  374. next;
  375. }
  376. while (<FILE>) { # get lines by and by
  377. chomp;
  378. &do_line( $_, $file );
  379. }
  380. close(FILE);
  381. } # end foreach
  382. } # handle_whole_files()
  383. ########################################################################
  384. # do_first_line()
  385. ########################################################################
  386. # As documented for the 'man' program, the first line can be
  387. # used as a groff option line. This is done by:
  388. # - start the line with '\" (apostrophe, backslash, double quote)
  389. # - add a space character
  390. # - a word using the following characters can be appended: 'egGjJpRst'.
  391. # Each of these characters means an option for the generated
  392. # 'groff' command line, e.g. '-t'.
  393. sub do_first_line {
  394. my ( $line, $file ) = @_;
  395. # globals: %preprocs_tmacs
  396. # For a leading groff options line use only [egGjJpRst]
  397. if ( $line =~ /^[.']\\"[\segGjJpRst]+&/ ) {
  398. # this is a groff options leading line
  399. if ( $line =~ /^\./ ) {
  400. # line is a groff options line with . instead of '
  401. print "First line in $file must start with an apostrophe \ " .
  402. "instead of a period . for groff options line!";
  403. }
  404. if ( $line =~ /j/ ) {
  405. $Groff{'chem'}++;
  406. }
  407. if ( $line =~ /e/ ) {
  408. $Groff{'eqn'}++;
  409. }
  410. if ( $line =~ /g/ ) {
  411. $Groff{'grn'}++;
  412. }
  413. if ( $line =~ /G/ ) {
  414. $Groff{'grap'}++;
  415. }
  416. if ( $line =~ /i/ ) {
  417. $Groff{'gideal'}++;
  418. }
  419. if ( $line =~ /p/ ) {
  420. $Groff{'pic'}++;
  421. }
  422. if ( $line =~ /R/ ) {
  423. $Groff{'refer'}++;
  424. }
  425. if ( $line =~ /s/ ) {
  426. $Groff{'soelim'}++;
  427. }
  428. ####### do_first_line()
  429. if ( $line =~ /t/ ) {
  430. $Groff{'tbl'}++;
  431. }
  432. return 1; # a leading groff options line, 1 means yes, 0 means no
  433. }
  434. # not a leading short groff options line
  435. return 0 if ( $line !~ /^[.']\\"\s*(.*)$/ ); # ignore non-comments
  436. return 0 unless ( $1 ); # for empty comment
  437. # all following array members are either preprocs or 1 tmac
  438. my @words = split '\s+', $1;
  439. my @in = ();
  440. my $word;
  441. for $word ( @words ) {
  442. if ( $word eq 'ideal' ) {
  443. $word = 'gideal';
  444. } elsif ( $word eq 'gpic' ) {
  445. $word = 'pic';
  446. } elsif ( $word =~ /^(gn|)eqn$/ ) {
  447. $word = 'eqn';
  448. }
  449. if ( exists $preprocs_tmacs{$word} ) {
  450. push @in, $word;
  451. } else {
  452. # not word for preproc or tmac
  453. return 0;
  454. }
  455. }
  456. for $word ( @in ) {
  457. $Groff{$word}++;
  458. }
  459. } # do_first_line()
  460. ########################################################################
  461. # do_line()
  462. ########################################################################
  463. my $before_first_command = 1; # for check of .TH
  464. sub do_line {
  465. my ( $line, $file ) = @_;
  466. return if ( $line =~ /^[.']\s*\\"/ ); # comment
  467. return unless ( $line =~ /^[.']/ ); # ignore text lines
  468. $line =~ s/^['.]\s*/./; # let only a dot as leading character,
  469. # remove spaces after the leading dot
  470. $line =~ s/\s+$//; # remove final spaces
  471. return if ( $line =~ /^\.$/ ); # ignore .
  472. return if ( $line =~ /^\.\.$/ ); # ignore ..
  473. if ( $before_first_command ) { # so far without 1st command
  474. if ( $line =~ /^\.TH/ ) {
  475. # check if .TH is 1st command for man
  476. $Groff{'TH_first'} = 1 if ( $line =~ /^\.\s*TH/ );
  477. }
  478. if ( $line =~ /^\./ ) {
  479. $before_first_command = 0;
  480. }
  481. }
  482. # split command
  483. $line =~ /^(\.\w+)\s*(.*)$/;
  484. my $command = $1;
  485. $command = '' unless ( defined $command );
  486. my $args = $2;
  487. $args = '' unless ( defined $args );
  488. ######################################################################
  489. # soelim
  490. if ( $line =~ /^\.(do)?\s*(so|mso|PS\s*<|SO_START).*$/ ) {
  491. # '.so', '.mso', '.PS<...', '.SO_START'
  492. $Groff{'soelim'}++;
  493. return;
  494. }
  495. if ( $line =~ /^\.(do)?\s*(so|mso|PS\s*<|SO_START).*$/ ) {
  496. # '.do so', '.do mso', '.do PS<...', '.do SO_START'
  497. $Groff{'soelim'}++;
  498. return;
  499. }
  500. ####### do_line()
  501. ######################################################################
  502. # macros
  503. if ( $line =~ /^\.de1?\W?/ ) {
  504. # this line is a macro definition, add it to %macros
  505. my $macro = $line;
  506. $macro =~ s/^\.de1?\s+(\w+)\W*/.$1/;
  507. return if ( exists $macros{$macro} );
  508. $macros{$macro} = 1;
  509. return;
  510. }
  511. # if line command is a defined macro, just ignore this line
  512. return if ( exists $macros{$command} );
  513. ######################################################################
  514. # preprocessors
  515. if ( $command =~ /^(\.cstart)|(begin\s+chem)$/ ) {
  516. $Groff{'chem'}++; # for chem
  517. return;
  518. }
  519. if ( $command =~ /^\.EQ$/ ) {
  520. $Groff{'eqn'}++; # for eqn
  521. return;
  522. }
  523. if ( $command =~ /^\.G1$/ ) {
  524. $Groff{'grap'}++; # for grap
  525. return;
  526. }
  527. if ( $command =~ /^\.Perl/ ) {
  528. $Groff{'gperl'}++; # for gperl
  529. return;
  530. }
  531. if ( $command =~ /^\.pinyin/ ) {
  532. $Groff{'gpinyin'}++; # for gperl
  533. return;
  534. }
  535. if ( $command =~ /^\.GS$/ ) {
  536. $Groff{'grn'}++; # for grn
  537. return;
  538. }
  539. if ( $command =~ /^\.IS$/ ) {
  540. $Groff{'gideal'}++; # preproc gideal for ideal
  541. return;
  542. }
  543. if ( $command =~ /^\.lilypond$/ ) {
  544. $Groff{'lilypond'}++; # for glilypond
  545. return;
  546. }
  547. ####### do_line()
  548. # pic can be opened by .PS or .PF and closed by .PE
  549. if ( $command =~ /^\.PS$/ ) {
  550. $Groff{'pic'}++; # normal opening for pic
  551. return;
  552. }
  553. if ( $command =~ /^\.PF$/ ) {
  554. $Groff{'PF'}++; # alternate opening for pic
  555. return;
  556. }
  557. if ( $command =~ /^\.PE$/ ) {
  558. $Groff{'PE'}++; # closing for pic
  559. return;
  560. }
  561. if ( $command =~ /^\.R1$/ ) {
  562. $Groff{'refer'}++; # for refer
  563. return;
  564. }
  565. if ( $command =~ /^\.\[$/ ) {
  566. $Groff{'refer_open'}++; # for refer open
  567. return;
  568. }
  569. if ( $command =~ /^\.\]$/ ) {
  570. $Groff{'refer_close'}++; # for refer close
  571. return;
  572. }
  573. if ( $command =~ /^\.TS$/ ) {
  574. $Groff{'tbl'}++; # for tbl
  575. return;
  576. }
  577. if ( $command =~ /^\.TH$/ ) {
  578. unless ( $Groff{'TH_first'} ) {
  579. $Groff{'TH_later'}++; # for tbl
  580. }
  581. return;
  582. }
  583. ######################################################################
  584. # macro package (tmac)
  585. ######################################################################
  586. ##########
  587. # modern mdoc
  588. if ( $command =~ /^\.(Dd)$/ ) {
  589. $Groff{'Dd'}++; # for modern mdoc
  590. return;
  591. }
  592. ####### do_line()
  593. # In the old version of -mdoc 'Oo' is a toggle, in the new it's
  594. # closed by 'Oc'.
  595. if ( $command =~ /^\.Oc$/ ) {
  596. $Groff{'Oc'}++; # only for modern mdoc
  597. return;
  598. }
  599. ##########
  600. # old and modern mdoc
  601. if ( $command =~ /^\.Oo$/ ) {
  602. $Groff{'Oo'}++; # for mdoc and mdoc-old
  603. return;
  604. }
  605. ##########
  606. # old mdoc
  607. if ( $command =~ /^\.(Tp|Dp|De|Cx|Cl)$/ ) {
  608. $Groff{'mdoc_old'}++; # true for old mdoc
  609. return;
  610. }
  611. ##########
  612. # for ms
  613. ####### do_line()
  614. if ( $command =~ /^\.AB$/ ) {
  615. $Groff{'AB'}++; # for ms
  616. return;
  617. }
  618. if ( $command =~ /^\.AE$/ ) {
  619. $Groff{'AE'}++; # for ms
  620. return;
  621. }
  622. if ( $command =~ /^\.AI$/ ) {
  623. $Groff{'AI'}++; # for ms
  624. return;
  625. }
  626. if ( $command =~ /^\.AU$/ ) {
  627. $Groff{'AU'}++; # for ms
  628. return;
  629. }
  630. if ( $command =~ /^\.NH$/ ) {
  631. $Groff{'NH'}++; # for ms
  632. return;
  633. }
  634. if ( $command =~ /^\.TL$/ ) {
  635. $Groff{'TL'}++; # for ms
  636. return;
  637. }
  638. if ( $command =~ /^\.XP$/ ) {
  639. $Groff{'XP'}++; # for ms
  640. return;
  641. }
  642. ##########
  643. # for man and ms
  644. if ( $command =~ /^\.IP$/ ) {
  645. $Groff{'IP'}++; # for man and ms
  646. return;
  647. }
  648. if ( $command =~ /^\.LP$/ ) {
  649. $Groff{'LP'}++; # for man and ms
  650. return;
  651. }
  652. ####### do_line()
  653. if ( $command =~ /^\.P$/ ) {
  654. $Groff{'P'}++; # for man and ms
  655. return;
  656. }
  657. if ( $command =~ /^\.PP$/ ) {
  658. $Groff{'PP'}++; # for man and ms
  659. return;
  660. }
  661. if ( $command =~ /^\.SH$/ ) {
  662. $Groff{'SH'}++; # for man and ms
  663. return;
  664. }
  665. if ( $command =~ /^\.UL$/ ) {
  666. $Groff{'UL'}++; # for man and ms
  667. return;
  668. }
  669. ##########
  670. # for man only
  671. if ( $command =~ /^\.OP$/ ) { # for man
  672. $Groff{'OP'}++;
  673. return;
  674. }
  675. if ( $command =~ /^\.SS$/ ) { # for man
  676. $Groff{'SS'}++;
  677. return;
  678. }
  679. if ( $command =~ /^\.SY$/ ) { # for man
  680. $Groff{'SY'}++;
  681. return;
  682. }
  683. if ( $command =~ /^\.TP$/ ) { # for man
  684. $Groff{'TP'}++;
  685. return;
  686. }
  687. if ( $command =~ /^\.UR$/ ) {
  688. $Groff{'UR'}++; # for man
  689. return;
  690. }
  691. if ( $command =~ /^\.YS$/ ) { # for man
  692. $Groff{'YS'}++;
  693. return;
  694. }
  695. ####### do_line()
  696. ##########
  697. # me
  698. if ( $command =~ /^\.(
  699. [ilnp]p|
  700. sh
  701. )$/x ) {
  702. $Groff{'me'}++; # for me
  703. return;
  704. }
  705. #############
  706. # mm and mmse
  707. if ( $command =~ /^\.(
  708. H|
  709. MULB|
  710. LO|
  711. LT|
  712. NCOL|
  713. P\$|
  714. PH|
  715. SA
  716. )$/x ) {
  717. $Groff{'mm'}++; # for mm and mmse
  718. if ( $command =~ /^\.LO$/ ) {
  719. if ( $args =~ /^(DNAMN|MDAT|BIL|KOMP|DBET|BET|SIDOR)/ ) {
  720. $Groff{'mmse'}++; # for mmse
  721. }
  722. } elsif ( $command =~ /^\.LT$/ ) {
  723. if ( $args =~ /^(SVV|SVH)/ ) {
  724. $Groff{'mmse'}++; # for mmse
  725. }
  726. }
  727. return;
  728. }
  729. ####### do_line()
  730. ##########
  731. # mom
  732. if ( $line =~ /^\.(
  733. ALD|
  734. DOCTYPE|
  735. FAMILY|
  736. FT|
  737. FAM|
  738. LL|
  739. LS|
  740. NEWPAGE|
  741. PAGE|
  742. PAPER|
  743. PRINTSTYLE|
  744. PT_SIZE|
  745. T_MARGIN
  746. )$/x ) {
  747. $Groff{'mom'}++; # for mom
  748. return;
  749. }
  750. } # do_line()
  751. ########################################################################
  752. # sub make_groff_device
  753. ########################################################################
  754. my @m = ();
  755. my @preprograms = ();
  756. my $correct_tmac = '';
  757. sub make_groff_device {
  758. # globals: @devices
  759. # default device is 'ps' when without '-T'
  760. my $device;
  761. push @devices, 'ps' unless ( @devices );
  762. ###### make_groff_device()
  763. for my $d ( @devices ) {
  764. if ( $d =~ /^( # suitable devices
  765. dvi|
  766. html|
  767. xhtml|
  768. lbp|
  769. lj4|
  770. ps|
  771. pdf|
  772. ascii|
  773. cp1047|
  774. latin1|
  775. utf8
  776. )$/x ) {
  777. ###### make_groff_device()
  778. $device = $d;
  779. } else {
  780. next;
  781. }
  782. if ( $device ) {
  783. push @Command, '-T';
  784. push @Command, $device;
  785. }
  786. }
  787. ###### make_groff_device()
  788. if ( $device eq 'pdf' ) {
  789. if ( $pdf_with_ligatures ) { # with --ligature argument
  790. push( @Command, '-P-y' );
  791. push( @Command, '-PU' );
  792. } else { # no --ligature argument
  793. if ( $with_warnings ) {
  794. print STDERR <<EOF;
  795. If you have trouble with ligatures like 'fi' in the 'groff' output, you
  796. can proceed as one of
  797. - add 'grog' option '--with_ligatures' or
  798. - use the 'grog' option combination '-P-y -PU' or
  799. - try to remove the font named similar to 'fonts-texgyre' from your system.
  800. EOF
  801. } # end of warning
  802. } # end of ligature
  803. } # end of pdf device
  804. } # make_groff_device()
  805. ########################################################################
  806. # make_groff_preproc()
  807. ########################################################################
  808. sub make_groff_preproc {
  809. # globals: %Groff, @preprograms, @Command
  810. # preprocessors without 'groff' option
  811. if ( $Groff{'lilypond'} ) {
  812. push @preprograms, 'glilypond';
  813. }
  814. if ( $Groff{'gperl'} ) {
  815. push @preprograms, 'gperl';
  816. }
  817. if ( $Groff{'gpinyin'} ) {
  818. push @preprograms, 'gpinyin';
  819. }
  820. # preprocessors with 'groff' option
  821. if ( ( $Groff{'PS'} || $Groff{'PF'} ) && $Groff{'PE'} ) {
  822. $Groff{'pic'} = 1;
  823. }
  824. if ( $Groff{'gideal'} ) {
  825. $Groff{'pic'} = 1;
  826. }
  827. ###### make_groff_preproc()
  828. $Groff{'refer'} ||= $Groff{'refer_open'} && $Groff{'refer_close'};
  829. if ( $Groff{'chem'} || $Groff{'eqn'} || $Groff{'gideal'} ||
  830. $Groff{'grap'} || $Groff{'grn'} || $Groff{'pic'} ||
  831. $Groff{'refer'} || $Groff{'tbl'} ) {
  832. push(@Command, '-s') if $Groff{'soelim'};
  833. push(@Command, '-R') if $Groff{'refer'};
  834. push(@Command, '-t') if $Groff{'tbl'}; # tbl before eqn
  835. push(@Command, '-e') if $Groff{'eqn'};
  836. push(@Command, '-j') if $Groff{'chem'}; # chem produces pic code
  837. push(@Command, '-J') if $Groff{'gideal'}; # gideal produces pic
  838. push(@Command, '-G') if $Groff{'grap'};
  839. push(@Command, '-g') if $Groff{'grn'}; # gremlin files for -me
  840. push(@Command, '-p') if $Groff{'pic'};
  841. }
  842. } # make_groff_preproc()
  843. ########################################################################
  844. # make_groff_tmac_man_ms()
  845. ########################################################################
  846. sub make_groff_tmac_man_ms {
  847. # globals: @filespec, $tmac_ext, %Groff
  848. # 'man' requests, not from 'ms'
  849. if ( $Groff{'SS'} || $Groff{'SY'} || $Groff{'OP'} ||
  850. $Groff{'TH_first'} || $Groff{'TP'} || $Groff{'UR'} ) {
  851. $Groff{'man'} = 1;
  852. push(@m, '-man');
  853. $tmac_ext = 'man' unless ( $tmac_ext );
  854. &err('man requests found, but file name extension ' .
  855. 'was: ' . $tmac_ext) unless ( $tmac_ext eq 'man' );
  856. $tmac_ext = 'man';
  857. return 1; # true
  858. }
  859. ###### make_groff_tmac_man_ms()
  860. # 'ms' requests, not from 'man'
  861. if (
  862. $Groff{'1C'} || $Groff{'2C'} ||
  863. $Groff{'AB'} || $Groff{'AE'} || $Groff{'AI'} || $Groff{'AU'} ||
  864. $Groff{'BX'} || $Groff{'CD'} || $Groff{'DA'} || $Groff{'DE'} ||
  865. $Groff{'DS'} || $Groff{'ID'} || $Groff{'LD'} || $Groff{'NH'} ||
  866. $Groff{'TH_later'} ||
  867. $Groff{'TL'} || $Groff{'UL'} || $Groff{'XP'}
  868. ) {
  869. $Groff{'ms'} = 1;
  870. push(@m, '-ms');
  871. $tmac_ext = 'ms' unless ( $tmac_ext );
  872. &err('ms requests found, but file name extension ' .
  873. 'was: ' . $tmac_ext) unless ( $tmac_ext eq 'ms' );
  874. $tmac_ext = 'ms';
  875. return 1; # true
  876. }
  877. ###### make_groff_tmac_man_ms()
  878. # both 'man' and 'ms' requests
  879. if ( $Groff{'P'} || $Groff{'IP'} ||
  880. $Groff{'LP'} || $Groff{'PP'} || $Groff{'SH'} ) {
  881. if ( $tmac_ext eq 'man' ) {
  882. $Groff{'man'} = 1;
  883. push(@m, '-man');
  884. return 1; # true
  885. } elsif ( $tmac_ext eq 'ms' ) {
  886. $Groff{'ms'} = 1;
  887. push(@m, '-ms');
  888. return 1; # true
  889. }
  890. return 0;
  891. }
  892. } # make_groff_tmac_man_ms()
  893. ########################################################################
  894. # make_groff_tmac_others()
  895. ########################################################################
  896. sub make_groff_tmac_others {
  897. # globals: @filespec, $tmac_ext, %Groff
  898. # mdoc
  899. if ( ( $Groff{'Oo'} && $Groff{'Oc'} ) || $Groff{'Dd'} ) {
  900. $Groff{'Oc'} = 0;
  901. $Groff{'Oo'} = 0;
  902. push(@m, '-mdoc');
  903. return 1; # true
  904. }
  905. if ( $Groff{'mdoc_old'} || $Groff{'Oo'} ) {
  906. push(@m, '-mdoc_old');
  907. return 1; # true
  908. }
  909. # me
  910. if ( $Groff{'me'} ) {
  911. push(@m, '-me');
  912. return 1; # true
  913. }
  914. ##### make_groff_tmac_others()
  915. # mm and mmse
  916. if ( $Groff{'mm'} ) {
  917. push(@m, '-mm');
  918. return 1; # true
  919. }
  920. if ( $Groff{'mmse'} ) { # Swedish mm
  921. push(@m, '-mmse');
  922. return 1; # true
  923. }
  924. # mom
  925. if ( $Groff{'mom'} ) {
  926. push(@m, '-mom');
  927. return 1; # true
  928. }
  929. } # make_groff_tmac_others()
  930. ########################################################################
  931. # make_groff_line_rest()
  932. ########################################################################
  933. sub make_groff_line_rest {
  934. my $file_args_included; # file args now only at 1st preproc
  935. unshift @Command, 'groff';
  936. if ( @preprograms ) {
  937. my @progs;
  938. $progs[0] = shift @preprograms;
  939. push(@progs, @filespec);
  940. for ( @preprograms ) {
  941. push @progs, '|';
  942. push @progs, $_;
  943. }
  944. push @progs, '|';
  945. unshift @Command, @progs;
  946. $file_args_included = 1;
  947. } else {
  948. $file_args_included = 0;
  949. }
  950. ###### make_groff_line_rest()
  951. foreach (@Command) {
  952. next unless /\s/;
  953. # when one argument has several words, use accents
  954. $_ = "'" . $_ . "'";
  955. }
  956. ###### make_groff_line_rest()
  957. ##########
  958. # -m arguments
  959. my $nr_m_guessed = scalar @m;
  960. if ( $nr_m_guessed > 1 ) {
  961. print STDERR __FILE__ . ' ' . __LINE__ . ': ' .
  962. 'argument for -m found: ' . @m;
  963. }
  964. my $nr_m_args = scalar @Mparams; # m-arguments for grog
  965. my $last_m_arg = ''; # last provided -m option
  966. if ( $nr_m_args > 1 ) {
  967. # take the last given -m argument of grog call,
  968. # ignore other -m arguments and the found ones
  969. $last_m_arg = $Mparams[-1]; # take the last -m argument
  970. print STDERR __FILE__ . ' ' . __LINE__ . ': ' .
  971. $Prog . ": more than 1 '-m' argument: @Mparams";
  972. print STDERR __FILE__ . ' ' . __LINE__ . ': ' .
  973. 'We take the last one: ' . $last_m_arg;
  974. } elsif ( $nr_m_args == 1 ) {
  975. $last_m_arg = $Mparams[0];
  976. }
  977. ###### make_groff_line_rest()
  978. my $final_m = '';
  979. if ( $last_m_arg ) {
  980. my $is_equal = 0;
  981. for ( @m ) {
  982. if ( $_ eq $last_m_arg ) {
  983. $is_equal = 1;
  984. last;
  985. }
  986. next;
  987. } # end for @m
  988. if ( $is_equal ) {
  989. $final_m = $last_m_arg;
  990. } else {
  991. print STDERR __FILE__ . ' ' . __LINE__ . ': ' .
  992. 'Provided -m argument ' . $last_m_arg .
  993. ' differs from guessed -m args: ' . @m;
  994. print STDERR __FILE__ . ' ' . __LINE__ . ': ' .
  995. 'The argument is taken.';
  996. $final_m = $last_m_arg;
  997. }
  998. ###### make_groff_line_rest()
  999. } else { # no -m arg provided
  1000. if ( $nr_m_guessed > 1 ) {
  1001. print STDERR __FILE__ . ' ' . __LINE__ . ': ' .
  1002. 'More than 1 -m arguments were guessed: ' . @m;
  1003. print STDERR __FILE__ . ' ' . __LINE__ . ': ' . 'Guessing stopped.';
  1004. exit 1;
  1005. } elsif ( $nr_m_guessed == 1 ) {
  1006. $final_m = $m[0];
  1007. } else {
  1008. # no -m provided or guessed
  1009. }
  1010. }
  1011. push @Command, $final_m if ( $final_m );
  1012. push(@Command, @filespec) unless ( $file_args_included );
  1013. #########
  1014. # execute the 'groff' command here with option '--run'
  1015. if ( $do_run ) { # with --run
  1016. print STDERR __FILE__ . ' ' . __LINE__ . ': ' . "@Command";
  1017. my $cmd = join ' ', @Command;
  1018. system($cmd);
  1019. } else {
  1020. print "@Command";
  1021. }
  1022. exit 0;
  1023. } # make_groff_line_rest()
  1024. ########################################################################
  1025. # sub help
  1026. ########################################################################
  1027. sub help {
  1028. print <<EOF;
  1029. usage: grog [option]... [--] [filespec]...
  1030. "filespec" is either the name of an existing, readable file or "-" for
  1031. standard input. If no 'filespec' is specified, standard input is
  1032. assumed automatically. All arguments after a '--' are regarded as file
  1033. names, even if they start with a '-' character.
  1034. 'option' is either a 'groff' option or one of these:
  1035. -h|--help print this uasge message and exit
  1036. -v|--version print version information and exit
  1037. -C compatibility mode
  1038. --ligatures include options '-P-y -PU' for internal font, which
  1039. preserves the ligatures like 'fi'
  1040. --run run the checked-out groff command
  1041. --warnings display more warnings to standard error
  1042. All other options should be 'groff' 1-character options. These are then
  1043. appended to the generated 'groff' command line. The '-m' options will
  1044. be checked by 'grog'.
  1045. EOF
  1046. exit 0;
  1047. } # help()
  1048. ########################################################################
  1049. # sub version
  1050. ########################################################################
  1051. sub version {
  1052. our %at_at;
  1053. print "Perl version of GNU $Prog " .
  1054. "in groff version " . $at_at{'GROFF_VERSION'};
  1055. exit 0;
  1056. } # version()
  1057. 1;
  1058. ########################################################################
  1059. ### Emacs settings
  1060. # Local Variables:
  1061. # mode: CPerl
  1062. # End: