summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/scripts/psutils
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2013-04-07 18:42:53 +0000
committerKarl Berry <karl@freefriends.org>2013-04-07 18:42:53 +0000
commitedb2136c619d2c59bcb6dfd431c4c7636ff8913d (patch)
tree8aa04dd27bee1b2f2f9b3fd45dab41cf7771f82e /Master/texmf-dist/scripts/psutils
parentb3efa3bb4509e7bd53d737fb729d0d92a76f1f98 (diff)
texmf -> texmf-dist: scripts
git-svn-id: svn://tug.org/texlive/trunk@29719 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/texmf-dist/scripts/psutils')
-rwxr-xr-xMaster/texmf-dist/scripts/psutils/extractres.pl101
-rwxr-xr-xMaster/texmf-dist/scripts/psutils/fixdlsrps.pl54
-rwxr-xr-xMaster/texmf-dist/scripts/psutils/fixfmps.pl21
-rwxr-xr-xMaster/texmf-dist/scripts/psutils/fixpsditps.pl25
-rwxr-xr-xMaster/texmf-dist/scripts/psutils/fixpspps.pl58
-rwxr-xr-xMaster/texmf-dist/scripts/psutils/fixscribeps.pl19
-rwxr-xr-xMaster/texmf-dist/scripts/psutils/fixtpps.pl28
-rwxr-xr-xMaster/texmf-dist/scripts/psutils/fixwfwps.pl33
-rwxr-xr-xMaster/texmf-dist/scripts/psutils/fixwpps.pl31
-rwxr-xr-xMaster/texmf-dist/scripts/psutils/fixwwps.pl20
-rwxr-xr-xMaster/texmf-dist/scripts/psutils/includeres.pl45
-rwxr-xr-xMaster/texmf-dist/scripts/psutils/psmerge.pl86
12 files changed, 521 insertions, 0 deletions
diff --git a/Master/texmf-dist/scripts/psutils/extractres.pl b/Master/texmf-dist/scripts/psutils/extractres.pl
new file mode 100755
index 00000000000..adee938c95d
--- /dev/null
+++ b/Master/texmf-dist/scripts/psutils/extractres.pl
@@ -0,0 +1,101 @@
+#!/usr/bin/env perl
+# extractres: extract resources from PostScript file
+#
+# Copyright (C) Angus J. C. Duggan 1991-1995
+# See file LICENSE for details.
+
+$0 =~ s=.*/==;
+$prog = $0;
+
+%resources = (); # list of resources included
+%merge = (); # list of resources extracted this time
+%extn = ("font", ".pfa", "file", ".ps", "procset", ".ps", # resource extns
+ "pattern", ".pat", "form", ".frm", "encoding", ".enc");
+%type = ("%%BeginFile:", "file", "%%BeginProcSet:", "procset",
+ "%%BeginFont:", "font"); # resource types
+
+while (@ARGV) {
+ $_ = shift;
+ if (/^-m(erge)?$/) { $merge = 1; }
+ elsif (/^-/) {
+ print STDERR "Usage: $prog [-merge] [file]\n";
+ exit 1;
+ } else {
+ unshift(@ARGV, $_);
+ last;
+ }
+}
+
+if (defined($ENV{TMPDIR})) { # set body file name
+ $body = "$ENV{TMPDIR}/body$$.ps";
+} elsif (defined($ENV{TEMP})) {
+ $body = "$ENV{TEMP}/body$$.ps";
+} elsif (defined($ENV{TMP})) {
+ $body = "$ENV{TMP}/body$$.ps";
+} else {
+ $body = "body$$.ps";
+}
+
+open(BODY, $body) && die "Temporary file $body already exists";
+open(BODY, ">$body") || die "Can't write file $body";
+
+sub filename { # make filename for resource in @_
+ local($name);
+ foreach (@_) { # sanitise name
+ s/[!()\$\#*&\\\|\`\'\"\~\{\}\[\]\<\>\?]//g;
+ $name .= $_;
+ }
+ $name =~ s@.*/@@; # drop directories
+ die "Filename not found for resource ", join(" ", @_), "\n"
+ if $name =~ /^$/;
+ $name;
+}
+
+$output = STDOUT; # start writing header out
+while (<>) {
+ if (/^%%BeginResource:/ || /^%%BeginFont:/ || /^%%BeginProcSet:/) {
+ local($comment, @res) = split(/\s+/); # look at resource type
+ local($type) = defined($type{$comment}) ? $type{$comment} : shift(@res);
+ local($name) = &filename(@res, $extn{$type}); # make file name
+ $saveout = $output;
+ if (!$resources{$name}) {
+ print "%%IncludeResource: $type ", join(" ", @res), "\n";
+ if (!open(RES, $name)) {
+ open(RES, ">$name") || die "Can't write file $name";
+ $resources{$name} = $name;
+ $merge{$name} = $merge;
+ $output = RES;
+ } else { # resource already exists
+ close(RES);
+ undef $output;
+ }
+ } elsif ($merge{$name}) {
+ open(RES, ">>$name") || die "Can't append to file $name";
+ $output = RES;
+ } else { # resource already included
+ undef $output;
+ }
+ } elsif (/^%%EndResource/ || /^%%EndFont/ || /^%%EndProcSet/) {
+ if (defined $output) {
+ print $output $_;
+ close($output);
+ }
+ $output = $saveout;
+ next;
+ } elsif ((/^%%EndProlog/ || /^%%BeginSetup/ || /^%%Page:/)) {
+ $output = BODY;
+ }
+ print $output $_
+ if defined $output;
+}
+
+close(BODY); # close body output file
+
+open(BODY, $body); # reopen body for input
+while (<BODY>) { # print it all
+ print $_;
+}
+close(BODY);
+
+unlink($body); # dispose of body file
+
diff --git a/Master/texmf-dist/scripts/psutils/fixdlsrps.pl b/Master/texmf-dist/scripts/psutils/fixdlsrps.pl
new file mode 100755
index 00000000000..2a1d85a654c
--- /dev/null
+++ b/Master/texmf-dist/scripts/psutils/fixdlsrps.pl
@@ -0,0 +1,54 @@
+#!/usr/bin/env perl
+# fixdlsrps: fix DviLaser/PS document to work with PSUtils
+#
+# Copyright (C) Angus J. C. Duggan 1991-1995
+# See file LICENSE for details.
+
+$nesting = 0;
+$page = 1;
+$infont = 0;
+
+@fonts = ();
+@body = ();
+$header = 1;
+
+while (<>) {
+ if (/^XP/) {
+ $infont++;
+ push(@fonts, $_);
+ $infont-- if /PXL.*RP/ || /DN?F.*RP/;
+ } elsif ($infont) {
+ push(@fonts, $_);
+ $infont-- if /PXL.*RP/ || /DN?F.*RP/;
+ } elsif ((/^%%EndSetup/ || /^%%Page:/) && $header) {
+ print @body;
+ @body = ("%%EndSetup\n");
+ $header = 0;
+ } elsif (/^%%EndProlog/ && !$nesting) {
+ push(@body,
+ "\$DviLaser begin/GlobalMode{}bdef/LocalMode{}bdef/XP{}def/RP{}def",
+ "/DoInitialScaling{72.0 Resolution div dup scale}bdef end\n", $_);
+ } elsif (/^%%BeginPageSetup/ && !$nesting) {
+ push(@body, "%%Page: $page $page\n", $_,
+ "Resolution 72 div dup scale Magnification 1000 div dup scale\n",
+ "/DocumentInitState where {\n",
+ "/DocumentInitState [ matrix currentmatrix currentlinewidth",
+ " currentlinecap currentlinejoin currentdash currentgray",
+ " currentmiterlimit] cvx put}if\n");
+ $page++;
+ } elsif (/^%%BeginDocument:/ || /^%%BeginBinary:/ || /^%%BeginFile:/) {
+ push(@body, $_);
+ $nesting++;
+ } elsif (/^%%EndDocument/ || /^%%EndBinary/ || /^%%EndFile/) {
+ push(@body, $_);
+ $nesting--;
+ } elsif (!/^%%PageBoundingBox:/ && !/^%%Page:/) {
+ push(@body, $_);
+ }
+}
+
+print @fonts;
+print @body;
+
+exit 0;
+
diff --git a/Master/texmf-dist/scripts/psutils/fixfmps.pl b/Master/texmf-dist/scripts/psutils/fixfmps.pl
new file mode 100755
index 00000000000..039ac8e5a3e
--- /dev/null
+++ b/Master/texmf-dist/scripts/psutils/fixfmps.pl
@@ -0,0 +1,21 @@
+#!/usr/bin/env perl
+# fixfmps: get conforming PostScript out of FrameMaker version 2 file
+# move all FMDEFINEFONTs to start of pages
+#
+# Copyright (C) Angus J. C. Duggan 1991-1995
+# See file LICENSE for details.
+
+%fonts=();
+
+while (<>) {
+ if (/^([0-9]+) [0-9]+ .* FMDEFINEFONT$/) {
+ $fonts{$1} = $_;
+ } elsif (/^[0-9.]+ [0-9.]+ [0-9]+ FMBEGINPAGE$/) {
+ print $_, join('',values(%fonts));
+ } elsif (m%(.*/PageSize \[paperwidth paperheight\]put )setpagedevice(.*)%) {
+ print "$1pop$2\n";
+ } else {
+ print $_;
+ }
+}
+
diff --git a/Master/texmf-dist/scripts/psutils/fixpsditps.pl b/Master/texmf-dist/scripts/psutils/fixpsditps.pl
new file mode 100755
index 00000000000..2a1728a8204
--- /dev/null
+++ b/Master/texmf-dist/scripts/psutils/fixpsditps.pl
@@ -0,0 +1,25 @@
+#!/usr/bin/env perl
+# fixpsditps: fix psdit output for use in psutils
+#
+# Copyright (C) Angus J. C. Duggan 1991-1995
+# See file LICENSE for details.
+
+$nesting = 0;
+
+while (<>) {
+ if (/^\/p{pop showpage pagesave restore \/pagesave save def}def$/) {
+ print "/p{pop showpage pagesave restore}def\n";
+ } elsif (/^%%BeginDocument/ || /^%%BeginBinary/ || /^%%BeginFile/ ) {
+ print $_;
+ $nesting++;
+ } elsif (/^%%EndDocument/ || /^%%EndBinary/ || /^%%EndFile/) {
+ print $_;
+ $nesting--;
+ } elsif (/^%%Page:/ && $nesting == 0) {
+ print $_;
+ print "xi\n";
+ } elsif (! /^xi$/) {
+ print $_;
+ }
+}
+
diff --git a/Master/texmf-dist/scripts/psutils/fixpspps.pl b/Master/texmf-dist/scripts/psutils/fixpspps.pl
new file mode 100755
index 00000000000..77bba66d6b7
--- /dev/null
+++ b/Master/texmf-dist/scripts/psutils/fixpspps.pl
@@ -0,0 +1,58 @@
+#!/usr/bin/env perl
+# mangle PostScript produced by PSPrint to make it almost conforming
+#
+# Copyright (C) Angus J. C. Duggan 1991-1995
+# See file LICENSE for details.
+
+$header = 1; $ignore = 0;
+$verbose = 0;
+@body = ();
+%fonts = (); $font = "";
+$inchar = 0; @char = ();
+
+while (<>) {
+ if (/^\@end$/) {
+ $ignore = 1;
+ } elsif (/^[0-9]+ \@bop0$/) {
+ $ignore = 0;
+ $header = 1;
+ } elsif ($header) {
+ if (/^\/([a-z.0-9]+) \@newfont$/) {
+ if (! defined($fonts{$1})) {
+ $fonts{$1} = 1;
+ print;
+ } elsif ($verbose) {
+ print STDERR "$font already defined\n";
+ }
+ } elsif (/^([a-z.0-9]+) sf$/) {
+ $font = $1;
+ print;
+ } elsif (/^\[</) {
+ $inchar = 1;
+ push (@char, $_);
+ } elsif ($inchar) {
+ push (@char, $_);
+ if (/.*\] ([0-9]+) dc$/) {
+ if (! defined($fonts{$font,$1})) {
+ $fonts{$font,$1} = 1;
+ print (@char);
+ } elsif ($verbose) {
+ print STDERR "$font character $1 already defined\n";
+ }
+ $inchar = 0;
+ @char = ();
+ }
+ } elsif (/^([0-9]+) \@bop1$/) {
+ $header = 0;
+ push (@body, "%%Page: ? $1\n");
+ push (@body, $_);
+ } else {
+ print;
+ }
+ } elsif (! $ignore) {
+ push (@body, $_);
+ }
+}
+print (@body);
+print ("\@end\n");
+
diff --git a/Master/texmf-dist/scripts/psutils/fixscribeps.pl b/Master/texmf-dist/scripts/psutils/fixscribeps.pl
new file mode 100755
index 00000000000..bd4e9a0e3e0
--- /dev/null
+++ b/Master/texmf-dist/scripts/psutils/fixscribeps.pl
@@ -0,0 +1,19 @@
+#!/usr/bin/env perl
+# fixscribeps: get conforming PostScript out of Scribe
+#
+# Copyright (C) Angus J. C. Duggan 1991-1995
+# See file LICENSE for details.
+
+$inepsf = 0;
+$epsfn = 0;
+while (<>) {
+ if (/^([0-9]+ [0-9]+ [0-9]+ PB) (%!.*)/) {
+ print "$1\n%%BeginDocument: Scribe-EPSF $epsfn 0\n$2\n";
+ $inepsf++;
+ } elsif (/^ PE/ && $inepsf) {
+ print "%%EndDocument\n", $_;
+ } else {
+ print $_;
+ }
+}
+
diff --git a/Master/texmf-dist/scripts/psutils/fixtpps.pl b/Master/texmf-dist/scripts/psutils/fixtpps.pl
new file mode 100755
index 00000000000..4239bb9dfc5
--- /dev/null
+++ b/Master/texmf-dist/scripts/psutils/fixtpps.pl
@@ -0,0 +1,28 @@
+#!/usr/bin/env perl
+# fixtpps: fix tpscript document to work with PSUtils
+#
+# Copyright (C) Angus J. C. Duggan 1991-1995
+# See file LICENSE for details.
+
+$nesting = 0;
+$header = 1;
+
+while (<>) {
+ if (/^%%Page:/ && $nesting == 0) {
+ print $_;
+ print "save home\n";
+ $header = 0;
+ } elsif (/^%%BeginDocument/ || /^%%BeginBinary/ || /^%%BeginFile/) {
+ print $_;
+ $nesting++;
+ } elsif (/^%%EndDocument/ || /^%%EndBinary/ || /^%%EndFile/) {
+ print $_;
+ $nesting--;
+ } elsif (/save home/) {
+ s/save home//;
+ print $_;
+ } elsif (!$header || (! /^save$/ && ! /^home$/)) {
+ print $_;
+ }
+}
+
diff --git a/Master/texmf-dist/scripts/psutils/fixwfwps.pl b/Master/texmf-dist/scripts/psutils/fixwfwps.pl
new file mode 100755
index 00000000000..92d88443fe1
--- /dev/null
+++ b/Master/texmf-dist/scripts/psutils/fixwfwps.pl
@@ -0,0 +1,33 @@
+#!/usr/bin/env perl
+# fixwfwps: fix Word for windows PostScript for printing.
+#
+# Copyright (C) Angus J. C. Duggan 1991-1995
+# See file LICENSE for details.
+
+$nesting = 0;
+while (<>) {
+ tr/\000-\010\012-\014\016-\037//d;
+ foreach (grep($_ ne "", split("\015"))) {
+ s!/SVDoc\s+save\s+def!!g;
+ s!SVDoc\s+restore!!g;
+ if (/^(%!PS-Adobe-\d*\.\d*) EPSF-/ && !$nesting) {
+ print "$1\n";
+ $wfwepsf = 1;
+ } elsif (/^SS\s*$/ && $wfwepsf) {
+ print "%%Page: $wfwepsf $wfwepsf\n";
+ $wfwepsf++;
+ print "$_\n";
+ } elsif (/^%MSEPS Preamble/) {
+ print "%%BeginDocument: (Included EPSF)\n";
+ print "$_\n";
+ $nesting++;
+ } elsif (/^%MSEPS Trailer/) {
+ $nesting--;
+ print "$_\n";
+ print "%%EndDocument\n";
+ } elsif (! /^%%BoundingBox/) {
+ print "$_\n";
+ }
+ }
+}
+
diff --git a/Master/texmf-dist/scripts/psutils/fixwpps.pl b/Master/texmf-dist/scripts/psutils/fixwpps.pl
new file mode 100755
index 00000000000..83a5fdfaf0b
--- /dev/null
+++ b/Master/texmf-dist/scripts/psutils/fixwpps.pl
@@ -0,0 +1,31 @@
+#!/usr/bin/env perl
+# fixwpps: get semi-conforming PostScript out of WordPerfect 5.0 file
+#
+# Copyright (C) Angus J. C. Duggan 1991-1995
+# See file LICENSE for details.
+
+$page = 1;
+$nesting = 0;
+
+while (<>) {
+ s/([^\/]_t)([0-9]+)/\1 \2/g; # fix wp 5.0 bug
+ if (m!/_[be][dp]! || m!_bp \d+ \d+ roll!) {
+ print $_;
+ } elsif (/^(.*)(_bp.*)$/) {
+ print "$1\n" if $1 ne "";
+ print "%%Page: $page $page\n";
+ print "$2\n";
+ $page++;
+ $nesting++;
+ } elsif (/_ep$/) {
+ print $_;
+ $nesting--;
+ } elsif (/^(.*)(_ed.*)/) {
+ print "$1\n" if $1 ne "";
+ print "%%Trailer:\n";
+ print "$2\n";
+ } else {
+ print $_;
+ }
+}
+
diff --git a/Master/texmf-dist/scripts/psutils/fixwwps.pl b/Master/texmf-dist/scripts/psutils/fixwwps.pl
new file mode 100755
index 00000000000..bfd58c086da
--- /dev/null
+++ b/Master/texmf-dist/scripts/psutils/fixwwps.pl
@@ -0,0 +1,20 @@
+#!/usr/bin/env perl
+# fixwwps: get semi-conforming PostScript out of Windows Write file
+#
+# Copyright (C) Angus J. C. Duggan 1991-1995
+# See file LICENSE for details.
+
+$page = 1;
+
+while (<>) {
+ if (/^(%!.*) EPSF-\d.\d/) {
+ print $1, "\n";
+ } elsif (/^SS/) {
+ print "%%Page: $page $page\n";
+ print $_;
+ $page++;
+ } else {
+ print $_;
+ }
+}
+
diff --git a/Master/texmf-dist/scripts/psutils/includeres.pl b/Master/texmf-dist/scripts/psutils/includeres.pl
new file mode 100755
index 00000000000..c9d0eee61cb
--- /dev/null
+++ b/Master/texmf-dist/scripts/psutils/includeres.pl
@@ -0,0 +1,45 @@
+#!/usr/bin/env perl
+# includeres: include resources in PostScript file
+#
+# Copyright (C) Angus J. C. Duggan 1991-1995
+# See file LICENSE for details.
+
+$0 =~ s=.*/==;
+$prog = $0;
+
+%extn = ("font", ".pfa", "file", ".ps", "procset", ".ps", # resource extns
+ "pattern", ".pat", "form", ".frm", "encoding", ".enc");
+%type = ("%%BeginFile:", "file", "%%BeginProcSet:", "procset",
+ "%%BeginFont:", "font"); # resource types
+
+sub filename { # make filename for resource in @_
+ local($name);
+ foreach (@_) { # sanitise name
+ s/[!()\$\#*&\\\|\`\'\"\~\{\}\[\]\<\>\?]//g;
+ $name .= $_;
+ }
+ $name =~ s@.*/@@; # drop directories
+ die "Filename not found for resource ", join(" ", @_), "\n"
+ if $name =~ /^$/;
+ $name;
+}
+
+while (<>) {
+ if (/^%%IncludeResource:/ || /^%%IncludeFont:/ || /^%%IncludeProcSet:/) {
+ local($comment, @res) = split(/\s+/);
+ local($type) = defined($type{$comment}) ? $type{$comment} : shift(@res);
+ local($name) = &filename(@res);
+ if (open(RES, $name) || open(RES, "$name$extn{$type}")) {
+ while (<RES>) {
+ print $_;
+ }
+ close(RES);
+ } else {
+ print "%%IncludeResource: ", join(" ", $type, @res), "\n";
+ print STDERR "Resource $name not found\n";
+ }
+ } else {
+ print $_;
+ }
+}
+
diff --git a/Master/texmf-dist/scripts/psutils/psmerge.pl b/Master/texmf-dist/scripts/psutils/psmerge.pl
new file mode 100755
index 00000000000..ff1b8039b4d
--- /dev/null
+++ b/Master/texmf-dist/scripts/psutils/psmerge.pl
@@ -0,0 +1,86 @@
+#!/usr/bin/env perl
+# psmerge: merge PostScript files produced by same application and setup
+# usage: psmerge [-oout.ps] [-thorough] file1.ps file2.ps ...
+#
+# Copyright (C) Angus J. C. Duggan 1991-1995
+# See file LICENSE for details.
+
+$0 =~ s=.*/==;
+$prog = $0;
+
+while ($ARGV[0] =~ /^-/) {
+ $_ = shift;
+ if (/^-o(.+)/) {
+ if (!close(STDOUT) || !open(STDOUT, ">$1")) {
+ print STDERR "$prog: can't open $1 for output\n";
+ exit 1;
+ }
+ } elsif (/^-t(horough)?$/) {
+ $thorough = 1;
+ } else {
+ print STDERR "Usage: $prog [-oout] [-thorough] file...\n";
+ exit 1;
+ }
+}
+
+$page = 0;
+$first = 1;
+$nesting = 0;
+
+@header = ();
+$header = 1;
+
+@trailer = ();
+$trailer = 0;
+
+@pages = ();
+@body = ();
+
+@resources = ();
+$inresource = 0;
+
+while (<>) {
+ if (/^%%BeginFont:/ || /^%%BeginResource:/ || /^%%BeginProcSet:/) {
+ $inresource = 1;
+ push(@resources, $_);
+ } elsif ($inresource) {
+ push(@resources, $_);
+ $inresource = 0 if /^%%EndFont/ || /^%%EndResource/ || /^%%EndProcSet/;
+ } elsif (/^%%Page:/ && $nesting == 0) {
+ $header = $trailer = 0;
+ push(@pages, join("", @body)) if @body;
+ $page++;
+ @body = ("%%Page: ($page) $page\n");
+ } elsif (/^%%Trailer/ && $nesting == 0) {
+ push(@trailer, $_);
+ push(@pages, join("", @body)) if @body;
+ @body = ();
+ $trailer = 1;
+ $header = 0;
+ } elsif ($header) {
+ push(@trailer, $_);
+ push(@pages, join("", @body)) if @body;
+ @body = ();
+ $trailer = 1;
+ $header = 0;
+ } elsif ($trailer) {
+ if (/^%!/ || /%%EOF/) {
+ $trailer = $first = 0;
+ } elsif ($first) {
+ push(@trailer, $_);
+ }
+ } elsif (/^%%BeginDocument/ || /^%%BeginBinary/ || /^%%BeginFile/) {
+ push(@body, $_);
+ $nesting++;
+ } elsif (/^%%EndDocument/ || /^%%EndBinary/ || /^%%EndFile/) {
+ push(@body, $_);
+ $nesting--;
+ } else {
+ print $_ if $print;
+ }
+}
+
+print @trailer;
+
+exit 0;
+