1267 lines
28 KiB
Perl
1267 lines
28 KiB
Perl
#! /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:
|