123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266 |
- #! /usr/bin/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/subs.pl
- # Installed position: <prefix>/lib/grog/subs.pl
- # Copyright (C) 1993-2018 Free Software Foundation, Inc.
- # This file was split from grog.pl and put under GPL2 by
- # Bernd Warken <groff-bernd.warken-72@web.de>.
- # The macros for identifying the devices were taken from Ralph
- # Corderoy's 'grog.sh' of 2006.
- # Last update: 10 Sep 2015
- # 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 as published by
- # the Free Software Foundation, either version 2 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 can get the license text for the GNU General Public License
- # version 2 in the internet at
- # <http://www.gnu.org/licenses/gpl-2.0.html>.
- ########################################################################
- require v5.6;
- use warnings;
- use strict;
- use File::Spec;
- # printing of hashes: my %hash = ...; print Dumper(\%hash);
- use Data::Dumper;
- # for running shell based programs within Perl; use `` instead of
- # use IPC::System::Simple qw(capture capturex run runx system systemx);
- $\ = "\n";
- # my $Sp = "[\\s\\n]";
- # my $Sp = qr([\s\n]);
- # my $Sp = '' if $arg eq '-C';
- my $Sp = '';
- # from 'src/roff/groff/groff.cpp' near 'getopt_long'
- my $groff_opts =
- 'abcCd:D:eEf:F:gGhiI:jJkK:lL:m:M:n:No:pP:r:RsStT:UvVw:W:XzZ';
- my @Command = (); # stores the final output
- my @Mparams = (); # stores the options '-m*'
- my @devices = (); # stores -T
- my $do_run = 0; # run generated 'groff' command
- my $pdf_with_ligatures = 0; # '-P-y -PU' for 'pdf' device
- my $with_warnings = 0;
- my $Prog = $0;
- {
- my ($v, $d, $f) = File::Spec->splitpath($Prog);
- $Prog = $f;
- }
- my %macros;
- my %Groff =
- (
- # preprocessors
- 'chem' => 0,
- 'eqn' => 0,
- 'gperl' => 0,
- 'grap' => 0,
- 'grn' => 0,
- 'gideal' => 0,
- 'gpinyin' => 0,
- 'lilypond' => 0,
- 'pic' => 0,
- 'PS' => 0, # opening for pic
- 'PF' => 0, # alternative opening for pic
- 'PE' => 0, # closing for pic
- 'refer' => 0,
- 'refer_open' => 0,
- 'refer_close' => 0,
- 'soelim' => 0,
- 'tbl' => 0,
- # tmacs
- # 'man' => 0,
- # 'mandoc' => 0,
- # 'mdoc' => 0,
- # 'mdoc_old' => 0,
- # 'me' => 0,
- # 'mm' => 0,
- # 'mom' => 0,
- # 'ms' => 0,
- # requests
- 'AB' => 0, # ms
- 'AE' => 0, # ms
- 'AI' => 0, # ms
- 'AU' => 0, # ms
- 'NH' => 0, # ms
- 'TH_later' => 0, # TH not 1st command is ms
- 'TL' => 0, # ms
- 'UL' => 0, # ms
- 'XP' => 0, # ms
- 'IP' => 0, # man and ms
- 'LP' => 0, # man and ms
- 'P' => 0, # man and ms
- 'PP' => 0, # man and ms
- 'SH' => 0, # man and ms
- 'OP' => 0, # man
- 'SS' => 0, # man
- 'SY' => 0, # man
- 'TH_first' => 0, # TH as 1st command is man
- 'TP' => 0, # man
- 'UR' => 0, # man
- 'YS' => 0, # man
- # for mdoc and mdoc-old
- # .Oo and .Oc for modern mdoc, only .Oo for mdoc-old
- 'Oo' => 0, # mdoc and mdoc-old
- 'Oc' => 0, # mdoc
- 'Dd' => 0, # mdoc
- ); # end of %Groff
- # for first line check
- my %preprocs_tmacs =
- (
- 'chem' => 0,
- 'eqn' => 0,
- 'gideal' => 0,
- 'gpinyin' => 0,
- 'grap' => 0,
- 'grn' => 0,
- 'pic' => 0,
- 'refer' => 0,
- 'soelim' => 0,
- 'tbl' => 0,
- 'geqn' => 0,
- 'gpic' => 0,
- 'neqn' => 0,
- 'man' => 0,
- 'mandoc' => 0,
- 'mdoc' => 0,
- 'mdoc-old' => 0,
- 'me' => 0,
- 'mm' => 0,
- 'mom' => 0,
- 'ms' => 0,
- );
- my @filespec;
- my $tmac_ext = '';
- ########################################################################
- # err()
- ########################################################################
- sub err {
- my $text = shift;
- print STDERR $text;
- }
- ########################################################################
- # handle_args()
- ########################################################################
- sub handle_args {
- my $double_minus = 0;
- my $was_minus = 0;
- my $was_T = 0;
- my $optarg = 0;
- # globals: @filespec, @Command, @devices, @Mparams
- foreach my $arg (@ARGV) {
- if ( $optarg ) {
- push @Command, $arg;
- $optarg = 0;
- next;
- }
- if ( $double_minus ) {
- if (-f $arg && -r $arg) {
- push @filespec, $arg;
- } else {
- print STDERR __FILE__ . ' ' . __LINE__ . ': ' .
- "grog: $arg is not a readable file.";
- }
- next;
- }
- if ( $was_T ) {
- push @devices, $arg;
- $was_T = 0;
- next;
- }
- ####### handle_args()
- unless ( $arg =~ /^-/ ) { # file name, no opt, no optarg
- unless (-f $arg && -r $arg) {
- print 'unknown file name: ' . $arg;
- }
- push @filespec, $arg;
- next;
- }
- # now $arg starts with '-'
- if ($arg eq '-') {
- unless ($was_minus) {
- push @filespec, $arg;
- $was_minus = 1;
- }
- next;
- }
- if ($arg eq '--') {
- $double_minus = 1;
- push(@filespec, $arg);
- next;
- }
- &version() if $arg =~ /^--?v/; # --version, with exit
- &help() if $arg =~ /--?h/; # --help, with exit
- if ( $arg =~ /^--r/ ) { # --run, no exit
- $do_run = 1;
- next;
- }
- if ( $arg =~ /^--wa/ ) { # --warnings, no exit
- $with_warnings = 1;
- next;
- }
- ####### handle_args()
- if ( $arg =~ /^--(wi|l)/ ) { # --ligatures, no exit
- # the old --with_ligatures is only kept for compatibility
- $pdf_with_ligatures = 1;
- next;
- }
- if ($arg =~ /^-m/) {
- push @Mparams, $arg;
- next;
- }
- if ($arg =~ /^-T$/) {
- $was_T = 1;
- next;
- }
- if ($arg =~ s/^-T(\w+)$/$1/) {
- push @devices, $1;
- next;
- }
- if ($arg =~ /^-(\w)(\w*)$/) { # maybe a groff option
- my $opt_char = $1;
- my $opt_char_with_arg = $opt_char . ':';
- my $others = $2;
- if ( $groff_opts =~ /$opt_char_with_arg/ ) { # groff optarg
- if ( $others ) { # optarg is here
- push @Command, '-' . $opt_char;
- push @Command, '-' . $others;
- next;
- }
- # next arg is optarg
- $optarg = 1;
- next;
- ####### handle_args()
- } elsif ( $groff_opts =~ /$opt_char/ ) { # groff no optarg
- push @Command, '-' . $opt_char;
- if ( $others ) { # $others is now an opt collection
- $arg = '-' . $others;
- redo;
- }
- # arg finished
- next;
- } else { # not a groff opt
- print STDERR __FILE__ . ' ' . __LINE__ . ': ' .
- 'unknown argument ' . $arg;
- push(@Command, $arg);
- next;
- }
- }
- }
- @filespec = ('-') unless (@filespec);
- } # handle_args()
- ########################################################################
- # handle_file_ext()
- ########################################################################
- sub handle_file_ext {
- # get tmac from file name extension
- # output number of found single tmac
- # globals: @filespec, $tmac_ext;
- foreach my $file ( @filespec ) {
- # test for each file name in the arguments
- unless ( open(FILE, $file eq "-" ? $file : "< $file") ) {
- print STDERR __FILE__ . ' ' . __LINE__ . ': ' .
- "$Prog: can't open \'$file\': $!";
- next;
- }
- next unless ( $file =~ /\./ ); # file name has no dot '.'
- ##### handle_file_ext()
- # get extension
- my $ext = $file;
- $ext =~ s/^
- .*
- \.
- ([^.]*)
- $
- /$1/x;
- next unless ( $ext );
- ##### handle_file_ext()
- # these extensions are correct, but not based on a tmac
- next if ( $ext =~ /^(
- chem|
- eqn|
- g|
- grap|
- grn|
- groff|
- hdtbl|
- pdfroff|
- pic|
- pinyin|
- ref|
- roff|
- t|
- tbl|
- tr|
- www
- )$/x );
- ##### handle_file_ext()
- # extensions for man tmac
- if ( $ext =~ /^(
- [1-9lno]|
- man|
- n|
- 1b
- )$/x ) {
- # 'man|n' from 'groff' source
- # '1b' from 'heirloom'
- # '[1-9lno]' from man-pages
- if ( $tmac_ext && $tmac_ext ne 'man' ) {
- # found tmac is not 'man'
- print STDERR __FILE__ . ' ' . __LINE__ . ': ' .
- '2 different file name extensions found ' .
- $tmac_ext . ' and ' . $ext;
- $tmac_ext = '';
- next;
- }
- ##### handle_file_ext()
- $tmac_ext = 'man';
- next;
- }
- if ( $ext =~ /^(
- mandoc|
- mdoc|
- me|
- mm|
- mmse|
- mom|
- ms|
- $)/x ) {
- if ( $tmac_ext && $tmac_ext ne $ext ) {
- # found tmac is not identical to former found tmac
- ##### handle_file_ext()
- print STDERR __FILE__ . ' ' . __LINE__ . ': ' .
- '2 different file name extensions found ' .
- $tmac_ext . ' and ' . $ext;
- $tmac_ext = '';
- next;
- }
- $tmac_ext = $ext;
- next;
- }
- print STDERR __FILE__ . ' ' . __LINE__ . ': ' .
- 'Unknown file name extension '. $file . '.';
- next;
- } # end foreach file
- 1;
- } # handle_file_ext()
- ########################################################################
- # handle_whole_files()
- ########################################################################
- sub handle_whole_files {
- # globals: @filespec
- foreach my $file ( @filespec ) {
- unless ( open(FILE, $file eq "-" ? $file : "< $file") ) {
- print STDERR __FILE__ . ' ' . __LINE__ . ': ' .
- "$Prog: can't open \'$file\': $!";
- next;
- }
- my $line = <FILE>; # get single line
- unless ( defined($line) ) {
- # empty file, go to next filearg
- close (FILE);
- next;
- }
- if ( $line ) {
- chomp $line;
- unless ( &do_first_line( $line, $file ) ) {
- # not an option line
- &do_line( $line, $file );
- }
- } else { # empty line
- next;
- }
- while (<FILE>) { # get lines by and by
- chomp;
- &do_line( $_, $file );
- }
- close(FILE);
- } # end foreach
- } # handle_whole_files()
- ########################################################################
- # do_first_line()
- ########################################################################
- # As documented for the 'man' program, the first line can be
- # used as a groff option line. This is done by:
- # - start the line with '\" (apostrophe, backslash, double quote)
- # - add a space character
- # - a word using the following characters can be appended: 'egGjJpRst'.
- # Each of these characters means an option for the generated
- # 'groff' command line, e.g. '-t'.
- sub do_first_line {
- my ( $line, $file ) = @_;
- # globals: %preprocs_tmacs
- # For a leading groff options line use only [egGjJpRst]
- if ( $line =~ /^[.']\\"[\segGjJpRst]+&/ ) {
- # this is a groff options leading line
- if ( $line =~ /^\./ ) {
- # line is a groff options line with . instead of '
- print "First line in $file must start with an apostrophe \ " .
- "instead of a period . for groff options line!";
- }
- if ( $line =~ /j/ ) {
- $Groff{'chem'}++;
- }
- if ( $line =~ /e/ ) {
- $Groff{'eqn'}++;
- }
- if ( $line =~ /g/ ) {
- $Groff{'grn'}++;
- }
- if ( $line =~ /G/ ) {
- $Groff{'grap'}++;
- }
- if ( $line =~ /i/ ) {
- $Groff{'gideal'}++;
- }
- if ( $line =~ /p/ ) {
- $Groff{'pic'}++;
- }
- if ( $line =~ /R/ ) {
- $Groff{'refer'}++;
- }
- if ( $line =~ /s/ ) {
- $Groff{'soelim'}++;
- }
- ####### do_first_line()
- if ( $line =~ /t/ ) {
- $Groff{'tbl'}++;
- }
- return 1; # a leading groff options line, 1 means yes, 0 means no
- }
- # not a leading short groff options line
- return 0 if ( $line !~ /^[.']\\"\s*(.*)$/ ); # ignore non-comments
- return 0 unless ( $1 ); # for empty comment
- # all following array members are either preprocs or 1 tmac
- my @words = split '\s+', $1;
- my @in = ();
- my $word;
- for $word ( @words ) {
- if ( $word eq 'ideal' ) {
- $word = 'gideal';
- } elsif ( $word eq 'gpic' ) {
- $word = 'pic';
- } elsif ( $word =~ /^(gn|)eqn$/ ) {
- $word = 'eqn';
- }
- if ( exists $preprocs_tmacs{$word} ) {
- push @in, $word;
- } else {
- # not word for preproc or tmac
- return 0;
- }
- }
- for $word ( @in ) {
- $Groff{$word}++;
- }
- } # do_first_line()
- ########################################################################
- # do_line()
- ########################################################################
- my $before_first_command = 1; # for check of .TH
- sub do_line {
- my ( $line, $file ) = @_;
- return if ( $line =~ /^[.']\s*\\"/ ); # comment
- return unless ( $line =~ /^[.']/ ); # ignore text lines
- $line =~ s/^['.]\s*/./; # let only a dot as leading character,
- # remove spaces after the leading dot
- $line =~ s/\s+$//; # remove final spaces
- return if ( $line =~ /^\.$/ ); # ignore .
- return if ( $line =~ /^\.\.$/ ); # ignore ..
- if ( $before_first_command ) { # so far without 1st command
- if ( $line =~ /^\.TH/ ) {
- # check if .TH is 1st command for man
- $Groff{'TH_first'} = 1 if ( $line =~ /^\.\s*TH/ );
- }
- if ( $line =~ /^\./ ) {
- $before_first_command = 0;
- }
- }
- # split command
- $line =~ /^(\.\w+)\s*(.*)$/;
- my $command = $1;
- $command = '' unless ( defined $command );
- my $args = $2;
- $args = '' unless ( defined $args );
- ######################################################################
- # soelim
- if ( $line =~ /^\.(do)?\s*(so|mso|PS\s*<|SO_START).*$/ ) {
- # '.so', '.mso', '.PS<...', '.SO_START'
- $Groff{'soelim'}++;
- return;
- }
- if ( $line =~ /^\.(do)?\s*(so|mso|PS\s*<|SO_START).*$/ ) {
- # '.do so', '.do mso', '.do PS<...', '.do SO_START'
- $Groff{'soelim'}++;
- return;
- }
- ####### do_line()
- ######################################################################
- # macros
- if ( $line =~ /^\.de1?\W?/ ) {
- # this line is a macro definition, add it to %macros
- my $macro = $line;
- $macro =~ s/^\.de1?\s+(\w+)\W*/.$1/;
- return if ( exists $macros{$macro} );
- $macros{$macro} = 1;
- return;
- }
- # if line command is a defined macro, just ignore this line
- return if ( exists $macros{$command} );
- ######################################################################
- # preprocessors
- if ( $command =~ /^(\.cstart)|(begin\s+chem)$/ ) {
- $Groff{'chem'}++; # for chem
- return;
- }
- if ( $command =~ /^\.EQ$/ ) {
- $Groff{'eqn'}++; # for eqn
- return;
- }
- if ( $command =~ /^\.G1$/ ) {
- $Groff{'grap'}++; # for grap
- return;
- }
- if ( $command =~ /^\.Perl/ ) {
- $Groff{'gperl'}++; # for gperl
- return;
- }
- if ( $command =~ /^\.pinyin/ ) {
- $Groff{'gpinyin'}++; # for gperl
- return;
- }
- if ( $command =~ /^\.GS$/ ) {
- $Groff{'grn'}++; # for grn
- return;
- }
- if ( $command =~ /^\.IS$/ ) {
- $Groff{'gideal'}++; # preproc gideal for ideal
- return;
- }
- if ( $command =~ /^\.lilypond$/ ) {
- $Groff{'lilypond'}++; # for glilypond
- return;
- }
- ####### do_line()
- # pic can be opened by .PS or .PF and closed by .PE
- if ( $command =~ /^\.PS$/ ) {
- $Groff{'pic'}++; # normal opening for pic
- return;
- }
- if ( $command =~ /^\.PF$/ ) {
- $Groff{'PF'}++; # alternate opening for pic
- return;
- }
- if ( $command =~ /^\.PE$/ ) {
- $Groff{'PE'}++; # closing for pic
- return;
- }
- if ( $command =~ /^\.R1$/ ) {
- $Groff{'refer'}++; # for refer
- return;
- }
- if ( $command =~ /^\.\[$/ ) {
- $Groff{'refer_open'}++; # for refer open
- return;
- }
- if ( $command =~ /^\.\]$/ ) {
- $Groff{'refer_close'}++; # for refer close
- return;
- }
- if ( $command =~ /^\.TS$/ ) {
- $Groff{'tbl'}++; # for tbl
- return;
- }
- if ( $command =~ /^\.TH$/ ) {
- unless ( $Groff{'TH_first'} ) {
- $Groff{'TH_later'}++; # for tbl
- }
- return;
- }
- ######################################################################
- # macro package (tmac)
- ######################################################################
- ##########
- # modern mdoc
- if ( $command =~ /^\.(Dd)$/ ) {
- $Groff{'Dd'}++; # for modern mdoc
- return;
- }
- ####### do_line()
- # In the old version of -mdoc 'Oo' is a toggle, in the new it's
- # closed by 'Oc'.
- if ( $command =~ /^\.Oc$/ ) {
- $Groff{'Oc'}++; # only for modern mdoc
- return;
- }
- ##########
- # old and modern mdoc
- if ( $command =~ /^\.Oo$/ ) {
- $Groff{'Oo'}++; # for mdoc and mdoc-old
- return;
- }
- ##########
- # old mdoc
- if ( $command =~ /^\.(Tp|Dp|De|Cx|Cl)$/ ) {
- $Groff{'mdoc_old'}++; # true for old mdoc
- return;
- }
- ##########
- # for ms
- ####### do_line()
- if ( $command =~ /^\.AB$/ ) {
- $Groff{'AB'}++; # for ms
- return;
- }
- if ( $command =~ /^\.AE$/ ) {
- $Groff{'AE'}++; # for ms
- return;
- }
- if ( $command =~ /^\.AI$/ ) {
- $Groff{'AI'}++; # for ms
- return;
- }
- if ( $command =~ /^\.AU$/ ) {
- $Groff{'AU'}++; # for ms
- return;
- }
- if ( $command =~ /^\.NH$/ ) {
- $Groff{'NH'}++; # for ms
- return;
- }
- if ( $command =~ /^\.TL$/ ) {
- $Groff{'TL'}++; # for ms
- return;
- }
- if ( $command =~ /^\.XP$/ ) {
- $Groff{'XP'}++; # for ms
- return;
- }
- ##########
- # for man and ms
- if ( $command =~ /^\.IP$/ ) {
- $Groff{'IP'}++; # for man and ms
- return;
- }
- if ( $command =~ /^\.LP$/ ) {
- $Groff{'LP'}++; # for man and ms
- return;
- }
- ####### do_line()
- if ( $command =~ /^\.P$/ ) {
- $Groff{'P'}++; # for man and ms
- return;
- }
- if ( $command =~ /^\.PP$/ ) {
- $Groff{'PP'}++; # for man and ms
- return;
- }
- if ( $command =~ /^\.SH$/ ) {
- $Groff{'SH'}++; # for man and ms
- return;
- }
- if ( $command =~ /^\.UL$/ ) {
- $Groff{'UL'}++; # for man and ms
- return;
- }
- ##########
- # for man only
- if ( $command =~ /^\.OP$/ ) { # for man
- $Groff{'OP'}++;
- return;
- }
- if ( $command =~ /^\.SS$/ ) { # for man
- $Groff{'SS'}++;
- return;
- }
- if ( $command =~ /^\.SY$/ ) { # for man
- $Groff{'SY'}++;
- return;
- }
- if ( $command =~ /^\.TP$/ ) { # for man
- $Groff{'TP'}++;
- return;
- }
- if ( $command =~ /^\.UR$/ ) {
- $Groff{'UR'}++; # for man
- return;
- }
- if ( $command =~ /^\.YS$/ ) { # for man
- $Groff{'YS'}++;
- return;
- }
- ####### do_line()
- ##########
- # me
- if ( $command =~ /^\.(
- [ilnp]p|
- sh
- )$/x ) {
- $Groff{'me'}++; # for me
- return;
- }
- #############
- # mm and mmse
- if ( $command =~ /^\.(
- H|
- MULB|
- LO|
- LT|
- NCOL|
- P\$|
- PH|
- SA
- )$/x ) {
- $Groff{'mm'}++; # for mm and mmse
- if ( $command =~ /^\.LO$/ ) {
- if ( $args =~ /^(DNAMN|MDAT|BIL|KOMP|DBET|BET|SIDOR)/ ) {
- $Groff{'mmse'}++; # for mmse
- }
- } elsif ( $command =~ /^\.LT$/ ) {
- if ( $args =~ /^(SVV|SVH)/ ) {
- $Groff{'mmse'}++; # for mmse
- }
- }
- return;
- }
- ####### do_line()
- ##########
- # mom
- if ( $line =~ /^\.(
- ALD|
- DOCTYPE|
- FAMILY|
- FT|
- FAM|
- LL|
- LS|
- NEWPAGE|
- PAGE|
- PAPER|
- PRINTSTYLE|
- PT_SIZE|
- T_MARGIN
- )$/x ) {
- $Groff{'mom'}++; # for mom
- return;
- }
- } # do_line()
- ########################################################################
- # sub make_groff_device
- ########################################################################
- my @m = ();
- my @preprograms = ();
- my $correct_tmac = '';
- sub make_groff_device {
- # globals: @devices
- # default device is 'ps' when without '-T'
- my $device;
- push @devices, 'ps' unless ( @devices );
- ###### make_groff_device()
- for my $d ( @devices ) {
- if ( $d =~ /^( # suitable devices
- dvi|
- html|
- xhtml|
- lbp|
- lj4|
- ps|
- pdf|
- ascii|
- cp1047|
- latin1|
- utf8
- )$/x ) {
- ###### make_groff_device()
- $device = $d;
- } else {
- next;
- }
- if ( $device ) {
- push @Command, '-T';
- push @Command, $device;
- }
- }
- ###### make_groff_device()
- if ( $device eq 'pdf' ) {
- if ( $pdf_with_ligatures ) { # with --ligature argument
- push( @Command, '-P-y' );
- push( @Command, '-PU' );
- } else { # no --ligature argument
- if ( $with_warnings ) {
- print STDERR <<EOF;
- If you have trouble with ligatures like 'fi' in the 'groff' output, you
- can proceed as one of
- - add 'grog' option '--with_ligatures' or
- - use the 'grog' option combination '-P-y -PU' or
- - try to remove the font named similar to 'fonts-texgyre' from your system.
- EOF
- } # end of warning
- } # end of ligature
- } # end of pdf device
- } # make_groff_device()
- ########################################################################
- # make_groff_preproc()
- ########################################################################
- sub make_groff_preproc {
- # globals: %Groff, @preprograms, @Command
- # preprocessors without 'groff' option
- if ( $Groff{'lilypond'} ) {
- push @preprograms, 'glilypond';
- }
- if ( $Groff{'gperl'} ) {
- push @preprograms, 'gperl';
- }
- if ( $Groff{'gpinyin'} ) {
- push @preprograms, 'gpinyin';
- }
- # preprocessors with 'groff' option
- if ( ( $Groff{'PS'} || $Groff{'PF'} ) && $Groff{'PE'} ) {
- $Groff{'pic'} = 1;
- }
- if ( $Groff{'gideal'} ) {
- $Groff{'pic'} = 1;
- }
- ###### make_groff_preproc()
- $Groff{'refer'} ||= $Groff{'refer_open'} && $Groff{'refer_close'};
- if ( $Groff{'chem'} || $Groff{'eqn'} || $Groff{'gideal'} ||
- $Groff{'grap'} || $Groff{'grn'} || $Groff{'pic'} ||
- $Groff{'refer'} || $Groff{'tbl'} ) {
- push(@Command, '-s') if $Groff{'soelim'};
- push(@Command, '-R') if $Groff{'refer'};
- push(@Command, '-t') if $Groff{'tbl'}; # tbl before eqn
- push(@Command, '-e') if $Groff{'eqn'};
- push(@Command, '-j') if $Groff{'chem'}; # chem produces pic code
- push(@Command, '-J') if $Groff{'gideal'}; # gideal produces pic
- push(@Command, '-G') if $Groff{'grap'};
- push(@Command, '-g') if $Groff{'grn'}; # gremlin files for -me
- push(@Command, '-p') if $Groff{'pic'};
- }
- } # make_groff_preproc()
- ########################################################################
- # make_groff_tmac_man_ms()
- ########################################################################
- sub make_groff_tmac_man_ms {
- # globals: @filespec, $tmac_ext, %Groff
- # 'man' requests, not from 'ms'
- if ( $Groff{'SS'} || $Groff{'SY'} || $Groff{'OP'} ||
- $Groff{'TH_first'} || $Groff{'TP'} || $Groff{'UR'} ) {
- $Groff{'man'} = 1;
- push(@m, '-man');
- $tmac_ext = 'man' unless ( $tmac_ext );
- &err('man requests found, but file name extension ' .
- 'was: ' . $tmac_ext) unless ( $tmac_ext eq 'man' );
- $tmac_ext = 'man';
- return 1; # true
- }
- ###### make_groff_tmac_man_ms()
- # 'ms' requests, not from 'man'
- if (
- $Groff{'1C'} || $Groff{'2C'} ||
- $Groff{'AB'} || $Groff{'AE'} || $Groff{'AI'} || $Groff{'AU'} ||
- $Groff{'BX'} || $Groff{'CD'} || $Groff{'DA'} || $Groff{'DE'} ||
- $Groff{'DS'} || $Groff{'ID'} || $Groff{'LD'} || $Groff{'NH'} ||
- $Groff{'TH_later'} ||
- $Groff{'TL'} || $Groff{'UL'} || $Groff{'XP'}
- ) {
- $Groff{'ms'} = 1;
- push(@m, '-ms');
- $tmac_ext = 'ms' unless ( $tmac_ext );
- &err('ms requests found, but file name extension ' .
- 'was: ' . $tmac_ext) unless ( $tmac_ext eq 'ms' );
- $tmac_ext = 'ms';
- return 1; # true
- }
- ###### make_groff_tmac_man_ms()
- # both 'man' and 'ms' requests
- if ( $Groff{'P'} || $Groff{'IP'} ||
- $Groff{'LP'} || $Groff{'PP'} || $Groff{'SH'} ) {
- if ( $tmac_ext eq 'man' ) {
- $Groff{'man'} = 1;
- push(@m, '-man');
- return 1; # true
- } elsif ( $tmac_ext eq 'ms' ) {
- $Groff{'ms'} = 1;
- push(@m, '-ms');
- return 1; # true
- }
- return 0;
- }
- } # make_groff_tmac_man_ms()
- ########################################################################
- # make_groff_tmac_others()
- ########################################################################
- sub make_groff_tmac_others {
- # globals: @filespec, $tmac_ext, %Groff
- # mdoc
- if ( ( $Groff{'Oo'} && $Groff{'Oc'} ) || $Groff{'Dd'} ) {
- $Groff{'Oc'} = 0;
- $Groff{'Oo'} = 0;
- push(@m, '-mdoc');
- return 1; # true
- }
- if ( $Groff{'mdoc_old'} || $Groff{'Oo'} ) {
- push(@m, '-mdoc_old');
- return 1; # true
- }
- # me
- if ( $Groff{'me'} ) {
- push(@m, '-me');
- return 1; # true
- }
- ##### make_groff_tmac_others()
- # mm and mmse
- if ( $Groff{'mm'} ) {
- push(@m, '-mm');
- return 1; # true
- }
- if ( $Groff{'mmse'} ) { # Swedish mm
- push(@m, '-mmse');
- return 1; # true
- }
- # mom
- if ( $Groff{'mom'} ) {
- push(@m, '-mom');
- return 1; # true
- }
- } # make_groff_tmac_others()
- ########################################################################
- # make_groff_line_rest()
- ########################################################################
- sub make_groff_line_rest {
- my $file_args_included; # file args now only at 1st preproc
- unshift @Command, 'groff';
- if ( @preprograms ) {
- my @progs;
- $progs[0] = shift @preprograms;
- push(@progs, @filespec);
- for ( @preprograms ) {
- push @progs, '|';
- push @progs, $_;
- }
- push @progs, '|';
- unshift @Command, @progs;
- $file_args_included = 1;
- } else {
- $file_args_included = 0;
- }
- ###### make_groff_line_rest()
- foreach (@Command) {
- next unless /\s/;
- # when one argument has several words, use accents
- $_ = "'" . $_ . "'";
- }
- ###### make_groff_line_rest()
- ##########
- # -m arguments
- my $nr_m_guessed = scalar @m;
- if ( $nr_m_guessed > 1 ) {
- print STDERR __FILE__ . ' ' . __LINE__ . ': ' .
- 'argument for -m found: ' . @m;
- }
- my $nr_m_args = scalar @Mparams; # m-arguments for grog
- my $last_m_arg = ''; # last provided -m option
- if ( $nr_m_args > 1 ) {
- # take the last given -m argument of grog call,
- # ignore other -m arguments and the found ones
- $last_m_arg = $Mparams[-1]; # take the last -m argument
- print STDERR __FILE__ . ' ' . __LINE__ . ': ' .
- $Prog . ": more than 1 '-m' argument: @Mparams";
- print STDERR __FILE__ . ' ' . __LINE__ . ': ' .
- 'We take the last one: ' . $last_m_arg;
- } elsif ( $nr_m_args == 1 ) {
- $last_m_arg = $Mparams[0];
- }
- ###### make_groff_line_rest()
- my $final_m = '';
- if ( $last_m_arg ) {
- my $is_equal = 0;
- for ( @m ) {
- if ( $_ eq $last_m_arg ) {
- $is_equal = 1;
- last;
- }
- next;
- } # end for @m
- if ( $is_equal ) {
- $final_m = $last_m_arg;
- } else {
- print STDERR __FILE__ . ' ' . __LINE__ . ': ' .
- 'Provided -m argument ' . $last_m_arg .
- ' differs from guessed -m args: ' . @m;
- print STDERR __FILE__ . ' ' . __LINE__ . ': ' .
- 'The argument is taken.';
- $final_m = $last_m_arg;
- }
- ###### make_groff_line_rest()
- } else { # no -m arg provided
- if ( $nr_m_guessed > 1 ) {
- print STDERR __FILE__ . ' ' . __LINE__ . ': ' .
- 'More than 1 -m arguments were guessed: ' . @m;
- print STDERR __FILE__ . ' ' . __LINE__ . ': ' . 'Guessing stopped.';
- exit 1;
- } elsif ( $nr_m_guessed == 1 ) {
- $final_m = $m[0];
- } else {
- # no -m provided or guessed
- }
- }
- push @Command, $final_m if ( $final_m );
- push(@Command, @filespec) unless ( $file_args_included );
- #########
- # execute the 'groff' command here with option '--run'
- if ( $do_run ) { # with --run
- print STDERR __FILE__ . ' ' . __LINE__ . ': ' . "@Command";
- my $cmd = join ' ', @Command;
- system($cmd);
- } else {
- print "@Command";
- }
- exit 0;
- } # make_groff_line_rest()
- ########################################################################
- # sub help
- ########################################################################
- 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. All arguments after a '--' are regarded as file
- names, even if they start with a '-' character.
- 'option' is either a 'groff' option or one of these:
- -h|--help print this uasge message and exit
- -v|--version print version information and exit
- -C compatibility mode
- --ligatures include options '-P-y -PU' for internal font, which
- preserves the ligatures like 'fi'
- --run run the checked-out groff command
- --warnings display more warnings to standard error
- All other options should be 'groff' 1-character options. These are then
- appended to the generated 'groff' command line. The '-m' options will
- be checked by 'grog'.
- EOF
- exit 0;
- } # help()
- ########################################################################
- # sub version
- ########################################################################
- sub version {
- our %at_at;
- print "Perl version of GNU $Prog " .
- "in groff version " . $at_at{'GROFF_VERSION'};
- exit 0;
- } # version()
- 1;
- ########################################################################
- ### Emacs settings
- # Local Variables:
- # mode: CPerl
- # End:
|