[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[groff] 01/01: grog: rewrite program with many new sub functions, which
|
From: |
Bernd Warken |
|
Subject: |
[groff] 01/01: grog: rewrite program with many new sub functions, which are moved into the new file subs.pl |
|
Date: |
Tue, 10 Jun 2014 22:07:54 +0000 |
bwarken pushed a commit to branch master
in repository groff.
commit 04547372acb53ff5778c172a399fd0d1a1d4124d
Author: Bernd Warken <address@hidden>
Date: Wed Jun 11 00:07:38 2014 +0200
grog: rewrite program with many new sub functions, which are moved into the
new file subs.pl
---
ChangeLog | 13 +
src/roff/grog/Makefile.sub | 8 +-
src/roff/grog/grog.man | 77 ++++--
src/roff/grog/grog.pl | 401 +++++-----------------------
src/roff/grog/perl_test.pl | 6 +-
src/roff/grog/subs.pl | 626 ++++++++++++++++++++++++++++++++++++++++++++
6 files changed, 775 insertions(+), 356 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index eb2eb9f..9f6a57c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,18 @@
2014-06-02 Bernd Warken <address@hidden>
+ * src/roff/grog/grog.pl: Totally rewrite the `grog' version,
+ starting at the last stable version. Write many parts as `sub'
+ functions.
+
+ * src/roff/grog/subs.pl: New file by splitting the src file
+ `grog.pl', such that all functions get into the new file
+ `subs.pl'.
+
+ * src/roff/grog/Makefile.sub: Add file `subs.pl', which goes into
+ the `grog' libdir.
+
+2014-06-02 Bernd Warken <address@hidden>
+
* src/roff/grog/grog.pl: The `grog' version of yesterday has many
bugs. So reinstall an old version of `grog'.
diff --git a/src/roff/grog/Makefile.sub b/src/roff/grog/Makefile.sub
index fcc0020..d5957bd 100644
--- a/src/roff/grog/Makefile.sub
+++ b/src/roff/grog/Makefile.sub
@@ -5,7 +5,7 @@
# Copyright (C) 1993, 2006, 2009, 2013-2014
# Free Software Foundation, Inc.
-# Last update: 30 Mar 2014
+# Last update: 04 Jun 2014
# This file is part of `grog' which is part of `groff'.
@@ -30,8 +30,7 @@ MOSTLYCLEANADD=grog $(MAN1)
all: grog $(MAN1)
# lib .pl-files
-#GROG=$(srcdir)/subs.pl
-GROG=
+GROG=$(srcdir)/subs.pl
GROG_=`echo $(GROG) | sed 's|$(srcdir)/||g'`
@@ -40,9 +39,10 @@ GROG_=`echo $(GROG) | sed 's|$(srcdir)/||g'`
grog: grog.pl $(GROG) $(SH_DEPS_SED_SCRIPT)
rm -f $@
sed -f "$(SH_DEPS_SED_SCRIPT)" \
+ -e "1s|^\(#! \).*perl|\\1$(PERL)|" \
-e "s|@g@|$(g)|g" \
-e "s|@BINDIR@|$(DESTDIR)$(bindir)|g" \
- -e "s|@libdir@|$(DESTDIR)$(libdir)|g" \
+ -e "s|@grog_dir@|$(DESTDIR)$(grog_dir)|g" \
-e "s|@EGREP@|$(EGREP)|g" \
-e "s|@VERSION@|$(version)$(revision)|" \
-e "$(SH_SCRIPT_SED_CMD)" \
diff --git a/src/roff/grog/grog.man b/src/roff/grog/grog.man
index 539ad69..234bbe2 100644
--- a/src/roff/grog/grog.man
+++ b/src/roff/grog/grog.man
@@ -76,7 +76,7 @@ GPL2
.\" --------------------------------------------------------------------
.SH NAME
.
-grog \- guess options for groff command
+grog \- guess options for a groff command
.
.
.\" --------------------------------------------------------------------
@@ -84,6 +84,8 @@ grog \- guess options for groff command
.
.SY grog
.OP \-C
+.OP \-\-run
+.OP \-\-with_ligatures
.RI [ \%groff\-option\~ .\|.\|.\&]
.OP \-\-
.RI [ \%filespec\~ .\|.\|.]
@@ -106,41 +108,75 @@ grog \- guess options for groff command
.B grog
reads the input (file names or standard input) and guesses which of
the
-.BR groff (@MAN1EXT@)
+.BR groff (@MAN1EXT@)
options are needed to perform the input with the
.B groff
program.
.
+.
+.RS
+.P
The corresponding
.B groff
-command is output.
+command is usually displayed in standard output.
+.
+With the option
+.BR \-\-run ,
+the generated line is output into standard error and the generated
+.B groff
+command is run on the
+.IR "standard output" .
+.RE
.
.
.\" --------------------------------------------------------------------
.SH OPTIONS
.
-The only
-.B grog
-options recognized are
-.B \-C
-(which is also passed on) to enable compatibility mode;
+The option
.B \-v
-and
+or
.B \-\-version
-print information on the version number; and
+prints information on the version number.
+.
+Also
.B \-h
-and
+or
.B \-\-help
-print usage information.
+prints usage information.
.
-.BR \-v ,
-.BR \-\-version ,
-.BR \-h ,
-and
-.B \-\-help
-stop the program directly without printing a
+Both of these options automatically end the
+.B grog
+program.
+.
+Other options are thenignored, and no
.B groff
-command to standard output.
+command line is generated.
+.
+.
+The following 3 options are the only
+.B grog
+options,
+.
+.TP
+.B \-C
+this option means enabling the
+.I groff
+compatibility mode, which is also transfered to the generated
+.B groff
+command line.
+.
+.TP
+.B \-\-run
+with this option, the command line is output at standard error and
+then run on the computer.
+.
+.TP
+.B \-\-with_ligatures
+this option forces to include the arguments
+.B -P-y -PU
+within the generated
+.B groff
+command line.
.
.
.P
@@ -318,8 +354,9 @@ grog.sh
is used instead.
.
.
-.\" --------------------------------------------------------------------
+.\" ####################################################################
.SH EXAMPLES
+.\" ####################################################################
.
.IP \(bu
Calling
diff --git a/src/roff/grog/grog.pl b/src/roff/grog/grog.pl
index 1aca1f2..514f39d 100644
--- a/src/roff/grog/grog.pl
+++ b/src/roff/grog/grog.pl
@@ -6,15 +6,16 @@
# Source file position: <groff-source>/src/roff/grog/grog.pl
# Installed position: <prefix>/bin/grog
-# Copyright (C) 1993, 2006, 2009, 2011-2012 Free Software Foundation, Inc.
+# Copyright (C) 1993, 2006, 2009, 2011-2012, 2014
+# Free Software Foundation, Inc.
# Written by James Clark, maintained by Werner Lemberg.
# Rewritten and put under GPL by Bernd Warken <address@hidden>.
# 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 (GPL) as published
-# by the Free Software Foundation, either version 3 of the License, or
+# 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
@@ -23,366 +24,108 @@
# General Public License for more details.
# You should have received a copy of the GNU General Public License
-# along with this program. If not, see <http://www.gnu.org/licenses/>.
+# along with this program. If not, see
+# <http://www.gnu.org/licenses/gpl-2.0.html>.
########################################################################
-my $Last_Update = '24 May 2012';
+our $Last_Update = '10 Jun 2014';
########################################################################
require v5.6;
use warnings;
use strict;
-use File::Spec;
-my $Prog = $0;
-{
- my ($v, $d, $f) = File::Spec->splitpath($Prog);
- $Prog = $f;
-}
-
-#my $Sp = "[\\s\\n]";
-my $Sp = qr([\s\n]);
-
-my @Command; # stores the final output
-my @Mparams; # stores the options -m*
-my %Groff;
+# $Bin is the directory where this script is located
+use FindBin;
+my $before_make; # script before run of `make'
{
- my @filespec = ();
- my $double_minus = 0;
- my $was_minus = 0;
- my $had_filespec = 0;
-
- foreach my $arg (@ARGV) {
- next unless $arg;
- if ($double_minus) {
- $had_filespec = 1;
- if (-f $arg && -r $arg) {
- push @filespec, $arg;
- } else {
- print STDERR "grog: $arg is not a readable file.\n";
- }
- next;
- }
-
- if ($arg eq '--') {
- $double_minus = 1;
- push(@Command, $arg);
- next;
- }
- if ($arg eq '-') {
- unless ($was_minus) {
- push @filespec, $arg;
- $was_minus = 1;
- }
- next;
- }
-
- &version(0) if $arg eq '-v' || '--version' =~ /^$arg/;
- &help() if $arg eq '-h' || '--help' =~ /^$arg/;
- print STDERR "grog: wrong option $arg.\n" if $arg =~ /^--/;
-
- if ($arg =~ /^-m/) {
- push @Mparams, $arg;
- next;
- }
- $Sp = '' if $arg eq '-C';
-
- if ($arg =~ /^-/) {
- push(@Command, $arg);
- next;
- } else {
- $had_filespec = 1;
- if (-f $arg && -r $arg) {
- push @filespec, $arg;
- } else {
- print STDERR "grog: $arg is not a readable file.\n";
- }
- next;
- }
- }
- @filespec = ('-') if ! @filespec && ! $had_filespec;
- exit 1 unless @filespec;
- @ARGV = @filespec;
+ my $at = '@';
+ $before_make = 1 if '@VERSION@' eq "${at}VERSION${at}";
}
-foreach my $arg (@ARGV) {
- &process($arg, 0);
-}
-
-sub process {
- my ($filename, $level) = @_;
- local(*FILE);
-
- if (!open(FILE, $filename eq "-" ? $filename : "< $filename")) {
- print STDERR "$Prog: can't open \`$filename': $!\n";
- exit 1 unless $level;
- return;
- }
- while (<FILE>) {
- chomp;
- s/^[.']\s*/./;
- s/^\s+|\s+$//g;
- s/$/\n/;
- if (/^(.cstart)|(begin\s+chem)$/) {
- $Groff{'chem'}++;
- $Groff{'soelim'}++ if $level;
- } elsif (/^\.TS$Sp/) {
- $_ = <FILE>;
- if (!/^\./ || /^\.so/) {
- $Groff{'tbl'}++;
- $Groff{'soelim'}++ if $level;
- }
- } elsif (/^\.EQ$Sp/) {
- $_ = <FILE>;
- if (!/^\./ || /^\.[0-9]/ || /^\.so/) {
- $Groff{'eqn'}++;
- $Groff{'soelim'}++ if $level;
- }
- } elsif (/^\.GS$Sp/) {
- $_ = <FILE>;
- if (!/^\./ || /^\.so/) {
- $Groff{'grn'}++;
- $Groff{'soelim'}++ if $level;
- }
- } elsif (/^\.G1$Sp/) {
- $_ = <FILE>;
- if (!/^\./ || /^\.so/) {
- $Groff{'grap'}++;
- $Groff{'soelim'}++ if $level;
- }
-# } elsif (/^\.PS\Sp([ 0-9.<].*)?$/) {
-# if (/^\.PS\s*<\s*(\S+)/) {
-# $Groff{'pic'}++;
-# $Groff{'soelim'}++ if $level;
-# &process($1, $level);
-# } else {
-# $_ = <FILE>;
-# if (!/^\./ || /^\.ps/ || /^\.so/) {
-# $Groff{'pic'}++;
-# $Groff{'soelim'}++ if $level;
-# }
-# }
- } elsif (/^\.PS[\s\n<]/) {
- $Groff{'pic'}++;
- $Groff{'soelim'}++ if $level;
- if (/^\.PS\s*<\s*(\S+)/) {
- &process($1, $level);
- }
- } elsif (/^\.R1$Sp/) {
- $Groff{'refer'}++;
- $Groff{'soelim'}++ if $level;
- } elsif (/^\.\[/) {
- $Groff{'refer_open'}++;
- $Groff{'soelim'}++ if $level;
- } elsif (/^\.\]/) {
- $Groff{'refer_close'}++;
- $Groff{'soelim'}++ if $level;
- } elsif (/^\.NH$Sp/) {
- $Groff{'NH'}++; # for ms
- } elsif (/^\.TL$Sp/) {
- $Groff{'TL'}++; # for mm and ms
- } elsif (/^\.PP$Sp/) {
- $Groff{'PP'}++; # for mom and ms
- } elsif (/^\.[IL]P$Sp/) {
- $Groff{'ILP'}++; # for man and ms
- } elsif (/^\.P$/) {
- $Groff{'P'}++;
- } elsif (/^\.(PH|SA)$Sp/) {
- $Groff{'mm'}++;
- } elsif (/^\.TH$Sp/) {
- $Groff{'TH'}++;
- } elsif (/^\.SH$Sp/) {
- $Groff{'SH'}++;
- } elsif (/^\.([pnil]p|sh)$Sp/) {
- $Groff{'me'}++;
- } elsif (/^\.Dd$Sp/) {
- $Groff{'mdoc'}++;
- } elsif (/^\.(Tp|Dp|De|Cx|Cl)$Sp/) {
- $Groff{'mdoc_old'} = 1;
- }
- # In the old version of -mdoc `Oo' is a toggle, in the new it's
- # closed by `Oc'.
- elsif (/^\.Oo$Sp/) {
- $Groff{'Oo'}++;
- s/^\.Oo/\. /;
- redo;
- }
- # The test for `Oo' and `Oc' not starting a line (as allowed by the
- # new implementation of -mdoc) is not complete; it assumes that
- # macro arguments are well behaved, i.e., "" is used within "..." to
- # indicate a doublequote as a string element, and weird features
- # like `.foo a"b' are not used.
- elsif (/^\..* Oo( |$)/) {
- s/\\\".*//;
- s/\"[^\"]*\"//g;
- s/\".*//;
- if (s/ Oo( |$)/ /) {
- $Groff{'Oo'}++;
- }
- redo;
- } elsif (/^\.Oc$Sp/) {
- $Groff{'Oo'}--;
- s/^\.Oc/\. /;
- redo;
- } elsif (/^\..* Oc( |$)/) {
- s/\\\".*//;
- s/\"[^\"]*\"//g;
- s/\".*//;
- if (s/ Oc( |$)/ /) {
- $Groff{'Oo'}--;
- }
- redo;
- } elsif (/^\.(PRINTSTYLE|START)$Sp/) {
- $Groff{'mom'}++;
- }
- if (/^\.so$Sp/) {
- chop;
- s/^.so *//;
- s/\\\".*//;
- s/ .*$//;
- # The next if-clause catches e.g.
- #
- # .EQ
- # .so foo
- # .EN
- #
- # However, the code is not fully correct since it is too generous.
- # Theoretically, we should check for .so only within preprocessor
- # blocks like .EQ/.EN or .TS/.TE; but it doesn't harm if we call
- # soelim even if we don't need to.
- if ( $Groff{'pic'} || $Groff{'tbl'} || $Groff{'eqn'} ||
- $Groff{'grn'} || $Groff{'grap'} || $Groff{'refer'} ||
- $Groff{'refer_open'} || $Groff{'refer_close'} ||
- $Groff{'chem'} ) {
- $Groff{'soelim'}++;
- }
- &process($_, $level + 1) unless /\\/ || $_ eq "";
- }
- }
- close(FILE);
+our %at_at;
+my $file_perl_test_pl;
+my $grog_dir;
+
+if ($before_make) { # before installation
+ my $grog_source_dir = $FindBin::Bin;
+ $at_at{'BINDIR'} = $grog_source_dir;
+ $grog_dir = $grog_source_dir;
+ $file_perl_test_pl = File::Spec->catfile($grog_source_dir,
+ 'perl_test.pl');
+ my $top = $grog_source_dir . '/../../../';
+ open FILE, '<', $top . 'VERSION' ||
+ die 'Could not open top file VERSION.';
+ my $version = <FILE>;
+ chomp $version;
+ close FILE;
+ open FILE, '<', $top . 'REVISION' ||
+ die 'Could not open top file REVISION.';
+ my $revision = <FILE>;
+ chomp $revision;
+ $at_at{'GROFF_VERSION'} = $version . '.' . $revision;
+} else { # after installation}
+ $at_at{'GROFF_VERSION'} = '@VERSION@';
+ $at_at{'BINDIR'} = '@BINDIR@';
+ $grog_dir = '@grog_dir@';
+ $file_perl_test_pl = File::Spec->catfile($grog_dir,
+ 'perl_test.pl');
}
-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.
+die "$grog_dir is not an existing directory;" unless -d $grog_dir;
-"option" is either a "groff" option or one of these:
+unshift(@INC, $grog_dir);
--C compatibility mode
--h --help print this uasge message
--v --version print version information
+require 'subs.pl';
-"groff" options are appended to the output, "-m" options are checked.
-
-EOF
- exit 0;
+our $Prog = $0;
+{
+ my ($v, $d, $f) = File::Spec->splitpath($Prog);
+ $Prog = $f;
}
-sub version {
- my ($exit_status) = @_;
- print "Perl version of GNU $Prog of $Last_Update " .
- 'in groff version @VERSION@' . "\n";
- exit $exit_status;
-}
-{
- my @m = ();
- my $is_man = 0;
- my $is_mm = 0;
- my $is_mom = 0;
+&minus_args();
- $Groff{'refer'} ||= $Groff{'refer_open'} && $Groff{'refer_close'};
- if ( $Groff{'pic'} || $Groff{'tbl'} || $Groff{'eqn'} ||
- $Groff{'grn'} || $Groff{'grap'} || $Groff{'refer'} ||
- $Groff{'chem'} ) {
- my $s = "-";
- $s .= "s" if $Groff{'soelim'};
- $s .= "R" if $Groff{'refer'};
- $s .= "G" if $Groff{'grap'};
- $s .= "j" if $Groff{'chem'};
- $s .= "p" if $Groff{'pic'};
- $s .= "g" if $Groff{'grn'};
- $s .= "t" if $Groff{'tbl'};
- $s .= "e" if $Groff{'eqn'};
- push(@Command, $s);
- }
- if ( $Groff{'me'} ) {
- push(@m, '-me');
- push(@Command, '-me');
- }
- if ( $Groff{'SH'} && $Groff{'TH'} ) {
- push(@m, '-man');
- push(@Command, '-man');
- $is_man = 1;
+foreach my $file ( @ARGV ) { # test for each file name in the arguments
+ unless ( open(FILE, $file eq "-" ? $file : "< $file") ) {
+ print STDERR "$Prog: can't open \`$file\': $!";
+ next;
}
- if ( $Groff{'mom'} ) {
- push(@m, '-mom');
- push(@Command, '-mom');
- $is_mom = 1;
- }
- if ( $Groff{'mm'} || ($Groff{'P'} && ! $is_man) ) {
- push(@m, '-mm');
- push(@Command, '-mm');
- $is_mm = 1;
- }
- if ( $Groff{'NH'} || ($Groff{'TL'} && ! $is_mm) ||
- ($Groff{'ILP'} && ! $is_man) ||
- ($Groff{'PP'} && ! $is_mom && ! $is_man) ) {
- # .PP occurs in -mom, -man and -ms, .IP and .LP occur in -man and -ms
- push(@m, '-ms');
- push(@Command, '-ms');
- }
- if ( $Groff{'mdoc'} ) {
- my $s = ( $Groff{'mdoc_old'} || $Groff{'Oo'} ) ? '-mdoc-old' : '-mdoc';
- push(@m, $s);
- push(@Command, $s);
- }
-
- unshift @Command, 'groff';
- push(@Command, @ARGV);
-
- foreach (@Command) {
- next unless /\s/;
- $_ = "'" . $_ . "'";
- }
-
- # We could implement an option to execute the command here.
-# foreach (@Command) {
-# next unless /[\$\\\"\';&()|<> \t\n]/;
-# s/\'/\'\\\'\'/;
-# $_ = "'" . $_ . "'";
-# }
+ my $line = <FILE>;
- my $n = scalar @m;
- my $np = scalar @Mparams;
- print STDERR "$Prog: more than 1 `-m' argument: @Mparams" if $np > 1;
- if ($n == 0) {
- unshift @Command, $Mparams[0] if $np == 1;
- } elsif ($n == 1) {
- if ($np == 1) {
- print STDERR "$Prog: wrong `-m' argument: $Mparams[0]\n"
- if $m[0] ne $Mparams[0];
+ if ( defined $line ) {
+ if ( $line ) {
+ chomp $line;
+ unless ( &do_first_line( $line, $file ) ) { # not an option line
+ &do_line( $line, $file );
+ }
+ } else {
+ # empty first line
}
- } else {
- print STDERR "$Prog: error: there are several macro packages: @m\n";
+ } else { # empty file, go to next filearg
+ close (FILE);
+ next;
}
- print "@Command\n";
+ while (<FILE>) {
+ chomp;
+ &do_line( $_, $file );
+ }
+ close(FILE);
- exit $n if $n > 1;
- exit 0;
}
+&make_groff_line();
+
+
+1;
########################################################################
### Emacs settings
# Local Variables:
diff --git a/src/roff/grog/perl_test.pl b/src/roff/grog/perl_test.pl
index 19c68ed..5cc18cc 100644
--- a/src/roff/grog/perl_test.pl
+++ b/src/roff/grog/perl_test.pl
@@ -5,11 +5,11 @@
# Source file position: <groff-source>/roff/grog/perl_test.sh
# Installed position: <prefix>/lib/groff/grog/perl_test.sh
-# Copyright (C) 2013
+# Copyright (C) 2013-14
# Free Software Foundation, Inc.
# Written by Bernd Warken <address@hidden>.
-# Last update: 12 Apr 2013
+# Last update: 04 Jun 2014
# This file is part of `grog', which is part of `groff'.
@@ -29,7 +29,7 @@
########################################################################
# This file tests whether perl has a suitable version. It is used by
-# glilypond.pl and Makefile.sub.
+# grog.pl and Makefile.sub.
require v5.6;
diff --git a/src/roff/grog/subs.pl b/src/roff/grog/subs.pl
new file mode 100644
index 0000000..9025bf5
--- /dev/null
+++ b/src/roff/grog/subs.pl
@@ -0,0 +1,626 @@
+#! /usr/bin/env 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, 2006, 2009, 2011-2012, 2014
+# Free Software Foundation, Inc.
+# Split from grog.pl and put under GPL2 by
+# Bernd Warken <address@hidden>.
+
+# 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 should have received a copy of the GNU General Public License
+# along with this program. If not, see
+# <http://www.gnu.org/licenses/gpl-2.0.html>.
+
+########################################################################
+# Last_Update = '10 Jun 2014';
+########################################################################
+
+require v5.6;
+
+use warnings;
+use strict;
+use File::Spec;
+
+$\ = "\n";
+
+# my $Sp = "[\\s\\n]";
+# my $Sp = qr([\s\n]);
+# my $Sp = '' if $arg eq '-C';
+my $Sp = '';
+
+my @Command; # stores the final output
+my @Mparams; # stores the options `-m*'
+my $do_run = 0; # run generated `groff' command
+my $pdf_with_ligatures = 0; # `-P-y -PU' for `pdf' device
+my $device = '';
+
+our $Prog;
+
+my %macros;
+my %Groff = (
+ # preprocessors
+ 'chem' => 0,
+ 'eqn' => 0,
+ 'gperl' => 0,
+ 'grap' => 0,
+ 'grn' => 0,
+ 'lilypond' => 0,
+ 'pic' => 0,
+ 'refer' => 0,
+ 'refer_open' => 0,
+ 'refer_close' => 0,
+ 'soelim' => 0,
+ 'tbl' => 0,
+
+ # tmacs
+ 'man' => 0,
+ 'mdoc' => 0,
+ 'mdoc_old' => 0,
+ 'me' => 0,
+ 'mm' => 0,
+ 'mom' => 0,
+ 'ms' => 0,
+
+ # requests
+ 'NH' => 0, # ms
+ 'TH' => 0, # man and ms
+ 'SH' => 0, # man and ms
+ 'SS' => 0, # man
+ 'P' => 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
+);
+
+
+############################ subs ######################################
+
+########################################################################
+# sub minus_args: command line arguments except file names
+########################################################################
+
+sub minus_args {
+ my @filespec = ();
+ my $double_minus = 0;
+ my $was_minus = 0;
+ my $was_T = 0;
+ my $had_filespec = 0;
+
+ foreach my $arg (@ARGV) {
+ next unless $arg;
+ if ($double_minus) {
+ $had_filespec = 1;
+ if (-f $arg && -r $arg) {
+ push @filespec, $arg;
+ } else {
+ print STDERR "grog: $arg is not a readable file.";
+ }
+ next;
+ }
+
+ if ( $was_T ) {
+ $was_T = 0;
+ $device = $arg;
+ next;
+ }
+
+ if ( $arg =~ /^--/ ) {
+
+ if ($arg eq '--') {
+ $double_minus = 1;
+ push(@Command, $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 =~ /^--?w/ ) { # --with_ligatures, no exit
+ $pdf_with_ligatures = 1;
+ next;
+ }
+ }
+
+ print STDERR "grog: wrong option $arg." if $arg =~ /^--/;
+
+ if ($arg eq '-') {
+ unless ($was_minus) {
+ push @filespec, $arg;
+ $was_minus = 1;
+ }
+ next;
+ }
+
+ if ($arg =~ /^-m/) {
+ push @Mparams, $arg;
+ next;
+ }
+
+ if ($arg =~ /^-T\s*$/) {
+ $was_T = 1;
+ next;
+ }
+
+ if ($arg =~ s/^-T(.+)$/$1/) {
+ $device = $arg;
+ next;
+ }
+
+ if ($arg =~ /^-/) {
+ push(@Command, $arg);
+ next;
+ } else {
+ $had_filespec = 1;
+ if (-f $arg && -r $arg) {
+ push @filespec, $arg;
+ } else {
+ print STDERR "grog: $arg is not a readable file.";
+ }
+ next;
+ }
+ }
+ @filespec = ('-') if ! @filespec && ! $had_filespec;
+ exit 1 unless @filespec;
+ @ARGV = @filespec;
+}
+
+
+########################################################################
+# sub do_first_line
+########################################################################
+
+# As documented for the `man' program, the first line can be
+# used as an 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: `egGjpRst'.
+# Each of these characters means an option for the generated
+# `groff' command line, e.g. `-t'.
+
+sub do_first_line {
+ my ( $line, $file ) = @_;
+
+ # For a leading groff options line use only [egGjpRst]
+ if ( $line =~ /^[.']\\"[\segGjpRst]+&/ ) {
+ # 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 =~ /e/ ) {
+ $Groff{'eqn'}++;
+ }
+ if ( $line =~ /g/ ) {
+ $Groff{'grn'}++;
+ }
+ if ( $line =~ /G/ ) {
+ $Groff{'grap'}++;
+ }
+ if ( $line =~ /j/ ) {
+ $Groff{'chem'}++;
+ }
+ if ( $line =~ /p/ ) {
+ $Groff{'pic'}++;
+ }
+ if ( $line =~ /R/ ) {
+ $Groff{'refer'}++;
+ }
+ if ( $line =~ /s/ ) {
+ $Groff{'soelim'}++;
+ }
+ if ( $line =~ /t/ ) {
+ $Groff{'tbl'}++;
+ }
+ return 1; # a leading groff options line
+ } else {
+ return 0; # not a leading groff options line
+ }
+} # sub do_first_line
+
+
+########################################################################
+# sub do_line
+########################################################################
+
+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 ..
+
+ # soelim
+ if ( $line =~ /^\.(so|mso|PS\s*<).*$/ ) { # `.so', `.mso', `.PS<...'
+ $Groff{'soelim'}++;
+ return;
+ }
+ if ( $line =~ /^\.\s*do\s*(so|mso|PS\s*<).*$/ ) { # `.do so', etc
+ $Groff{'soelim'}++;
+ return;
+ }
+
+ 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;
+ }
+
+ $line =~ s/(\.\w+).*$/$1/; # let only request left
+
+ {
+ # if line command is a defined macro, just ignore this line
+ my $macro = $line;
+ $macro =~ s/^(\.\w+)/$1/;
+ return if ( exists $macros{ $macro } );
+ }
+
+ # preprocessors
+ if ( $line =~ /^(\.cstart)|(begin\s+chem)$/ ) {
+ $Groff{'chem'}++; # for chem
+ return;
+ }
+ if ( $line =~ /^\.EQ$/ ) {
+ $Groff{'eqn'}++; # for eqn
+ return;
+ }
+ if ( $line =~ /^\.G1$/ ) {
+ $Groff{'grap'}++; # for grap
+ return;
+ }
+ if ( $line =~ /^\.Perl$/ ) {
+ $Groff{'gperl'}++; # for gperl
+ return;
+ }
+ if ( $line =~ /^\.GS$/ ) {
+ $Groff{'grn'}++; # for grn
+ return;
+ }
+ if ( $line =~ /^\.lilypond$/ ) {
+ $Groff{'lilypond'}++; # for glilypond
+ return;
+ }
+ if ( $line =~ /^\.PS$/ ) {
+ $Groff{'pic'}++; # for gpic
+ return;
+ }
+ if ( $line =~ /^\.R1$/ ) {
+ $Groff{'refer'}++; # for refer
+ return;
+ }
+ if ( $line =~ /^\.\[$/ ) {
+ $Groff{'refer_open'}++; # for refer open
+ return;
+ }
+ if ( $line =~ /^\.\]$/ ) {
+ $Groff{'refer_close'}++; # for refer close
+ return;
+ }
+ if ( $line =~ /^\.TS$/ ) {
+ $Groff{'tbl'}++; # for tbl
+ return;
+ }
+
+
+ # devices
+
+ # for man
+ if ( $line =~ /^\.TH$/ ) {
+ $Groff{'TH'}++;
+ return;
+ }
+ if ( $line =~ /^\.SH$/ ) {
+ $Groff{'SH'}++;
+ return;
+ }
+ if ( $line =~ /^\.SS$/ ) {
+ $Groff{'SS'}++;
+ return;
+ }
+# if ( $line =~ /^\.P$/ ) {
+# $Groff{'P'}++;
+# return;
+# }
+
+ # In the old version of -mdoc `Oo' is a toggle, in the new it's
+ # closed by `Oc'.
+ if ( $line =~ /^\.Oc$/ ) {
+ $Groff{'Oc'}++; # only for modern mdoc
+ return;
+ }
+ if ( $line =~ /^\.Oo$/ ) {
+ $Groff{'Oo'}++; # for mdoc and mdoc-old
+ return;
+ }
+
+ if ( $line =~ /^\.(Dd)$/ ) {
+ $Groff{'Dd'}++; # for modern mdoc
+ return;
+ }
+ if ( $line =~ /^\.(Tp|Dp|De|Cx|Cl)$/ ) {
+ $Groff{'mdoc_old'}++; # true for old mdoc
+ return;
+ }
+
+ if ( $line =~ /^\.([ilnp]p|sh)$/ ) {
+ $Groff{'me'}++; # for me
+ return;
+ }
+ if ( $line =~ /^\.(PH|SA)$/ ) {
+ $Groff{'mm'}++; # for mm
+ return;
+ }
+ if ( $line =~ /^\.(PRINTSTYLE|START)$/ ) {
+ $Groff{'mom'}++; # for mom
+ return;
+ }
+ if ( $line =~ /^\.NH$/ ) {
+ $Groff{'NH'}++; # for ms
+ return;
+ }
+} # sub do_line
+
+
+########################################################################
+# sub make_groff_line
+########################################################################
+
+sub make_groff_line {
+ my @m = ();
+ my @preprograms = ();
+
+ # device from -T
+ $device = '' unless ( defined $device );
+
+ # default device when without `-T' is `ps' ($device empty)
+
+ if ( $device =~
+ /^(
+ dvi
+ |
+ html
+ |
+ xhtml
+ |
+ lbp
+ |
+ lj4
+ |
+ ps
+ |
+ pdf
+ |
+ ascii
+ |
+ cp1047
+ |
+ latin1
+ |
+ utf8
+ )$/x ) { # suitable device
+
+ push(@Command, '-T' . $device); # for all suitable devices
+
+ if ( $device eq 'pdf' ) {
+ if ( $pdf_with_ligatures ) { # with ligature argument
+ push( @Command, '-P-y -PU' );
+ } else { # no ligature argument
+ 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 ligature
+ } # end of pdf device
+ } else { # wrong device
+ if ( $device ) {
+ print STDERR 'The device ' . $device . ' for -T is wrong.';
+ $device = '';
+ }
+ }
+
+ # preprocessors
+ if ( $Groff{'lilypond'} ) {
+ push @preprograms, 'glilypond';
+ }
+ if ( $Groff{'gperl'} ) {
+ push @preprograms, 'gperl';
+ }
+ $Groff{'refer'} ||= $Groff{'refer_open'} && $Groff{'refer_close'};
+ if ( $Groff{'pic'} || $Groff{'tbl'} || $Groff{'eqn'} ||
+ $Groff{'grn'} || $Groff{'grap'} || $Groff{'refer'} ||
+ $Groff{'chem'} ) {
+ my $s = "-";
+ $s .= "e" if $Groff{'eqn'};
+ $s .= "g" if $Groff{'grn'};
+ $s .= "G" if $Groff{'grap'};
+ $s .= "j" if $Groff{'chem'};
+ $s .= "p" if $Groff{'pic'};
+ $s .= "R" if $Groff{'refer'};
+ $s .= "s" if $Groff{'soelim'};
+ $s .= "t" if $Groff{'tbl'};
+ push(@Command, $s);
+ }
+
+
+ # tmacs
+
+ if ( $Groff{'TH'} && ( $Groff{'SH'} || $Groff{'SS'} ) ) {
+ $Groff{'TH'} = 0;
+ $Groff{'SH'} = 0;
+ $Groff{'SS'} = 0;
+ $Groff{'man'} = 1;
+ push(@m, '-man');
+ push(@Command, '-man');
+ }
+
+ if ( $Groff{'NH'} ) {
+ $Groff{'ms'}++;
+ push(@m, '-ms');
+ push(@Command, '-ms');
+ }
+
+ if ( ( $Groff{'Oo'} && $Groff{'Oc'} ) || $Groff{'Dd'} ) {
+ $Groff{'Oc'} = 0;
+ $Groff{'Oo'} = 0;
+ push(@m, '-mdoc');
+ push(@Command, '-mdoc');
+ }
+
+ if ( $Groff{'mdoc_old'} || $Groff{'Oo'} ) {
+ push(@m, '-mdoc_old');
+ push(@Command, '-mdoc_old');
+ }
+
+
+ if ( $Groff{'me'} ) {
+ push(@m, '-me');
+ push(@Command, '-me');
+ }
+ if ( $Groff{'mm'} ) {
+ push(@m, '-mm');
+ push(@Command, '-mm');
+ }
+ if ( $Groff{'mom'} ) {
+ push(@m, '-mom');
+ push(@Command, '-mom');
+ }
+
+
+ unshift @Command, 'groff';
+ if ( @preprograms ) {
+ my @progs;
+ $progs[0] = shift @preprograms;
+ push(@progs, @ARGV);
+ for ( @preprograms ) {
+ push @progs, '|';
+ push @progs, $_;
+ }
+ push @progs, '|';
+ unshift @Command, @progs;
+ } else {
+ push(@Command, @ARGV);
+ }
+
+ foreach (@Command) {
+ next unless /\s/;
+ $_ = "'" . $_ . "'";
+ }
+
+
+ my $n = scalar @m;
+ my $np = scalar @Mparams;
+ print STDERR "$Prog: more than 1 `-m' argument: @Mparams" if $np > 1;
+ if ($n == 0) {
+ unshift @Command, $Mparams[0] if $np == 1;
+ } elsif ($n == 1) {
+ if ($np == 1) {
+ print STDERR "$Prog: wrong `-m' argument: $Mparams[0]"
+ if $m[0] ne $Mparams[0];
+ }
+ } else {
+ print STDERR "$Prog: error: there are several macro packages: @m";
+ exit 1;
+ }
+
+ # execute the `groff' command here with option `--run'
+ if ( $do_run ) {
+ print STDERR "@Command";
+ system(join ' ', @Command);
+ } else {
+ print "@Command";
+ }
+
+ exit $n if $n > 1;
+ exit 0;
+} # sub make_groff_line
+
+
+########################################################################
+# 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
+--run run the checked-out groff command
+--with_ligatures include options `-P-y -PU' for internal font,
+ which preserverses the ligatures like `fi'
+
+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;
+} # sub help
+
+
+########################################################################
+# sub version
+########################################################################
+
+sub version {
+ our %at_at;
+ our $Last_Update;
+ print "Perl version of GNU $Prog of $Last_Update " .
+ "in groff version " . $at_at{'GROFF_VERSION'};
+ exit 0;
+} # sub version
+
+
+1;
+########################################################################
+### Emacs settings
+# Local Variables:
+# mode: CPerl
+# End:
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [groff] 01/01: grog: rewrite program with many new sub functions, which are moved into the new file subs.pl,
Bernd Warken <=