diff options
Diffstat (limited to '')
| -rw-r--r-- | contrib/mm/mmroff.pl | 179 |
1 files changed, 179 insertions, 0 deletions
diff --git a/contrib/mm/mmroff.pl b/contrib/mm/mmroff.pl new file mode 100644 index 0000000..af8bf90 --- /dev/null +++ b/contrib/mm/mmroff.pl @@ -0,0 +1,179 @@ +#!@PERL@ +# Copyright (C) 1989-2020 Free Software Foundation, Inc. +# +# This file 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 3 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/>. + +use strict; +use warnings; + +(my $progname = $0) =~s @.*/@@; + +# runs groff in safe mode, that seems to be the default +# installation now. That means that I have to fix all nice +# features outside groff. Sigh. +# I do agree however that the previous way opened a whole bunch +# of security holes. + +my $no_exec; + +if (grep(/^--help$/, @ARGV)) { + print "usage: mmroff [-x] [groff-option ...] [file ...]\n"; + exit; +} + +if (grep(/^--version$/, @ARGV)) { + print "mmroff (groff) @VERSION@\n"; + exit; +} + +# check for -x and remove it +if (grep(/^-x$/, @ARGV)) { + $no_exec++; + @ARGV = grep(!/^-x$/, @ARGV); +} + +# mmroff should always have -mm, but not twice +@ARGV = grep(!/^-mm$/, @ARGV); +my $check_macro = "groff -rRef=1 -z -mm @ARGV"; +my $run_macro = "groff -mm @ARGV"; + +my (%cur, $rfilename, $max_height, $imacro, $max_width, @out, @indi); +open(MACRO, "$check_macro 2>&1 |") || die "run $check_macro:$!"; +while(<MACRO>) { + if (m#^\.\\" Rfilename: (\S+)#) { + # remove all directories just to be more secure + ($rfilename = $1) =~ s#.*/##; + next; + } + if (m#^\.\\" Imacro: (\S+)#) { + # remove all directories just to be more secure + ($imacro = $1) =~ s#.*/##; + next; + } + if (m#^\.\\" Index: (\S+)#) { + # remove all directories just to be more secure + my $f; + ($f = $1) =~ s#.*/##; + &print_index($f, \@indi, $imacro); + @indi = (); + $imacro = ''; + next; + } + my $x; + if (($x) = m#^\.\\" IND (.+)#) { + $x =~ s#\\##g; + my @x = split(/\t/, $x); + grep(s/\s+$//, @x); + push(@indi, join("\t", @x)); + next; + } + if (m#^\.\\" PIC id (\d+)#) { + %cur = ('id', $1); + next; + } + if (m#^\.\\" PIC file (\S+)#) { + &psbb($1); + &ps_calc($1); + next; + } + if (m#^\.\\" PIC (\w+)\s+(\S+)#) { + eval "\$cur{'$1'} = '$2'"; + next; + } + s#\\ \\ $##; + push(@out, $_); +} +close(MACRO); + +sub Die { + print STDERR "$progname: fatal error: @_\n"; + exit 1; +} + +if ($rfilename) { + push(@out, ".nr pict*max-height $max_height\n") if defined $max_height; + push(@out, ".nr pict*max-width $max_width\n") if defined $max_width; + + open(OUT, ">$rfilename") + or &Die("unable to create $rfilename:$!"); + print OUT '.\" references', "\n"; + my $i; + for $i (@out) { + print OUT $i; + } + close(OUT); +} + +exit 0 if $no_exec; +exit system($run_macro); + +sub print_index { + my ($f, $ind, $macro) = @_; + + open(OUT, ">$f") or &Die("unable to create $f:$!"); + my $i; + for $i (sort @$ind) { + if ($macro) { + $i = '.'.$macro.' "'.join('" "', split(/\t/, $i)).'"'; + } + print OUT "$i\n"; + } + close(OUT); +} + +sub ps_calc { + my ($f) = @_; + + my $w = abs($cur{'llx'}-$cur{'urx'}); + my $h = abs($cur{'lly'}-$cur{'ury'}); + $max_width = $w if $w > $max_width; + $max_height = $h if $h > $max_height; + + my $id = $cur{'id'}; + push(@out, ".ds pict*file!$id $f\n"); + push(@out, ".ds pict*id!$f $id\n"); + push(@out, ".nr pict*llx!$id $cur{'llx'}\n"); + push(@out, ".nr pict*lly!$id $cur{'lly'}\n"); + push(@out, ".nr pict*urx!$id $cur{'urx'}\n"); + push(@out, ".nr pict*ury!$id $cur{'ury'}\n"); + push(@out, ".nr pict*w!$id $w\n"); + push(@out, ".nr pict*h!$id $h\n"); +} + + +sub psbb { + my ($f) = @_; + + unless (open(IN, $f)) { + print STDERR "Warning: Postscript file $f:$!"; + next; + } + while(<IN>) { + if (/^%%BoundingBox:\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)/) { + $cur{'llx'} = $1; + $cur{'lly'} = $2; + $cur{'urx'} = $3; + $cur{'ury'} = $4; + } + } + close(IN); +} + + +1; +# Local Variables: +# mode: CPerl +# End: |