summaryrefslogtreecommitdiff
path: root/Build
diff options
context:
space:
mode:
authorVladimir Volovich <vvv@vsu.ru>2008-05-26 09:52:43 +0000
committerVladimir Volovich <vvv@vsu.ru>2008-05-26 09:52:43 +0000
commitf3c03b631382b9331ea7292aa1a637204ab70001 (patch)
tree50b9212eb937044622bc49e2264cf639499e2857 /Build
parent7cf2257799dd7bb3e8051d6e188477aa541176a1 (diff)
per conversation with Karl:
added copies of LINKED_SCRIPTS to the source/texk/texlive/linked_scripts directory, and install them suring "make install" to $prefix/texmf(-dist)/scripts/... (according to the location specified in LINKED_SCRIPTS). this avoids dangling symlinks produced by "make install"; the scripts in Master texmf trees listed in LINKED_SCRIPTS are still master copies, and the files in linked_scripts directory are secondary copies which should be kept in sync with the Master tree. git-svn-id: svn://tug.org/texlive/trunk@8355 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Build')
-rw-r--r--Build/source/texk/texlive/Makefile.in11
-rwxr-xr-xBuild/source/texk/texlive/linked_scripts/TeXcount.pl866
-rwxr-xr-xBuild/source/texk/texlive/linked_scripts/a2ping.pl2572
-rwxr-xr-xBuild/source/texk/texlive/linked_scripts/dviasm.py951
-rwxr-xr-xBuild/source/texk/texlive/linked_scripts/e2pall.pl89
-rwxr-xr-xBuild/source/texk/texlive/linked_scripts/epstopdf.pl396
-rwxr-xr-xBuild/source/texk/texlive/linked_scripts/getnonfreefonts.pl306
-rwxr-xr-xBuild/source/texk/texlive/linked_scripts/makeglossaries293
-rwxr-xr-xBuild/source/texk/texlive/linked_scripts/mkjobtexmf.pl804
-rwxr-xr-xBuild/source/texk/texlive/linked_scripts/pdfcrop.pl369
-rwxr-xr-xBuild/source/texk/texlive/linked_scripts/pdfthumb.texlua44
-rwxr-xr-xBuild/source/texk/texlive/linked_scripts/perltex.pl476
-rwxr-xr-xBuild/source/texk/texlive/linked_scripts/pkfix.pl860
-rwxr-xr-xBuild/source/texk/texlive/linked_scripts/ppower4.texlua43
-rwxr-xr-xBuild/source/texk/texlive/linked_scripts/ps2eps.pl930
-rwxr-xr-xBuild/source/texk/texlive/linked_scripts/ps4pdf133
-rwxr-xr-xBuild/source/texk/texlive/linked_scripts/texdoc.tlu345
-rwxr-xr-xBuild/source/texk/texlive/linked_scripts/texdoctk.pl1794
-rwxr-xr-xBuild/source/texk/texlive/linked_scripts/thumbpdf.pl1565
-rwxr-xr-xBuild/source/texk/texlive/linked_scripts/tlmgr.pl1440
-rwxr-xr-xBuild/source/texk/texlive/linked_scripts/vpe.pl421
21 files changed, 14704 insertions, 4 deletions
diff --git a/Build/source/texk/texlive/Makefile.in b/Build/source/texk/texlive/Makefile.in
index 46764970dbe..19fb20e2f89 100644
--- a/Build/source/texk/texlive/Makefile.in
+++ b/Build/source/texk/texlive/Makefile.in
@@ -9,7 +9,8 @@ kpse_include ../make/programs.mk
LIVESCRIPTS = simpdftex ebong giftopng
-# These scripts do not exist here in /source/ at all, the instances
+# Copies of these scripts exist in /source/live_scripts/ for the sake
+# of avoiding dangling links produced by Build; the instances
# in texmf are the masters (except when it is CTAN).
LINKED_SCRIPTS = \
texmf/scripts/a2ping/a2ping.pl \
@@ -87,12 +88,14 @@ install-linked-scripts:
target=$$target$(LINKSUFFIX); \
rm -f $$target; \
case "$(scriptdir)" in \
- */bin) s=../$$s;; \
- */bin/*) s=../../$$s;; \
+ */bin) d=..;; \
+ */bin/*) d=../..;; \
*) echo "$(scriptdir): strange directory for linked scripts" >&2;\
exit 1;; \
esac; \
- ln -s $$s $$target; \
+ $(SHELL) $(srcdir)/../mkinstalldirs $(prefix)/`dirname $$s`; \
+ $(INSTALL_SCRIPT) $(srcdir)/linked_scripts/`basename $$s` $(prefix)/$$s; \
+ ln -s $$d/$$s $$target; \
done
install-linked-sys-scripts:
diff --git a/Build/source/texk/texlive/linked_scripts/TeXcount.pl b/Build/source/texk/texlive/linked_scripts/TeXcount.pl
new file mode 100755
index 00000000000..1ed70fc8a56
--- /dev/null
+++ b/Build/source/texk/texlive/linked_scripts/TeXcount.pl
@@ -0,0 +1,866 @@
+#! /usr/bin/env perl
+use strict;
+use warnings;
+use Term::ANSIColor;
+#--- --- ---#
+use POSIX qw(locale_h);
+use locale;
+setlocale(LC_CTYPE,"no_NO");
+
+my $versionnumber="2.0";
+my $versiondate="2008 Feb 10";
+
+#--- --- ---#
+
+### Macros for headers
+# Macros that identify headers: i.e. following token or
+# {...} is counted as header. The =>[2] indicates transition to
+# state 2 which is used within headers (although the value is
+# actually never used). This is copied to %TeXmacro and the
+# only role of defining it here is that the counter for the number
+# of headers is incremented by one.
+my %TeXheader=('\title'=>[2],'\part'=>[2],'\chapter'=>[2],
+ '\section'=>[2],'\subsection'=>[2],'\subsubsection'=>[2],
+ '\paragraph'=>[2],'\subparagraph'=>[2]);
+
+### How many tokens to gobble after macro
+# Each macro is assumed to gobble up a given number of
+# tokens (or {...} groups), as well as options [...] before, within
+# and after. The %TeXmacro hash gives a link from a macro
+# (or beginNAME for begin-end groups without the backslash)
+# to either an integer giving the number of tokens to ignore
+# or to an array (specified as [num,num,...]) of length N where
+# N is the number of tokens to be read with the macro and the
+# array values tell how each is to be interpreted (see the status
+# values: 0=ignore, 1=count, etc.). Thus specifying a number N is
+# equivalent to specifying an array [0,...,0] of N zeros.
+#
+# For macros not specified here, the default value is 0: i.e.
+# no tokens are excluded, but [...] options are. Header macros
+# specified in %TeXheader are automatically included here.
+my %TeXmacro=(%TeXheader,
+ '\documentclass'=>1,'\documentstyle'=>1,'\usepackage'=>1, '\hyphenation'=>1,
+ '\pagestyle'=>1,'\thispagestyle'=>1, '\pagenumbering'=>1,'\markboth'=>1, '\markright'=>1,
+ '\newcommand'=>[-3,-3],'\renewcommand'=>[-3,-3],
+ '\newenvironment'=>[-3,-3,-3], 'renewenvironment'=>[-3,-3,-3],
+ '\newfont'=>2,'\newtheorem'=>2,'\bibliographystyle'=>1, '\bibliography'=>1,
+ '\parbox'=>1, '\marginpar'=>[3],'\makebox'=>0, '\raisebox'=>1, '\framebox'=>0,
+ '\newsavebox'=>1, '\sbox'=>1, '\savebox'=>2, '\usebox'=>1,'\rule'=>2,
+ '\footnote'=>[3],'\label'=>1, '\ref'=>1, '\pageref'=>1, '\bibitem'=>1,
+ '\cite'=>1, '\citep'=>1, '\citet'=>1, '\citeauthor'=>1, '\citealt'=>1, '\nocite'=>1,
+ '\eqlabel'=>1, '\eqref'=>1,'\hspace'=>1, '\vspace'=>1, '\addvspace'=>1,
+ '\input'=>1, '\include'=>1, '\includeonly'=>1,'\includegraphics'=>1,
+ '\newlength'=>1, '\setlength'=>2, '\addtolength'=>2,'\settodepth'=>2,
+ '\settoheight'=>2, '\settowidth'=>2,'\newcounter'=>1, '\setcounter'=>2,
+ '\addtocounter'=>2,'\stepcounter'=>1, '\refstepcounter'=>1, '\usecounter'=>1,
+ '\alph'=>1, '\arabic'=>1, '\fnsymbol'=>1, '\roman'=>1, '\value'=>1,
+ '\cline'=>1, '\multicolumn'=>3,'\typeout'=>1, '\typein'=>1,
+ 'beginlist'=>2, 'beginminipage'=>1, 'begintabular'=>1,
+ 'beginthebibliography'=>1,'beginlrbox'=>1,
+ '\begin'=>1,'\end'=>1,'\title'=>[2]);
+
+### Macros that should be counted as one or more words
+# Macros that represent text may be declared here. The value gives
+# the number of words the macro represents.
+my %TeXmacroword=('\LaTeX'=>1,'\TeX'=>1);
+
+### Macros that are counted within the preamble
+# The preamble is the text between \documentclass and \begin{document}.
+# Text and macros in the preamble is ignored unless specified here. The
+# value is the status (1=text, 2=header, etc.) they should be interpreted as.
+# Note that only the first unit (token or {...} block) is counted.
+my %TeXpreamble=('\title'=>[2],
+ '\newcommand'=>[-3,-3],'\renewcommand'=>[-3,-3],
+ '\newenvironment'=>[-3,-3,-3], 'renewenvironment'=>[-3,-3,-3],
+ );
+
+### Begin-End groups
+# Identified as begin-end groups, and define =>state. The
+# states used corresponds to the elements of the count array, and
+# are:
+# 0: Not included
+# 1: Text, word included in text count
+# 2: Header, words included in header count
+# 3: Float caption, words included in float caption count
+# 6: Inline mathematics, words not counted
+# 7: Displayed mathematics, words not counted
+# -1: Float, not included, but looks for captions
+#
+# 4 and 5 are used to count number of headers and floats
+# and are not used as states.
+#
+# Groups that are not defined will be counted as the surrounding text.
+#
+# Note that some environments may only exist within math-mode, and
+# therefore need not be defined here: in fact, they should not as it
+# is not clear if they will be in inlined or displayed math.
+#
+my %TeXgroup=('document'=>1,'letter'=>1,'titlepage'=>0,
+ 'center'=>1,'flushleft'=>1,'flushright'=>1,
+ 'abstract'=>1,'quote'=>1,'quotation'=>1,'verse'=>1,'minipage'=>1,'verbatim'=>1,
+ 'description'=>1,'enumerate'=>1,'itemize'=>1,'list'=>1,
+ 'theorem'=>1,'lemma'=>1,'definition'=>1,'corollary'=>1,'example'=>1,
+ 'math'=>6,'displaymath'=>7,'equation'=>7,'eqnarray'=>7,
+ 'figure'=>-1,'float'=>-1,'picture'=>-1,'table'=>-1,
+ 'tabbing'=>0,'tabular'=>0,'thebibliography'=>0,'lrbox'=>0);
+
+### In floats: include only specific macros
+# Macros used to identify caption text within floats.
+my %TeXfloatinc=('\caption'=>[3]);
+
+### Macros for including tex files
+# Allows \macro{file} or \macro file. If the value is 1, the filetype .tex will
+# be added if file is without a filetype; if the value is 0, this will not be
+# done.
+my %TeXfileinclude=('\input'=>0,'\include'=>1);
+
+### Count labels
+# Labels used to describe the counts
+my @countlabel=('Files','Words in text','Words in headers',
+ 'Words in float captions','Number of headers','Number of floats',
+ 'Number of math inlines','Number of math displayed');
+
+# Styles
+my @STYLES=();
+my %STYLE;
+$STYLES[0]={'error'=>'bold red'};
+$STYLES[1]={%{$STYLES[0]},
+ 'word1'=>'blue','word2'=>'bold blue','word3'=>'blue',
+ 'grouping'=>'red','document'=>'red','mathgroup'=>'magenta',
+ 'state'=>'cyan underline'};
+$STYLES[2]={%{$STYLES[1]},
+ 'word0'=>'yellow','word-1'=>'yellow',
+ 'command'=>'green','exclgroup'=>'yellow','exclmath'=>'yellow',
+ 'ignore'=>'cyan'};
+$STYLES[3]={%{$STYLES[2]},
+ 'tc'=>'bold yellow','comment'=>'yellow','option'=>'yellow','fileinclude'=>'bold green'};
+$STYLES[4]={%{$STYLES[3]}};
+
+# Options and states
+my $verbose=0;
+my $showstates=0;
+my $htmlstyle=0;
+my $blankline=0;
+my $includeTeX=0;
+my $briefsum=0;
+
+#--- --- ---#
+
+## SHORT HELP AND INFO
+if (!defined @ARGV) {
+ print_version();
+ print_syntax();
+ print_reference();
+ exit;
+} elsif ($ARGV[0]=~/^(\-(h|\?|\-?help)|\/\?)$/) {
+ print_help();
+ exit;
+} elsif ($ARGV[0]=~/^\-?\-version$/) {
+ print_version();
+ exit;
+} elsif ($ARGV[0]=~/^\-?\-license$/) {
+ print_license();
+ exit;
+}
+
+# PROCESS ARGUMENTS AND FILES
+my $totalcount=new_count();
+my @toplevelfiles;
+my @filelist;
+foreach my $arg (@ARGV) {
+ if ($arg eq '-noinc') {$includeTeX=0; next;}
+ if ($arg eq '-inc') {$includeTeX=1; next;}
+ if ($arg eq '-brief') {$briefsum=1; next;}
+ if ($arg eq '-v0') {$verbose=0; next;}
+ if ($arg eq '-v1') {$verbose=1; next;}
+ if ($arg eq '-vv' || $arg eq '-v2') {$verbose=2; next;}
+ if ($arg eq '-vvv' || $arg eq '-v3' || $arg eq '-v') {$verbose=3; next;}
+ if ($arg eq '-vvvv' || $arg eq '-v4') {$verbose=3; $showstates=1; next;}
+ if ($arg =~ /^\-showstate/ ){$showstates=1; next;}
+ if ($arg =~ /^\-html/ ) {
+ $ENV{'ANSI_COLORS_DISABLED'} = 1;
+ $htmlstyle = $arg eq '-htmlcore' ? 1 : 2;
+ if ($htmlstyle>1) {html_head();}
+ next;
+ }
+ if ($arg=~/^\-(nocol|nc$)/) {
+ $ENV{'ANSI_COLORS_DISABLED'} = 1;
+ next;
+ }
+ if ($arg=~/^\-/) {
+ print 'Invalid opton '.$arg."\n";
+ print_syntax();
+ exit;
+ }
+ $arg=~s/\\/\//g;
+ push @toplevelfiles,$arg;
+}
+%STYLE=%{$STYLES[$verbose]};
+for my $file (<@toplevelfiles>) {
+ @filelist=($file);
+ foreach my $f (@filelist) {
+ my $tex=TeXfile($f);
+ my $fpath=$f;
+ $fpath=~s/^(.*[\\\/])[^\\\/]+/$1/;
+ if (!defined $tex) {
+ print "File not found or not readable: ".$f."\n";
+ } else {
+ parse($tex);
+ print "\n";
+ print_count($tex->{'count'},'FILE: '.$f);
+ print "\n";
+ add_count($totalcount,$tex->{'count'});
+ }
+ }
+}
+if (${$totalcount}[0]>1) {
+ print "\n";
+ formatprint('Total','h1');
+ print_count($totalcount,'SUM');
+}
+if ($htmlstyle>1) {
+ html_tail();
+}
+
+
+
+#########
+######### Subroutines
+#########
+
+sub TeXfile {
+ my $filename=shift @_;
+ my $file=read_file($filename) || return undef;
+ return TeXcode($file,$filename);
+}
+
+sub TeXcode {
+ my ($texcode,$filename)=@_;
+ my %TeX=();
+ $TeX{'filename'}=$filename;
+ if (!defined $filename) {
+ $TeX{'filepath'}='';
+ } elsif ($filename=~/^(.*[\\\/])[^\\\/]+$/) {
+ $TeX{'filepath'}=$1;
+ } else {
+ $TeX{'filepath'}='';
+ }
+ $TeX{'line'}=$texcode;
+ $TeX{'next'}=undef;
+ $TeX{'type'}=undef;
+ $TeX{'style'}=undef;
+ $TeX{'printstate'}=undef;
+ $TeX{'eof'}=0;
+ $TeX{'count'}=new_count();
+ $TeX{'count'}[0]++;
+ return \%TeX;
+}
+
+sub set_style {
+ my ($tex,$style)=@_;
+ if (!(($tex->{'style'}) && ($tex->{'style'} eq '-'))) {$tex->{'style'}=$style;}
+}
+
+sub flush_style {
+ my ($tex,$style)=@_;
+ set_style($tex,$style);
+ flush_next($tex);
+}
+
+sub line_return {
+ my $blank=shift @_;
+ if ($blank>$blankline) {
+ if ($htmlstyle) {print "<br>\n";} else {print "\n";}
+ $blankline++;
+ }
+}
+
+sub print_style {
+ my ($text,$style,$state)=@_;
+ (($verbose>=0) && (defined $text) && (defined $style)) || return;
+ my $colour;
+ ($colour=$STYLE{$style}) || return;
+ if (($colour) && !($colour eq '-')) {
+ if ($htmlstyle) {
+ print "<span class='".$style."'>".$text."</span>";
+ } else {
+ print Term::ANSIColor::colored($text,$colour);
+ }
+ if ($state) {
+ print_style($state,'state');
+ }
+ $blankline=-1;
+ }
+}
+
+sub print_error {
+ my $text=shift @_;
+ line_return(1);
+ print_style("### ".$text." ###",'error');
+ line_return(1);
+}
+
+sub formatprint {
+ my ($text,$tag,$class)=@_;
+ my $break=($text=~s/\n$//);
+ if ($htmlstyle && defined $tag) {
+ print '<'.$tag;
+ if ($class) {print " class='".$class."'";}
+ print '>'.$text.'</'.$tag.'>';
+ } else {
+ print $text;
+ }
+ if ($break) {print "\n";}
+}
+
+sub read_file {
+ my $filename=shift @_;
+ open(FH,"<".$filename."") || return undef;
+ if ($verbose) {
+ #line_return(1);
+ formatprint("File: ".$filename."\n",'h2');
+ $blankline=0;
+ }
+ my @text=();
+ while (my $line=<FH>) {
+ push @text,$line;
+ }
+ close(FH);
+ return join('',@text);
+}
+
+sub next_token {
+ my $tex=shift @_;
+ my ($next,$type);
+ if (defined $tex->{'next'}) {print_style($tex->{'next'}.' ',$tex->{'style'});}
+ $tex->{'style'}=undef;
+ while (defined ($next=get_next_token($tex))) {
+ $type=$tex->{'type'};
+ if ($type==0) {
+ print_style($next,'comment');
+ } elsif ($type==9) {
+ if ($verbose) {line_return(1);}
+ } else {
+ return $next;
+ }
+ }
+ return $next;
+}
+
+sub flush_next {
+ my $tex=shift @_;
+ if (defined $tex->{'next'}) {
+ print_style($tex->{'next'}.' ',$tex->{'style'},$tex->{'printstate'});
+ }
+ $tex->{'printstate'}=undef;
+ $tex->{'style'}='-';
+}
+
+sub get_next_token {
+ # Token (or token group) category:
+ # 0: comment
+ # 1: word (or other forms of text or text components)
+ # 2: symbol (not word, e.g. punctuation)
+ # 3: macro
+ # 4: curly braces {}
+ # 5: brackets []
+ # 6: maths
+ # 999: end of line or blank line
+ # 666: TeXcount instruction (%TC:instruction)
+ my $tex=shift @_;
+ my $next;
+ (defined ($next=get_token($tex,'\%+TC:[^\n]*',666))) && return $next;
+ (defined ($next=get_token($tex,'\%[^\n]*',0))) && return $next;
+ (defined ($next=get_token($tex,'\n',9))) && return $next;
+ (defined ($next=get_token($tex,'\\\\[\{\}]',2))) && return $next;
+ (defined ($next=get_token($tex,'(\w+\.)+\w+\.?',1))) && return $next;
+ (defined ($next=get_token($tex,'\w+([\-\']\w+)*',1))) && return $next;
+ (defined ($next=get_token($tex,'[\"\'\`:\.,\(\)\[\]!\+\-\*=/\^\_\@\<\>\~\#\&]',2))) && return $next;
+ (defined ($next=get_token($tex,'\\\\([a-zA-Z_]+|[^a-zA-Z_])',3))) && return $next;
+ (defined ($next=get_token($tex,'[\{\}]',4))) && return $next;
+ (defined ($next=get_token($tex,'[\[\]]',5))) && return $next;
+ (defined ($next=get_token($tex,'\$\$',6))) && return $next;
+ (defined ($next=get_token($tex,'\$',6))) && return $next;
+ (defined ($next=get_token($tex,'.',999))) && return $next;
+ (defined ($next=get_token($tex,'[^\s]+',999))) && return $next;
+ $tex->{'eof'}=1;
+ return undef;
+}
+
+sub get_token {
+ my ($tex,$regexp,$type)=@_;
+ if (!defined $regexp) {print_error("ERROR in get_token: undefined regex.");}
+ if (!defined $tex->{'line'}) {print_error("ERROR in get_token: undefined tex-line. ".$tex->{'next'});}
+ if ( $tex->{'line'} =~ s/^($regexp)[ \t\r\f]*// ) {
+ $tex->{'next'}=$1;
+ $tex->{'type'}=$type;
+ return $1;
+ }
+ return undef;
+}
+
+sub new_count {
+ my @count=(0,0,0,0,0,0,0,0);
+ # files, text words, header words, float words,
+ # headers, floats, math-inline, math-display;
+ return \@count;
+}
+
+sub count_word {
+ my ($count,$type,$word,$style,$verb)=@_;
+ ($word) || ($word="");
+ ($style) || ($style=0);
+ ($verb) || ($verb=0);
+ if ($type>0) {${$count}[$type]++;}
+ if ($verb >= $verbose) {
+ }
+}
+
+sub print_count {
+ my ($count,$header)=@_;
+ if ($briefsum) {
+ if ($htmlstyle) {print "<p class='count'>\n";}
+ print ${$count}[1]."+".${$count}[2]."+".${$count}[3].
+ " (".${$count}[4]."/".${$count}[5]."/".${$count}[6]."/".${$count}[7].") ".
+ $header;
+ if ($htmlstyle) {print "</p>\n";}
+ return;
+ }
+ if ($htmlstyle) {print "<dl class='count'>\n";}
+ if (defined $header) {
+ formatprint($header."\n",'dt','header');
+ }
+ for (my $i=1;$i<8;$i++) {
+ formatprint($countlabel[$i].': ','dt');
+ formatprint(${$count}[$i]."\n",'dd');
+ }
+ if ($htmlstyle) {print "</dl>\n";}
+}
+
+sub add_count {
+ my ($a,$b)=@_;
+ for (my $i=0;$i<8;$i++) {
+ ${$a}[$i]+=${$b}[$i];
+ }
+}
+
+sub parse {
+ my ($tex)=@_;
+ if ($htmlstyle && $verbose) {print "<p class=parse>\n";}
+ while (!($tex->{'eof'})) {
+ parse_unit($tex,1);
+ }
+ if ($htmlstyle && $verbose) {print "</p>\n";}
+}
+
+sub parse_unit {
+ # Status:
+ # 0 = exclude from count
+ # 1 = text
+ # 2 = header text
+ # 3 = float text
+ # -1 = float (exclude)
+ # -2 = strong exclude, ignore begin-end groups
+ # -3 = stronger exclude, do not parse macro parameters
+ # -9 = preamble (between \documentclass and \begin{document})
+ my ($tex,$status,$end)=@_;
+ if (!defined $status) {
+ print_error("CRITICAL ERROR: Undefined parser status!");
+ exit;
+ } elsif (ref($status) eq 'ARRAY') {
+ print_error("CRITICAL ERROR: Invalid parser status!");
+ exit;
+ }
+ my $count=$tex->{'count'};
+ my $substat;
+ if ($showstates) {
+ if (defined $end) {
+ $tex->{'printstate'}=':'.$status.':'.$end.':';
+ } else {
+ $tex->{'printstate'}=':'.$status.':';
+ }
+ flush_next($tex);
+ }
+ while (defined (my $next=next_token($tex))) {
+ # parse next token; or tokens until match with $end
+ set_style($tex,"ignore");
+ if ((defined $end) && ($end eq $next)) {
+ # end of unit
+ return;
+ } elsif (!defined $next) {
+ print_error("ERROR: End of file while waiting for ".$end);
+ return;
+ }
+ if ($status==-9 && $next eq '\begin' && $tex->{'line'}=~/^\{\s*document\s*\}/) {
+ # \begin{document}
+ $status=1;
+ }
+ if ($next eq '\documentclass') {
+ # starts preamble
+ set_style($tex,'document');
+ gobble_option($tex);
+ gobble_macro_parms($tex,1);
+ while (!($tex->{'eof'})) {
+ parse_unit($tex,-9);
+ }
+ } elsif ($tex->{'type'}==666) {
+ # parse TC instructions
+ parse_tc($tex);
+ } elsif ($tex->{'type'}==1) {
+ # word
+ if ($status>0) {
+ ${$count}[$status]++;
+ set_style($tex,'word'.$status);
+ }
+ } elsif ($next eq '{') {
+ # {...}
+ parse_unit($tex,$status,'}');
+ } elsif ($tex->{'type'}==3 && $status==-3) {
+ set_style($tex,'ignore');
+ } elsif ($tex->{'type'}==3) {
+ # macro call
+ set_style($tex,'command');
+ if ($next eq '\begin' && $status!=-2) {
+ parse_begin_end($tex,$count,$status);
+ } elsif (($status==-1) && ($substat=$TeXfloatinc{$next})) {
+ # text included from float
+ gobble_macro_parms($tex,$substat);
+ } elsif ($status==-9 && defined ($substat=$TeXpreamble{$next})) {
+ # parse preamble include macros
+ if (defined $TeXheader{$next}) {${$count}[4]++;}
+ gobble_macro_parms($tex,$substat,1);
+ } elsif ($status<0) {
+ # ignore
+ gobble_option($tex);
+ } elsif ($next eq '\(') {
+ # math inline
+ parse_math($tex,$count,$status,6,'\)');
+ } elsif ($next eq '\[') {
+ # math display
+ parse_math($tex,$count,$status,7,'\]');
+ } elsif ($next eq '\def') {
+ # ignore \def...
+ $tex->{'line'} =~ s/^([^\{]*)\{/\{/;
+ flush_next($tex);
+ print_style($1.' ','ignore');
+ parse_unit($tex,-2);
+ } elsif (defined (my $addsuffix=$TeXfileinclude{$next})) {
+ # include file: queue up for parsing
+ parse_include_file($tex,$count,$status,$addsuffix);
+ } elsif (defined ($substat=$TeXmacro{$next})) {
+ # macro: exclude options
+ if (defined $TeXheader{$next}) {${$count}[4]++;}
+ gobble_macro_parms($tex,$substat,$status);
+ } elsif (defined ($substat=$TeXmacroword{$next})) {
+ # count macro as word (or a given number of words)
+ ${$count}[$status]+=$substat;
+ set_style($tex,'word'.$status);
+ } elsif ($next =~ /^\\[^\w\_]/) {
+ } else {
+ gobble_option($tex);
+ }
+ } elsif ($next eq '$') {
+ # math inline
+ parse_math($tex,$count,$status,6,'$');
+ } elsif ($next eq '$$') {
+ # math display (unless already in inlined math)
+ if (! $end eq '$') {parse_math($tex,$count,$status,7,'$$');}
+ }
+ if (!defined $end) {return;}
+ }
+}
+
+sub gobble_option {
+ my $tex=shift @_;
+ flush_next($tex);
+ if ($tex->{'line'} =~ s/^(\[(\w|[,\-\s\~\.\:\;\+\?\*\_\=])*\])//) {
+ print_style($1,'option');
+ return $1;
+ }
+ return undef;
+}
+
+sub parse_tc {
+ my ($tex)=@_;
+ set_style($tex,'tc');
+ if ($tex->{'next'}=~/^\%+TC:\s*(\w+)\s+([\\]*\w+)\s+([^\s\n]+)(\s+([0-9]+))?/) {
+ my $instr=$1;
+ my $macro=$2;
+ my $param=$3;
+ my $option=$5;
+ if ($param=~/^\[([0-9,]+)\]$/) {$param=[split(',',$1)];}
+ if (($instr eq 'macro') || ($instr eq 'exclude')) {$TeXmacro{$macro}=$param;}
+ elsif ($instr eq 'header') {$TeXheader{$macro}=$param;$TeXmacro{$macro}=$param;}
+ elsif ($instr eq 'macroword') {$TeXmacroword{$macro}=$param;}
+ elsif ($instr eq 'preambleinclude') {$TeXpreamble{$macro}=$param;}
+ elsif ($instr eq 'group') {$TeXmacro{'begin'.$macro}=$param;$TeXgroup{$macro}=$option;}
+ elsif ($instr eq 'floatinclude') {$TeXfloatinc{$macro}=$param;}
+ elsif ($instr eq 'fileinclude') {$TeXfileinclude{$macro}=$param;}
+ else {print_error("Warning: Unknown TC command: ".$instr);}
+ } elsif ($tex->{'next'}=~/^\%+TC:\s*(\w+)/) {
+ my $instr=$1;
+ print_error("Warning: Unknown TC command: ".$instr);
+ }
+}
+
+sub parse_math {
+ my ($tex,$count,$status,$substat,$end)=@_;
+ my $localstyle=$status>0 ? 'mathgroup' : 'exclmath';
+ if ($status>0) {${$count}[$substat]++;}
+ set_style($tex,$localstyle);
+ parse_unit($tex,0,$end);
+ set_style($tex,$localstyle);
+}
+
+sub parse_begin_end {
+ my ($tex,$count,$status)=@_;
+ my $localstyle=$status>0 ? 'grouping' : 'exclgroup';
+ flush_style($tex,$localstyle);
+ gobble_option($tex);
+ my $groupname;
+ if ($tex->{'line'} =~ s/^\{\s*([^\{\}]+)\s*\*?\}[ \t\r\f]*//) {
+ # gobble group type
+ $groupname=$1;
+ print_style('{'.$1.'}',$localstyle);
+ my $next='begin'.$1;
+ if (defined (my $substat=$TeXmacro{$next})) {
+ gobble_macro_parms($tex,$substat);
+ }
+ } else {
+ print_error("Warning: BEGIN group without type.");
+ }
+ # find group status (or leave unchanged)
+ my $substat;
+ defined ($substat=$TeXgroup{$1}) || ($substat=$status);
+ if ($status<=0 && $status<$substat) {$substat=$status;}
+ if (($status>0) && ($substat==-1)) {
+ # Count float
+ ${$count}[5]++;
+ }
+ if ($status>0 and $substat>3) {
+ # count item, exclude contents
+ ${$count}[$substat]++;
+ $substat=0;
+ }
+ parse_unit($tex,$substat,'\end');
+ if ($tex->{'line'} =~ s/^\{\s*([^\{\}]+)\s*\}[ \t\r\f]*//) {
+ # gobble group type
+ flush_style($tex,$localstyle);
+ print_style('{'.$1.'}',$localstyle);
+ } else {
+ print_error("Warning: END group without type while waiting to end ".$groupname.".");
+ }
+}
+
+sub parse_include_file {
+ my ($tex,$count,$status,$addsuffix)=@_;
+ $tex->{'line'} =~ s/^\{([^\{\}\s]+)\}// ||
+ $tex->{'line'} =~ s/^\s*([^\{\}\%\\\s]+)// ||
+ return;
+ flush_next($tex);
+ if ($status>0) {
+ print_style($&,'fileinclude');
+ my $fname=$1;
+ if ($addsuffix && ($fname=~/^[^\.]+$/)) {$fname.='.tex';}
+ if ($includeTeX) {push @filelist,$tex->{'filepath'}.$fname;}
+ } else {
+ print_style($&,'ignored');
+ }
+}
+
+sub gobble_options {
+ while (gobble_option(@_)) {}
+}
+
+sub gobble_macro_modifier {
+ my $tex=shift @_;
+ flush_next($tex);
+ if ($tex->{'line'} =~ s/^\*//) {
+ print_style($1,'option');
+ return $1;
+ }
+ return undef;
+}
+
+sub gobble_macro_parms {
+ my ($tex,$parm,$oldstat)=@_;
+ my $i;
+ if (ref($parm) eq 'ARRAY') {
+ $i=scalar @{$parm};
+ } else {
+ $i=$parm;
+ $parm=[0,0,0,0,0,0,0,0,0];
+ }
+ if ($i>0) {gobble_macro_modifier($tex);}
+ gobble_options($tex);
+ for (my $j=0;$j<$i;$j++) {
+ parse_unit($tex,new_status($parm->[$j],$oldstat));
+ gobble_options($tex);
+ }
+}
+
+sub new_status {
+ my ($substat,$old)=@_;
+ if (!defined $old) {return $substat;}
+ if ($old==-3 || $substat==-3) {return -3;}
+ if ($old==-2 || $substat==-2) {return -2;}
+ if ($old==0 || $substat==0) {return 0;}
+ if ($old==-9 || $substat==-9) {return -9;}
+ if ($old>$substat) {return $old;}
+ return $substat;
+}
+
+### HTML context
+
+sub html_head {
+ print '
+<html>
+<head>
+<style>
+<!--
+body {width:100%;padding:5;margin:5 10 5 5;}
+.error {font-weight:bold;color:#f00;font-style:italic;}
+.parse {font-size: 80%; background: #eef;}
+.word1,.word2,.word3 {color: #009;}
+.word2 {font-weight: 700;}
+.word3 {font-style: italic;}
+.word-1 {color: #66c;}
+.command {color: #c00;}
+.option {color: #cc0;}
+.grouping, .document {color: #900; font-weight:bold;}
+.mathgroup {color: #090;}
+.exclmath {color: #6c6;}
+.ignore {color: #999;}
+.exclgroup {color:#c66;}
+.tc {color: #999; font-weight:bold;}
+.comment {color: #999; font-style: italic;}
+.state {color: #990; font-size: 70%;}
+.fileinclude {color: #696; font-weight:bold;}
+dl.count {background: #cfc; color: 009;}
+dl.count dt.header {font-weight: 700; font-style: italic; float: none;}
+dl.count dt {clear: both; float: left;}
+dl.count dd {font-weight: 700;}
+.warning {color: #c00; font-weight: 700;}
+.parse, .count {border: solid 1px #999; margin: 0pt; padding: 4pt;}
+.parse {border-bottom:none;}
+-->
+</style>
+</head>
+<body>
+<h1>LaTeX word count</h1>
+';
+}
+
+sub html_tail {
+ print '</body></html>';
+}
+
+
+### HELP AND INFO
+
+sub print_version {
+ print "TeXcount version ".$versionnumber.", ".$versiondate.'.';
+}
+
+sub print_syntax {
+ print '
+Syntax: TeXcount.pl [options] files
+
+Options:
+ -v Verbose (same as -v3)
+ -v0 Do not present parsing details
+ -v1 Verbose: print parsed words, mark formulae
+ -v2 More verbose: also print ignored text
+ -v3 Even more verbose: include comments and options
+ -showstate Show internal states (with verbose)
+ -brief Only prints a brief, one line summary of counts
+ -nc, -nocol No colours (colours require ANSI)
+ -inc Include tex files included in the document
+ -noinc Do not include included tex files (default)
+ -html Output in HTML format
+ -htmlcore Only HTML body contents
+ -h, -?, --help, /? Help
+ --version Print version number
+ --license License information
+';
+}
+
+sub print_help {
+ print '
+***************************************************************
+* TeXcount.pl '.$versionnumber.', '.$versiondate.'
+*
+
+Count words in TeX and LaTeX files, ignoring macros, tables,
+formulae, etc.
+';
+ print_syntax();
+ print '
+The script counts words as either words in the text, words in
+headers/titles or words in floats (figure/table captions).
+Macro options (i.e. \marco[...]) are ignored; macro parameters
+(i.e. \macro{...}) are counted or ignored depending on the
+macro, but by default counted. Begin-end groups are by default
+ignored and treated as \'floats\', though some (e.g. center) are
+counted.
+
+Unless -nocol (or -nc) has been specified, the output will be
+colour coded. Counted text is coloured blue with headers are in
+bold and in HTML output caption text is italicised.
+
+Mathematical formulae are not counted as words, but are instead
+counted separately with separate counts for inlined formulae
+and displayed formulae. Similarly, the number of headers and
+the number of \'floats\' are counted. Note that \'float\' is used
+here to describe anything defined in a begin-end group unless
+explicitly recognized as text or mathematics.
+
+The verbose options (-v1, -v2, -v3, showstate) produces output
+indicating how the text has been interpreted. Check this to
+ensure that words in the text has been interpreted as such,
+whereas mathematical formulae and text/non-text in begin-end
+groups have been correctly interpreted.
+
+Unix hint: Use \'less -r\' instead of just \'less\' to view output:
+the \'-r\' option makes less treat text formating codes properly.
+
+Windows hint: If your Windows interprets ANSI colour codes, lucky
+you! Otherwise, use the -nocol (or -nc) option with the verbose
+options or the output will be riddled with colour codes. Instead,
+you can use -html to produce HTML code, write this to file and
+view with your favourite browser.
+';
+ print_reference();
+}
+
+sub print_reference {
+ print '
+The TeXcount script is copyright of Einar Andreas Rødland (2008)
+and published under the LaTeX Project Public License.
+
+For more information about the script, e.g. news, updates, help,
+usage tips, known issues and short-comings, go to
+ http://folk.uio.no/einarro/Comp/texwordcount.html
+or go to
+ http://folk.uio.no/einarro/Services/texcount.html
+to access the script as a web service. Feedback such as problems
+or errors can be reported to einarro@ifi.uio.no.
+';
+}
+
+sub print_license {
+ print 'TeXcount version '.$versionnumber.'
+
+Copyright 2008 Einar Andreas Rødland
+
+The TeXcount script is published under the LaTeX Project Public
+License (LPPL)
+ http://www.latex-project.org/lppl.txt
+which grants you, the user, the right to use, modify and distribute
+the script. However, if the script is modified, you must change its
+name or use other technical means to avoid confusion.
+
+The script has LPPL status "maintained" with Einar Andreas
+Rødland being the current maintainer.
+';
+}
diff --git a/Build/source/texk/texlive/linked_scripts/a2ping.pl b/Build/source/texk/texlive/linked_scripts/a2ping.pl
new file mode 100755
index 00000000000..39331beb795
--- /dev/null
+++ b/Build/source/texk/texlive/linked_scripts/a2ping.pl
@@ -0,0 +1,2572 @@
+#! /bin/sh
+eval '(exit $?0)' && eval 'PERL_BADLANG=x;export PERL_BADLANG;: \
+;exec perl -x -S -- "$0" ${1+"$@"};#'if 0;
+eval 'setenv PERL_BADLANG x;exec perl -x -S -- "$0" $argv:q;#'.q+
+#!perl -w
+package Htex::a2ping; $0=~/(.*)/s;unshift@INC,'.';do($1);die$@if$@;__END__+if !1;
+# This Perl script was generated by JustLib2 at Wed Apr 23 09:14:13 2003.
+# Don't touch/remove any lines above; http://www.inf.bme.hu/~pts/justlib
+#
+# This program is free software, licensed under the GNU GPL, >=2.0.
+# This software comes with absolutely NO WARRANTY. Use at your own risk!
+#
+# !! Imp: merge back to a2ping.pa
+# !! Ghostcript compute pipe too slow
+# $ a2ping.pl -v debrecen-hyph.ps de brecen-hyph.pdf
+# a2ping.pl 2.77p, 2004-04-28 -- Written by <pts@fazekas.hu> from April 2003.
+# This is free software, GNU GPL >=2.0. There is NO WARRANTY.
+# (epstopdf 2.7 Copyright 1998-2001 by Sebastian Rahtz et al.)
+# * Strongest BoundingBox comment: %%HiResBoundingBox:
+# * Doing --PaperSize unchanged
+# * Output filename: debrecen-hyph.pdf
+# * Output FileFormat: PDF
+# * Ghostscript ps2pdf command: gs -dSAFER
+# * Compression: zip
+# * Input filename: debrecen-hyph.ps
+# * Computing BBox info from non-EPS PS file
+# * Ghostscript compute pipe: gs -dSAFER -dWRITESYSTEMDICT -dNOPAUSE -sDEVICE=bbox -sFN=debrecen-hyph.ps /tmp/a2ping_pl-16977-298938572-c.tgs 2>&1
+# * Applying BoundingBox from Compute-GS T-: 71 81 539 769
+# * Applying HiResBoundingBox from Compute-GS T-H: 71.837998 81.971997 538.235984 768.113977
+# * Scanning header for BoundingBox
+# * Applying BoundingBox from ADSC T-: 0 0 596 842
+# * Final BoundingBox: 0 0 596 842
+# * Ghostscript ps2pdf pipe: gs -dSAFER -q -dBATCH -sDEVICE=pdfwrite -sOutputFile =debrecen-hyph.pdf -
+# * Done OK, created PDF file debrecen-hyph.pdf (338451 bytes)
+#
+package just; BEGIN{$INC{'just.pm'}='just.pm'}
+BEGIN{ $just::VERSION=2 }
+sub end(){1}
+sub main(){}
+
+BEGIN{$ INC{'strict.pm'}='strict.pm'} {
+package strict;
+use just;
+# by pts@fazekas.hu at Wed Jan 10 12:42:08 CET 2001
+require 5.002;
+sub bits {
+ (grep{'refs'eq$_}@_ && 2)|
+ (grep{'subs'eq$_}@_ && 0x200)|
+ (grep{'vars'eq$_}@_ && 0x400)|
+ ($@ || 0x602)
+}
+sub import { shift; $^H |= bits @_ }
+sub unimport { shift; $^H &= ~ bits @_ }
+just::end}
+
+BEGIN{$ INC{'integer.pm'}='integer.pm'} {
+package integer;
+use just;
+# by pts@fazekas.hu at Wed Jan 10 12:42:08 CET 2001
+sub import { $^H |= 1 }
+sub unimport { $^H &= ~1 }
+just::end}
+
+BEGIN{$ INC{'Pts/string.pm'}='Pts/string.pm'} {
+package Pts::string;
+# by pts@fazekas.hu at Sat Dec 21 21:32:18 CET 2002
+use just;
+use integer;
+use strict;
+
+#** @param $_[0] a string
+#** @param $_[1] index of first bit to return. Bit 128 of byte 0 is index 0.
+#** @param $_[2] number of bits to return (<=32)
+#** @return an integer (negative on overflow), bit at $_[1] is its MSB
+sub get_bits_msb($$$) {
+ # assume: use integer;
+ my $loop=$_[1];
+ my $count=$_[2];
+ my $ret=0;
+ ($ret+=$ret+(1&(vec($_[0],$loop>>3,8)>>(7-($loop&7)))), $loop++) while $count--!=0;
+ $ret
+}
+
+#** @param $_[0] a string
+#** @return value if $_[0] represents a floating point numeric constant
+#** in the C language (without the LU etc. modifiers) -- or undef. Returns
+#** undef for integer constants
+sub c_floatval($) {
+ my $S=$_[0];
+ no integer; # very important; has local scope
+ return 0.0+$S if $S=~/\A[+-]?(?:[0-9]*\.[0-9]+|[0-9]+\.])(?:[eE][+-]?[0-9]+)?\Z(?!\n)/;
+ undef
+}
+
+#** @param $_[0] a string
+#** @return value if $_[0] represents a floating point or integer numeric
+#** constant in the C language (without the LU etc. modifiers) -- or undef
+sub c_numval($) {
+ my $S=$_[0];
+ no integer; # very important; has local scope
+ return 0+$S if $S=~/\A[+-]?(?:[0-9]*\.[0-9]+(?:[eE][+-]?[0-9]+)?|[0-9]+\.?)\Z(?!\n)/;
+ undef
+}
+
+#** @param $_[0] a string
+#** @return the integer value of $_[0] in C -- or undef
+sub c_intval($) {
+ my $S=$_[0];
+ my $neg=1;
+ $neg=-1 if $S=~s@\A([+-])@@ and '-'eq$1;
+ return $neg*hex $1 if $S=~/\A0[xX]([0-9a-fA-F]+)\Z(?!\n)/;
+ return $neg*oct $1 if $S=~/\A0([0-7]+)\Z(?!\n)/;
+ return $neg*$1 if $S=~/\A([0-9]+)\Z(?!\n)/;
+ undef
+}
+
+sub import {
+ no strict 'refs';
+ my $package = (caller())[0];
+ shift; # my package
+ for my $p (@_ ? @_ : qw{get_bits_msb c_floatval c_numval c_intval}) { *{$package."::$p"}=\&{$p} }
+}
+
+just::end}
+
+BEGIN{$ INC{'Htex/dimen.pm'}='Htex/dimen.pm'} {
+package Htex::dimen;
+# by pts@fazekas.hu at Sat Dec 21 21:26:15 CET 2002
+use just;
+use integer;
+use strict;
+use Pts::string qw(c_numval);
+
+my %bp_mul;
+{ no integer; %bp_mul=(
+ 'bp'=>1, # 1 bp = 1 bp (big point)
+ 'in'=>72, # 1 in = 72 bp (inch)
+ 'pt'=>72/72.27, # 1 pt = 72/72.27 bp (point)
+ 'pc'=>12*72/72.27, # 1 pc = 12*72/72.27 bp (pica)
+ 'dd'=>1238/1157*72/72.27, # 1 dd = 1238/1157*72/72.27 bp (didot point) [about 1.06601110141206 bp]
+ 'cc'=>12*1238/1157*72/72.27, # 1 cc = 12*1238/1157*72/72.27 bp (cicero)
+ 'sp'=>72/72.27/65536, # 1 sp = 72/72.27/65536 bp (scaled point)
+ 'cm'=>72/2.54, # 1 cm = 72/2.54 bp (centimeter)
+ 'mm'=>7.2/2.54, # 1 mm = 7.2/2.54 bp (millimeter)
+) }
+
+#** @param $_[0] a (real or integer) number, optionally postfixed by a
+#** TeX dimension specifier (default=bp)
+#** @return the number in bp, or undef
+sub dimen2bp($) {
+ no integer;
+ my $S=$_[0];
+ my $mul;
+ $mul=$bp_mul{$1} if $S=~s/\s*([a-z][a-z0-9]+)\Z(?!\n)// and exists $bp_mul{$1};
+ my $val=c_numval($S);
+ $val*=$mul if defined $val and defined $mul;
+ $val
+}
+
+just::end}
+
+BEGIN{$ INC{'Htex/papers.pm'}='Htex/papers.pm'} {
+package Htex::papers;
+# contains paper size information
+# by pts@fazekas.hu at Sun Dec 22 00:30:58 CET 2002
+use just;
+use integer;
+use strict;
+use Htex::dimen;
+
+my @papers=(
+#
+# paper.txt
+# by pts@fazekas.hu at Tue Jan 16 18:21:59 CET 2001
+# by pts@fazekas.hu at Tue Jan 16 19:13:16 CET 2001
+#
+# Examined: dvips, gs, libpaperg
+#
+# all units are measured in Big Points (bp)
+# 72 bp == 1 in
+# 2.54 cm == 1 in
+#
+# papername width height
+qw{Comm10 297 684},
+qw{Monarch 279 540},
+qw{halfexecutive 378 522},
+
+qw{Legal 612 1008},
+qw{Statement 396 612},
+qw{Tabloid 792 1224},
+qw{Ledger 1224 792},
+qw{Folio 612 936},
+qw{Quarto 610 780},
+qw{7x9 504 648},
+qw{9x11 648 792},
+qw{9x12 648 864},
+qw{10x13 720 936},
+qw{10x14 720 1008},
+qw{Executive 540 720},
+
+qw{ISOB0 2835 4008},
+qw{ISOB1 2004 2835},
+qw{ISOB2 1417 2004},
+qw{ISOB3 1001 1417},
+qw{ISOB4 709 1001},
+qw{ISOB5 499 709},
+qw{ISOB6 354 499},
+qw{ISOB7 249 354},
+qw{ISOB8 176 249},
+qw{ISOB9 125 176},
+qw{ISOB10 88 125},
+qw{jisb0 2916 4128},
+qw{jisb1 2064 2916},
+qw{jisb2 1458 2064},
+qw{jisb3 1032 1458},
+qw{jisb4 729 1032},
+qw{jisb5 516 729},
+qw{jisb6 363 516},
+
+qw{C7 230 323},
+qw{DL 312 624},
+
+qw{a3 842 1190}, # defined by Adobe
+qw{a4 595 842}, # defined by Adobe; must precede a4small
+
+# a4small should be a4 with an ImagingBBox of [25 25 570 817].},
+qw{a4small 595 842},
+qw{letter 612 792}, # must precede lettersmall
+# lettersmall should be letter with an ImagingBBox of [25 25 587 767].
+qw{lettersmall 612 792},
+# note should be letter (or some other size) with the ImagingBBox
+# shrunk by 25 units on all 4 sides.
+qw{note 612 792},
+qw{letterLand 792 612},
+# End of Adobe-defined page sizes
+
+qw{a0 2380 3368},
+qw{a1 1684 2380},
+qw{a2 1190 1684},
+qw{a5 421 595},
+qw{a6 297 421},
+qw{a7 210 297},
+qw{a8 148 210},
+qw{a9 105 148},
+qw{a10 74 105},
+qw{b0 2836 4008},
+qw{b1 2004 2836},
+qw{b2 1418 2004},
+qw{b3 1002 1418},
+qw{b4 709 1002},
+qw{b5 501 709}, # defined by Adobe
+
+qw{a0Land 3368 2380},
+qw{a1Land 2380 1684},
+qw{a2Land 1684 1190},
+qw{a3Land 1190 842},
+qw{a4Land 842 595},
+qw{a5Land 595 421},
+qw{a6Land 421 297},
+qw{a7Land 297 210},
+qw{a8Land 210 148},
+qw{a9Land 148 105},
+qw{a10Land 105 74},
+qw{b0Land 4008 2836},
+qw{b1Land 2836 2004},
+qw{b2Land 2004 1418},
+qw{b3Land 1418 1002},
+qw{b4Land 1002 709},
+qw{b5Land 709 501},
+
+qw{c0 2600 3677},
+qw{c1 1837 2600},
+qw{c2 1298 1837},
+qw{c3 918 1298},
+qw{c4 649 918},
+qw{c5 459 649},
+qw{c6 323 459},
+
+# vvv U.S. CAD standard paper sizes
+qw{archE 2592 3456},
+qw{archD 1728 2592},
+qw{archC 1296 1728},
+qw{archB 864 1296},
+qw{archA 648 864},
+
+qw{flsa 612 936}, # U.S. foolscap
+qw{flse 612 936}, # European foolscap
+qw{halfletter 396 612},
+qw{csheet 1224 1584}, # ANSI C 17x22
+qw{dsheet 1584 2448}, # ANSI D 22x34
+qw{esheet 2448 3168}, # ANSI E 34x44
+qw{17x22 1224 1584}, # ANSI C 17x22
+qw{22x34 1584 2448}, # ANSI D 22x34
+qw{34x44 2448 3168}, # ANSI E 34x44
+);
+
+#** Converts a numeric paper size to a well-defined paper name. Tolerance is
+#** 8.5bp
+#** @param $_[0] width, in bp
+#** @param $_[1] height, in bp
+#** @return () or ("papername", ret.paper.width.bp, ret.paper.height.bp)
+sub valid_bp($$;$$) {
+ no integer;
+ my ($W1,$H1)=(defined$_[2]?$_[2]:0,defined$_[3]?$_[3]:0);
+ my ($WW,$HH)=(Htex::dimen::dimen2bp($_[0])-$W1, Htex::dimen::dimen2bp($_[1])-$H1);
+ # Dat: 1mm == 720/254bp; 3mm =~ 8.5bp
+ no integer;
+ for (my $I=0; $I<@papers; $I+=3) {
+ return @papers[$I,$I+1,$I+2] if abs($papers[$I+1]-$WW)<=8.5 and abs($papers[$I+2]-$HH)<=8.5;
+ }
+ ()
+}
+
+#** @param $_[0] (width width_unit "," height height_unit)
+#** @return () or ("papername", width.bp, height.bp)
+sub valid($) { # valid_papersize
+ my $S=lc$_[0];
+ $S=~/^\s*(\d+(\.\d+)?)\s*([a-z][a-z0-9]+)\s*,\s*(\d+(\.\d+)?)\s*([a-z][a-z0-9]+)\s*\Z(?!\n)/ ?
+ valid_bp("$1$3","$4$6") : ();
+}
+
+#** @param $_[0] (width width_unit? ("," || "x") height height_unit?) || (papername)
+#** @return () or ("papername"?, width.bp, height.bp)
+sub any($) {
+ my $S=lc$_[0];
+ if ($S=~/\A[a-z]\w+\Z(?!\n)/) {
+ for (my $I=0; $I<@papers; $I+=3) {
+ return @papers[$I,$I+1,$I+2] if lc($papers[$I]) eq $S;
+ }
+ }
+ return () if $S!~/^\s*(\d+(\.\d+)?)\s*((?:[a-z][a-z0-9]+)?)\s*[,xX]\s*(\d+(\.\d+)?)\s*((?:[a-z][a-z0-9]+)?)\s*\Z(?!\n)/;
+ # ^^^ Dat: [xX] is xdvi-style, [,] is dvips-style spec
+ my($w,$h)=($1.$3, $4.$6);
+ my @L=valid_bp($w,$h);
+ @L ? @L : (undef,Htex::dimen::dimen2bp($w),Htex::dimen::dimen2bp($h))
+}
+
+just::end}
+
+BEGIN{$ INC{'Htex/a2ping.pm'}='Htex/a2ping.pm'}
+
+package Htex::a2ping;
+# a2ping.pl -- convert between PS, EPS and PDF and other page description formats
+# by pts@fazekas.hu et al. at Wed Apr 16 14:54:13 CEST 2003
+# a2ping.pa created at Sun Apr 20 22:25:47 2003
+#
+# This file contains perldoc(1) documentation. Search for `=head1'.
+# See revision history at end of this file.
+#
+
+use just +1; # a JustLib application
+use strict;
+use integer;
+use Htex::papers;
+BEGIN { $Htex::a2ping::VERSION="2.77p" }
+
+# Imp: option to ignore `%%Orientation: Portrait', which gs respects and rotates by 90 degrees if necessary
+# Imp: gs(704?!) sometimes finds too small bbox, see Univers.eps
+# Imp: respect bbox in METAPOST %! (not EPS), don't use Compute-GS T-
+# Imp: -sPDFPassword=...
+# Imp: `a2ping.pl -v jf.eps pdf1: t.pdf' PDF1: must be forced to have --below
+# Imp: option to `clip' an EPS to the specified bbox -- does file size decrease?
+# Imp: fix bug a2ping -v ~/a2ping_bug.ps a2ping_bug.pdf; running type1fix on
+# all fonts with dff.pl has fixed the problem
+# Imp: post-process PNG etc. written by sam2p
+# Imp: better help and docs
+# Imp: respect full /MediaBox for a PDF -> EPS|PDF1 conversion
+# Imp: --ll x,y command line option
+# Imp: Htex/a2ping.pa -v ../image/tuzv.ps t.pdf (1st and second page different)
+# Imp: also save+restore /pdfmark ??
+# Imp: fix /MediaBox an all PDF pages if !$ll_zero
+# Imp: PDF -> PDF1 conversion with gs -sDEVICE=pdfwrite
+# Imp: direct PDF to PCL5 conversion with gs
+# Imp: remove %%BeginDefaults | %%PageMedia: plain | %%EndDefaults (pdftops(1))
+# Imp: fix completely bogus margin and papersize handling:
+# ../justlib2/Htex/a2ping.pa --duplex=force-short -v -p:a3 -r force-unknown tuzv.ps t.pdf
+# Imp: careful distinction between PDF and PDF1
+# Imp: psnup support (-1 -2 -3 -4 ...)
+# Imp: idempotent PS -> PS, add other header
+# Imp: use convert(1) etc.
+# Imp: possibly disable compute-pipe
+# Imp: $header_remove_p ??
+# Imp: --leftright option instead of --below
+# Imp: pdfboxes.pl, get offset from gs
+# Imp: detect error messages from GS, abort...
+# Imp: use all pdftops + gs + acroread
+# Imp: possibly accept /PageSize from %%DocumentMedia
+# Imp: /DocumentMedia seems to screw up sub-pt placement in gv(1)
+#
+# Dat: example: a2ping.pl --extra=-c:ijg:50 -r86 nn1.eps nn1.jpg
+# Dat: calling ``showpage'' is not required for -sDEVICE=pdfwrite with gs 6.50,
+# but -sDEVICE=pgmraw depends on it
+# Dat: the functionality of pdfboxes.pl cannot be provided here with a shorter
+# implementation, because gs always outputs the content stream of the PDF
+# objects first
+# Dat: pdftops -eps writes negative bbox correctly
+# Dat: markedEPS: include pdfmarks
+# Dat: gs 7.04 gdevdjet.[ch], gdevdljm.[ch]
+# Dat: to be undeffed in setpagedevice: /.MarginsHWResolution /PageSize
+# /ImagingBBox /HWResolution /HWSize /.MediaSize (we undef all)
+
+### program identification
+my $program = "a2ping.pl";
+my $filedate="2006-11-15"; # my $filedate="2001/03/05";
+my $copyright = "Written by <pts\@fazekas.hu> from April 2003.
+This is free software, GNU GPL >=2.0. There is NO WARRANTY.
+(epstopdf 2.7 Copyright 1998-2001 by Sebastian Rahtz et al.)\n";
+# "Contains modifications by pts\@fazekas.hu";
+my $title = "$program $Htex::a2ping::VERSION, $filedate -- $copyright\n";
+
+### ghostscript command name
+my($quote,$GS)=("'","gs");
+($quote,$GS) = ("\"","gswin32c") if $^O eq 'MSWin32' or $^O =~ /cygwin/i;
+
+# --- help functions
+
+sub fnq($) {
+ my $fn=$_[0];
+ return $fn if $fn!~y@-a-zA-Z0-9/.+_@@c;
+ $fn=~s@'@\\'@g if $quote eq "'";
+ $quote.$fn.$quote
+}
+
+sub debug {
+ print STDERR "* @_\n" if $::opt_verbose;
+}
+sub warning {
+ print STDERR "$0: warning: @_\n";
+}
+sub error {
+ my $s=$title; $title="";
+ die "$s$0: @_\n";
+}
+
+# unlink temporary files?
+my $tmpunlink_p=1;
+my $tmpsig=1;
+my %tmpfiles;
+my $tmpdir=exists $ENV{TMPDIR} ? $ENV{TMPDIR} : '/tmp';
+$tmpdir="." if (!-d $tmpdir or !-w $tmpdir) and -w '.';
+sub cleanup() {
+ unlink keys %tmpfiles;
+ exit 125;
+}
+END { unlink keys %tmpfiles; }
+sub temp_unlink($) {
+ if (defined $_[0] and exists $tmpfiles{$_[0]}) {
+ unlink $_[0] if $tmpunlink_p;
+ delete $tmpfiles{$_[0]};
+ }
+}
+sub temp_prefix() {
+ my $prog0=$program;
+ $prog0=~y@a-zA-Z0-9@_@c;
+ if ($tmpsig) {
+ $tmpsig=0;
+ $SIG{INT}=$SIG{TERM}=$SIG{HUP}=$SIG{QUIT}=\&cleanup;
+ }
+ return "$tmpdir/$prog0-$$-".int(rand(1<<30))."-"; # 30: nonnegative
+}
+
+#** @return arg rounded down to int
+sub myfloor($) {
+ # Dat: Perl int() rounds towards zero
+ no integer;
+ $_[0]==int($_[0]) ? $_[0] : $_[0] < 0 ? -int(1-$_[0]) : int($_[0])
+}
+
+#** @return arg rounded up to int
+sub myceil($) {
+ no integer; #### BUGFIX at Wed Nov 15 17:23:29 CET 2006
+ $_[0]==int($_[0]) ? $_[0] : 1+ ($_[0] < 0 ? -int(-$_[0]) : int($_[0]));
+}
+
+just::main;
+
+# ---
+
+sub FL_PAGE1_STOP(){1} # is file format single-page?
+sub FL_SET_PAGESIZE_OK(){2}
+sub FL_PDFMARK(){4}
+sub FL_NEED_SHOWPAGE(){8} # does gs -sDEVICE=... need showpage?
+sub FL_SAMPLED(){16} # is it a sampled (raster, pixel-based)
+sub FL_ANY_ORIGIN_OK(){32} # (llx,lly) may be anything, not just (0,0)
+sub FL_HAS_ANTIALIAS(){64}
+sub FL_VIA_SAM2P(){128} # sam2p(1) should convert PNM to such a format
+sub FL_OK_SAM2P(){256} # sam2p(1) can convert PNM to such a format
+
+my %fmts=( # Name=>[flags]
+ 'EPS'=>[FL_PAGE1_STOP],
+ 'markedEPS'=>[FL_PAGE1_STOP|FL_PDFMARK], # Imp: should we have FL_SET_PAGESIZE_OK?
+ 'PDF1'=>[FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_PDFMARK],
+ 'PDF'=>[FL_SET_PAGESIZE_OK|FL_PDFMARK|FL_ANY_ORIGIN_OK],
+ 'PS'=>[FL_SET_PAGESIZE_OK|FL_ANY_ORIGIN_OK],
+ 'markedPS'=>[FL_SET_PAGESIZE_OK|FL_PDFMARK|FL_ANY_ORIGIN_OK],
+ 'PCL5'=>[FL_SET_PAGESIZE_OK|FL_ANY_ORIGIN_OK],
+ # ^^^ Dat: no FL_HAS_ANTIALIAS -- would need lj5gray, which is loonger
+ # ^^^ Dat: no FL_SAMPLED, because cannot set resolution
+ 'PBM'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_OK_SAM2P], # Dat FL_HAS_ANTIALIAS produces obscure image
+ 'PGM'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_OK_SAM2P],
+ 'PPM'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_OK_SAM2P],
+ # Now come the FileFormats supported via sam2p
+ 'PNG'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_VIA_SAM2P],
+ 'XWD'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_VIA_SAM2P],
+ 'BMP'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_VIA_SAM2P],
+ 'TIFF'=>[FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_VIA_SAM2P],
+ 'JPEG'=>[FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_VIA_SAM2P],
+ 'GIF'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_VIA_SAM2P], # Imp: disable antialias for few colors?
+ 'XPM'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_VIA_SAM2P], # Imp: disable antialias for few colors?
+);
+my %fmt_aliases=qw(MARKEDPS markedPS MARKEDEPS markedEPS PCL PCL5
+ UNMARKEDPS PS UNMARKEDEPS EPS EPDF PDF1 MEPS markedEPS);
+# Dat: .ps will be unmarked PS
+# Imp: sometimes markedEPS for .eps?
+my %fmt_exts=qw(eps EPS epsi EPS epsf EPS eps2 EPS ps PS ps2 PS
+ pcl PCL5 pcl5 PCL5 pbm PBM pgm PGM pnm PPM ppm PPM pdf PDF png PNG
+ xwd XWD bmp BMP rle BMP tif TIFF tiff TIFF jpg JPEG jpe JPEG
+ jpg JPEG gif GIF xpm XPM);
+
+### usage
+# vvv deprecated options:
+# --outfile=<file>: write result to <file>
+# --debug: verbose debug informations (default: $bool[$::opt_verbose])
+# --(no)filter: d. read standard input (default: false)
+# --(no)gs d. run Ghostscript to create PDF
+my $usage=
+"${title}Usage: $program [options] <inputfile> [[<outformat>:] <outputfile>]
+Run with --doc to read documentation as a UNIX man(1) page.
+Options: --help print this help message
+--(no)compress use compression (def: best)
+--(no)hires scan HiResBoundingBox (def: yes)
+--(no)exact scan ExactBoundingBox (def: no)
+--(no)verbose verbose debug informations (def: no)
+--(no)below allow below+left_from baseline (def: no)
+--(no)tmpunlink unlink temporary files (def: yes)
+--(no)antialias render shades at outlines (def: scale3no) (=scale3yes =no =yes)
+--(no)lossy allow lossy image filters (EPS->PDF) (def: yes)
+--(no)keepoldmediabox keep only old, [0 0]-based MediaBox in PDF (def: no)
+--gs-cmd= path to Ghostscript (def: gs or gswin32c)
+--gs-ccmd= path to Ghostscript, 4 bbox calc (def: gs or gswin32c)
+--gsextra= extra arg to gs
+--extra= extra arg to external prg (i.e pdftops)
+--bboxfrom= adsc|compute-gs|pagesize (def: guess)
+--papersize= unchanged|force-unknown|600bpx5cm (def: default) (bp)
+--threshold= min color for 1 in 8->1 bit conv (def: 128)
+Possible input formats: PS EPS PDF JPEG GIF TIFF PNG PNM PCX BMP LBM XPM TGA
+Possible output formats: @{[sort keys %fmts]}
+Examples for producing 'test.pdf':
+ * $program test.eps
+ * produce postscript | $program -v - test.pdf
+Example: look for HiResBoundingBox and produce corrected PostScript:
+ * $program -d --nogs -hires test.ps>testcorr.ps
+";
+sub errorUsage {
+ die "$usage\U!\E!\U!\E Error: @_\n";
+}
+
+# --- @ARGV parsing
+
+### default option values
+my @extra=();
+my @gsextra=();
+#** Output file format (string)
+my $FileFormat=undef;
+$::opt_help=0;
+$::opt_verbose=0;
+my %vals_compression=map{$_=>1} qw(best none flate zip);
+$::opt_compression='best';
+#** Prefer %%HiResBoundingBox over %%BoundingBox, but emit both
+$::opt_hires=1;
+$::opt_exact=0;
+# $::opt_filter=0; # deprecated
+# $::opt_outputfile=undef; # deprecated
+$::opt_below=undef;
+$::opt_keepoldmediabox=0;
+$::opt_lossy=1;
+$::opt_antialias=undef; # render shades at path outlines for better readability
+$::opt_gs_cmd=undef;
+$::opt_extra="";
+$::opt_duplex="default";
+$::opt_threshold=128;
+my %vals_antialias=map{$_=>1} qw(no yes scale3yes scale3no);
+my %vals_duplex=map{$_=>1} qw(force-unknown force-simplex force-long
+ force-short unchanged default-simplex default-long default-short);
+# ^^^ short: duplex printing, will bind short edge of paper (ideal for
+# duplexing psnup -2)
+#** Dat: force-unknown is forced by /setpagedevice/load def
+$::opt_resolution="default"; # unchanged force-unknown 600x600 (DPI)
+$::opt_papersize="default"; # unchanged force-unknown 600bpx600cm (bp)
+#** --bboxfrom=adsc sets %%BoundingBox from the 1st page if no ADSC comment in non-EPS ps
+my %vals_bboxfrom=map{$_=>1} qw(adsc compute-gs guess pagesize);
+$::opt_bboxfrom="guess";
+my $InputFilename;
+my $OutputFilename;
+
+sub is_page1_stop() { 0!=($fmts{$FileFormat}[0]&FL_PAGE1_STOP) }
+sub is_set_pagesize_ok() { 0!=($fmts{$FileFormat}[0]&FL_SET_PAGESIZE_OK) }
+sub is_pdfmark() { 0!=($fmts{$FileFormat}[0]&FL_PDFMARK) }
+sub is_need_showpage() { 0!=($fmts{$FileFormat}[0]&FL_NEED_SHOWPAGE) }
+sub is_sampled() { 0!=($fmts{$FileFormat}[0]&FL_SAMPLED) }
+sub is_any_origin_ok() { 0!=($fmts{$FileFormat}[0]&FL_ANY_ORIGIN_OK) }
+sub is_has_antialias() { 0!=($fmts{$FileFormat}[0]&FL_HAS_ANTIALIAS) }
+sub is_via_sam2p() { 0!=($fmts{$FileFormat}[0]&FL_VIA_SAM2P) }
+sub is_ok_sam2p() { 0!=($fmts{$FileFormat}[0]&FL_OK_SAM2P) }
+
+# ---
+
+sub show_doc() {
+ # run `pod2man __FILE__ | man -l -', same as `perldoc __FILE', but perldoc(1)
+ # is missing from some Debian sites that have pod2man.
+ my @path=split/:+/,$ENV{PATH};
+ my $pod2man_='pod2man --center="a2ping: advanced PS, PDF, EPS converter" ';
+ $pod2man_=q~perl -ne 'if($a>1){print}elsif($a&&/^=head1/){$a=2}else{$a=!/\S/}' ~
+ if !grep { -x "$_/pod2man" } @path;
+ my $pager='';
+ for my $pageri ((defined $ENV{PAGER} ? $ENV{PAGER}: ''),'less','most','more','view - ','vim -R - ','vi - ','joe -rdonly -asis -','pager') {
+ next if $pageri!~/^(\S+)/;
+ my $pagert="/$1";
+ if (grep { -x $_.$pagert } @path) { $pager=$pageri; last }
+ }
+ $pager=q~perl -pe 's@\010_@@g;s@.\010@@gs' | ~.$pager
+ if substr($pager,-2)eq' ' or $pager=~/\A(?:view|vim?|joe|emacs|mcedit|nano|nano-tiny|ae)\b/;
+ # ^^^ Dat: these cannot handle underline/bold backspace directly
+ $ENV{PAGER}=$pager;
+ my $man='';
+ if (substr($pod2man_,0,5)ne 'perl ') {
+ $man=' | man -l -'; # calls $PAGER
+ if ((!grep { -x "$_/man" } @path) or qx(man -l 2>&1)=~/\binvalid option\b/) {
+ $man=' | nroff -Tlatin1 -mandoc'; # Linux, no need for eqn(1), tbl(1) etc.
+ if (!grep { -x "$_/nroff" } @path) { $man='' } # just write it
+ }
+ }
+ my $cmd=$pod2man_.fnq(__FILE__).$man;
+ if ($cmd!~/[|] man -l -\Z(?!\n)/) {
+ if (!length $pager) {
+ die unless open PIPE, "$cmd|";
+ print while sysread PIPE, $_, 4096;
+ die "$0: error showing doc\n" unless close PIPE;
+ exit 0;
+ }
+ $cmd.=' | $PAGER';
+ }
+ ##die $cmd;
+ $ENV{LESS}="" if !defined $ENV{LESS};
+ $ENV{LESS}="$ENV{LESS}R"; # show ANSI escapes
+ die "$0: exec ($cmd) failed: $!\n" if !exec $cmd;
+}
+
+die $usage if !@ARGV or (1==@ARGV and $ARGV[0] eq '-h' or $ARGV[0] eq '--help'
+ or $ARGV[0] eq 'help');
+show_doc() if 1==@ARGV and $ARGV[0] eq '--doc' or $ARGV[0] eq 'doc';
+
+{ my($I,$optname,$optval);
+ my %optmap=qw(o outputfile outfile outputfile r resolution h help
+ f filter d verbose v verbose debug verbose p papersize
+ c compression compress compression h hires b below e exact x extra);
+ #** Options that have a mandatory argument
+ my %argopt1=qw(outputfile 1 duplex 1 resolution 1 extra 1 compression 1 gs-cmd 1
+ gs-ccmd 1
+ papersize 1 paper 1 bboxfrom 1 antialias 1 gsextra 1 threshold 1); # 1 arg
+ my %argnone=qw(help 1 verbose 1 noverbose 1 nocompress 1 noantialias 1); # 0 arg
+ my %argmaybe=qw(); # 0 or 1 arg
+ my %argbool=qw(hires 1 exact 1 below 1 gs 1 filter 1 tmpunlink 1
+ approx 1 lossy 1 keepoldmediabox 1); # boolean arg
+ # Dat: --noverbose --nocompress
+ my $opts_ok=1;
+ for ($I=0; $I<@ARGV; $I++) {
+ if ($ARGV[$I]eq '--') {
+ $OutputFilename=$InputFilename if defined $InputFilename and
+ !defined $OutputFilename and $opts_ok;
+ $opts_ok=0;
+ } elsif ($opts_ok and $ARGV[$I]=~/\A--+(\w[\w-]*)(?:[:=](.*))?\Z(?!\n)/s) {
+ $optname=lc$1; $optval=$2;
+ } elsif ($opts_ok and $ARGV[$I]=~/\A-(\w)(.*)\Z(?!\n)/s) {
+ $optname=lc$1;
+ if (length($2)==0) { $optval=undef }
+ elsif (index(":=",substr($2,0,1))>=0) { $optval=substr($2,1) }
+ else { $optval=$2 }
+ } elsif ($opts_ok and !defined $FileFormat and defined $InputFilename and $ARGV[$I]=~s@\A(\w+):@@) {
+ my $fmtag=uc$1;
+ # errorUsage "invalid FileFormat tag: $fmtag" if $fmtag!~s@:\Z(?!\n)@@;
+ if (exists $fmts{$fmtag}) { $FileFormat=$fmtag }
+ elsif (exists $fmt_aliases{$fmtag}) { $FileFormat=$fmt_aliases{$fmtag} }
+ else { errorUsage "Unknown FileFormat tag: $fmtag" }
+ if (0!=length($ARGV[$I])) {
+ errorUsage "Multiple output filenames" if defined $OutputFilename;
+ $OutputFilename=$ARGV[$I];
+ }
+ next
+ } elsif (!defined $InputFilename) { $InputFilename=$ARGV[$I]; next }
+ elsif (!defined $OutputFilename) { $OutputFilename=$ARGV[$I]; next }
+ else { errorUsage "Too many arguments (multiple input/output files?)" }
+ $optname=$optmap{$optname} if exists $optmap{$optname};
+ if (exists $argopt1{$optname} and !defined $optval) {
+ errorUsage "Argument expected for --$optname" if $I==@ARGV;
+ $optval=$ARGV[++$I];
+ }
+ # Dat: $optname and $optval are now correct
+ errorUsage "No argument expected for --$optname=$optval" if exists $argnone{$optname} and defined $optval;
+ if (substr($optname,0,2)eq"no" and exists $argbool{substr($optname,2)}) {
+ $optname=substr($optname,2);
+ errorUsage "No argument expected for no --no$optname=$optval" if defined $optval;
+ $optval="no";
+ }
+ if (exists $argbool{$optname}) {
+ # same as sam2p GenBuffer::parseBool, understands:
+ # on true yes ja igen oui enable 1 true vrai? right sure allowed
+ # off false no nein nem non disable 0 false faux? wrong nope disallowed
+ $optval=(!defined($optval) or 0==length($optval)
+ or $optval=~/\Ao[nu]/i or $optval!~/\A[fndw0]/i) ? 1 : 0;
+ } elsif (!exists $argopt1{$optname} and !exists $argnone{$optname} and !exists $argmaybe{$optname}) {
+ errorUsage "Unknown option --$optname, see --help"
+ }
+ # vvv application-specific
+ if ($optname eq "help") { die $usage }
+ elsif ($optname eq "help") { show_doc() }
+ elsif ($optname eq "noverbose") { $::opt_verbose=0 }
+ elsif ($optname eq "nocompress") { $::opt_compression='none' }
+ elsif ($optname eq "verbose") { $::opt_verbose++ }
+ elsif ($optname eq "hires") { $::opt_hires =$optval }
+ elsif ($optname eq "exact") { $::opt_exact =$optval }
+ elsif ($optname eq "below") { $::opt_below =$optval }
+ elsif ($optname eq "keepoldmediabox") { $::opt_keepoldmediabox=$optval }
+ elsif ($optname eq "lossy") { $::opt_lossy =$optval }
+ elsif ($optname eq "approx") { $::opt_approx=$optval }
+ elsif ($optname eq "threshold") { $::opt_threshold=$optval+0 } # Imp: accept only int 0..256
+ elsif ($optname eq "filter") {
+ # errorUsage "Multiple input filenames" if defined $InputFilename;
+ # $InputFilename='-';
+ errorUsage "Multiple output filenames" if defined $OutputFilename;
+ $OutputFilename='-';
+ } elsif ($optname eq "tmpunlink") { $tmpunlink_p=$optval }
+ elsif ($optname eq "gs") { $FileFormat=$optval ? 'PDF1' : 'markedEPS' }
+ elsif ($optname eq "compression") {
+ errorUsage "--$optname expects one of: @{[keys%vals_compression]}" if !exists $vals_compression{$optval};
+ $::opt_compression=$optval;
+ $::opt_compression='zip' if $::opt_compression eq 'flate';
+ } elsif ($optname eq "outputfile") {
+ errorUsage "Multiple output filenames" if defined $OutputFilename;
+ $OutputFilename=$optval;
+ } elsif ($optname eq "gs-cmd") {
+ errorUsage "Multiple --gs-cmd" if defined $::opt_gs_cmd;
+ $::opt_gs_cmd=$optval;
+ } elsif ($optname eq "gs-ccmd") {
+ errorUsage "Multiple --gs-ccmd" if defined $::opt_gs_ccmd;
+ $::opt_gs_ccmd=$optval;
+ } elsif ($optname eq "extra") { push @extra, $optval }
+ elsif ($optname eq "gsextra") { push @gsextra, $optval }
+ elsif ($optname eq "duplex") {
+ errorUsage "--$optname expects one of: @{[keys%vals_duplex]}" if !exists $vals_duplex{$optval};
+ $::opt_duplex=$optval
+ } elsif ($optname eq "bboxfrom") {
+ errorUsage "--$optname expects one of: @{[keys%vals_bboxfrom]}" if !exists $vals_bboxfrom{$optval};
+ $::opt_bboxfrom=$optval
+ } elsif ($optname eq "noantialias") {
+ $::opt_antialias='no'
+ } elsif ($optname eq "antialias") {
+ errorUsage "--$optname expects one of: @{[keys%vals_antialias]}" if !exists $vals_antialias{$optval};
+ $::opt_antialias=$optval
+ } elsif ($optname eq "resolution") {
+ if ($optval eq "unchanged" or $optval eq "force-unknown") { }
+ elsif ($optval=~/^(\d+(?:[.]\d+)?)\Z(?!\n)/) { $optval="$1x$1" }
+ elsif ($optval=~/^(\d+(?:[.]\d+)?[x,]\d+(?:[.]\d+)?)\Z(?!\n)/) { }
+ else { errorUsage "--Resultion expects unchanged | force-unknown | DPI | XDPIxYDPI" }
+ $::opt_resolution=$optval
+ } elsif ($optname eq "papersize" or $optname eq"paper") {
+ if ($optval eq "unchanged" or $optval eq "force-unknown") { $::opt_papersize=$optval }
+ else {
+ my @L=Htex::papers::any($optval);
+ errorUsage "invalid or unknown for --papersize" if !@L;
+ $::opt_papersize="$L[1],$L[2]" # width, height
+ }
+ } else { die } # unreachable
+ } # NEXT opt
+ errorUsage "Too many arguments (multiple input/output files?)" if $I!=@ARGV;
+ # splice @ARGV, 0, $I;
+}
+
+$GS=$::opt_gs_cmd if defined $::opt_gs_cmd;
+my $CGS=$GS;
+$CGS=$::opt_gs_ccmd if defined $::opt_gs_ccmd;
+# vvv SUXX: (r) file doesn't work with gs 8.5x -DSAFER
+#$GS.= " -dSAFER"; # -dWRITESYSTEMDICT
+#$CGS.=" -dSAFER"; # -dWRITESYSTEMDICT
+
+### get input and output filename
+if (!defined $InputFilename and defined $OutputFilename) { # --filter
+ $InputFilename='-';
+} elsif (!defined $InputFilename) {
+ errorUsage "Input filename missing"
+} elsif (!defined $OutputFilename) {
+ $FileFormat='PDF1' if !defined $FileFormat;
+ if ($FileFormat eq 'PDF1' or $FileFormat eq 'PDF') {
+ if (($OutputFilename=$InputFilename) ne '-') {
+ $OutputFilename =~ s/\.[^\.]*$//;
+ $OutputFilename .= ".pdf";
+ }
+ } else {
+ $OutputFilename = '-'; # standard output
+ }
+}
+print STDERR $title if $::opt_verbose;
+$title="";
+
+# Dat: no more @ARGV
+errorUsage "please specify <outformat>" if
+ !defined $FileFormat and ($OutputFilename!~m@[.]([^/.]+)\Z(?!\n)@ or
+ !defined($FileFormat=$fmt_exts{lc$1}));
+$::opt_below=is_any_origin_ok() if !defined $::opt_below;
+error "--below=1 invalid for FileFormat $FileFormat" if $::opt_below and
+ !is_any_origin_ok() and $FileFormat ne 'PDF1' and $FileFormat ne 'EPS' and
+ $FileFormat ne 'markedEPS';
+error "--below=0 invalid for FileFormat $FileFormat" if !$::opt_below and
+ is_any_origin_ok();
+$::opt_antialias=is_has_antialias() ?
+ (is_sampled() ? 'scale3no' : 'yes') : 'no' if
+ !defined $::opt_antialias;
+
+if ($FileFormat eq 'PBM' and ($::opt_antialias eq 'scale3yes' or
+ $::opt_antialias eq 'scale3no')) {
+} elsif ($::opt_antialias ne 'no' and !is_has_antialias()) {
+ $::opt_antialias='no';
+ warning "--AntiAlias ignored for FileFormat $FileFormat"
+}
+if ($::opt_antialias eq 'scale3no' or $::opt_antialias eq 'scale3yes') {
+ $::opt_resolution="72,72" if $::opt_resolution eq 'unchanged' or $::opt_resolution eq 'force-unknown' or $::opt_resolution eq 'default';
+ # ^^^ GS raster default
+ my @L=split/[,x]/,$::opt_resolution;
+ @L=(@L,@L); # Imp: ..
+ $L[0]*=3; $L[1]*=3;
+ $::opt_resolution="$L[0],$L[0]";
+}
+
+### option compress
+my $GSOPTS=join(" ",map{fnq$_}@gsextra);
+# $GSOPTS.=" -r72 -sPAPERSIZE=a4 "; # default -- will be overridden by `setpagedevice'
+# ^^^ Dat: default does only harm; user should specify on command line
+
+### option BoundingBox types
+#**** pts ****
+# scan all of them and find the best
+{ my $BBprint = "%%BoundingBox:";
+ $BBprint = "%%HiResBoundingBox:" if $::opt_hires;
+ $BBprint = "%%ExactBoundingBox:" if $::opt_exact;
+ debug "Strongest BoundingBox comment:", $BBprint;
+}
+my $BBregex='%%(Hi[Rr]es|Exact|)BoundingBox:';
+
+if (!is_set_pagesize_ok()) {
+ if ($::opt_papersize ne'default' and $::opt_papersize ne'force-unknown') {
+ error "Cannot set --PaperSize for FileFormat $FileFormat"
+ } else { $::opt_papersize='force-unknown' }
+} elsif ($::opt_papersize eq'default') { $::opt_papersize='unchanged' }
+
+if ($::opt_resolution eq'default') { $::opt_resolution='force-unknown' }
+error "Cannot set --Resolution for FileFormat $FileFormat (must be markedPS or sampled)"
+ if $FileFormat ne 'markedPS' and !is_sampled()
+ and $::opt_resolution ne'force-unknown';
+error "Bad --Resolution=$::opt_resolution" if $::opt_resolution ne 'unchanged'
+ and $::opt_resolution ne 'force-unknown' and $::opt_resolution!~/\A(\d+)+[,x](\d+)\Z(?!\n)/;
+
+if ($FileFormat ne 'markedPS' and $FileFormat ne 'PCL5') {
+ if ($::opt_duplex ne'default' and $::opt_duplex ne'force-unknown') {
+ error "Cannot set --Duplex for FileFormat $FileFormat (must be markedPS or PCL5)"
+ } else { $::opt_duplex='force-unknown' }
+} elsif ($::opt_duplex eq'default') { $::opt_duplex='force-unknown' }
+
+debug "Doing --PaperSize $::opt_papersize" if $::opt_papersize ne 'force-unknown';
+debug "Doing --Duplex $::opt_duplex" if $::opt_duplex ne 'force-unknown';
+debug "Doing --Resolution $::opt_resolution" if $::opt_resolution ne 'force-unknown';
+debug "Doing --AntiAlias=$::opt_antialias" if $::opt_antialias ne 'no';
+
+### option outfile
+if ($OutputFilename eq '-') {
+ debug "Output file: standard output";
+} else {
+ debug "Output filename: $OutputFilename";
+ #error "$OutputFilename: won't overwrite input file with itself"
+ # if $OutputFilename eq $InputFilename;
+}
+
+### option gs
+debug "Output FileFormat: $FileFormat";
+$::opt_compression='zip' if $::opt_compression ne 'none';
+if ($FileFormat eq 'PDF' or $FileFormat eq 'PDF1') {
+ debug "Ghostscript ps2pdf command: $GS $GSOPTS";
+ debug "Compression: $::opt_compression";
+} elsif ($FileFormat eq 'PCL5') {
+ debug "Ghostscript ps2ljet command: $GS $GSOPTS";
+} elsif (is_sampled()) {
+ debug "Ghostscript ps2sampled command: $GS $GSOPTS";
+}
+
+#**** pts ****
+sub read_error() { error "read $InputFilename: $!" }
+my $in_mac_p=0; # 0: "\n" or "\r\n" is line terminator; 1: "\r" is line terminator
+my $bytes_left=-1; # -1==unlimited
+my $already_read=0;
+sub dem1($){defined$_[0]?$_[0]:-1}
+#** @param $_[0] number of bytes to read, or undef to read a line
+#** @return the string read
+sub readIN(;$) {
+ my $S;
+ ## return "" if $bytes_left==0;
+ ## print STDERR "READ($_[0])\n";
+ if (defined $_[0]) { read_error if 0>dem1 read IN, $S, $_[0] }
+ else {
+ $!=0; # clean up error code
+ if ($in_mac_p) {
+ local $/="\r";
+ $S=~s@\r\Z(?!\n)@\n@ if defined($S=<IN>);
+ } else { $S=<IN> }
+ read_error if !defined($S) and $!;
+ $S="" if !defined $S; # EOF
+ }
+ if ($bytes_left<0) { # unlimited
+ } elsif (length($S)>=$bytes_left) {
+ $S=substr($S, 0, $bytes_left);
+ $bytes_left=0;
+ } else { $bytes_left-=length($S) }
+ $already_read+=length($S);
+ $S
+}
+
+sub open_OUT() {
+ error "Cannot write outfile '$OutputFilename'" unless
+ open(OUT, $OutputFilename eq '-' ? ">-" : "> $OutputFilename")
+}
+
+#** @param $_[0] temp file extension (e.g ".img")
+#** @param $_[1] preprint
+#** @param $_[2] bool: force pipe even if seekable?
+sub fix_pipe_in($$$) {
+ my $c="";
+ if ($_[2] or (length($c=readIN(1))!=0 and !seek IN,-1,1)) { # we cannot seek back
+ # Dat: ^^^ test seekability instead of $InputFilename eq '-'
+ my($ext,$preprint)=@_;
+ my $tifn;
+ # $ext=$1 if $InputFilename=~/[.](\w+)\Z(?!\n)/; # never true
+ $tifn=temp_prefix()."M$ext";
+ error "Cannot open temp input: $tifn" unless open TI, "> $tifn";
+ $tmpfiles{$tifn}=1;
+ die unless print TI $preprint, $c;
+ print TI or die while length($_=readIN 4096);
+ die unless close TI;
+ $InputFilename=$tifn;
+ debug "Temp input file: $InputFilename";
+ die unless open IN, "< $tifn";
+ die unless seek IN, length($preprint), 0;
+ $already_read=length($preprint);
+ $bytes_left=-1; # unlimited, since readIN() has copied only part
+ # $bytes_left++ if $bytes_left>=0; # ungetc($c)
+ # temp_unlink $tifn; # do it later (at END{})
+ } else {
+ $already_read--; $bytes_left++ if $bytes_left>=0; # BUGFIX at Fri May 14 00:21:18 CEST 2004
+ }
+}
+
+my $temp_out_fn;
+
+#** Does overwrite $temp_out_fn. Fine.
+sub fix_force_out($) {
+ my($ext)=$_[0];
+ # $ext=$1 if $InputFilename=~/[.](\w+)\Z(?!\n)/; # never true
+ $temp_out_fn=temp_prefix()."O$ext";
+ # error "Cannot save output: $!" unless open SAVEOUT, ">&OUT"; # always STDOUT; maybe not open yet
+ error "Cannot open temp output: $temp_out_fn" unless open OUT, "> $temp_out_fn";
+ $tmpfiles{$temp_out_fn}=1;
+ # $OutputFilename=$temp_out_fn;
+ debug "Temp output file: $temp_out_fn";
+ # temp_unlink $temp_out_fn; # do it later (at END{})
+ return $temp_out_fn;
+}
+
+#** @param $_[0] temp file extension (e.g ".img")
+#** @return new output filename
+sub fix_pipe_out($) {
+ if (!defined $temp_out_fn) {
+ return $OutputFilename if $OutputFilename ne '-';
+ return fix_force_out($_[0]);
+ }
+ $temp_out_fn
+}
+sub fix_close_out() {
+ # error "closing filter out: $? $!" unless close OUT;
+ if (defined $temp_out_fn) {
+ my $buf;
+ die unless open FCO, "< $temp_out_fn";
+ print STDOUT $buf while sysread FCO, $buf, 4096;
+ die unless close FCO;
+ temp_unlink $temp_out_fn;
+ undef $temp_out_fn;
+ }
+}
+
+sub do_system {
+ my($progname)=splice@_,0,1;
+ debug "Running: $progname @extra @_";
+ error "prog $progname failed: $? $!"
+ if 0!=system $progname, @extra, @_; # Dat: non-zero exit() or not found
+}
+
+sub do_exec {
+ my($progname)=splice@_,0,1;
+ if (scalar keys %tmpfiles) {
+ # Cannot exec() right now, because we have to unlink some temporary files
+ # later.
+ do_system $progname, @_;
+ } else {
+ debug "Execing: $progname @extra @_";
+ 1 if exec $progname, @extra, @_;
+ # ^^^ Dat: $OutputFilename eq '-' should be OK
+ error "exec failed: $!";
+ }
+ exit(0);
+}
+
+#sub shq($) {
+# my $S=$_[0];
+# return $S if $S!~y@A-Za-z0-9_,:./-@@c and length($S)>0;
+# $S=~s@'@'\\''@g;
+# return "'$S'"
+#}
+
+### open input file
+if ($InputFilename eq '-') {
+ debug "Input file: standard input";
+ open(IN, "<&STDIN") or error "cannot open standard input";
+} else {
+ # -f $InputFilename or error "input file missing: $InputFilename"; # Imp: named pipe?
+ open(IN,"< $InputFilename") or error "cannot open input file: $InputFilename";
+ debug "Input filename:", $InputFilename;
+ if ($InputFilename eq $OutputFilename) {
+ # error "same input and output file: $InputFilename";
+ my $ext=$InputFilename=~m@([.][^./]+)\Z(?!\n)@ ? $1 : "";
+ binmode IN; $bytes_left=-1;
+ fix_pipe_in($ext, "", 1); # Dat: defined later
+ }
+}
+binmode IN;
+
+#** Dat: uses $FileFormat, $InputFileName, $OutputFileName
+#** @param $S prepend to pipe
+sub run_sam2p($$) {
+ my($approx_p,$S)=@_;
+ # Imp: why isn't sam2p(1) PNG -> PNG idempotent?
+ my $tfmt=$FileFormat eq'markedEPS' || $FileFormat eq 'EPS' ? 'EPS'
+ : $FileFormat eq'markedPS' || $FileFormat eq 'PS' ? 'PS' # Dat: emits no /PageSize
+ : $FileFormat eq'PDF1' || $FileFormat eq 'PDF' ? 'PDF'
+ : undef;
+ if (defined $tfmt) {}
+ elsif (is_via_sam2p() or is_ok_sam2p()) {$tfmt=$FileFormat; $::opt_approx=1}
+ else { error "sam2p doesn't support our FileFormat $FileFormat" }
+ fix_pipe_in ".img", $S, 0;
+ if ($approx_p) {
+ if ($tfmt eq 'GIF') {
+ # Dat: reduce palette to 8-bit if necessary
+ my @args=('sam2p',@extra,"$tfmt:",'--',$InputFilename,$OutputFilename);
+ debug "Running: @args";
+ my $cmd=join(' ',map{fnq$_}@args)." 2>&1";
+ my $res=readpipe($cmd);
+ if ($res=~/\binvalid combination, no applicable OutputRule\b/) {
+ # Dat: reduce palette to 8-bit
+ #die "NOR";
+ my $have_convert_p;
+ my $have_pnmquant_p=0;
+ for my $dir (split/:/,$ENV{PATH}) {
+ if ((-f"$dir/pnmquant")) { $have_pnmquant_p=1 }
+ }
+ if (!$have_pnmquant_p) {
+ $have_convert_p=0;
+ for my $dir (split/:/,$ENV{PATH}) {
+ if ((-f"$dir/convert")) { $have_convert_p=1 }
+ }
+ }
+ my $cmd;
+ if ($have_pnmquant_p) {
+ my @args1=('sam2p','PPM:','--',$InputFilename,'-');
+ my @args2=('sam2p',@extra,"$tfmt:",'--','-',$OutputFilename);
+ $cmd=join(' ',map{fnq$_}@args1)." | pnmquant 256 | ".
+ join(' ',map{fnq$_}@args2);
+ } elsif ($have_convert_p) {
+ my @args1=('sam2p','PPM:','--',$InputFilename,'-');
+ my @args2=('sam2p',@extra,"$tfmt:",'--','-',$OutputFilename);
+ # vvv Dat: `convert - GIF:-' does quantize (and emits GIF)
+ $cmd=join(' ',map{fnq$_}@args1)." | convert - GIF:- | ".
+ join(' ',map{fnq$_}@args2);
+ }
+ debug "Running pipe: $cmd";
+ exec($cmd);
+ } elsif ($? !=0) { die $res }
+ # die $cmd;
+ #debug "Running: $progname @extra @_";
+ #error "prog $progname failed: $? $!"
+ #if 0!=system $progname, @extra, @_; # Dat: non-zero exit() or not found
+ }
+ do_exec('sam2p', ("$tfmt:", '--', $InputFilename, $OutputFilename));
+ } else {
+ warning "post-processing of sam2p PDF output increases file size" if $tfmt eq 'PDF';
+ $tfmt='EPS' if $tfmt eq 'PDF'; # Imp: PDF1<->PDF
+ close IN;
+ my $tpfn=temp_prefix()."Psimg";
+ error "Cannot open temp pipe dest: $tpfn" unless open TP, "> $tpfn";
+ $tmpfiles{$tpfn}=1;
+ die unless close TP;
+ do_system('sam2p', ("$tfmt:", '--', $InputFilename, $tpfn));
+ error "Cannot open temp pipe src: $tpfn" unless open IN, "< $tpfn";
+ $already_read=0; $bytes_left=-1;
+ $InputFilename=$tpfn; # '-'
+ goto SCAN_AGAIN
+ }
+}
+
+#** Force this value for %%HiResBoundingBox if a %BoundingBox is read
+my $force_hiresbbox_value;
+
+### scan first line, check for DOS EPSF (and remove DOS headers)
+my $header;
+{ SCAN_AGAIN:
+ my $S;
+ $_=$header="";
+ read_error if 0>read IN, $S, 4;
+ error "$InputFilename: empty file" if 0==length($S);
+ $already_read+=length($S);
+ ##print tell(IN)." bar=$already_read\n";
+ my $iff="?"; # Input File Format
+ # vvv be permissive, since we have only 4 chars
+ if ($S eq "\211PNG") { $iff="PNG" }
+ elsif ($S=~/\A(\377+\330)\377/) { $iff="JPEG" }
+ elsif ($S eq "MM\000\052" or $S eq "II\052\000") { $iff="TIFF" }
+ elsif ($S=~m@\AP([1-6])[\s#]@) { $iff="PNM" }
+ elsif ($S=~/\ABM/) { $iff="BMP" }
+ elsif ($S eq "GIF8") { $iff="GIF" }
+ elsif ($S eq "FORM") { $iff="LBM" }
+ elsif ($S eq "/* X" or $S eq "/*XP") { $iff="XPM" }
+ elsif ($S=~/\A\12[\0-\005]\001[\001-\10]/) { $iff="PCX" }
+ elsif ($S=~/\A[\36-\77](?:\001[\001\11]|\0[\002\12\003\13])\0/) { $iff="TGA" }
+ elsif ($S eq "\305\320\323\306") { $iff="DOS-EPSF" }
+ elsif ($S eq "\033%-1") { $iff="UEL" }
+ elsif (substr($S,0,1)eq'%') { $iff="P" } # PS, EPS or PDF
+
+ # PNG JPEG TIFF PNM BMP GIF LBM XPM PCX TGA
+ if ($iff eq "DOS-EPSF") { # DOS EPSF header
+ read_error if 30-4>read IN, $S, 30-4, 4;
+ my ($eheader,$ps_ofs,$ps_len,$wmf_ofs,$wmf_len,$tif_ofs,$tif_len,$checksum)=
+ unpack"A4VVVVVVv", $S;
+ $already_read+=30-4;
+ error "$InputFilename: bad DOS EPS" if $eheader ne "\305\320\323\306" or $ps_ofs<30;
+ my($ps_end, $wmf_end, $tif_end)=($ps_ofs+$ps_len, $wmf_ofs+$wmf_len, $tif_ofs+$tif_len);
+ $ps_ofs-=30;
+ if (!seek IN, $ps_ofs, 1) {
+ while ($ps_ofs>4096) { $ps_ofs-=4096; readIN 4096 }
+ read_in $ps_ofs if $ps_ofs>0;
+ }
+ $bytes_left=($ps_end>$wmf_end and $ps_end>$tif_end) ? -1 : $ps_len;
+ $S=readIN(1);
+ } elsif ($iff eq "UEL") { # HP PJL UEL, untested
+ $S.=readIN;
+ $S=substr($S,1);
+ error "$InputFilename: bad HP PJL UEL header: ".(~chomp($S)&&$S)
+ if $S!~/\A\\e?%-12345X\@PJL ENTER LANGUAGE\s*=\s*POSTSCRIPT\s*\r?$/i;
+ 1 while length($S=readIN())!=0 and substr($S,0,4)ne'%!PS';
+ die "$InputFilename: premature HP PJL UEL header" if length($S)==0;
+ } elsif ($iff eq "P") {
+ # no-op yet, see later
+ } elsif ($iff eq "?") {
+ error "unknown input image format: $InputFilename";
+ } else { # source file is in some raster graphics format
+ run_sam2p($::opt_approx,$S);
+ goto SCAN_AGAIN
+ }
+
+ # now deal with PS, EPS and PDF
+ if (substr($S,0,1) eq '%') {
+ { my $max=128;
+ my $C;
+ while (length($S)<$max and defined($C=readIN(1)) and
+ $C ne "\n" and $C ne "\r") { $S.=$C }
+ error "couldn't find end of PS/PDF header line in $max bytes\n" if
+ length($S)>=$max or !defined($C);
+ $C=($C eq "\r") ? readIN(1) : "NONE";
+ if (!defined$C or ($C ne "\n" and $C ne "NONE")) {
+ use IO::Handle; # Dat: needed for ungetc
+ IN->ungetc(ord($C)) if defined $C;
+ debug "MAC \\r detected";
+ $in_mac_p=1;
+ } elsif ($C eq "\n") { # Dat: \r\n, DOS CRLF
+ $in_mac_p=0; $S.="\r";
+ } else { $in_mac_p=0 }
+ $S.="\n";
+ } # $S.=readIN;
+ if (substr($S,0,4)eq'%PDF') {
+ # error "$InputFilename: won't read a PDF file";
+ if ($FileFormat eq 'PDF') { # convert PDF to PDF
+ # !! PDF->PS->PDF
+ open_OUT();
+ $_=$S;
+ debug "Doing a bit-by-bit copy";
+ do {
+ error "input error: $!" unless print OUT;
+ } while (length($_=readIN 4096));
+ close OUT; close IN;
+ exit 0;
+ } elsif ($FileFormat eq 'PDF1') { # Dat: remove extra pages by running pdftops and gs -sDEVICE=pdfwrite
+ # !! Imp: possibly Run MetaPost output through full dvips (texc.pro) when prologues:=0
+ # !! Imp: add full dvips %* font comment when prologues:=1 (design sizes missing :-()
+ # Dat: no way to use $::opt_approx, because it doesn't remove extra pages
+ fix_pipe_in ".pdf", $S, 0; # in case of stdin
+ # Imp: option to open pdftops pipe instead of temp file
+ # Dat: we rather use a temp file here for safety and early error detection
+ do_input_pdftops: # come from EPS: and markedEPS:
+ close IN; # after fix_pipe_in()
+ my $tpfn=temp_prefix()."Peps";
+ error "Cannot open temp pipe dest: $tpfn" unless open TP, "> $tpfn";
+ $tmpfiles{$tpfn}=1;
+ die unless close TP;
+ do_system qw(pdftops -f 1 -l 1 -eps -- ), $InputFilename, $tpfn;
+ error "Cannot open temp pipe src: $tpfn" unless open IN, "< $tpfn";
+ $already_read=0; $bytes_left=-1;
+ $InputFilename=$tpfn; # '-'
+ goto SCAN_AGAIN
+ } elsif ($FileFormat eq 'EPS' or $FileFormat eq 'markedEPS') { # convert PDF to EPS
+ # Dat: limitation: markedEPS and EPS are treated the same
+ # vvv Dat: pdftops(1) is part of the xpdf package
+ # vvv Dat: pdftops(1) can emit to stdout
+ fix_pipe_in ".pdf", $S, 0;
+ if ($::opt_approx) {
+ do_exec qw(pdftops -f 1 -l 1 -eps --), $InputFilename, $OutputFilename;
+ } else { goto do_input_pdftops }
+ } elsif ($FileFormat eq 'PS' or $FileFormat eq 'markedPS') {
+ # Dat: limitation: markedEPS and EPS are treated the same
+ fix_pipe_in ".pdf", $S, 0;
+ close IN;
+ # vvv we must query the BoundingBox first
+ my $cmd="pdftops -f 1 -l 1 -eps ".fnq($InputFilename)." -";
+ debug "pdftops bbox pipe: $cmd";
+ error "pipe: $!" unless open PIPE, "$cmd |";
+ my $line;
+ error "expected PS document" if !defined($line=<PIPE>) or $line!~/^%!PS-Adobe-\d.*EPSF-\d/;
+ my @L; # $papersize_x, $papersize_y
+ while (<PIPE>) {
+ last if /^%%EndComments/ or !/^%/;
+ @L=($1,$2) if /^%%(?:Hires|Exact)BoundingBox:\s*\S+\s*\S+\s*(\S+)\s*(\S+)\s*$/i;
+ @L=($1,$2) if /^%%BoundingBox:\s*\S+\s*\S+\s*(\S+)\s*(\S+)\s*$/i and !@L;
+ # ^^^ Dat: HiRes has priority
+ # ^^^ Dat: ignore llx and lly coordinates
+ }
+ 1 while read PIPE, $line, 4096;
+ error "closing PIPE: $?" unless close PIPE;
+ error "BoundingBox not found in pdftops output" if !@L;
+ debug "Got PaperSize: @L";
+
+ # vvv Dat: pdftops without -eps doesn't report HiResBoundingBox,
+ # so we force it here
+ # at Wed Nov 15 17:19:23 CET 2006
+ $::opt_bboxfrom='adsc' if $::opt_bboxfrom eq 'guess';
+ $force_hiresbbox_value="0 0 @L";
+
+ #die defined $L[1];
+ $L[0]=myceil $L[0]; $L[1]=myceil $L[1]; # Dat: pdftops expects integer papersize :-( )
+ if ($::opt_approx) {
+ # vvv Dat: even pdftops 3.01 accepts only integer for -paperw and paperh
+ do_exec 'pdftops', '-paperw', myfloor($L[0]+0.5), '-paperh', myfloor($L[1]+0.5), $InputFilename, $OutputFilename;
+ } else {
+ my $tpfn=temp_prefix()."Pps";
+ error "Cannot open temp pipe dest: $tpfn" unless open TP, "> $tpfn";
+ $tmpfiles{$tpfn}=1;
+ die unless close TP;
+ do_system 'pdftops', '-paperw', myfloor($L[0]+0.5), '-paperh', myfloor($L[1]+0.5), $InputFilename, $tpfn;
+ error "Cannot open temp pipe src: $tpfn" unless open IN, "< $tpfn";
+ $already_read=0; $bytes_left=-1;
+ $InputFilename=$tpfn; # '-'
+ goto SCAN_AGAIN
+ }
+ } elsif (is_ok_sam2p() or is_via_sam2p()) {
+ # Dat: PDF to GIF conversion
+ run_sam2p(1,$S);
+ }
+
+ error "cannot create from PDF: FileFormat $FileFormat";
+ OK:
+ }
+ error "$InputFilename: EPS DSC must be %!PS-Adobe" if substr($S,0,4)ne'%!PS';
+ # ^^^ Dat: mpost outputs "%!PS\n"
+ } else {
+ warning "$InputFilename: no PS ADSC header, BoundingBox not found\n"
+ }
+ $header=$S;
+}
+
+# Dat: Now we are converting from PS|EPS to EPS|markedEPS|PDF|PCL5|PGM
+# So we're converting from PS|EPS with Ghostscript
+
+### variables and pattern for BoundingBox search
+my $bbxpatt = '[0-9eE\.\-]';
+my $BBValues = "\\s*($bbxpatt+)\\s+($bbxpatt+)\\s+($bbxpatt+)\\s+($bbxpatt+)"; # protect backslashes: "\\" gets '\'
+
+my $ll_zero=0; # ($llx,$lly)==(0,0) in the output file
+my $need_grestore=0; # 0 v 1
+#** Applies %%*BoundingBox, %%EndComments, special setpagedevice, gsave..translate
+#** @param $_[0] llx, may be undef to signify that bbox is undetected
+#** @param $_[1] lly
+#** @param $_[2] urx
+#** @param $_[3] ury
+#** @param $_[4] after_correct PostScript code (resolution, page size)
+#** @return PostScript code to be printed after the header
+sub CorrectBoundingBox($$$$$$$) {
+ no integer;
+ my $bbx="";
+ my $pagedev_mark="";
+ my $translate="";
+ my ($llx, $lly, $urx, $ury, $after_correct, $fontsdefs, $is_restored) = @_;
+ if (defined $llx) {
+ my ($xoffset, $yoffset) = (0, 0);
+ my $old_bbox="$llx $lly $urx $ury"; # debug "Old BoundingBox: $old_bbox";
+ # my ($width, $height) = ($urx - $llx, $ury - $lly);
+ ($xoffset, $yoffset) = (-$llx, -$lly);
+ # $::opt_below=0 if $lly>=0; # always move to (0,0)
+ # my ($urxh,$uryh)=($urx,$ury);
+ # my $no_translate=$::opt_below;
+ #die $no_translate;
+ ($llx,$lly,$urx,$ury)=(0,0,$urx-$llx,$ury-$lly) if !$::opt_below;
+ $urx=1 if $urx<=0; # Dat: GS dislikes empty image; fix also negative image
+ $ury=1 if $ury<=0;
+ my($px,$py)=($urx,$ury);
+ ($px,$py)=($1+0,$2+0) if $after_correct=~m@/PageSize\s*\[(\S+)\s+(\S+)+\]@;
+ my @paper=Htex::papers::any("$px,$py");
+ $paper[0]=defined $paper[0] ? "%%DocumentPaperSizes: $paper[0]\n" : "";
+ $bbx.="%%BoundingBox: ".myfloor($llx)." ".myfloor($lly)." ".
+ myceil($urx)." ". myceil($ury)."\n";
+ $bbx.="%%HiResBoundingBox: $llx $lly $urx $ury\n".
+ "%%ExactBoundingBox: $llx $lly $urx $ury\n" if myfloor($llx)!=$llx
+ or myfloor($lly)!=$lly or myceil($urx)!=$urx or myceil($ury)!=$ury;
+ $bbx.="%%DocumentMedia: plain $px $py 0 () ()\n". # like pdftops(1)
+ "$paper[0]";
+ # ^^^ Imp: can DocumentMedia be non-integer? As of us, it can.
+ # vvv we output a second /MediaBox here, and we'll remove the first one
+ # (written by GS) later
+ # vvv Dat: old version of Ghostscript insisted on an integer /CropBox (??).
+ # we do not force it now
+ $pagedev_mark.="mark /CropBox [$llx $lly $urx $ury] /PAGE pdfmark\n" if is_pdfmark();
+ # die "$xoffset $yoffset $::opt_below";
+ if ($xoffset==0 and $yoffset==0) { #**** pts ****
+ $need_grestore=0;
+ $ll_zero=1; # Dat: we do not insert extra /MediaBox here, gs -sDEVICE=pdfwrite will do
+ } elsif ($::opt_below) {
+ # Do not translate (set (0,0) to the origin) with --below or multi-page
+ # file formats.
+ $need_grestore=0;
+ $ll_zero=0; # fix /MediaBox because it become non-(0,0)-based
+ $pagedev_mark.="mark /MediaBox [$llx $lly $urx $ury] /PAGE pdfmark\n" if
+ is_pdfmark(); # $FileFormat eq 'markedEPS' or $FileFormat eq 'markedPS';
+ # Dat: markedPS and contains pdfmark!
+ } else {
+ # debug "Offset:", $xoffset, $yoffset; # no new information, see -$llx, -$lly
+ $xoffset=0 if $xoffset==0; # get rid of `-0'
+ $yoffset=0 if $yoffset==0; # get rid of `-0'
+ if ($is_restored) { $translate="" } # save..restore does gsave..grestore
+ else { $translate="gsave "; $need_grestore=1 }
+ $ll_zero=0;
+ # vvv the /MediaBox is different from what gs dumps
+ # $pagedev_mark=~s@/PageSize\s*\[[^\]]*]@/PageSize [$urx $ury]@; # BUGFIX at Tue Apr 22 10:08:17 CEST 2003
+ $pagedev_mark.="mark /MediaBox [$llx $lly $urx $ury] /PAGE pdfmark\n" if is_pdfmark();
+ $translate.="$xoffset $yoffset translate\n"
+ }
+ my $new_bbox="$llx $lly $urx $ury";
+ if ($old_bbox eq $new_bbox) {
+ debug "Final (HiRes)BoundingBox: $new_bbox";
+ } else {
+ debug "Old (HiRes)BoundingBox: $old_bbox";
+ debug "Final corrected (HiRes)BoundingBox: $new_bbox";
+ }
+ $pagedev_mark="/pdfmark where{pop}{/pdfmark/cleartomark load def}ifelse\n$pagedev_mark"
+ if length($pagedev_mark)!=0;
+ }
+ # vvv Imp: `<<' -> `dict'
+ # Dat: it is inherently impossible to tell GS that it shouldn't
+ # recompress the images already compressed in the EPS file, but keep
+ # them in their original, compressed form. So we rather instruct GS to
+ # recompress
+ # !! Dat: /CompatibilityLevel 1.3 %PDF-1.2 -- Dat: 1.2 won't embed Courier
+ my $markpagedevices="";
+ my $imagesopts=($::opt_lossy ? "
+/AutoFilterMonoImages true
+/AutoFilterGrayImages true
+/AutoFilterColorImages true
+/MonoImageFilter /CCITTFaxEncode
+/GrayImageFilter /DCTEncode
+/ColorImageFilter /DCTEncode
+" : "
+/AutoFilterMonoImages false
+/AutoFilterGrayImages false
+/AutoFilterColorImages false
+/MonoImageFilter /LZWEncode
+/GrayImageFilter /LZWEncode
+/ColorImageFilter /LZWEncode
+"); # Dat: assumes new, patent-free LZW
+ if (is_pdfmark()) {
+ # Dat: CompatibilityLevel 1.3 is required for font embedding & all /FlateDecode
+ $markpagedevices="
+/CompatibilityLevel 1.3 %PDF-1.3
+/EmbedAllFonts true
+/Optimize true % ignored by gs-6.70
+/AutoRotatePages /None
+/UseFlateCompression ".($::opt_compression ne 'none'?"true":"false")."
+/AutoPositionEPSFiles false
+/ConvertImagesToIndexed false
+/DownsampleMonoImages false
+/DownsampleGrayImages false
+/DownsampleColorImages false
+/EncodeMonoImages true
+/EncodeGrayImages true
+/EncodeColorImages true
+/AntiAliasMonoImages false
+/AntiAliasGrayImages false
+/AntiAliasColorImages false\n$imagesopts";
+ $markpagedevices=(length($markpagedevices)!=0 ? "<< $markpagedevices >> setpagedevice\n" : "");
+ $markpagedevices.="1 dict dup /ImagingBBox null put setpagedevice\n";
+ $markpagedevices.="1 dict dup /Policies 1 dict dup /PageSize 3 put put setpagedevice\n"; # ripped from pdftops(1)
+ }
+ my $setpagesize="";
+ # die defined $urx;
+ # die is_set_pagesize_ok();
+ # die $after_correct;
+ if (defined $urx and is_set_pagesize_ok()
+ and $::opt_papersize ne'force-unknown'
+ and $after_correct!~m@/PageSize\s*\[@) { # Imp: m@/Pagesize ugly
+ # Dat: true for FileFormat PGM
+ # Dat: emit /PageSize even for PDF1
+ # Dat: Ghostscript 6.70 rounds /PageSize down, but we need up when creating /MediaBox for PDF
+ $setpagesize="2 dict dup /PageSize [".myceil($urx)." ".myceil($ury)."] put setpagedevice\n";
+ # ^^^ Dat: PLRM.pdf doesn't forbid a non-integer /PageSize
+ }
+ my $bsetup=is_page1_stop()?"":"%%BeginSetup\n%%EndSetup\n";
+ # ^^^ Dat: CUPS inserts its setpagedevice calls for /Duplex and /PageSize
+ # etc. just after the %%BeginSetup line (or, if missing, puts it in
+ # front of the first %%Page). We'd like this execution order: CUPS,
+ # ours, PStoPS (or psnup). (When we come after CUPS, we'll have a
+ # chance to override its settings.) So we emit a fake
+ # %%BeginSetup..%%EndSetup pair just before our code doing
+ # `setpagedevice'.
+ # !! ?? run pstops first, and then a2ping.pl
+ # !! why does a PDF -> PS conversion need $is_restored?
+ # vvv Dat: `mark' is necessary, because pstops 1.17 from xpdf(1) emits lines
+ # lines leaving `false' on the stack:
+ # %%BeginResource: font SKPOPP+LMRoman12-Regular
+ # %!PS-AdobeFont-1.0: LMRoman12-Regular 0.86
+ # %%CreationDate: 4th August (Monday) 2003
+ # % Generated by MetaType1 (a MetaPost-based engine)
+ # % CM sources: copyright (C) 1997 AMS, all rights reserved; METATYPE1/Type 1 ver
+ # % ADL: 694 194 112
+ # %%EndComments
+ # FontDirectory/LMRoman12-Regular known{/LMRoman12-Regular findfont dup/UniqueID
+ # /UniqueID get 0 eq exch/FontType get 1 eq and}{pop false}ifelse
+ # {save true}{false}ifelse}{false}ifelse
+ my $save=$is_restored?"save mark\n":"";
+ $bbx.$fontsdefs."%%EndComments\n".$bsetup.$setpagesize.$markpagedevices.$pagedev_mark.$after_correct.$save.$translate
+}
+
+### scan header
+my $to_OUT="";
+my $after_code="";
+my $do_fix_tumble=0;
+my $is_restored=0;
+if (1<length($header)) {
+ my($llx,$lly,$urx,$ury);
+ my($bbtype)='-'; # None
+ my $allow_adsc_bb=1;
+ my $after_correct="";
+ my $do_bb_line=sub { # sub do_bbline($$)
+ no integer;
+ # Decreasing precedence of various BoundingBoxes:
+ # The last valid *bbox entry has effect.
+ # Active policy:
+ # normal mode : BoundingBox ExactBoundingBox HiResBoundingBox
+ # --hires mode: HiResBoundingBox BoundingBox ExactBoundingBox
+ # --exact mode: ExactBoundingBox BoundingBox HiResBoundingBox
+ # -hi -ex mode: ExactBoundingBox HiResBoundingBox BoundingBox
+ # Another possible policy:
+ # normal mode : BoundingBox HiResBoundingBox==ExactBoundingBox
+ # --hires mode: HiResBoundingBox ExactBoundingBox BoundingBox
+ # --exact mode: ExactBoundingBox HiResBoundingBox BoundingBox
+ # -hi -ex mode: ExactBoundingBox==HiResBoundingBox BoundingBox
+ my($S,$from)=@_;
+ return if $S!~/^(?:$BBregex|set)$BBValues/oi;
+ # print STDERR "($S)\n";
+ my $E1=defined$1 ? $1 : "+";
+ my $T=!defined($1) ? 'S' : uc substr $1,0,1; # '' || 'H' || 'E'
+ # debug "Trying BoundingBox T-$bbtype: $llx $lly $urx $ury";
+ if ($T eq 'S'
+ or !$::opt_hires and !$::opt_exact and ($T eq '' or ($bbtype ne '' and ($T eq 'E' or $bbtype ne 'E')))
+ or $::opt_hires and !$::opt_exact and ($T eq 'H' or ($bbtype ne 'H' and ($T eq '' or $bbtype ne '')))
+ or $::opt_exact and !$::opt_hires and ($T eq 'E' or ($bbtype ne 'E' and ($T eq '' or $bbtype ne '')))
+ or $::opt_exact and $::opt_hires and ($T eq 'E' or ($bbtype ne 'E' and ($T eq 'H' or $bbtype ne 'H')))
+ ) {
+ # if ($allow_bb) {
+ ($bbtype,$llx,$lly,$urx,$ury)=($T,$2+0,$3+0,$4+0,$5+0);
+ debug "Applying ${E1}BoundingBox$from T-$bbtype: $llx $lly $urx $ury";
+ # }
+ } else {
+ my @L=($2+0,$3+0,$4+0,$5+0); # convert 0.00 to 0
+ debug "Ignoring ${E1}BoundingBox$from T-$bbtype: @L";
+ }
+ # Dat: don't do $do_bb_line=sub{};# same as $allow_bb=0;
+ };
+ $header=~s@\r\n?\Z(?!\n)@@;
+ my $after_comments=""; # after %%EndComments
+ # my $res;
+ { my $headEPSF;
+ my $headPS="PS-Adobe-3.0";
+ # vvv Imp: run this correction even w/o input EPS header
+ if ($header!~s/\s+(EPSF-[.\d]+)$// or $::opt_bboxfrom ne 'guess') { # a PS not an EPS already
+ # This is the compute-pipe routine.
+ # To convert an [E]PS to an EPS:
+ # -- find the end of the 1st page in the code, and remove everything after it
+ # -- `pop' off the execution stack after the 1st page
+ # -- `end' the dictionary stack after the 1st page
+ # -- change the ADSC magic `%!PS-Adobe-...' to `%!PS-Adobe-3.0 EPSF-3.0'
+ # -- remove the `%%Pages', `%%DocumentPaperSizes', `%%PageOrder:'
+ # (Ascending) comment from the ADSC header
+ # -- possibly remove the `%%Page' ADSC comment [no]
+ # -- ignore calls to = setpage setpagemargin setpageparams .setpagesize
+ # setpagedevice setpagetype setprintername setresolution a4 letter ...
+ # -- surround the code by save ... pop* end* restore (implies gsave ... grestore)
+ # -- possibly ignore calls to showpage [showpage is forced]
+ $headEPSF=" EPSF-3.0";
+ debug "Computing BBox info from non-EPS PS file";
+ fix_pipe_in 'i.ps', "%!$headPS\n", 0;
+ my $tfn=temp_prefix()."c.tgs";
+ error "temp open $tfn: $!" unless open F, "> $tfn";
+ $tmpfiles{$tfn}=1;
+ ##print tell(IN)." car=$already_read\n";
+ die "$0: $!\n" unless print F "% this is temporary gs command file created by $program".'
+/DOCUT true def
+/MAINFILE FN (r) file def
+/DICTCOUNT countdictstack def
+count /OPCOUNT exch def
+<</BeginPage { % <PageCount> BeginPage -
+ dup 1 eq {
+ count OPCOUNT sub 1 sub (pop-count==) ..print ===
+ countdictstack DICTCOUNT sub (end-count==) ..print ===
+ DOCUT { (cut-offset==) ..print MAINFILE fileposition === flush } if
+ (bbox-success\n) ..print
+ quit
+ } if
+ .callbeginpage
+ }
+>> setpagedevice
+
+% vvv do these after our call to /setpagedevice
+.currentglobal true .setglobal
+systemdict begin
+/..paper.redef<< >>def
+/..print/print load def
+/setpageparams{pop pop pop pop (\nset-called-4==/setpageparams\n) ..print flush}def
+/setpage{pop pop pop (\nset-called-3==/setpage\n) ..print flush}def
+/setpagesize{pop pop (\nset-called-2==/setpagesize\n) ..print flush}def
+/.setpagesize{pop pop (\nset-called-2==/.setpagesize\n) ..print flush}def
+/setpagemargin{pop (\nset-called-1==/setpagemargin\n) ..print flush}def
+{% anti-Windows-printer-driver `%%[ ProductName:` etc.
+ dup type/stringtype eq{
+ dup length 3 ge{
+ dup 0 3 getinterval (%%[) eq{
+ (\nset-called-1==/=\n) ..print flush
+ (\nset-called-1==/print\n) ..print flush
+ }if}if}if
+ pop
+}
+dup/= exch def /print exch def
+/setpagedevice{pop (\nset-called-1==/setpagedevice\n) ..print flush}def
+/..sdict <<
+ /PageSize { % [. .] PageSize -
+ dup type /arraytype eq {
+ dup length 2 ge {
+ dup 0 get type dup /integertype eq exch /realtype eq or {
+ dup 1 get type dup /integertype eq exch /realtype eq or {
+ (\npapersize-x==) ..print dup 0 get ===
+ (\npapersize-y==) ..print dup 1 get === (\n) ..print
+ } if
+ } if
+ } if
+ } if
+ pop
+ }
+ /HWResolution { % [. .] PageSize -
+ dup type /arraytype eq {
+ dup length 2 ge {
+ dup 0 get type dup /integertype eq exch /realtype eq or {
+ dup 1 get type dup /integertype eq exch /realtype eq or {
+ (\nresolution-x==) ..print dup 0 get ===
+ (\nresolution-y==) ..print dup 1 get === (\n) ..print
+ } if
+ } if
+ } if
+ } if
+ pop
+ }
+ /Duplex { % [. .] PageSize -
+ dup type /booleantype eq {
+ (\nsides-duplex==) ..print dup === (\n) ..print
+ } if
+ pop
+ }
+ /Tumble { % [. .] PageSize -
+ dup type /booleantype eq {
+ (\nsides-tumble==) ..print dup === (\n) ..print
+ } if
+ pop
+ }
+>> def
+%/.setpagesize{pop pop (hehehe\n) print} def
+% /a4{(hehehe\n) ..print} def % doesn"t work, has to be put into userdict
+/setpagedevice{
+ { % <key> <val>
+ exch dup ..sdict exch known { % run all keys known in ..sdict
+ ..sdict exch get exec
+ } {pop pop} ifelse
+ } forall
+ (\nset-called-1==/setpagedevice\n) ..print flush
+}def
+/setpagetype{pop (\nset-called-1==/setpagetype\n) ..print flush}def
+/setprintername{pop (\nset-called-1==/setprintername\n) ..print flush}def
+/setresolution{pop (\nset-called-1==/setresolution\n) ..print flush}def
+[ % Dat: fixed at Mon May 19 14:32:31 CEST 2003
+ statusdict /.pagetypenames 2 copy known {get}{pop pop{}}ifelse
+ % ^^^ Dat: may be {/a4 STRICT {(%END SIZES) .skipeof} if /a5}
+ { /11x17/a3/a4/a4small/b5/ledger/legal/letter % GS 7.04
+ /lettersmall/note/a0/a1/a2/a5/a6/a7/a8/a9/c0/c1/c2/c3/c4/c5/c6
+ /a10/b0/b1/b2/b3/b4/b5/b6
+ /isob0/isob1/isob2/isob3/isob4/isob5/isob6
+ /jisb0/jisb1/jisb2/jisb3/jisb4/jisb5/jisb6
+ /archE/archD/archC/archB/archA/flsa/flse/halfletter
+ /tabloid/csheet/dsheet/esheet/executivepage/com10envelope
+ /monarchenvelope/c5envelope/dlenvelope/folio/quarto
+ }
+]{{
+ dup type /nametype eq { dup xcheck not { % Dat: fixed
+ % dup ===
+ dup ..paper.redef exch known {pop} {
+ dup ..paper.redef exch null put
+ dup userdict exch 2 copy known { 2 copy get
+ 1 index userdict exch undef
+ % Stack: /a4 userdict /a4 {...}
+ % 3 copy pop undef
+ 4 2 roll exch undef
+ } { exch pop pop {} } ifelse
+ % Stack: /a4 {595 842 //.setpagesize --exec--}
+ % Stack: /a4 {595 842 {/statusdict --.systemvar-- --begin-- .setpagesize --end--} --exec--}
+ { /get exec /pop (\nset-called-0==) ..print === flush } % dump
+ dup length array copy cvx % make a copy for subsequent invocations
+ 2 copy exch 0 exch put exch pop % change /get to {...}
+ 2 copy exch 2 exch put % change /pop to /a4
+ def % overwrite it in systemdict
+ } ifelse
+ true
+ } if } if
+ pop
+}forall} forall
+end % systemdict
+.setglobal
+systemdict readonly pop
+
+(bbox-begin\n) ..print
+MAINFILE cvx exec
+(add-showpage==1\n) ..print
+/DOCUT false def
+showpage quit
+';
+ die unless close F;
+ # vvv Imp: make it work on Win32 (no >&1 redirection)
+ my $gs3=$CGS. # "-dPAGE1QUIT=".($FileFormat eq 'EPS' or $FileFormat eq 'markedEPS' ? 'quit' : '{}').
+ " -dWRITESYSTEMDICT -dNOPAUSE -sDEVICE=bbox -sFN=".fnq($InputFilename)." ".fnq($tfn)." 2>&1";
+ debug "Ghostscript compute pipe: $gs3";
+ my $res=`$gs3`;
+ ## die $res;
+ temp_unlink $tfn;
+ ## print STDERR $res;
+ error $?==11 ? "segmentation fault in $GS" : "not a GS output from $GS ($?)"
+ if !defined $res # BUGFIX at Sun Mar 7 18:51:34 CET 2004
+ or $res!~s/\A(?:\w+ Ghostscript \d|Copyright .* artofcode ).*\n// # AFPL Ghostscript 6.50 (2000-12-02)
+ or $res!~s/.*?^bbox-begin\n//m;
+ if ($res!~s/\nbbox-success\n\Z(?!\n)/\n/) {
+ warning # not `error', mpost(1) `prologues:=0; ... btex fonts' output won't compile
+ "BBox discovery was not successful";
+ # !! continue only if MetaPost output?
+ goto SKIP_BBOX_DISC;
+ }
+ #: Copyright (C) 2000 Aladdin Enterprises, Menlo Park, CA. All rights reserved.
+ #: This software comes with NO WARRANTY: see the file PUBLIC for details.
+ #: set-called-0==/a4
+ #: %%BoundingBox: 56 41 539 783
+ #: %%HiResBoundingBox: 56.645998 41.849999 538.811984 782.351976
+ #: pop-count==0
+ #: end-count==1
+ #: cut-offset==81898
+ my $pop_count=0;
+ my $end_count=0;
+ my $cut_offset=-1;
+ my $papersize_x=undef; # page_width
+ my $papersize_y=undef; # page_height
+ my $resolution_x=undef;
+ my $resolution_y=undef;
+ my $duplexi=0;
+ my $tumblei=0;
+ my %H;
+ my $undefs="";
+ my $bbc=0; # required
+ for my $line (split/\n/, $res) {
+ if ($line=~/^$BBregex$BBValues/oi) { $do_bb_line->($line," from Compute-GS"); $bbc++ }
+ elsif ($line=~m@^set-called-(\d+)==/(\S+)$@) {
+ if (not exists $H{$2}) {
+ $H{$2}=1;
+ $undefs.="/$2".(
+ $1==0 ? "{}def\n" :
+ $1==1 ? "/pop load def\n" :
+ "{".("pop "x$1)."}bind def\n"
+ );
+ }
+ # Dat: Safe, restorable, EPS-wise: /setpagedevice {pop} def
+ # Dat: Smart, documentwise /a4 dup where{dup wcheck{exch{}put}{pop{}def}ifelse}{pop}ifelse
+ }
+ elsif ($line=~/^pop-count==(\d+)$/) { $pop_count=$1+0 }
+ elsif ($line=~/^end-count==(\d+)$/) { $end_count=$1+0 }
+ elsif ($line=~/^cut-offset==(\d+)$/) { $cut_offset=$1+0 }
+ elsif ($line=~/^papersize-x==([-+0-9eE.]+)$/) { no integer; $papersize_x=$1+0 }
+ elsif ($line=~/^papersize-y==([-+0-9eE.]+)$/) { no integer; $papersize_y=$1+0 }
+ elsif ($line=~/^resolution-x==([-+0-9eE.]+)$/) { no integer; $resolution_x=$1+0 }
+ elsif ($line=~/^resolution-y==([-+0-9eE.]+)$/) { no integer; $resolution_y=$1+0 }
+ elsif ($line=~/^sides-duplex==true$/) { $duplexi=1 }
+ elsif ($line=~/^sides-dumplex==false$/) { $duplexi=2 }
+ elsif ($line=~/^sides-tumble==true$/) { $tumblei=1 }
+ elsif ($line=~/^sides-tumble==false$/) { $tumblei=2 }
+ elsif ($line=~/^add-showpage==\d+$/) { } # !!
+ elsif (length($line)==0 or $line=~/^(?:Copyright |This software )/) {}
+ elsif ($line=~/^Loading (\S+) font from.*[.][.][.]/) { debug "GS builtin font used: $1" }
+ else { debug "unknown line ($line)" }
+ }
+ undef $papersize_y if !defined $papersize_x;
+ die unless $allow_adsc_bb==1;
+ # Dat: This only applies when converting fron non-EPS PS:
+ # Setting $allow_adsc_bb=0|1 now would disallow/allow the %%BoundingBox
+ # etc. ADSC comment override the bbox computed by -sDEVICE=bbox.
+ # When converting PS -> EPS, the PS file usually contains
+ # `%%BoundingBox: 0 0 paperwidth paperheight', but the figure
+ # itself is smaller.
+ $bbtype='-';
+ ## die "$papersize_x;;"; # PDF -sPAPERSIZE=a4
+ #if ($::opt_papersize ne 'force-unknown' and $::opt_papersize ne 'unchanged') {
+ # # override bbox
+ # ($llx,$lly)=(0,0);
+ # ($urx,$ury)=split/,/,$::opt_papersize;
+ #} elsif (!is_page1_stop() and defined $papersize_x and defined $papersize_y) {
+ #}
+ debug "PaperSize wd=${papersize_x}bp ht=${papersize_y}bp" if defined $papersize_x;
+ if ($::opt_papersize eq 'force-unknown' or ($::opt_papersize eq 'unchanged' and !defined $papersize_x)) {}
+ elsif ($::opt_papersize ne 'unchanged') {
+ die if is_page1_stop();
+ ($papersize_x,$papersize_y)=split/,/,$::opt_papersize;
+ goto do_force_papersize
+ } else {
+ # Dat: no $do_bb_line here, because we've done it with $bbc++, and we'll also do it later
+ do_force_papersize:
+ die if is_page1_stop();
+ # vvv ($llx,$lly,$urx,$ury)=(0,0,$papersize_x,$papersize_y);
+ # $do_bb_line->("set 0 0 $papersize_x $papersize_y"," from /PageSize");
+ $after_correct.="1 dict dup /PageSize [".myceil($papersize_x)." ".myceil($papersize_y)."] put setpagedevice\n";
+ # ^^^ Dat: both PS and markedPS would benefit from /PaperSize
+ # ^^^ Dat: will be put after CorrectBoundingBox
+ # Dat: unneeded: $allow_adsc_bb=0 if $FileFormat eq 'PDF'; # force this into /CropBox (otherwise only /MediaBox)
+ }
+ if (defined $papersize_x and ($::opt_bboxfrom eq 'papersize' or ($::opt_bboxfrom eq 'guess' and is_set_pagesize_ok()))) {
+ $allow_adsc_bb=0;
+ $do_bb_line->("set 0 0 $papersize_x $papersize_y"," from /PageSize"); # does ($llx,$lly,$urx,$ury)=(0,0,$papersize_x,$papersize_y);
+ }
+ $allow_adsc_bb=0 if ($::opt_bboxfrom eq 'compute-gs') ? ($bbc!=0)
+ : ($::opt_bboxfrom eq 'guess') ? ($bbc!=0 and is_page1_stop()) # Imp: is is_page1_stop() OK here?
+ : 0;
+ if (!is_page1_stop()) {
+ $pop_count=$end_count=0; # assume PS is correct
+ $cut_offset=-1;
+ }
+ # if ($FileFormat ne 'EPS' and $FileFormat ne 'PS') { # device-specific (marked)
+ # ^^^ Dat: $::opt_resolution and $::opt_duplex are already 'force-unknown' if $FileFormat is appropriate
+ {
+ $::opt_resolution=$resolution_x.','.$resolution_y if
+ $::opt_resolution eq 'unchanged' and defined $resolution_x and defined $resolution_y;
+
+ # vvv Imp: move down like $::opt_resolution
+ if ($::opt_duplex eq 'force-unknown' or ($::opt_duplex eq 'unchanged' and $duplexi==0)) { $do_fix_tumble=($duplexi==1 && $tumblei==1) }
+ elsif ($::opt_duplex eq 'force-simplex') { do_simplex: $after_correct.="1 dict dup /Duplex false put setpagedevice\n" }
+ elsif ($::opt_duplex eq 'force-long' ) { do_long: $after_correct.="2 dict dup /Duplex true put dup /Tumble false put setpagedevice\n" }
+ elsif ($::opt_duplex eq 'force-short') { do_short: $do_fix_tumble=1; $after_correct.="2 dict dup /Duplex true put dup /Tumble true put setpagedevice\n" }
+ else {
+ $duplexi ||= $::opt_duplex eq 'default-simplex' ? 2 : 1;
+ $tumblei ||= $::opt_duplex eq 'default-short' ? 1 : 2;
+ goto do_simplex if $duplexi!=1;
+ goto do_long if $tumblei!=1;
+ goto do_short;
+ }
+ }
+ # vvv Dat: save...restore is _always_ necessary to undo the changes made
+ # by the file itself (??)
+ # vvv BUGFIX (only EPS) at Tue Feb 8 21:40:11 CET 2005
+ # vvv Dat: now with PS output it is possible that garbage is left on
+ # the stack (see the `LMRoman' example above)
+ $is_restored=1 if $FileFormat eq'EPS' or $FileFormat eq'markedEPS';
+ $after_comments.=$undefs; # after our precious setpagedevice calls
+ # debug "pop_count=$pop_count;";
+ # debug "end_count=$end_count;";
+ # debug "cut_offset=$cut_offset;";
+ $after_code.=("pop\n"x$pop_count).("end\n"x$end_count);
+ if ($cut_offset>=0 and ($bytes_left==-1 or $cut_offset<$bytes_left)) {
+ $bytes_left=$cut_offset-$already_read;
+ ##print tell(IN)." ar=$already_read\n";
+ debug "Cutting after showpage at $cut_offset -> $bytes_left";
+ # ^^^ Dat: cutting after `showpage' makes PS -> EPS conversion easy
+ # sleep 1000;
+ }
+ # Dat: don't unlink $tifn yet, we'll continue scanning it
+ # Imp: verify EPS created
+ } else { $headEPSF=" $1" }
+ SKIP_BBOX_DISC:
+ if ($::opt_resolution eq 'force-unknown' or $::opt_resolution eq 'unchanged') {}
+ else { $after_correct.="1 dict dup /HWResolution [@{[split/[x,]/,$::opt_resolution]}] put setpagedevice\n" }
+ # ^^^ Dat: syntax already ok for $::opt_resolution
+ $after_correct.="2 dict dup /TextAlphaBits 4 put dup /GraphicsAlphaBits 4 put setpagedevice\n" if
+ $::opt_antialias eq 'yes' or $::opt_antialias eq 'scale3yes';
+
+ $headEPSF="" if $FileFormat ne 'EPS' and $FileFormat ne 'markedEPS';
+ $headPS=$1 if $header=~s/(PS-Adobe-[.\d]+)$//;
+ $to_OUT.="%!$headPS$headEPSF\n";
+ }
+
+ debug "Scanning header for BoundingBox";
+ my $do_atend=0;
+ my $doing_atend=0;
+ my $saved_pos;
+ my $saved_bytes_left;
+ my $creator_metapost_p=0; # HiResBoundingBox: after EndProlog
+ my $creator_adobeps_p=0;
+ my $had_pages=is_page1_stop(); # Dat: don't put `Pages:' to target EPS
+ my $fontsdefs="";
+ my %fontsnames;
+ my @creator;
+ read_again: while (length($_=readIN)) {
+ #print STDERR "(($_))\n";
+ ### end of header
+ next unless /\S/;
+ y@\r@@d; chomp;
+ if (!$doing_atend) {
+ if (/^%%EndComments\b/i) {
+ # Dat: EPSI created by ImageMagick has BeginDefaults+EndDefaults+BeginPreview
+ # Dat: PS output by ADOBEPS4.DRV has BeginDefaults+PageBoundingBox+ViewingOrientation+PageFeatures+EndDefaults
+ 1 while length($_=readIN) and !/\S/;
+ if (!/^%%BeginDefaults\b/i) { y@\r@@d; chomp; $after_comments.="$_\n"; last }
+ 1 while length($_=readIN) and !/\S/;
+ if (!/^%%EndDefaults\b/i) { y@\r@@d; chomp; $after_comments.="%%BeginDefaults\n$_\n"; last }
+ next
+ } elsif (/^%%EndDefaults\b/i) { # EPSI created by ImageMagick
+ } elsif (/^%%Creator:\s*ADOBEPS/i) { # ADOBEPS4.DRV
+ # Emits ``%%BoundingBox 1 1 ...' instead of `0 0'
+ $creator_adobeps_p=1;
+ } elsif (/^%%Creator:\s*MetaPost\b/i) {
+ $creator_metapost_p=1;
+ } elsif ((substr($_,0,2)ne'%%' and substr($_,0,7)ne'%*Font:' and
+ substr($_,0,5)ne'%ADO_' and !/^%AI\d_/ # Dat: %ADO_DSC_..., %AI7_Thumbnail
+ and substr($_,0,5)ne'%EPS ') # epsincl.mp
+ or !$creator_metapost_p and substr($_,0,5)eq'%%End'
+ or /^%%Begin(?:Prolog|Setup)\b/i
+ ) { $after_comments.="$_\n"; last }
+ }
+ if (/^%%BeginPreview\b/i) { # remove EPSI preview ballast ****pts****
+ while (1) {
+ error "Missing EPSI %%EndPreview" if !length($_=readIN);
+ last if /^%%EndPreview\b/;
+ y@\r@@d; chomp
+ }
+ } elsif (/^%%Creator:\s*(.*)/i) {
+ push @creator, $1;
+ $creator[-1]=~s@\s+\Z(?!\n)@@;
+ $creator[-1]=~s@, a2ping .*@@; # remove old
+ } elsif (/^%%(?:DocumentPaperSizes|PageOrder|DocumentMedia):/i) {
+ # silently ignore these -- will be recalculated
+ } elsif (/^%%Pages:\s+(\d+)\s*/i and !$had_pages) { # Not `%%Pages: (atend)'
+ # Dat: don't `$do_atend=1' only for %%Pages
+ $to_OUT.="$_\n"; $had_pages=1
+ } elsif (/^%%Pages:/i) {
+ # silently ignore these -- not significant for EPS
+ } elsif (/^$BBregex$BBValues/oi) { ### BoundingBox with values
+ s@($BBregex)\s*1\s+1\s+@$1 0 0 @ if $creator_adobeps_p;
+ # vvv $bbtype may be possibly already set by compute-gs
+ if ($allow_adsc_bb) {
+ $do_bb_line->($_," from ADSC");
+ if ($force_hiresbbox_value) {
+ $do_bb_line->("%%HiResBoundingBox: $force_hiresbbox_value"," from ADSC");
+ }
+ }
+ } elsif (/^$BBregex\s*\(atend\)/oi) {
+ ### BoundingBox with (atend)
+ debug "At end $1BoundingBox";
+ # warning "Cannot look for BoundingBox in the trailer with option --filter" if $::opt_filter;
+ # ^^^ Dat: may be seekable anyway, omit warning
+ $do_atend=1
+ } elsif (/^%%Page:/i and !$creator_metapost_p) { # at Thu Sep 25 15:59:52 CEST 2003
+ $after_comments.="$_\n"; last
+ } elsif (/^%(?:ADO_DSC_|AI\d_)/) { # Dat: example: %ADO_DSC_Encoding: MacOS Roman
+ $to_OUT.="%$_\n";
+ } elsif (/^%\*Font:\s+(\S+)\s+/) { # mpost(1) output
+ ## debug $_;
+ $fontsdefs.="$_\n"; # put in front (before `gsave ... translate')
+ $fontsnames{$1}=1;
+ } elsif (substr($_,0,5) eq '%EPS ') { # epsincl.mp
+ $after_correct.="$_\n" if !$doing_atend; # before `gsave'
+ } elsif ($doing_atend or /^%%End/) {
+ # we might be in mid-line
+ } else {
+ $to_OUT.="$_\n"
+ }
+ }
+ if ($doing_atend) { # already read (atend); restore file position
+ seek(IN, $saved_pos, 0) or error "Input unseekable, cannot go back to line `: (atend)'";
+ $bytes_left=$saved_bytes_left;
+ } elsif ($do_atend) { # seek to near EOF and try again
+ # error "Cannot leave line `: (atend)'" if ($saved_pos=tell IN)<0 or !seek(IN,0,1);
+ fix_pipe_in "j.ps", $to_OUT, 0;
+ die if ($saved_pos=tell IN)<0;
+ $saved_bytes_left=$bytes_left;
+ # vvv get the very last *BoundingBox entry from the last 4096 bytes
+ if ($bytes_left>4096) {
+ die unless seek(IN, $bytes_left-4096, 1);
+ $bytes_left=4096;
+ } elsif ($bytes_left<0) {
+ die unless seek(IN, -4096, 2) or seek(IN, 0,0); # Dat: 0,0 for short files
+ }
+ $doing_atend=1; goto read_again;
+ }
+ # if (!$had_pages) { debug "Lying %%Pages: 1"; $to_OUT.="%%Pages: 1\n" }
+ # ^^^ Dat: rather not lie !! go to (atend) if command line
+ # vvv Dat: $bbtype ne'-' would be a bad idea
+ warning "BoundingBox not found, try --bboxfrom=compute-gs" if !defined $llx; # !! compute-gs
+ push @creator, "$program $Htex::a2ping::VERSION"; # if "@creator"!~/\ba2ping\b/;
+ $to_OUT.="%%Creator: ".join(", ",@creator)."\n"; # before CorrectBoundingBox to be before `gsave' etc.
+ $to_OUT.=CorrectBoundingBox $llx, $lly, $urx, $ury, $after_correct, $fontsdefs, $is_restored;
+ $to_OUT.=$after_comments;
+ if (%fontsnames) { # !! save .. restore
+ $to_OUT.="{@{[sort keys%fontsnames]}}{\ndup where{pop pop}{cvlit dup def}ifelse}forall\n";
+ $to_OUT.="/fshow where{pop}{/fshow{exch findfont exch scalefont setfont show}bind def}ifelse\n";
+ }
+}
+
+### open output file or pipe (do this as late as possible)
+my $do_scale3_pnm=0;
+my $scale3_pnm_fn;
+my @pnm2sampled_cmd;
+if ($FileFormat eq 'PDF' or $FileFormat eq 'PDF1') {
+ my $ofn=$ll_zero ? $OutputFilename : fix_pipe_out('.pdf');
+ my $pipe = "$GS -q -dBATCH -sDEVICE=pdfwrite $GSOPTS -sOutputFile=".fnq($ofn)." -";
+ debug "Ghostscript ps2pdf pipe:", $pipe;
+ open(OUT, "| $pipe") or error "Cannot open Ghostscript pipe";
+} elsif ($FileFormat eq 'PCL5') {
+ my $ofn=$do_fix_tumble ? fix_pipe_out('.pcl5') : $OutputFilename;
+ # vvv ljet4 cannot do duplex, ljet4d can
+ my $pipe = "$GS -q -dBATCH -sDEVICE=ljet4d $GSOPTS -sOutputFile=".fnq($ofn)." -";
+ debug "Ghostscript ps2ljet pipe:", $pipe;
+ open(OUT, "| $pipe") or error "Cannot open Ghostscript pipe";
+} elsif ($FileFormat eq 'PBM' or $FileFormat eq 'PGM' or $FileFormat eq 'PPM'
+ or is_via_sam2p()) {
+ $do_scale3_pnm=($::opt_antialias eq'scale3no' or $::opt_antialias eq 'scale3yes');
+ my $device=$FileFormat eq 'PPM' || is_via_sam2p() ? 'ppmraw' :
+ $FileFormat eq 'PBM' && $::opt_antialias eq 'no' ? 'pbmraw' : 'pgmraw';
+ # Dat: -sDEVICE=pgm is ASCII, pgmraw is binary
+ my $pipe ="$GS -q -dBATCH -sDEVICE=$device ";
+ # $pipe.="-dTextAlphaBits=4 -dGraphicsAlphaBits=4 " if $::opt_antialias; # Dat: already done
+ my $ofn=$OutputFilename;
+ if (is_via_sam2p()) {
+ # Dat: fortunately the following file format names are commin in sam2p(1)
+ # and a2ping.pl: PNG XWD BMP TIFF JPEG GIF XPM
+ @pnm2sampled_cmd=('sam2p',"$FileFormat:",'--'); # Imp: use convert(1) if no sam2p(1)
+ $ofn=fix_force_out('SS.pnm');
+ push @pnm2sampled_cmd, $ofn, $OutputFilename;
+ }
+ if ($do_scale3_pnm) {
+ $scale3_pnm_fn=$ofn;
+ $ofn=fix_force_out('S3.pnm') if $do_scale3_pnm;
+ # ^^^ Dat: this must be the last call to fix_force_out()
+ }
+ $pipe.="$GSOPTS -sOutputFile=".fnq($ofn)." -";
+ debug "Ghostscript ps2raster pipe:", $pipe;
+ open(OUT, "| $pipe") or error "Cannot open Ghostscript pipe";
+} else { open_OUT() }
+
+my $unlink_OutputFilename;
+END { unlink $unlink_OutputFilename if defined $unlink_OutputFilename }
+$unlink_OutputFilename=$OutputFilename;
+
+die unless binmode OUT;
+#die $to_OUT;
+# !! remove setpagedevice from EPS->EPS, but keep EPS->PGM
+# vvv needed by EPS->PGM conversion !!
+if (is_need_showpage() and is_page1_stop()) {
+ $to_OUT.="/showpage{showpage quit}bind def\n"; # don't call showpage twice
+ $after_code.="showpage\n";
+}
+error "write OUT" if !print OUT $to_OUT;
+$to_OUT="";
+
+### print rest of file
+sub OVERLAP_LENGTH(){4096} # `%%TrailerLength: 1162' by ADOBEPS4.DRV
+my $extra_trailer="%%Trailer\n";
+##undef $unlink_OutputFilename; die;
+{ my $overlap=""; # keeps OVERLAP_LENGTH chars
+ my $S;
+ # print OUT while length($_=readIN 4096);
+ while (length($S=readIN 4096)) { # Dat: 4096>=OVERLAP_LENGTH
+ #if (length($S)<OVERLAP_LENGTH) { $S="$overlap$S"; $overlap=""; }
+ #die if length($S)<OVERLAP_LENGTH; # happens sometimes
+ #print OUT $overlap, substr($S,0,length($S)-OVERLAP_LENGTH());
+ #$overlap=substr($S,-OVERLAP_LENGTH(),OVERLAP_LENGTH);
+ next if length($overlap.=$S)<OVERLAP_LENGTH;
+ print OUT substr($overlap,0,length($overlap)-OVERLAP_LENGTH());
+ $overlap=substr($overlap,-OVERLAP_LENGTH());
+ }
+ if ($overlap=~s@\r?\n%%Trailer\r?\n(.*?)\Z(?!\n)@\n%%Trailer\n@s) {
+ my $S=$1;
+ $S=~y@\r@@d;
+ $S=~s@\n%%TrailerLength:.*$@@m; # ADOBEPS4.DRV
+ $overlap.=$S;
+ $extra_trailer="";
+ }
+ $overlap=~s@(?:[\n\r\0\f]+%%EOF)?[\n\r\0\f]*\Z(?!\n)@@;
+ # vvv Dat: would move %%Trailer after dvips output `end userdict /end-hook known{end-hook}if'
+ # $overlap=~s@(?:[\n\r\0\f]+%%Trailer)?(?:[\n\r\0\f]+%%EOF)?[\n\r\0\f]+\Z(?!\n)@@;
+ print OUT $overlap;
+}
+
+### close files
+error "closing IN: $?" unless close IN;
+# ^^^ SUXX: gs always exit(0), if exists
+# vvv Dat: $after_code is pop+end
+print OUT "\n$extra_trailer$after_code",
+ ("grestore\n"x$need_grestore),
+ ("cleartomark restore\n"x$is_restored),
+ "%%EOF\n";
+error "closing gs filter: $? $!" unless close OUT;
+
+# --- PNM scaling routines for --antialias=scale3*
+
+sub pnm_gettok($) {
+ my ($fh,$S,$C)=($_[0],"");
+ while (1) {
+ die "unexpected EOF" if !defined($C=getc($fh));
+ if ($C eq'#') { <$fh> } # ignore rest of line
+ elsif ($C=~y@ \n\r\t@@) { last if length($S)!=0 }
+ else { $S.=$C }
+ }
+ $S
+}
+
+my @div9=(0,0,0,0,0,map { $_, $_, $_, $_, $_, $_, $_, $_, $_ } 1..255, 255);
+
+#** @param $_[0] length always divisible by 3
+sub p5_avg_lines($$$$) {
+ use integer;
+ my $len=length($_[0]);
+ my $olen=$len/3;
+ while ($len>0) {
+ vec($_[3],--$olen,8)=$div9[
+ vec($_[0],$len-1,8)+vec($_[0],$len-2,8)+vec($_[0],$len-3,8)+
+ vec($_[1],$len-1,8)+vec($_[1],$len-2,8)+vec($_[1],$len-3,8)+
+ vec($_[2],$len-1,8)+vec($_[2],$len-2,8)+vec($_[2],$len-3,8)];
+ $len-=3;
+ }
+}
+
+#** @param $_[0] length always divisible by 9
+sub p6_avg_lines($$$$) {
+ # Imp: why is it lighter than: convert -scale '33.3333%' a3.pbm a3r.pgm
+ use integer;
+ my $len=length($_[0]);
+ my $olen=$len/3;
+ while ($len>0) {
+ vec($_[3],--$olen,8)=$div9[
+ vec($_[0],$len-1,8)+vec($_[0],$len-4,8)+vec($_[0],$len-7,8)+
+ vec($_[1],$len-1,8)+vec($_[1],$len-4,8)+vec($_[1],$len-7,8)+
+ vec($_[2],$len-1,8)+vec($_[2],$len-4,8)+vec($_[2],$len-7,8)];
+ $len-=6 if 0==--$len%3;
+ }
+}
+
+# ---
+
+if (!$ll_zero and ($FileFormat eq 'PDF' or $FileFormat eq 'PDF1')) { # correct /MediaBox if not (0,0)-based
+ ### ****pts**** remove incorrect /MediaBox produced by gs
+ my $tfn=temp_prefix()."p.tgs";
+ error "temp open $tfn: $!" unless open F, "> $tfn";
+ $tmpfiles{$tfn}=1;
+ # vvv Dat: doesn't work with gs 8.53: Error: /undefined in readxrefentry
+ die unless print F "% this is temporary gs command file created by $program".'
+ GS_PDF_ProcSet begin
+ pdfdict begin
+ FN (r) file pdfopen begin
+ % vvv keep file offsets, because `pdffindpageref` overrides it with contents
+ /OFT Objects 0 get dup length array copy def
+ % vvv Dat: the generation number is assumed to be 0
+ % vvv Dat: modifies Objects[0]
+ 1 pdffindpageref 0 get
+ Objects 0 OFT put
+ %===
+ %print_xref
+ { readxrefentry } stopped { Objects exch lget } if
+ ===
+ currentdict pdfclose end end end
+ ';
+ die unless close F;
+
+ my $gs2="$GS -dNODISPLAY -dBATCH -sFN=".fnq(fix_pipe_out(undef))." -q ".fnq($tfn);
+ debug "Ghostscript dup pipe: $gs2";
+ my $offset=`$gs2`;
+ #die $offset;
+ chomp $offset;
+ temp_unlink $tfn;
+ if ($offset=~/\A\d+\Z(?!\n)/) {
+ # Dat: now $offsets is a file position containing our /Page object
+ die unless open F, "+< ".fix_pipe_out(undef);
+ die unless binmode F;
+ die unless seek F, $offset+=0, 0;
+ my $pageobj;
+ die unless 32<read F, $pageobj, 4096;
+ if ($::opt_keepoldmediabox) {
+ if ($pageobj=~m@\A(.*?/Type\s*/Page\b.*?/MediaBox\s*\[0 0 [^\]]*\].*?)((?:/CropBox\s*\[[^\]]+\]\s*)?/MediaBox\s*\[[^\]]+\])@s) {
+ substr($pageobj, length($1), length($2))=" "x length($2);
+ # ^^^ overwrite first buggy /MediaBox definition with spaces
+ die unless seek F, $offset, 0;
+ die unless print F $pageobj;
+ debug "new /MediaBox destroyed.";
+ } else {
+ debug "warning: double /MediaBox not found at $offset";
+ }
+ } else {
+ if ($pageobj=~m@\A(.*?/Type\s*/Page\b.*?)(/MediaBox\s*\[0 0 [^\]]*\]).*?/MediaBox\b@s) {
+ substr($pageobj, length($1), length($2))=" "x length($2);
+ # ^^^ overwrite first buggy /MediaBox definition with spaces
+ die unless seek F, $offset, 0;
+ die unless print F $pageobj;
+ debug "old /MediaBox destroyed.";
+ } else {
+ debug "warning: double /MediaBox not found at $offset";
+ }
+ }
+ die unless close F;
+ } else {
+ debug "warning: gs failed to locate double /MediaBox";
+ }
+}
+if ($FileFormat eq 'PCL5' and $do_fix_tumble) {
+ # stupid Ghostscript ignores /Tumble true with -sDEVICE=ljet4
+ # 2 dict dup /Duplex true /Tumble false put setpagedevice % long HP PCL5e "\033&l1S"
+ # 2 dict dup /Duplex true /Tumble true put setpagedevice % short HP PCL5e "\033&l2S"
+ # 2 dict dup /Duplex false /Tumble false put setpagedevice % simplex HP PCL5e "\033&l0S"
+ # HP PCL5e gs header "\033E\033&l2A\033&l1S\033&l0o0l0E\033&l-180u36Z"
+ die unless open F, "+< ".fix_pipe_out(undef);
+ die unless binmode F;
+ my $pageobj;
+ die unless 32<read F, $pageobj, 4096;
+ if ($pageobj=~s@\033&l1S.*@\033&l2S@s) {
+ die unless seek F, 0, 0;
+ die unless print F $pageobj;
+ debug "fixed /Tumble true (short).";
+ } elsif ($pageobj=~m@\033&l0S@) {
+ debug "no need to fix to /Tumble.";
+ } else {
+ debug "warning: /Duplex /Tumble settings not found"
+ }
+ die unless close F;
+}
+if ($do_scale3_pnm) {
+ # Imp: scale down the file in place, ovoid early overwrite
+ # Imp: possibly call an external C program that is faster
+ debug "Scaling down PNM by 3x3";
+ die unless open F, "> $scale3_pnm_fn";
+ die unless binmode F;
+ die unless open FIN, "< ".fix_pipe_out(undef);
+ my $hd;
+ die "PNMraw expected\n" if read(FIN,$hd,2)!=2 or $hd!~/\AP[456]/;
+ my $wd=pnm_gettok(*FIN); die "width expected\n" if $wd!~/\A(\d+)\Z(?!\n)/;
+ my $wd3=$hd eq 'P4' ? ($wd+7)>>3 : $hd eq 'P5' ? $wd : $wd*3; # bw/grayscale/RGB
+ my $ht=pnm_gettok(*FIN); die "height expected\n" if $ht!~/\A(\d+)\Z(?!\n)/;
+ if ($hd ne 'P4') {
+ my $mx=pnm_gettok(*FIN); die "max==255 expected, got: $mx\n" if $mx ne '255';
+ }
+ $wd+=0; $ht+=0;
+ { use integer;
+ my $phd=($hd eq 'P5' and $FileFormat eq 'PBM') ? "P4 ".(($wd+2)/3)." ".(($ht+2)/3)."\n"
+ : ($hd eq 'P6' ? 'P6' : 'P5')."\n# reduced-3x3\n".
+ (($wd+2)/3)." ".(($ht+2)/3)." 255\n";
+ die if !print F $phd;
+ }
+
+ my($l1,$l2,$l3);
+ my $ret="";
+ if ($hd eq 'P4') {
+ while ($ht>0) {
+ die "full row expected1\n" if $wd3!=read FIN, $l1, $wd3;
+ if (--$ht==0) { $l2=$l1 }
+ else {
+ die "full row expected2\n" if $wd3!=read FIN, $l2, $wd3;
+ if (--$ht==0) { $l3=$l2 } # Imp: adjust 2/3 weight
+ else { $ht--;
+ die "full row expected3\n" if $wd3!=read FIN, $l3, $wd3;
+ }
+ }
+ $l1=unpack("B$wd",$l1); $l1=~y@10@\000\377@; $l1.=substr($l1,-3+length($l1)%3) if length($l1)%3!=0;
+ $l2=unpack("B$wd",$l2); $l2=~y@10@\000\377@; $l2.=substr($l2,-3+length($l2)%3) if length($l2)%3!=0;
+ $l3=unpack("B$wd",$l3); $l3=~y@10@\000\377@; $l3.=substr($l3,-3+length($l3)%3) if length($l3)%3!=0;
+ p5_avg_lines($l1, $l2, $l3, $ret);
+ die if !print F $ret;
+ }
+ } elsif ($hd eq 'P5') {
+ while ($ht>0) {
+ die "full row expected1\n" if $wd3!=read FIN, $l1, $wd3;
+ $l1.=substr($l1,-3+length($l1)%3) if length($l1)%3!=0;
+ if (--$ht==0) { $l2=$l1 }
+ else {
+ die "full row expected2\n" if $wd3!=read FIN, $l2, $wd3;
+ $l2.=substr($l2,-3+length($l2)%3) if length($l2)%3!=0;
+ if (--$ht==0) { $l3=$l2 } # Imp: adjust 2/3 weight
+ else { $ht--;
+ die "full row expected3\n" if $wd3!=read FIN, $l3, $wd3;
+ $l3.=substr($l3,-3+length($l3)%3) if length($l3)%3!=0;
+ }
+ }
+ p5_avg_lines($l1, $l2, $l3, $ret);
+ if ($FileFormat eq 'PBM') {
+ my $I=length($ret);
+ while ($I--) { vec($ret,$I,8)=vec($ret,$I,8)<$::opt_threshold } # [\0\1]
+ # ^^^ grayscale>=$::opt_threshold will be white
+ $ret=pack"B".length($ret),$ret;
+ }
+ die if !print F $ret;
+ }
+ } elsif ($hd eq 'P6') {
+ while ($ht>0) {
+ die "full row expected1\n" if $wd3!=read FIN, $l1, $wd3;
+ $l1.=substr($l1,-9+length($l1)%9) if length($l1)%9!=0;
+ if (--$ht==0) { $l2=$l1 }
+ else {
+ die "full row expected2\n" if $wd3!=read FIN, $l2, $wd3;
+ $l2.=substr($l2,-9+length($l2)%9) if length($l2)%9!=0;
+ if (--$ht==0) { $l3=$l2 } # Imp: adjust 2/3 weight
+ else { $ht--;
+ die "full row expected3\n" if $wd3!=read FIN, $l3, $wd3;
+ $l3.=substr($l3,-9+length($l3)%9) if length($l3)%9!=0;
+ }
+ }
+ p6_avg_lines($l1, $l2, $l3, $ret);
+ die if !print F $ret;
+ }
+ }
+ die unless close F;
+ temp_unlink $temp_out_fn;
+ undef $temp_out_fn;
+}
+if (@pnm2sampled_cmd) { # $scale3_pnm_fn -> $OutputFilename
+ do_system @pnm2sampled_cmd; # Dat: uses @extra -- really share that?
+ temp_unlink $scale3_pnm_fn;
+} else { # BUGFIX for `a2ping.pl -v --antialias=no negyzet.eps negyzet.png' at Wed Jul 20 21:34:29 CEST 2005
+ fix_close_out();
+}
+undef $unlink_OutputFilename;
+if ($OutputFilename eq '-') {
+ debug "Done OK, stdout is $FileFormat"
+} elsif (-f $OutputFilename) {
+ debug "Done OK, created $FileFormat file $OutputFilename (".(-s _)." bytes)";
+} else {
+ error "missing $OutputFilename"
+}
+just::end __END__
+
+Dat: `=item * foo' is wrong, puts big space between `*' and `foo'
+
+=begin man
+
+.ds pts-dev \*[.T]
+.do if '\*[.T]'ascii' .ds pts-dev tty
+.do if '\*[.T]'ascii8' .ds pts-dev tty
+.do if '\*[.T]'latin1' .ds pts-dev tty
+.do if '\*[.T]'nippon' .ds pts-dev tty
+.do if '\*[.T]'utf8' .ds pts-dev tty
+.do if '\*[.T]'cp1047' .ds pts-dev tty
+.do if '\*[pts-dev]'tty' \{\
+.ll 79
+.pl 33333v
+.nr IN 2n
+.\}
+.ad n
+
+=end
+
+=head1 NAME
+
+a2ping.pl -- convert between PS, EPS and PDF and other page description
+formats
+
+=head1 SYNOPSIS
+
+Z<> B<a2ping.pl> [B<-->]B<help>
+ B<a2ping.pl> [B<-->]B<doc>
+ B<a2ping.pl> [I<options>] <I<inputfile>> [[I<outformat>:] I<outputfile>]
+
+=head1 DESCRIPTION
+
+B<a2ping> is a UNIX command line utility written in Perl that
+converts many raster image and vector graphics formats to EPS or PDF and
+other page description formats. Accepted input file formats are: PS
+(PostScript), EPS, PDF, PNG, JPEG, TIFF, PNM, BMP, GIF, LBM, XPM, PCX,
+TGA. Accepted output formats are: EPS, PCL5, PDF, PDF1, PBM, PGM, PPM,
+PS, markedEPS, markedPS, PNG, XWD, BMP, TIFF, JPEG, GIF, XPM.
+B<a2ping> delegates the low-level work to
+Ghostscript (GS), B<pdftops> and B<sam2p>. B<a2ping> fixes many glitches
+during the EPS to EPS conversion, so its output is often more compatible
+and better embeddable than its input.
+
+Without the C<--below> option, it is guarenteed to start at the 0,0
+coordinate. C<--below>, C<--hires> and C<-v> are recommended options.
+
+The page size is set exactly corresponding to the BoundingBox.
+This means that when Ghostscript renders it, the result needs no
+cropping, and the PDF MediaBox is correct.
+
+If the bounding box is not right, of course, you have problems. If you
+feed crap in, you get crap. But you can supply the
+B<--bboxfrom=compute-gs> option to make GS recompute the bounding box.
+
+The name of the input file doesn't matter -- B<a2ping> detects the file
+format based on the first few bytes of the file. The name of the output
+file matters if I<outformat> is missing from the command line: then the
+extension of the output file determines the FileFormat (I<outformat>).
+
+=head1 EXTERNAL PROGRAMS
+
+The internal file format of B<a2ping.pl> is PS/EPS. Everything read is
+first converted to PS or EPS, then processed by B<a2ping.pl>, then
+converted to the output format.
+
+To analyse the bounding box and other properties of non-EPS PS files
+(and EPS files with option B<--bboxfrom> other than B<=guess>), GS is
+used. Converting PS to EPS involves this analysis.
+
+To write PDF files, GS is used.
+
+To read PDF files, B<pdftops> from the B<xpdf> package is used.
+
+Sampled input formats are PNG, JPEG, TIFF, PNM, BMP, GIF, LBM, XPM, PCX
+and TGA. To read sampled input formats, B<sam2p> is used. B<sam2p> is
+a raster image converter written in C++ by the author of B<a2ping.pl>.
+
+Extra output formats are PNG, XWD, BMP, TIFF, JPEG, GIF and XPM. To
+write extra output formats, B<sam2p> and GS are used.
+
+PNM output formats are PGM, PGM and PPM. To write PNM output formats, GS
+is used.
+
+
+=head1 TIPS AND TRICKS
+
+=over 2
+
+=item *
+
+Call with the B<-v> option to see progress and debug messages.
+
+=item *
+
+If your EPS contains a wrong bounding box, you can fix it by running
+C<a2ping.pl -v --bboxfrom=compute-gs thefile.eps -->
+
+=item *
+
+You can specify B<-> as I<inputfile> to get stdin and as I<outputfile>
+to get stdout. This works even for PDF files (which must be seekable),
+because B<a2ping> copies them to a temporary file automatically.
+
+=item *
+
+If I<inputfile> and I<outputfile> are the same, B<a2ping> copies the
+I<inputfile> to a temporary location first. However, this usage is
+recommended only if there is a backup of the file to be restored in case
+B<a2ping> doesn't produce the desired result.
+
+=item *
+
+If you specify B<--> as I<outputfile>, it will be the same as I<inputfile>.
+
+=item *
+
+B<a2ping> respects B<--Duplex> for FileFormat PCL5, even though GS doesn't.
+
+=item *
+
+If you have an incompatible PS that GS can read but your printer cannot print,
+just run C<a2ping.pl foo.ps PDF: - | a2ping.pl - PS: foo.ps>
+
+=item *
+
+If you have a PS coming from Win32 (often with extension C<.prn>), run
+it through B<a2ping>. It will remove the resolution changes and the
+progress text printed to the terminal (which confuses gv(1) and makes
+some filters in the print queue emit incorrect output).
+
+=item *
+
+B<a2ping> does antialiasing (B<--antialias=scale3no>) of glyphs and
+curves when emitting a sampled image (FileFormats such as PGM and PPM).
+This improves readability of the glyphs. B<=yes> instructs GS to do
+internal antialiasing, but it usually doesn't improve much. B<=scale3no>
+turns off GS internal antialiasing, but makes it render everything 3x3
+as big, and then scales it back down. B<=scale3no> turns on both 3x3
+scaling and GS internal antialiasing, which results in thicker lines and
+worse quality in general.
+
+=item *
+
+When creating a PBM file, antialiasing usually doesn't improve the
+quality, so it is switched off by default. But if you set
+B<--antialias=scale3no> or B<--antialias=scale3yes>, GS will render a PGM file,
+and the value of B<--threshold> determines the minimum intensity for white in
+the final PBM.
+
+=item *
+
+If you need a bigger sampled output file, specify a larger
+B<--Resolution>. The default is B<--Resolution=72>. If your sampled output file
+is going to be really big, you should specify B<--AntiAlias=yes> instead of
+the default B<--AntiAlias=scale3no> to speed up conversion.
+
+=back
+
+
+=head1 MISC
+
+=over 2
+
+=item *
+
+Doesn't depend on the filename or extension of the input file.
+
+=item *
+
+Conversion from EPS to PDF: fixes glitches etc., calls gs
+-sDEVICE=pdfwrite
+
+=item *
+
+Conversion from EPS to EPS: fixes various glitches, moves (llx,lly) to
+(0,0), removes binary junk from the beginning of the EPS etc.
+
+=item *
+
+Conversion from PDF to PDF: keeps the file intact
+
+=item *
+
+Conversion from PDF to EPS: calls pdftops -eps (of the xpdf package)
+
+=item *
+
+Conversion from PS to EPS: keeps 1st page only, removes setpagedevice etc.
+
+=back
+
+=head1 AUTHORS
+
+The author of B<a2ping> is Szabó Péter <F<pts@fazekas.hu>>.
+
+B<a2ping> is inspired by and historically based on the B<epstopdf> Perl
+script modified by Thomas Esser, Sept. 1998, but his modifications have
+been removed from B<a2ping>, and also B<a2ping> and B<epstopdf> do not
+share common code anymore. B<epstopdf> is written by Sebastian Rahtz,
+for Elsevier Science. B<epstopdf> contained extra tricks from Hans Hagen's
+texutil.
+
+=head1 HISTORY
+
+=head2 1999/05/06 v2.5 (Heiko Oberdiek)
+
+ * New options: --hires, --exact, --filter, --help.
+ * Many cosmetics: title, usage, ...
+ * New code for debug, warning, error
+ * Detecting of cygwin perl
+ * Scanning for %%{Hires,Exact,}BoundingBox.
+ * Scanning only the header in order not to get a wrong
+ BoundingBox of an included file.
+ * (atend) supported.
+ * uses strict; (earlier error detecting).
+ * changed first comment from '%!PS' to '%!';
+ * corrected (atend) pattern: '\s*\(atend\)'
+ * using of $bbxpat in all BoundingBox cases,
+ correct the first white space to '...Box:\s*$bb...'
+ * corrected first line (one line instead of two before 'if 0;';
+
+=head2 2000/11/05 v2.6 (Heiko Oberdiek)
+
+ * %%HiresBoundingBox corrected to %%HiResBoundingBox
+
+=head2 2001/03/05 v2.7 (Heiko Oberdiek)
+
+ * Newline before grestore for the case that there is no
+ whitespace at the end of the eps file.
+
+=head2 2003/02/02 (Szabó Péter)
+
+ * option --below
+ * removes DOS EPSF binary junk correctly
+ * adds all 3 BoundingBox DSC comments
+ * reads all 3 BoundingBox DSC comments, and picks the best
+ * forces BoundingBox to be an integer
+ * adds %%EndComments and proper %!PS-Adobe-?-? EPSF-?.? header
+ * adds %%Pages:
+ * adds invocation syntax: a2ping <infile.eps> <outfile.eps|pdf>
+ * can convert PDF to EPS (by calling pdftops(1)) and PDF to PDF
+ * emulates work for PDF input
+
+=head2 2003/04/16 (Szabó Péter)
+
+ * added PS and sam2p support, renamed to a2ping
+ * sam2p and pdftops if $InputFilename eq '-';
+ * remove PJL UEL header from the beginning
+ * works for PS non-EPS files for input
+ * input support for PNG JPEG TIFF PNM BMP GIF LBM XPM PCX TGA via sam2p
+ * removes ^L (form feed) from end of EPS file
+ * -x=-c:rle to add sam2p options
+
+=head2 2003/04/26 (Szabó Péter)
+
+ * omit the unnecessary setpagedevice calls when creating normal eps
+ * --noverbose --nocompress supported differently
+ * no more option defaults :-(
+ * justlib2
+ * multi-page output with PS:, PDF:, PCL5:
+ * after `a2ping -pa4', file out.pcl says: `HP PCL printer data - A4 page
+ size', instead of `US letter'
+ * justlib2-ified doesn't depend on Getopt::Long anymore
+ * fully supports filtering (stdin and/or stdout), PDF and PCL5 output to
+ pipe (!$$ll_zero)
+ * adds DSC ``%%DocumentMedia: plain 612 792 0 () ()''
+ * BoundingBox precedence for EPS input: --PageSize, %%*BoundingBox,
+ setpagedevice. Precedence for other inputs: --PageSize, setpagedevice,
+ %%*BoundingBox
+
+=head2 2003/09/25 (Szabó Péter)
+
+ * --bboxfrom=adsc: %%BoundingBox overrides -sDEVICE=bbox
+ * improved bbox discovery
+ * many bugfixes
+ * MetaPost EPS input fixes for prologues:=0;
+ * a2ping.pl -v --papersize=50,60 --bboxfrom=compute-gs t.ps t2.ps
+ * consistent bbox, --PageSize, /PageSize handling
+ * consistent --Resolution and --Duplex handling
+
+=head2 2003/12/02 (Szabó Péter)
+
+ * --bboxfrom=compute-gs option to fix PS -> EPS bbox (gs -sDEVICE=bbox), tuzv.eps
+
+=head2 2004/02/10 v2.77 (Szabó Péter)
+
+ * the compute-pipe routine is now run unless --bboxfrom=guess with EPS
+ * added --gsextra=
+ * added --antialias=
+ * added FileFormat PBM, PGM, PPM
+ * separated FileFormat features to FL_* constants
+ * added --doc
+ * there is no default FileFormat (PDF) anymore
diff --git a/Build/source/texk/texlive/linked_scripts/dviasm.py b/Build/source/texk/texlive/linked_scripts/dviasm.py
new file mode 100755
index 00000000000..4fadc21e6dc
--- /dev/null
+++ b/Build/source/texk/texlive/linked_scripts/dviasm.py
@@ -0,0 +1,951 @@
+#! /usr/bin/env python
+# -*- coding: utf_8 -*-
+#
+# This is DVIasm, a DVI utility for editing DVI files directly.
+#
+# Copyright (C) 2007-2008 by Jin-Hwan Cho <chofchof@ktug.or.kr>
+#
+# This program 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.
+#
+# This program 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/>.
+
+import sys, os.path
+from optparse import OptionParser
+
+# Global variables
+is_ptex = False
+is_subfont = False
+cur_font = None
+cur_dsize = 0
+cur_ssize = 0
+subfont_idx = 0
+subfont_list = ['cyberb', 'outbtm', 'outbtb', 'outgtm', 'outgtb']
+
+# DVI opcodes
+SET_CHAR_0 = 0; SET_CHAR_127 = 127;
+SET1 = 128; SET2 = 129; SET3 = 130; SET4 = 131;
+SET_RULE = 132;
+PUT1 = 133; PUT2 = 134; PUT3 = 135; PUT4 = 136;
+PUT_RULE = 137;
+NOP = 138;
+BOP = 139; EOP = 140;
+PUSH = 141; POP = 142;
+RIGHT1 = 143; RIGHT2 = 144; RIGHT3 = 145; RIGHT4 = 146;
+W0 = 147; W1 = 148; W2 = 149; W3 = 150; W4 = 151;
+X0 = 152; X1 = 153; X2 = 154; X3 = 155; X4 = 156;
+DOWN1 = 157; DOWN2 = 158; DOWN3 = 159; DOWN4 = 160;
+Y0 = 161; Y1 = 162; Y2 = 163; Y3 = 164; Y4 = 165;
+Z0 = 166; Z1 = 167; Z2 = 168; Z3 = 169; Z4 = 170;
+FNT_NUM_0 = 171; FNT_NUM_63 = 234;
+FNT1 = 235; FNT2 = 236; FNT3 = 237; FNT4 = 238;
+XXX1 = 239; XXX2 = 240; XXX3 = 241; XXX4 = 242;
+FNT_DEF1 = 243; FNT_DEF2 = 244; FNT_DEF3 = 245; FNT_DEF4 = 246;
+PRE = 247; POST = 248; POST_POST = 249;
+# DVIV opcodes
+DIR = 255;
+# XDVI opcodes (not supported yet!)
+NATIVE_FONT_DEF = 250;
+PDF_FILE = 251; PIC_FILE = 252;
+GLYPH_ARRAY = 253; GLYPH_STRING = 254;
+# DVI identifications
+DVI_ID = 2; DVIV_ID = 3; XDVI_ID = 5;
+
+def Warning(msg):
+ sys.stderr.write('%s\n' % msg)
+
+def BadDVI(msg):
+ raise AttributeError, 'Bad DVI file: %s!' % msg
+
+def GetByte(fp): # { returns the next byte, unsigned }
+ try: return ord(fp.read(1))
+ except: return -1
+
+def SignedByte(fp): # { returns the next byte, signed }
+ try: b = ord(fp.read(1))
+ except: return -1
+ if b < 128: return b
+ else: return b - 256
+
+def Get2Bytes(fp): # { returns the next two bytes, unsigned }
+ try: a, b = map(ord, fp.read(2))
+ except: BadDVI('Failed to Get2Bytes()')
+ return (a << 8) + b
+
+def SignedPair(fp): # {returns the next two bytes, signed }
+ try: a, b = map(ord, fp.read(2))
+ except: BadDVI('Failed to SignedPair()')
+ if a < 128: return (a << 8) + b
+ else: return ((a - 256) << 8) + b
+
+def Get3Bytes(fp): # { returns the next three bytes, unsigned }
+ try: a, b, c = map(ord, fp.read(3))
+ except: BadDVI('Failed to Get3Bytes()')
+ return (((a << 8) + b) << 8) + c
+
+def SignedTrio(fp): # { returns the next three bytes, signed }
+ try: a, b, c = map(ord, fp.read(3))
+ except: BadDVI('Failed to SignedTrio()')
+ if a < 128: return (((a << 8) + b) << 8) + c
+ else: return ((((a - 256) << 8) + b) << 8) + c
+
+def SignedQuad(fp): # { returns the next four bytes, signed }
+ try: a, b, c, d = map(ord, fp.read(4))
+ except: BadDVI('Failed to get SignedQuad()')
+ if a < 128: return (((((a << 8) + b) << 8) + c) << 8) + d
+ else: return ((((((a - 256) << 8) + b) << 8) + c) << 8) + d
+
+def PutByte(q):
+ return chr(q & 0xff)
+
+def Put2Bytes(q):
+ return PutByte(q>>8) + PutByte(q)
+
+def Put3Bytes(q):
+ return PutByte(q>>16) + PutByte(q>>8) + PutByte(q)
+
+def PutSignedQuad(q):
+ if q < 0: q += 0x100000000
+ return PutByte(q>>24) + PutByte(q>>16) + PutByte(q>>8) + PutByte(q)
+
+def PutUnsigned(q):
+ if q >= 0x1000000: return (3, PutSignedQuad(q))
+ if q >= 0x10000: return (2, Put3Bytes(q))
+ if q >= 0x100: return (1, Put2Bytes(q))
+ return (0, PutByte(q))
+
+def PutSigned(q):
+ if 0 <= q < 0x800000: return PutUnsigned(q)
+ if q < -0x800000 or q >= 0x800000: return (3, PutSignedQuad(q))
+ if q < -0x8000: q += 0x1000000; return (2, Put3Bytes(q))
+ if q < -0x80: q += 0x10000; return (1, Put2Bytes(q))
+ return (0, PutByte(q))
+
+def GetInt(s):
+ try: return int(s)
+ except: return -1
+
+def GetStrASCII(s): # used in Parse()
+ if len(s) > 1 and ((s[0] == "'" and s[-1] == "'") or (s[0] == '"' and s[-1] == '"')): return [ord(c) for c in s[1:-1].decode('unicode_escape')]
+ else: return ''
+
+def UCS2toJIS(c):
+ s = c.encode('iso2022-jp')
+ if len(s) == 1: return ord(s)
+ else: return (ord(s[3]) << 8) + ord(s[4])
+
+def GetStrUTF8(s): # used in Parse()
+ if len(s) > 1 and ((s[0] == "'" and s[-1] == "'") or (s[0] == '"' and s[-1] == '"')):
+ t = s[1:-1].decode('string_escape').decode('utf8')
+ if is_ptex: return [UCS2toJIS(c) for c in t]
+ else: return [ord(c) for c in t]
+ else: return ''
+
+def PutStrASCII(t): # unsed in Dump()
+ s = ''
+ for o in t:
+ if o == 92: s += '\\\\'
+ elif 32 <= o < 127: s += chr(o)
+ elif o < 256: s += ('\\x%02x' % o)
+ elif o < 65536: s += ('\\u%04x' % o)
+ else:
+ Warning('Not support characters > 65535; may skip %d.\n' % o)
+ return "'%s'" % s
+
+def PutStrLatin1(t): # unsed in Dump()
+ s = ''
+ for o in t:
+ if o == 92: s += '\\\\'
+ elif 32 <= o < 127 or 161 <= o < 256: s += chr(o)
+ elif o < 256: s += ('\\x%02x' % o)
+ elif o < 65536: s += ('\\u%04x' % o)
+ else:
+ Warning('Not support characters > 65535; may skip %d.\n' % o)
+ return "'%s'" % s
+
+def PutStrUTF8(t): # unsed in Dump()
+ s = ''
+ if is_subfont:
+ for o in t:
+ s += unichr((subfont_idx << 8) + o).encode('utf8')
+ else: # not the case of subfont
+ for o in t:
+ if o == 92: s += '\\\\'
+ elif 32 <= o < 127: s += chr(o)
+ elif o < 128: s += ('\\x%02x' % o)
+ elif is_ptex:
+ s += ''.join(['\x1b$B', chr(o/256), chr(o%256)]).decode('iso2022-jp').encode('utf8')
+ else: s += unichr(o).encode('utf8')
+ return "'%s'" % s
+
+def PutStrSJIS(t): # unsed in Dump()
+ s = ''
+ for o in t:
+ if o == 92: s += '\\\\'
+ elif 32 <= o < 127: s += chr(o)
+ elif o < 128: s += ('\\x%02x' % o)
+ else:
+ s += ''.join(['\x1b$B', chr(o/256), chr(o%256)]).decode('iso2022-jp').encode('sjis')
+ return "'%s'" % s
+
+def IsFontChanged(f, z):
+ global cur_font, cur_ssize, subfont_idx, is_subfont
+ for n in subfont_list:
+ if n == f[:-2]:
+ is_subfont = True
+ subfont_idx = int(f[-2:], 16)
+ if cur_font == n and cur_ssize == z:
+ return False
+ else:
+ cur_font = n; cur_ssize = z
+ return True
+ else:
+ is_subfont = False
+ cur_font = f; cur_ssize = z
+ return True
+
+############################################################
+# DVI class
+############################################################
+class DVI(object):
+ def __init__(self, unit='pt'):
+ if unit == 'sp': self.byconv = self.by_sp_conv
+ elif unit == 'bp': self.byconv = self.by_bp_conv
+ elif unit == 'mm': self.byconv = self.by_mm_conv
+ elif unit == 'cm': self.byconv = self.by_cm_conv
+ elif unit == 'in': self.byconv = self.by_in_conv
+ else: self.byconv = self.by_pt_conv
+ self.Initialize()
+
+ ##########################################################
+ # Initialize: Required by __init__(), Load(), and Parse()
+ ##########################################################
+ def Initialize(self):
+ self.id = DVI_ID
+ self.numerator = 25400000
+ self.denominator = 473628672
+ self.mag = 1000
+ self.ComputeConversionFactors()
+ self.comment = ''
+ self.font_def = {}
+ self.max_v = self.max_h = self.max_s = self.total_pages = 0
+ self.pages = []
+
+ ##########################################################
+ # Load: DVI -> Internal Format
+ ##########################################################
+ def Load(self, fn):
+ fp = file(fn, 'rb')
+ self.LoadFromFile(fp)
+ fp.close()
+
+ def LoadFromFile(self, fp):
+ self.Initialize()
+ fp.seek(0, 2)
+ if fp.tell() < 53: BadDVI('less than 53 bytes long')
+ self.ProcessPreamble(fp)
+ self.ProcessPostamble(fp)
+ loc = self.first_backpointer
+ while loc >= 0:
+ fp.seek(loc)
+ if GetByte(fp) != BOP: BadDVI('byte %d is not bop' % fp.tell())
+ cnt = [SignedQuad(fp) for i in xrange(10)]
+ loc = SignedQuad(fp)
+ page = self.ProcessPage(fp)
+ self.pages.insert(0, {'count':cnt, 'content':page})
+
+ def ProcessPreamble(self, fp):
+ fp.seek(0)
+ if GetByte(fp) != PRE: BadDVI("First byte isn't start of preamble")
+ id = GetByte(fp)
+ if id != DVI_ID and id != DVIV_ID and id != XDVI_ID:
+ Warning("ID byte is %d; use the default %d!" % (id, DVI_ID))
+ else:
+ self.id = id
+ numerator = SignedQuad(fp)
+ if numerator <= 0:
+ Warning('numerator is %d; use the default 25400000!' % numerator)
+ else:
+ self.numerator = numerator
+ denominator = SignedQuad(fp)
+ if denominator <= 0:
+ Warning('denominator is %d; use the default 473628672!' % denominator)
+ else:
+ self.denominator = denominator
+ mag = SignedQuad(fp)
+ if mag <= 0:
+ Warning('magnification is %d; use the default 1000!' % mag)
+ else:
+ self.mag = mag
+ self.comment = fp.read(GetByte(fp))
+ self.ComputeConversionFactors()
+
+ def ProcessPostamble(self, fp):
+ fp.seek(-5, 2) # at least four 223's
+ while True:
+ k = GetByte(fp)
+ if k < 0: BadDVI('all 223s; is it a DVI file?') # found EOF
+ elif k != 223: break
+ fp.seek(-2, 1)
+ if k != DVI_ID and k != DVIV_ID and k != XDVI_ID:
+ Warning('ID byte is %d' % k)
+ fp.seek(-5, 1)
+ q = SignedQuad(fp)
+ m = fp.tell() # id_byte
+ if q < 0 or q > m - 33: BadDVI('post pointer %d at byte %d' % (q, m - 4))
+ fp.seek(q) # move to post
+ k = GetByte(fp)
+ if k != POST: BadDVI('byte %d is not post' % k)
+ self.post_loc = q
+ self.first_backpointer = SignedQuad(fp)
+
+ if SignedQuad(fp) != self.numerator:
+ Warning("numerator doesn't match the preamble!")
+ if SignedQuad(fp) != self.denominator:
+ Warning("denominator doesn't match the preamble!")
+ if SignedQuad(fp) != self.mag:
+ Warning("magnification doesn't match the preamble!")
+ self.max_v = SignedQuad(fp)
+ self.max_h = SignedQuad(fp)
+ self.max_s = Get2Bytes(fp)
+ self.total_pages = Get2Bytes(fp)
+ while True:
+ k = GetByte(fp)
+ if k == FNT_DEF1: p = GetByte(fp)
+ elif k == FNT_DEF2: p = Get2Bytes(fp)
+ elif k == FNT_DEF3: p = Get3Bytes(fp)
+ elif k == FNT_DEF4: p = SignedQuad(fp)
+ elif k != NOP: break
+ self.DefineFont(p, fp)
+ if k != POST_POST:
+ Warning('byte %d is not postpost!' % (fp.tell() - 1))
+ if SignedQuad(fp) != self.post_loc:
+ Warning('bad postamble pointer in byte %d!' % (fp.tell() - 4))
+ m = GetByte(fp)
+ if m != DVI_ID and m != DVIV_ID and m != XDVI_ID:
+ Warning('identification in byte %d should be %d, %d, or %d!' % (fp.tell() - 1, DVI_ID, DVIV_ID, XDVI_ID))
+
+ def DefineFont(self, e, fp):
+ c = SignedQuad(fp) # font_check_sum
+ q = SignedQuad(fp) # font_scaled_size
+ d = SignedQuad(fp) # font_design_size
+ n = fp.read(GetByte(fp) + GetByte(fp))
+ try:
+ f = self.font_def[e]
+ except KeyError:
+ self.font_def[e] = {'name':n, 'checksum':c, 'scaled_size':q, 'design_size':d}
+ if q <= 0 or q >= 01000000000:
+ Warning("%s---not loaded, bad scale (%d)!" % (n, q))
+ elif d <= 0 or d >= 01000000000:
+ msssage("%s---not loaded, bad design size (%d)!" % (n, d))
+ else:
+ if f['checksum'] != c:
+ Warning("\t---check sum doesn't match previous definition!")
+ if f['scaled_size'] != q:
+ Warning("\t---scaled size doesn't match previous definition!")
+ if f['design_size'] != d:
+ Warning("\t---design size doesn't match previous definition!")
+ if f['name'] != n:
+ Warning("\t---font name doesn't match previous definition!")
+
+ def ProcessPage(self, fp):
+ s = []
+ while True:
+ o = GetByte(fp)
+ p = self.Get1Arg(o, fp)
+ if o < SET_CHAR_0 + 128 or o in (SET1, SET2, SET3, SET4):
+ q = [p]
+ while True:
+ o = GetByte(fp)
+ p = self.Get1Arg(o, fp)
+ if o < SET_CHAR_0 + 128 or o in (SET1, SET2, SET3, SET4):
+ q.append(p)
+ else:
+ break
+ s.append([SET1, q])
+ if o == SET_RULE:
+ s.append([SET_RULE, [p, SignedQuad(fp)]])
+ elif o in (PUT1, PUT2, PUT3, PUT4):
+ s.append([PUT1, p])
+ elif o == PUT_RULE:
+ s.append([PUT_RULE, [p, SignedQuad(fp)]])
+ elif o == NOP:
+ continue
+ elif o == BOP:
+ Warning('bop occurred before eop!')
+ break
+ elif o == EOP:
+ break
+ elif o == PUSH:
+ s.append([PUSH])
+ elif o == POP:
+ s.append([POP])
+ elif o in (RIGHT1, RIGHT2, RIGHT3, RIGHT4):
+ s.append([RIGHT1, p])
+ elif o == W0:
+ s.append([W0])
+ elif o in (W1, W2, W3, W4):
+ s.append([W1, p])
+ elif o == X0:
+ s.append([X0])
+ elif o in (X1, X2, X3, X4):
+ s.append([X1, p])
+ elif o in (DOWN1, DOWN2, DOWN3, DOWN4):
+ s.append([DOWN1, p])
+ elif o == Y0:
+ s.append([Y0])
+ elif o in (Y1, Y2, Y3, Y4):
+ s.append([Y1, p])
+ elif o == Z0:
+ s.append([Z0])
+ elif o in (Z1, Z2, Z3, Z4):
+ s.append([Z1, p])
+ elif o < FNT_NUM_0 + 64 or o in (FNT1, FNT2, FNT3, FNT4):
+ s.append([FNT1, p])
+ elif o in (XXX1, XXX2, XXX3, XXX4):
+ q = fp.read(p)
+ s.append([XXX1, q])
+ elif o in (FNT_DEF1, FNT_DEF2, FNT_DEF3, FNT_DEF4):
+ self.DefineFont(p, fp)
+ elif o == DIR:
+ s.append([DIR, p])
+ elif o == PRE:
+ Warning('preamble command within a page!')
+ break
+ elif o in (POST, POST_POST):
+ Warning('postamble command %d!' % o)
+ break
+ else:
+ Warning('undefined command %d!' % o)
+ break
+ return s
+
+ def Get1Arg(self, o, fp):
+ if o < SET_CHAR_0 + 128:
+ return o - SET_CHAR_0
+ if o in (SET1, PUT1, FNT1, XXX1, FNT_DEF1, DIR):
+ return GetByte(fp)
+ if o in (SET2, PUT2, FNT2, XXX2, FNT_DEF2):
+ return Get2Bytes(fp)
+ if o in (SET3, PUT3, FNT3, XXX3, FNT_DEF3):
+ return Get3Bytes(fp)
+ if o in (RIGHT1, W1, X1, DOWN1, Y1, Z1):
+ return SignedByte(fp)
+ if o in (RIGHT2, W2, X2, DOWN2, Y2, Z2):
+ return SignedPair(fp)
+ if o in (RIGHT3, W3, X3, DOWN3, Y3, Z3):
+ return SignedTrio(fp)
+ if o in (SET4, SET_RULE, PUT4, PUT_RULE, RIGHT4, W4, X4, DOWN4, Y4, Z4, FNT4, XXX4, FNT_DEF4):
+ return SignedQuad(fp)
+ if o in (NOP, BOP, EOP, PUSH, POP, PRE, POST, POST_POST) or o > POST_POST:
+ return 0
+ if o in (W0, X0, Y0, Z0):
+ return 0
+ if o < FNT_NUM_0 + 64:
+ return o - FNT_NUM_0
+
+ ##########################################################
+ # Save: Internal Format -> DVI
+ ##########################################################
+ def Save(self, fn):
+ fp = file(fn, 'wb')
+ self.SaveToFile(fp)
+ fp.close()
+
+ def SaveToFile(self, fp):
+ # WritePreamble
+ fp.write(''.join([chr(PRE), PutByte(self.id), PutSignedQuad(self.numerator), PutSignedQuad(self.denominator), PutSignedQuad(self.mag), PutByte(len(self.comment)), self.comment]))
+ # WriteFontDefinitions
+ self.WriteFontDefinitions(fp)
+ # WritePages
+ stackdepth = 0; loc = -1
+ for page in self.pages:
+ w = x = y = z = 0; stack = []
+ s = [chr(BOP)]
+ s.extend([PutSignedQuad(c) for c in page['count']])
+ s.append(PutSignedQuad(loc))
+ for cmd in page['content']:
+ if cmd[0] == SET1:
+ for o in cmd[1]:
+ if o < 128: s.append(chr(SET_CHAR_0 + o))
+ else: s.append(self.CmdPair([SET1, o]))
+ elif cmd[0] in (SET_RULE, PUT_RULE):
+ s.append(chr(cmd[0]) + PutSignedQuad(cmd[1][0]) + PutSignedQuad(cmd[1][1]))
+ elif cmd[0] == PUT1:
+ s.append(self.CmdPair([PUT1, cmd[1][0]]))
+ elif cmd[0] in (RIGHT1, DOWN1):
+ s.append(self.CmdPair(cmd))
+ elif cmd[0] in (W0, X0, Y0, Z0):
+ s.append(chr(cmd[0]))
+ elif cmd[0] == PUSH:
+ s.append(chr(PUSH))
+ stack.append((w, x, y, z))
+ if len(stack) > stackdepth: stackdepth = len(stack)
+ elif cmd[0] == POP:
+ s.append(chr(POP))
+ w, x, y, z = stack.pop()
+ elif cmd[0] == W1:
+ w = cmd[1]; s.append(self.CmdPair(cmd))
+ elif cmd[0] == X1:
+ x = cmd[1]; s.append(self.CmdPair(cmd))
+ elif cmd[0] == Y1:
+ y = cmd[1]; s.append(self.CmdPair(cmd))
+ elif cmd[0] == Z1:
+ z = cmd[1]; s.append(self.CmdPair(cmd))
+ elif cmd[0] == FNT1:
+ if cmd[1] < 64: s.append(chr(FNT_NUM_0 + cmd[1]))
+ else: s.append(self.CmdPair(cmd))
+ elif cmd[0] == XXX1:
+ l = len(cmd[1])
+ if l < 256: s.append(chr(XXX1) + chr(l) + cmd[1])
+ else: s.append(chr(XXX4) + PutSignedQuad(l) + cmd[1])
+ elif cmd[0] == DIR:
+ s.append(chr(DIR) + chr(cmd[1]))
+ else:
+ Warning('invalid command %s!' % cmd[0])
+ s.append(chr(EOP))
+ loc = fp.tell()
+ fp.write(''.join(s))
+ # WritePostamble
+ post_loc = fp.tell()
+ fp.write(''.join([chr(POST), PutSignedQuad(loc), PutSignedQuad(self.numerator), PutSignedQuad(self.denominator), PutSignedQuad(self.mag), PutSignedQuad(self.max_v), PutSignedQuad(self.max_h), Put2Bytes(stackdepth+1), Put2Bytes(len(self.pages))]))
+ # WriteFontDefinitions
+ self.WriteFontDefinitions(fp)
+ # WritePostPostamble
+ fp.write(''.join([chr(POST_POST), PutSignedQuad(post_loc), PutByte(self.id), '\xdf\xdf\xdf\xdf']))
+ loc = fp.tell()
+ while (loc % 4) != 0:
+ fp.write('\xdf'); loc += 1
+
+ def WriteFontDefinitions(self, fp):
+ s = []
+ for e in sorted(self.font_def.keys()):
+ l, q = PutUnsigned(e)
+ s.append(PutByte(FNT_DEF1 + l))
+ s.append(q)
+ s.append(PutSignedQuad(self.font_def[e]['checksum']))
+ s.append(PutSignedQuad(self.font_def[e]['scaled_size']))
+ s.append(PutSignedQuad(self.font_def[e]['design_size']))
+ s.append('\x00')
+ s.append(PutByte(len(self.font_def[e]['name'])))
+ s.append(self.font_def[e]['name'])
+ fp.write(''.join(s))
+
+ def CmdPair(self, cmd):
+ l, q = PutSigned(cmd[1])
+ return chr(cmd[0] + l) + q
+
+ ##########################################################
+ # Parse: Text -> Internal Format
+ ##########################################################
+ def Parse(self, fn, encoding=''):
+ fp = file(fn, 'r')
+ s = fp.read()
+ fp.close()
+ self.ParseFromString(s, encoding=encoding)
+
+ def ParseFromString(self, s, encoding=''):
+ global GetStr, cur_font, cur_dsize, cur_ssize, subfont_idx
+ if encoding == 'ascii': GetStr = GetStrASCII
+ else: GetStr = GetStrUTF8
+ self.Initialize()
+ self.fnt_num = 0
+ for l in s.split('\n'):
+ l = l.strip()
+ if not l or l[0] == '%': continue
+ try:
+ key, val = l.split(':', 1)
+ key = key.strip(); val = val.strip()
+ except:
+ if l[-1] == ']': v = l[:-1].split(' ')
+ else: v = l.split(' ')
+ if v[0] == "[page":
+ self.cur_page = []
+ count = [GetInt(c) for c in v[1:]]
+ if len(count) < 10: count += ([0] * (10-len(count)))
+ self.pages.append({'count':count, 'content':self.cur_page})
+ continue
+ # ParsePreamble
+ if key == "id":
+ self.id = GetInt(val)
+ if self.id != DVI_ID and self.id != DVIV_ID and self.id != XDVI_ID:
+ Warning("identification byte should be %d, %d, or %d!" % (DVI_ID, DVIV_ID, XDVI_ID))
+ elif key == "numerator":
+ d = GetInt(val)
+ if d <= 0:
+ Warning('non-positive numerator %d!' % d)
+ else:
+ self.numerator = d
+ self.ComputeConversionFactors()
+ elif key == "denominator":
+ d = GetInt(val)
+ if d <= 0:
+ Warning('non-positive denominator %d!' % d)
+ else:
+ self.denominator = d
+ self.ComputeConversionFactors()
+ elif key == "magnification":
+ d = GetInt(val)
+ if d <= 0:
+ Warning('non-positive magnification %d!' % d)
+ else:
+ self.mag = d
+ elif key == "comment":
+ self.comment = val[1:-1]
+ # Parse Postamble
+ elif key == "maxv":
+ self.max_v = self.ConvLen(val)
+ elif key == "maxh":
+ self.max_h = self.ConvLen(val)
+ elif key == "maxs":
+ self.max_s = GetInt(val)
+ elif key == "pages":
+ self.total_pages = GetInt(val)
+ # Parse Font Definitions
+ elif key == "fntdef":
+ n, q, d = self.GetFntDef(val)
+ self.font_def[self.fnt_num] = {'name':n, 'design_size':d, 'scaled_size':q, 'checksum':0}
+ self.fnt_num += 1
+ # Parse Pages
+ elif key == 'xxx':
+ self.cur_page.append([XXX1, eval(val)])
+ elif key == 'set':
+ ol = GetStr(val)
+ if is_subfont:
+ subfont_idx = (ol[0] >> 8)
+ self.AppendFNT1()
+ nl = [ol[0] & 0xff]
+ for o in ol[1:]:
+ idx = (o >> 8)
+ if idx != subfont_idx:
+ self.cur_page.append([SET1, nl])
+ subfont_idx = idx
+ self.AppendFNT1()
+ nl = [o & 0xff]
+ else:
+ nl.append(o & 0xff)
+ self.cur_page.append([SET1, nl])
+ else:
+ self.cur_page.append([SET1, ol])
+ elif key == 'put':
+ self.cur_page.append([PUT1, GetStr(val)])
+ elif key == 'setrule':
+ v = val.split(' ')
+ if len(v) != 2:
+ Warning('two values are required for setrule!')
+ continue
+ self.cur_page.append([SET_RULE, [self.ConvLen(c) for c in v]])
+ elif key == 'putrule':
+ v = val.split(' ')
+ if len(v) != 2:
+ Warning('two values are required for putrule!')
+ continue
+ self.cur_page.append([PUT_RULE, [self.ConvLen(c) for c in v]])
+ elif key == 'fnt':
+ n, q, d = self.GetFntDef(val)
+ if n in subfont_list:
+ is_subfont = True
+ cur_font = n; cur_dsize = d; cur_ssize = q
+ else:
+ is_subfont = False
+ f = {'name':n, 'design_size':d, 'scaled_size':q, 'checksum':0}
+ try:
+ e = self.font_def.keys()[self.font_def.values().index(f)]
+ except:
+ e = self.fnt_num
+ self.font_def[self.fnt_num] = f
+ self.fnt_num += 1
+ self.cur_page.append([FNT1, e])
+ elif key == 'right':
+ self.cur_page.append([RIGHT1, self.ConvLen(val)])
+ elif key == 'down':
+ self.cur_page.append([DOWN1, self.ConvLen(val)])
+ elif key == 'w':
+ self.cur_page.append([W1, self.ConvLen(val)])
+ elif key == 'x':
+ self.cur_page.append([X1, self.ConvLen(val)])
+ elif key == 'y':
+ self.cur_page.append([Y1, self.ConvLen(val)])
+ elif key == 'z':
+ self.cur_page.append([Z1, self.ConvLen(val)])
+ elif key == 'push':
+ self.cur_page.append([PUSH])
+ elif key == 'pop':
+ self.cur_page.append([POP])
+ elif key == 'w0':
+ self.cur_page.append([W0])
+ elif key == 'x0':
+ self.cur_page.append([X0])
+ elif key == 'y0':
+ self.cur_page.append([Y0])
+ elif key == 'z0':
+ self.cur_page.append([Z0])
+ elif key == 'dir':
+ self.cur_page.append([DIR, GetInt(val)])
+ else:
+ Warning('invalid command %s!' % key)
+
+ def AppendFNT1(self):
+ f = {'name':cur_font+"%02x"%subfont_idx, 'design_size':cur_dsize, 'scaled_size':cur_ssize, 'checksum':0}
+ try:
+ e = self.font_def.keys()[self.font_def.values().index(f)]
+ except:
+ e = self.fnt_num
+ self.font_def[e] = f
+ self.fnt_num += 1
+ self.cur_page.append([FNT1, e])
+
+ ##########################################################
+ # Dump: Internal Format -> Text
+ ##########################################################
+ def Dump(self, fn, tabsize=2, encoding=''):
+ fp = file(fn, 'w')
+ self.DumpToFile(fp, tabsize=tabsize, encoding=encoding)
+ fp.close()
+
+ def DumpToFile(self, fp, tabsize=2, encoding=''):
+ global PutStr
+ if encoding == 'ascii': PutStr = PutStrASCII
+ elif encoding == 'latin1': PutStr = PutStrLatin1
+ elif encoding == 'sjis': PutStr = PutStrSJIS
+ else: PutStr = PutStrUTF8
+ # DumpPreamble
+ fp.write("[preamble]\n")
+ fp.write("id: %d\n" % self.id)
+ fp.write("numerator: %d\n" % self.numerator)
+ fp.write("denominator: %d\n" % self.denominator)
+ fp.write("magnification: %d\n" % self.mag)
+ fp.write("comment: %s\n" % repr(self.comment))
+ # DumpPostamble
+ fp.write("\n[postamble]\n")
+ fp.write("maxv: %s\n" % self.byconv(self.max_v))
+ fp.write("maxh: %s\n" % self.byconv(self.max_h))
+ fp.write("maxs: %d\n" % self.max_s)
+ fp.write("pages: %d\n" % self.total_pages)
+ # DumpFontDefinitions
+ fp.write("\n[font definitions]\n")
+ for e in sorted(self.font_def.keys()):
+ fp.write("fntdef: %s " % self.font_def[e]['name'])
+ if self.font_def[e]['design_size'] != self.font_def[e]['scaled_size']:
+ fp.write("(%s) " % self.by_pt_conv(self.font_def[e]['design_size']))
+ fp.write("at %s\n" % self.by_pt_conv(self.font_def[e]['scaled_size']))
+ # DumpPages
+ for page in self.pages:
+ fp.write("\n[page" + (" %d"*10 % tuple(page['count'])) + "]\n")
+ indent = 0
+ for cmd in page['content']:
+ if cmd[0] == POP:
+ indent -= tabsize
+ fp.write("%spop:\n" % (' ' * indent))
+ continue
+ fp.write("%s" % (' ' * indent))
+ if cmd[0] == PUSH:
+ fp.write("push:\n")
+ indent += tabsize
+ elif cmd[0] == XXX1:
+ fp.write("xxx: %s\n" % repr(cmd[1]))
+ elif cmd[0] == DIR:
+ fp.write("dir: %d\n" % cmd[1])
+ elif cmd[0] == SET_RULE:
+ fp.write("setrule: %s %s\n" % (self.byconv(cmd[1][0]), self.byconv(cmd[1][1])))
+ elif cmd[0] == PUT_RULE:
+ fp.write("putrule: %s %s\n" % (self.byconv(cmd[1][0]), self.byconv(cmd[1][1])))
+ elif cmd[0] == SET1:
+ fp.write("set: %s\n" % PutStr(cmd[1]))
+ elif cmd[0] == PUT1:
+ fp.write("put: %s\n" % PutStr(cmd[1]))
+ elif cmd[0] == FNT1:
+ f = self.font_def[cmd[1]]['name']
+ z = self.font_def[cmd[1]]['scaled_size']
+ if IsFontChanged(f, z):
+ fp.write("fnt: %s " % cur_font)
+ if self.font_def[cmd[1]]['design_size'] != self.font_def[cmd[1]]['scaled_size']:
+ fp.write("(%s) " % self.by_pt_conv(self.font_def[cmd[1]]['design_size']))
+ fp.write("at %s\n" % self.by_pt_conv(cur_ssize))
+ elif cmd[0] == RIGHT1:
+ fp.write("right: %s\n" % self.byconv(cmd[1]))
+ elif cmd[0] == DOWN1:
+ fp.write("down: %s\n" % self.byconv(cmd[1]))
+ elif cmd[0] == W1:
+ fp.write("w: %s\n" % self.byconv(cmd[1]))
+ elif cmd[0] == X1:
+ fp.write("x: %s\n" % self.byconv(cmd[1]))
+ elif cmd[0] == Y1:
+ fp.write("y: %s\n" % self.byconv(cmd[1]))
+ elif cmd[0] == Z1:
+ fp.write("z: %s\n" % self.byconv(cmd[1]))
+ elif cmd[0] == W0:
+ fp.write("w0:\n")
+ elif cmd[0] == X0:
+ fp.write("x0:\n")
+ elif cmd[0] == Y0:
+ fp.write("y0:\n")
+ elif cmd[0] == Z0:
+ fp.write("z0:\n")
+
+ ##########################################################
+ # Misc Functions
+ ##########################################################
+ def ComputeConversionFactors(self):
+ self.sp_conv = (self.numerator / 25400000.) * (473628672. / self.denominator)
+ self.pt_conv = (self.numerator / 25400000.) * (7227. / self.denominator)
+ self.bp_conv = (self.numerator / 254000.) * (72. / self.denominator)
+ self.mm_conv = (self.numerator / 10000.) / self.denominator
+ self.cm_conv = (self.numerator / 100000.) / self.denominator
+ self.in_conv = (self.numerator / 254000.) * (1. / self.denominator)
+
+ def ConvLen(self, s):
+ try: return int(s)
+ except: pass
+ try: f = float(s[:-2])
+ except: return 0
+ m = s[-2:]
+ if m == "pt": return int(round(f / self.pt_conv))
+ elif m == "in": return int(round(f / self.in_conv))
+ elif m == "mm": return int(round(f / self.mm_conv))
+ elif m == "cm": return int(round(f / self.cm_conv))
+ elif m == "bp": return int(round(f / self.bp_conv))
+ elif m == "sp": return int(round(f / self.sp_conv))
+ else:
+ try: return int(round(f / self.pt_conv))
+ except: return 0
+
+ def GetFntDef(self, s):
+ try:
+ n, size = s.split('(', 1)
+ d, q = size.split(')', 1)
+ except:
+ n, q = s.split(' ', 1)
+ n = n.strip(); q = q.strip()
+ if q[:2] == "at": q = q[2:]
+ q = self.ConvLen(q.strip())
+ try: d = self.ConvLen(d.strip())
+ except: d = q
+ return n, q, d
+
+ def by_sp_conv(self, a):
+ v = self.sp_conv * a
+ return "%dsp" % int(v)
+
+ def by_pt_conv(self, a):
+ v = self.pt_conv * a
+ if v == int(v): return "%dpt" % int(v)
+ else: return "%fpt" % v
+
+ def by_bp_conv(self, a):
+ v = self.bp_conv * a
+ if v == int(v): return "%dbp" % int(v)
+ else: return "%fbp" % v
+
+ def by_mm_conv(self, a):
+ v = self.mm_conv * a
+ if v == int(v): return "%dmm" % int(v)
+ else: return "%fmm" % v
+
+ def by_cm_conv(self, a):
+ v = self.cm_conv * a
+ if v == int(v): return "%dcm" % int(v)
+ else: return "%fcm" % v
+
+ def by_in_conv(self, a):
+ v = self.in_conv * a
+ if v == int(v): return "%din" % int(v)
+ else: return "%fin" % v
+
+############################################################
+# Misc Functions for Main Routine
+############################################################
+def ProcessOptions():
+ usage = "%prog [options] dvi_file|dvi_dump_file"
+ version = """This is %prog-20080520 by Jin-Hwan Cho (Korean TeX Society)
+
+Copyright (C) 2007-2008 by Jin-Hwan Cho <chofchof@ktug.or.kr>
+
+This 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."""
+ parser = OptionParser(usage=usage, version=version)
+ parser.add_option("-u", "--unit",
+ action="store", type="string", dest="unit",
+ metavar="STR",
+ help="unit (sp, pt, bp, mm, cm, in) [default=%default]")
+ parser.add_option("-o", "--output",
+ action="store", type="string", dest="output",
+ metavar="FILE",
+ help="filename for output instead of stdout")
+ parser.add_option("-e", "--encoding",
+ action="store", type="string", dest="encoding",
+ metavar="STR",
+ help="encoding for input/output [default=%default]")
+ parser.add_option("-t", "--tabsize",
+ action="store", type="int", dest="tabsize",
+ metavar="INT",
+ help="tab size for push/pop [default=%default]")
+ parser.add_option("-p", "--ptex",
+ action="store_true", dest="ptex", default=False,
+ help="extended DVI for Japanese pTeX")
+ parser.add_option("-s", "--subfont",
+ action="append", type="string", dest="subfont",
+ metavar="STR",
+ help="the list of fonts with UCS2 subfont scheme (comma separated); disable internal subfont list if STR is empty")
+ parser.set_defaults(unit='pt', encoding='utf8', tabsize=2)
+ (options, args) = parser.parse_args()
+ if not options.unit in ['sp', 'pt', 'bp', 'mm', 'cm', 'in']:
+ parser.error("invalid unit name '%s'!" % options.unit)
+ if options.tabsize < 0:
+ parser.error("negative tabsize!")
+ if not options.encoding in ['ascii', 'latin1', 'utf8', 'sjis']:
+ parser.error("invalid encoding '%s'!" % options.encoding)
+ if options.ptex:
+ global is_ptex
+ is_ptex = True
+ if not options.encoding in ['utf8', 'sjis']:
+ parser.error("invalid encoding '%s' for Japanese pTeX!" % options.encoding)
+ if options.subfont:
+ global subfont_list
+ if not options.subfont[0]: # disable subfont
+ subfont_list = []
+ for l in options.subfont:
+ subfont_list.extend([f.strip() for f in l.split(',')])
+ if len(args) != 1:
+ parser.error("try with the option --help!")
+ return (options, args)
+
+def IsDVI(fname):
+ from os.path import splitext
+ if splitext(fname)[1] != '.dvi': return False
+ try:
+ fp = file(fname, 'rb')
+ fp.seek(0)
+ if GetByte(fp) != PRE: return False
+ fp.seek(-4, 2)
+ if GetByte(fp) != 223: return False
+ fp.close()
+ except:
+ sys.stderr.write('Failed to read %s\n' % fname)
+ return False
+ return True
+
+############################################################
+# Main Routine
+############################################################
+if __name__ == '__main__':
+ (options, args) = ProcessOptions()
+ aDVI = DVI(unit=options.unit)
+ if IsDVI(args[0]): # dvi -> dump
+ aDVI.Load(args[0])
+ if options.output: aDVI.Dump(options.output, tabsize=options.tabsize, encoding=options.encoding)
+ else: aDVI.DumpToFile(sys.stdout, tabsize=options.tabsize, encoding=options.encoding)
+ else: # dump -> dvi
+ aDVI.Parse(args[0], encoding=options.encoding)
+ if options.output: aDVI.Save(options.output)
+ else: aDVI.SaveToFile(sys.stdout)
diff --git a/Build/source/texk/texlive/linked_scripts/e2pall.pl b/Build/source/texk/texlive/linked_scripts/e2pall.pl
new file mode 100755
index 00000000000..2997f8b1102
--- /dev/null
+++ b/Build/source/texk/texlive/linked_scripts/e2pall.pl
@@ -0,0 +1,89 @@
+#!/usr/bin/env perl
+
+# Author: Jody Klymak <jklymak@apl.washington.edu>, publisted by a posting
+# to the pdftex mailinglist.
+
+# recursively finds all your eps files. Looks down \input{fname}.
+# CAVEATS:
+# 1) cannot handle \input{fname} split over more than one line.
+# 1.5) cannot handle multiple \input{} or \includegraphics{} on one line.
+# 2) Must be run from same directory as the Latex file.
+# 3) Does not look down $TEXINPUTS or anything fancy like that...
+# 4) Handling of \include is untested (though I guess its trivial)
+# 5) Assumes *all* your graphics inclusions are [e]ps. But don't
+# fret, because if they are not epstopdf dies anyhow....
+# 6) Does not distinguish between percent (\%) and comment (%).
+
+# Changelog:
+# 20030103 -- Lachlan Andrew <lha@users.sourceforge.net>
+# * Only append '.tex' if $fname doesn't exist.
+# * Correctly handle lines with '}' after the \includegraphics{}
+# * Allow multiple extensions for graphics files. .eps -> .ps -> none
+# (Should try them in the same order as \includegraphics does
+# -- given by \DeclareGraphicsExtensions{}?)
+# * Allow \include the same way as \input
+# * Allow \includegraphics{} to be split over multiple lines
+# * Check that commands begin with '\', and allow spaces before arguments
+
+# EDIT these two lines for your system....
+
+$Eps2PdfCom = "epstopdf";
+$ThisFunCom = "e2pall";
+
+$fname=$ARGV[0];
+
+# check for a *.tex at the end...
+if ((-f "$fname")=="" && $fname !~ /.tex$/){
+ $fname = "$fname.tex";
+}
+
+open(TEXFILE,$fname) or die "Cannot open file $fname";
+# print "Finding *.eps files in $fname\n";
+
+$seekingArg = 0;
+while($line=<TEXFILE>){
+ # truncate $line after % sign....
+ $line=~s/%.*//;
+ # check for /input....
+ if ($line=~/\\input *{([^}]*)}/){
+ print `$ThisFunCom $1`;
+ }
+ # check for /include....
+ if ($line=~/\\include *{([^}]*)}/){
+ print `$ThisFunCom $1`;
+ }
+
+ $base = "";
+ if ($line=~/\\includegraphics.*{([^}]*)}/){
+ $base = $1;
+ }
+ elsif ($seekingArg==1 && ($line=~/{([^}]*)}/)){
+ $base = $1;
+ }
+ elsif ($line=~/\\includegraphics/){
+ $seekingArg = 1;
+ }
+
+ if ($base ne "") {
+ $seekingArg = 0;
+ if ((-f "$base.eps")!="") {
+ $srcfile = "$base.eps";
+ }
+ elsif ((-f "$base.ps")!=""){
+ $srcfile = "$base.ps";
+ }
+ else {
+ $srcfile = $base;
+ }
+ # check that the [e]ps version is newer than the pdf version....
+ if ((-M "$base.pdf")=="" || (-M "$base.pdf") >= (-M "$srcfile")){
+ print "Constructing \t $base.pdf from $srcfile\n";
+ print `$Eps2PdfCom $srcfile`;
+ }
+ else{
+ print "$base.pdf \t is up to date with $srcfile\n";
+ }
+
+ };
+}
+close(TEXFILE);
diff --git a/Build/source/texk/texlive/linked_scripts/epstopdf.pl b/Build/source/texk/texlive/linked_scripts/epstopdf.pl
new file mode 100755
index 00000000000..c50dcbbd96d
--- /dev/null
+++ b/Build/source/texk/texlive/linked_scripts/epstopdf.pl
@@ -0,0 +1,396 @@
+eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}' && eval 'exec perl -S $0 $argv:q'
+ if 0;
+use strict;
+
+# THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED
+# WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
+# EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+# LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+# PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+# LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+# NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
+# EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+# Change by Thomas Esser, Sept. 1998: The above lines allows us to find
+# perl along $PATH rather than guessing a fixed location. The above
+# construction should work with most shells.
+
+# A script to transform an EPS file so that:
+# a) it is guarenteed to start at the 0,0 coordinate
+# b) it sets a page size exactly corresponding to the BoundingBox
+# This means that when Ghostscript renders it, the result needs no
+# cropping, and the PDF MediaBox is correct.
+# c) the result is piped to Ghostscript and a PDF version written
+#
+# It needs a Level 2 PS interpreter.
+# If the bounding box is not right, of course, you have problems...
+#
+# The only thing I have not allowed for is the case of
+# "%%BoundingBox: (atend)", which is more complicated.
+#
+# Sebastian Rahtz, for Elsevier Science
+#
+# now with extra tricks from Hans Hagen's texutil.
+#
+# History
+# 1999/05/06 v2.5 (Heiko Oberdiek)
+# * New options: --hires, --exact, --filter, --help.
+# * Many cosmetics: title, usage, ...
+# * New code for debug, warning, error
+# * Detecting of cygwin perl
+# * Scanning for %%{Hires,Exact,}BoundingBox.
+# * Scanning only the header in order not to get a wrong
+# BoundingBox of an included file.
+# * (atend) supported.
+# * uses strict; (earlier error detecting).
+# * changed first comment from '%!PS' to '%!';
+# * corrected (atend) pattern: '\s*\(atend\)'
+# * using of $bbxpat in all BoundingBox cases,
+# correct the first white space to '...Box:\s*$bb...'
+# * corrected first line (one line instead of two before 'if 0;';
+# 2000/11/05 v2.6 (Heiko Oberdiek)
+# * %%HiresBoundingBox corrected to %%HiResBoundingBox
+# 2001/03/05 v2.7 (Heiko Oberdiek)
+# * Newline before grestore for the case that there is no
+# whitespace at the end of the eps file.
+# 2002/02/18 v2.8draft (Gerben Wierda)
+# * Handle different eol styles transparantly
+# * Applied fix from Peder Axensten for Freehand bug
+# 2002/02/21 v2.8draft (Gerben Wierda)
+# * Fixed bug where last line of buffer was not copied out (ugh!)
+# 2003/04/22 v2.9draft (Gerben Wierda)
+# * Fixed bug where with cr-eol files everything up to the first %!
+# * in the first 2048 bytes was gobbled (double ugh!)
+# 2004/03/17 v2.9.1draft (Gerben Wierda)
+# * No autorotate page
+# 2005/09/29 v2.9.2draft (Gerben Wierda)
+# * Quote OutFilename
+# 2005/10/01 v2.9.3draft (Gerben Wierda)
+# * Quote OutFilename
+# 2005/10/06 v2.9.4gw (Gerben Wierda)
+# * This has become the official version for now
+# 2005/10/06 v2.9.5gw (Gerben Wierda)
+# * Fixed a horrendous bug in the (atend) handling code
+# 2007/01/24 v2.9.6sw (Staszek Wawrykiewicz)
+# * patched to work also on Windows
+# 2007/05/15 v2.9.6tp (Theo Papadopoulo)
+# * Simplified the (atend) support
+# 2007/05/18 v.2.9.7gw (Gerben Wierda)
+# * Merged both supplied 2.9.6 versions
+# 2007/07/18 v.2.9.8gw
+
+### program identification
+my $program = "epstopdf";
+my $filedate="2007/05/18";
+my $fileversion="2.9.8gw";
+my $copyright = "Copyright 1998-2001 by Sebastian Rahtz et al., 2002-2007 by Gerben Wierda et al. Free software under a BSD-style license.";
+my $title = "\U$program\E $fileversion, $filedate - $copyright\n";
+
+### ghostscript command name
+my $GS = "gs";
+$GS = "gswin32c" if $^O eq 'MSWin32';
+$GS = "gswin32c" if $^O =~ /cygwin/;
+
+### options
+$::opt_help=0;
+$::opt_debug=0;
+$::opt_compress=1;
+$::opt_gs=1;
+$::opt_hires=0;
+$::opt_exact=0;
+$::opt_filter=0;
+$::opt_outfile="";
+
+### usage
+my @bool = ("false", "true");
+my $usage = <<"END_OF_USAGE";
+${title}Syntax: $program [options] <eps file>
+Options:
+ --help: print usage
+ --outfile=<file>: write result to <file>
+ --(no)filter: read standard input (default: $bool[$::opt_filter])
+ --(no)gs: run ghostscript (default: $bool[$::opt_gs])
+ --(no)compress: use compression (default: $bool[$::opt_compress])
+ --(no)hires: scan HiResBoundingBox (default: $bool[$::opt_hires])
+ --(no)exact: scan ExactBoundingBox (default: $bool[$::opt_exact])
+ --(no)debug: debug informations (default: $bool[$::opt_debug])
+Examples for producing 'test.pdf':
+ * $program test.eps
+ * produce postscript | $program --filter >test.pdf
+ * produce postscript | $program -f -d -o=test.pdf
+Example: look for HiResBoundingBox and produce corrected PostScript:
+ * $program -d --nogs -hires test.ps>testcorr.ps
+END_OF_USAGE
+
+### process options
+use Getopt::Long;
+GetOptions (
+ "help!",
+ "debug!",
+ "filter!",
+ "compress!",
+ "gs!",
+ "hires!",
+ "exact!",
+ "outfile=s",
+) or die $usage;
+
+### help functions
+sub debug {
+ print STDERR "* @_\n" if $::opt_debug;
+}
+sub warning {
+ print STDERR "==> Warning: @_!\n";
+}
+sub error {
+ die "$title!!! Error: @_!\n";
+}
+sub errorUsage {
+ die "$usage\n!!! Error: @_!\n";
+}
+
+### option help
+die $usage if $::opt_help;
+
+### get input filename
+my $InputFilename = "";
+if ($::opt_filter) {
+ @ARGV == 0 or
+ die errorUsage "Input file cannot be used with filter option";
+ $InputFilename = "-";
+ debug "Input file: standard input";
+}
+else {
+ @ARGV > 0 or die errorUsage "Input filename missing";
+ @ARGV < 2 or die errorUsage "Unknown option or too many input files";
+ $InputFilename = $ARGV[0];
+ -f $InputFilename or error "\"$InputFilename\" does not exist";
+ debug "Input filename:", $InputFilename;
+}
+
+### option compress
+my $GSOPTS = "";
+$GSOPTS = "-dUseFlateCompression=false " unless $::opt_compress;
+
+### option BoundingBox types
+my $BBName = "%%BoundingBox:";
+!($::opt_hires and $::opt_exact) or
+ error "Options --hires and --exact cannot be used together";
+$BBName = "%%HiResBoundingBox:" if $::opt_hires;
+$BBName = "%%ExactBoundingBox:" if $::opt_exact;
+debug "BoundingBox comment:", $BBName;
+
+### option outfile
+my $OutputFilename = $::opt_outfile;
+if ($OutputFilename eq "") {
+ if ($::opt_gs) {
+ $OutputFilename = $InputFilename;
+ if (!$::opt_filter) {
+ $OutputFilename =~ s/\.[^\.]*$//;
+ $OutputFilename .= ".pdf";
+ }
+ }
+ else {
+ $OutputFilename = "-"; # standard output
+ }
+}
+if ($::opt_filter) {
+ debug "Output file: standard output";
+}
+else {
+ debug "Output filename:", $OutputFilename;
+}
+
+### option gs
+if ($::opt_gs) {
+ debug "Ghostscript command:", $GS;
+ debug "Compression:", ($::opt_compress) ? "on" : "off";
+}
+
+### open input file
+open(IN,"<$InputFilename") or error "Cannot open",
+ ($::opt_filter) ? "standard input" : "\"$InputFilename\"";
+binmode IN;
+
+### open output file
+if ($::opt_gs) {
+ my $pipe = "$GS -q -sDEVICE=pdfwrite $GSOPTS -dAutoRotatePages=/None" .
+ " -sOutputFile=\"$OutputFilename\" - -c quit";
+ debug "Ghostscript pipe:", $pipe;
+ open(OUT,"|$pipe") or error "Cannot open Ghostscript for piped input";
+}
+else {
+ open(OUT,">$OutputFilename") or error "Cannot write \"$OutputFilename\"";
+}
+
+# reading a cr-eol file on a lf-eol system makes it impossible to parse
+# the header and besides it will read the intire file into yor line by line
+# scalar. this is also true the other way around.
+
+### scan a block, try to determine eol style
+
+my $buf;
+my $buflen;
+my @bufarray;
+my $bufarraypos;
+
+# We assume 2048 is big enough.
+my $EOLSCANBUFSIZE = 2048;
+
+$buflen = read( IN, $buf, $EOLSCANBUFSIZE);
+if ($buflen > 0) {
+ my $crlfpos;
+ my $lfpos;
+ my $crpos;
+
+ # remove binary junk before header
+ # if there is no header, we assume the file starts with ascii style and
+ # we look for a eol style anyway, to prevent possible loading of the
+ # entire file
+ if ($buf =~ /%!/) {
+ # throw away binary junk before %!
+ $buf =~ s/(.*?)%!/%!/o;
+ }
+ $lfpos = index( $buf, "\n");
+ $crpos = index( $buf, "\r");
+ $crlfpos = index( $buf, "\r\n");
+
+ if ($crpos > 0 and ($lfpos == -1 or $lfpos > $crpos+1)) {
+ # The first eol was a cr and it was not immediately followed by a lf
+ $/ = "\r";
+ debug "The first eol character was a CR ($crpos) and not immediately followed by a LF ($lfpos)";
+ }
+
+ # Now we have set the correct eol-character. Get one more line and add
+ # it to our buffer. This will make the buffer contain an entire line
+ # at the end. Then split the buffer in an array. We will draw lines from
+ # that array until it is empty, then move again back to <IN>
+ $buf .= <IN> unless eof( IN);
+ $buflen = length( $buf);
+ $bufarraypos = 0;
+
+ # Some extra magic is needed here: if we set $/ to \r, Perl's re engine
+ # still thinks eol is \n in regular expressions (not very nice) so we
+ # cannot split on ^, but have to split on \r and reappend those.
+ if ($/ eq "\r") {
+ @bufarray = split( /\r/ms, $buf); # split on \r
+ grep( $_ .= "\r", @bufarray); # re-append \r to each array item
+ }
+ else {
+ @bufarray = split( /^/ms, $buf);
+ }
+}
+
+### getline
+sub getline {
+ if ($#bufarray >= 0) {
+ $_ = shift( @bufarray);
+ $bufarraypos += length( $_);
+ # debug "getline from array. bufarraypos = $bufarraypos";
+ # debug "*** READ: $_";
+ }
+ else {
+ $_ = <IN>;
+ }
+ return( defined( $_));
+}
+
+### scan first line
+my $header = 0;
+getline();
+if (/%!/) {
+ # throw away binary junk before %!
+ s/(.*)%!/%!/o;
+}
+$header = 1 if /^%/;
+debug "Scanning header for BoundingBox";
+print OUT;
+
+### variables and pattern for BoundingBox search
+my $bbxpatt = '[0-9eE\.\-]';
+ # protect backslashes: "\\" gets '\'
+my $BBValues = "\\s*($bbxpatt+)\\s+($bbxpatt+)\\s+($bbxpatt+)\\s+($bbxpatt+)";
+my $BBCorrected = 0;
+
+sub CorrectBoundingBox {
+ my ($llx, $lly, $urx, $ury) = @_;
+ debug "Old BoundingBox:", $llx, $lly, $urx, $ury;
+ my ($width, $height) = ($urx - $llx, $ury - $lly);
+ my ($xoffset, $yoffset) = (-$llx, -$lly);
+ debug "New BoundingBox: 0 0", $width, $height;
+ debug "Offset:", $xoffset, $yoffset;
+
+ print OUT "%%BoundingBox: 0 0 $width $height\n";
+ print OUT "<< /PageSize [$width $height] >> setpagedevice\n";
+ print OUT "gsave $xoffset $yoffset translate\n";
+}
+
+### scan header
+if ($header) {
+ HEADER: while (getline()) {
+ ### Fix for freehand bug ### by Peder Axensten
+ next HEADER if(!/\S/);
+
+ ### end of header
+ if (!/^%/ or /^%%EndComments/) {
+ print OUT;
+ last;
+ }
+
+ ### BoundingBox with values
+ if (/^$BBName$BBValues/) {
+ CorrectBoundingBox $1, $2, $3, $4;
+ $BBCorrected = 1;
+ last;
+ }
+
+ ### BoundingBox with (atend)
+ if (/^$BBName\s*\(atend\)/) {
+ debug $BBName, "(atend)";
+ if ($::opt_filter) {
+ warning "Cannot look for BoundingBox in the trailer",
+ "with option --filter";
+ last;
+ }
+ my $pos = tell(OUT)+length($_);
+ debug "Current file position:", $pos;
+
+ # looking for %%BoundingBox
+ while (getline()) {
+ # skip over included documents
+ if (/^%%BeginDocument/) {
+ while (getline()) {
+ last if /^%%EndDocument/;
+ }
+ }
+ if (/^$BBName$BBValues/) {
+ CorrectBoundingBox $1, $2, $3, $4;
+ $BBCorrected = 1;
+ last;
+ }
+ }
+
+ # go back
+ seek( IN, $pos, 0) or error "Cannot go back to line \"$BBName (atend)\"";
+ last;
+ }
+
+ # print header line
+ print OUT;
+ }
+}
+
+### print rest of file
+while (getline()) {
+ print OUT;
+}
+
+### close files
+close(IN);
+print OUT "\ngrestore\n" if $BBCorrected;
+close(OUT);
+warning "BoundingBox not found" unless $BBCorrected;
+debug "Ready.";
+;
diff --git a/Build/source/texk/texlive/linked_scripts/getnonfreefonts.pl b/Build/source/texk/texlive/linked_scripts/getnonfreefonts.pl
new file mode 100755
index 00000000000..382a6f9c290
--- /dev/null
+++ b/Build/source/texk/texlive/linked_scripts/getnonfreefonts.pl
@@ -0,0 +1,306 @@
+#!/usr/bin/env perl
+
+## getnonfreefonts
+## Copyright 2006-2008 Reinhard Kotucha <reinhard.kotucha@web.de>
+#
+# This work may be distributed and/or modified under the
+# conditions of the LaTeX Project Public License, either version 1.3
+# of this license or (at your option) any later version.
+# The latest version of this license is in
+# http://www.latex-project.org/lppl.txt
+#
+# The current maintainer is Reinhard Kotucha.
+
+my $TL_version='2008';
+
+my $getfont_url="ftp://tug.org/tex/getnonfreefonts/getfont$TL_version";
+
+use File::Copy;
+use Getopt::Long;
+$Getopt::Long::autoabbrev=0;
+
+$opt_lsfonts=0;
+$opt_force=0;
+
+sub usage {
+ print <<'EOF';
+Usage:
+ getnonfreefonts[-sys] [-a|--all] [-d|--debug] [-f|--force]
+ [-l|--lsfonts] [-v|--verbose] [--version] [font1] [font2] ...
+
+ getnonfreefonts installs fonts in $TEXMFHOME.
+ getnonfreefonts-sys installs fonts in $TEXMFLOCAL.
+
+ Options:
+ -a|--all Install all fonts.
+
+ -d|--debug Provide additional messages for debugging.
+
+ -f|--force Install fonts even if they are installed already.
+
+ -h|--help Print this message.
+
+ -l|--lsfonts List all fonts available.
+
+ -v|--verbose Be more verbose.
+
+ --version Print version number.
+
+EOF
+;
+}
+
+@ARGS=@ARGV;
+
+GetOptions
+ "all|a",
+ "debug|d",
+ "force|f",
+ "help|h",
+ "lsfonts|l",
+ "verbose|v",
+ "version",
+ "sys";
+
+$^W=1 if $opt_debug;
+
+my $sys=($0=~/-sys$/)? 1:0;
+$sys=1 if $opt_sys;
+$sys=1 if (defined $ENV{'TEX_SYS_PROG'});
+
+@allpackages=@ARGV;
+
+print "$TL_version\n" and exit 0 if $opt_version;
+
+if ($opt_help or !@ARGS) {
+ print "\nThis is getnonfreefonts";
+ print '-sys' if ($sys);
+ print ", version $TL_version.\n\n";
+ usage;
+}
+
+
+sub message {
+ my $message=shift;
+ if ($message=~/^\[/) {
+ print "$message\n";
+ } else {
+ printf "%-60s", $message;
+ }
+}
+
+
+sub debug_msg {
+ my $message=shift;
+ if ($opt_debug) {
+ print STDERR "DEBUG: $message.\n";
+ }
+}
+
+
+sub expand_var {
+ my $var=shift;
+
+ if ($^O=~/^MSWin(32|64)/i) {
+ open KPSEWHICH, 'kpsewhich --expand-var=$' . "$var |";
+ } else {
+ open KPSEWHICH, 'kpsewhich --expand-var=\$' . "$var |";
+ }
+ while (<KPSEWHICH>) {
+ chop;
+ return "$_";
+ }
+ close KPSEWHICH;
+}
+
+# get TMP|TEMP|TMPDIR environment variable
+
+if ($opt_debug) {
+ for my $var ("TMP","TEMP","TMPDIR") {
+ if (defined $ENV{$var}) {
+ debug_msg "Environment variable $var='$ENV{$var}'";
+ } else {
+ debug_msg "Environment variable $var not set";
+ }
+ }
+}
+
+
+if (defined $ENV{'TMP'}) {
+ $SYSTMP="$ENV{'TMP'}";
+} elsif (defined $ENV{'TEMP'}) {
+ $SYSTMP="$ENV{'TEMP'}";
+} elsif (defined $ENV{'TMPDIR'}) {
+ $SYSTMP="$ENV{'TMPDIR'}";
+} else {
+ $SYSTMP="/tmp";
+}
+
+debug_msg "Internal variable SYSTMP set to '$SYSTMP'";
+
+# Windows usually uses backslashes though forward slashes are probably
+# allowed. Perl always needs forward slashes.
+
+# We convert backslashes to forward slashes on Windows.
+$SYSTMP=~s/\\/\//g if ($^O=~/^MSWin(32|64)/i);
+
+
+debug_msg "Internal variable SYSTMP converted to '$SYSTMP'";
+
+sub check_tmpdir{
+die "! ERROR: The temporary directory '$SYSTMP' doesn't exist.\n"
+ unless (-d "$SYSTMP");
+
+die "! ERROR: The temporary directory '$SYSTMP' is not writable.\n"
+ unless (-w "$SYSTMP");
+}
+
+# Determine INSTALLROOT.
+
+if ($opt_debug) {
+ my @path=split ':', $ENV{PATH};
+ for my $dir (@path) {
+ debug_msg "Search for kpsewhich in '$dir'";
+ opendir DIR, "$dir";
+ my @kpsewichs=grep /^kpsewhich/, readdir DIR;
+ closedir DIR;
+ for (@kpsewichs) {
+ debug_msg "Found $dir/$_" if /^kpsewhich/;
+ }
+ }
+}
+
+
+$INSTALLROOTNAME=($sys)? 'TEXMFLOCAL':'TEXMFHOME';
+
+$INSTALLROOT=expand_var "$INSTALLROOTNAME";
+
+($sys)? debug_msg "sys=true":debug_msg "sys=false";
+
+debug_msg "INSTALLROOT='$INSTALLROOT'";
+
+$INSTALLROOT=~s/\\/\//g if ($^O=~/^MSWin(32|64)/i);
+
+debug_msg "Internal variable INSTALLROOT converted to '$INSTALLROOT'";
+
+sub check_installroot {
+ die "! ERROR: The variable $INSTALLROOTNAME is not set.\n"
+ unless length ("$INSTALLROOT") > 0;
+
+ die "! ERROR: The install directory '$INSTALLROOT' doesn't " .
+ "exist.\n" .
+ " If this is the correct path, please create " .
+ "this directory manually.\n"
+ unless (-d "$INSTALLROOT");
+
+ die "! ERROR: The install directory '$INSTALLROOT' is not writable.\n"
+ unless (-w "$INSTALLROOT");
+}
+
+if ($opt_help or !@ARGS) {
+ print <<"ENDUSAGE";
+ Directories:
+ temporary: '$SYSTMP/getfont-<PID>'
+ install: '$INSTALLROOT'
+
+ENDUSAGE
+check_tmpdir;
+check_installroot;
+exit 0;
+}
+
+check_tmpdir;
+check_installroot;
+
+my $tmpdir="$SYSTMP/getfont-$$";
+debug_msg "Internal variable tmpdir set to '$tmpdir'";
+
+mkdir "$tmpdir" or die "! ERROR: Can't mkdir '$tmpdir'.";
+chdir "$tmpdir" or die "! ERROR: Can't cd '$tmpdir'.";
+
+sub remove_tmpdir {
+ chdir "$SYSTMP" or die "! ERROR: Can't cd '$SYSTMP'.\n";
+ opendir TMPDIR, "$tmpdir"
+ or print "! ERROR: Can't read directory '$tmpdir'.\n";
+
+ @alltmps=readdir TMPDIR;
+ closedir TMPDIR;
+
+ foreach $file (@alltmps) {
+ next if $file=~/^\./;
+ unlink "$tmpdir/$file";
+ }
+ rmdir "$tmpdir" or die "! ERROR: Can't remove directory '$tmpdir'.\n";
+}
+
+# Signal handlers.
+
+my @common_signals=qw(INT ILL FPE SEGV TERM ABRT);
+my @signals_UNIX=qw(QUIT BUS PIPE);
+my @signals_Win32=qw(BREAK);
+
+
+if ($^O=~/^MSWin(32|64)$/i) {
+ @signals=(@common_signals, @signals_Win32);
+} else {
+ @signals=(@common_signals, @signals_UNIX);
+}
+
+debug_msg "Supported signals: @signals\n";
+
+foreach my $signal (@signals) {
+ $SIG{"$signal"}=\&remove_tmpdir;
+}
+
+# Download the script from tug.org.
+
+debug_msg "Running 'wget $getfont_url'";
+
+system ('wget', "$getfont_url") == 0 or die "! Error: Can't execute wget.\n";
+
+# Download the fonts.
+
+my @getfont=('perl', "./getfont$TL_version", '--getnonfreefonts');
+push @getfont, "--installroot=$INSTALLROOT";
+push @getfont, '--lsfonts' if $opt_lsfonts;
+push @getfont, '--force' if $opt_force;
+push @getfont, '--debug' if $opt_debug;
+push @getfont, '--verbose' if $opt_verbose;
+push @getfont, '--sys' if $sys;
+push @getfont, '--all' if $opt_all;
+push @getfont, @allpackages;
+
+debug_msg "Running '@getfont'";
+
+system @getfont;
+
+# Evaluate the exit status. It will be 2 if something had been
+# installed and in this case we need to run texhash/updmap.
+
+my $exit_code=$?;
+my $exit_status=int($exit_code/256);
+
+if ($sys) {
+ debug_msg "Info: Execute updmap-sys if exit status is 2";
+} else {
+ debug_msg "Info: Execute updmap if exit status is 2";
+}
+
+debug_msg "Exit status of getfont$TL_version is $exit_status";
+
+if ($exit_status==2) {
+ print "\n";
+ system 'texhash', "$INSTALLROOT";
+ $updmap_command=($sys)? 'updmap-sys':'updmap';
+ @updmap=("$updmap_command");
+ push @updmap, '--quiet' unless $opt_verbose;
+ print "\n";
+ message "Updating map files ($updmap_command)...";
+ system @updmap;
+
+ message $?? '[failed]':'[done]';
+}
+
+remove_tmpdir;
+
+__END__
diff --git a/Build/source/texk/texlive/linked_scripts/makeglossaries b/Build/source/texk/texlive/linked_scripts/makeglossaries
new file mode 100755
index 00000000000..3b9f1cb6b48
--- /dev/null
+++ b/Build/source/texk/texlive/linked_scripts/makeglossaries
@@ -0,0 +1,293 @@
+#!/usr/bin/env perl
+
+# File : makeglossaries
+# Author : Nicola Talbot
+# Version : 1.4 (2008/05/10)
+# Description: simple Perl script that calls makeindex.
+# Intended for use with "glossaries.sty" (saves having to remember
+# all the various switches)
+
+# This file is distributed as part of the glossaries LaTeX package.
+# Copyright 2007 Nicola L.C. Talbot
+# This work may be distributed and/or modified under the
+# conditions of the LaTeX Project Public License, either version 1.3
+# of this license of (at your option) any later version.
+# The latest version of this license is in
+# http://www.latex-project.org/lppl.txt
+# and version 1.3 or later is part of all distributions of LaTeX
+# version 2005/12/01 or later.
+#
+# This work has the LPPL maintenance status `maintained'.
+#
+# The Current Maintainer of this work is Nicola Talbot.
+
+# This work consists of the files glossaries.dtx and glossaries.ins
+# and the derived files glossaries.sty, mfirstuc.sty,
+# glossary-hypernav.sty, glossary-list.sty, glossary-long.sty,
+# glossary-super.sty, glossaries.perl.
+# Also makeglossaries and makeglossaries.
+#
+# History:
+# v1.4 (2008-05-10) :
+# * added support for filenames with spaces.
+# v1.3 (2008-03-08) :
+# * changed first line from /usr/bin/perl -w to /usr/bin/env perl
+# (Thanks to Karl Berry for suggesting this.)
+# v1.2 (2008-03-02) :
+# * added support for --help and --version
+# * improved error handling
+# v1.1 (2008-02-13) :
+# * added -w and strict
+# * added check to ensure .tex file not passed to makeglossaries
+#
+# v1.0 (2007-05-10) : Initial release.
+
+use Getopt::Std;
+use strict;
+
+$Getopt::Std::STANDARD_HELP_VERSION = 1;
+
+my $version="1.3 (2008-03-08)";
+
+my($opt_q, $opt_t, $opt_o, $opt_s, $opt_p, $opt_g, $opt_c, $opt_r,
+ $opt_l, $opt_i)=("","","","","","","","","","");
+
+getopts('s:o:t:p:ilqrcg');
+
+unless ($#ARGV == 0)
+{
+ die "makeglossaries: Need exactly one file argument.\nUse `makeglossaries --help' for help.\n";
+}
+
+# define known extensions
+
+my %exttype = (
+ main => {in=>'glo', out=>'gls', 'log'=>'glg'},
+ );
+
+my $ext = '';
+my $name = $ARGV[0];
+
+# modified this to make sure users don't try passing the
+# tex file:
+if (length($ARGV[0]) > 3 and substr($ARGV[0],-4,1) eq ".")
+{
+ $name = substr($ARGV[0],0,length($ARGV[0])-4);
+
+ $ext = substr($ARGV[0],-3,3);
+
+ if (lc($ext) eq 'tex')
+ {
+ die("Don't pass the tex file to makeglossaries:\n"
+ ."either omit the extension to make all the glossaries, "
+ ."or specify one of the glossary files, e.g. $name.glo, to "
+ ."make just that glossary.\n")
+ }
+}
+
+my $istfile = "$name.ist";
+
+# check aux file for other glossary types
+# and for ist file name
+
+if (open AUXFILE, "$name.aux")
+{
+ while (<AUXFILE>)
+ {
+ if (m/\\\@newglossary\s*\{(.*)\}{(.*)}{(.*)}{(.*)}/
+ and ($1 ne 'main'))
+ {
+ $exttype{$1}{'log'} = $2;
+ $exttype{$1}{'out'} = $3;
+ $exttype{$1}{'in'} = $4;
+
+ if (!$opt_q)
+ {
+ print "added glossary type '$1' ($2,$3,$4)\n";
+ }
+ }
+
+ if (m/\\\@istfilename\s*{([^}]*)}/)
+ {
+ $istfile = $1;
+
+ # check if double quotes were added to \jobname
+ $istfile=~s/^"(.*)"\.ist$/$1.ist/;
+ }
+ }
+
+ close AUXFILE;
+}
+else
+{
+ print STDERR "Unable to open $name.aux: $!\n";
+}
+
+# save all the general makeindex switches
+
+my $mkidxopts = '';
+
+if ($opt_i)
+{
+ $mkidxopts .= " -i";
+}
+
+if ($opt_l)
+{
+ $mkidxopts .= " -l";
+}
+
+if ($opt_q)
+{
+ $mkidxopts .= " -q";
+}
+
+if ($opt_r)
+{
+ $mkidxopts .= " -r";
+}
+
+if ($opt_c)
+{
+ $mkidxopts .= " -c";
+}
+
+if ($opt_g)
+{
+ $mkidxopts .= " -g";
+}
+
+unless ($opt_p eq "")
+{
+ $mkidxopts .= " -p $opt_p";
+}
+
+unless ($opt_s eq "")
+{
+ $istfile = $opt_s;
+}
+
+if ($ext ne '')
+{
+ my %thistype = %{$exttype{'main'}}; #default
+
+ foreach my $type (keys %exttype)
+ {
+ if ($exttype{$type}{'in'} eq $ext)
+ {
+ %thistype = %{$exttype{$type}};
+
+ last;
+ }
+ }
+
+ my $outfile;
+
+ if ($opt_o eq "")
+ {
+ $outfile = "$name.$thistype{out}";
+ }
+ else
+ {
+ $outfile = $opt_o;
+ }
+
+ my $transcript;
+
+ if ($opt_t eq "")
+ {
+ $transcript = "$name.$thistype{'log'}";
+ }
+ else
+ {
+ $transcript = $opt_t;
+ }
+
+ &makeindex("$name.$ext",$outfile,$transcript,$istfile,
+ $mkidxopts,$opt_q);
+}
+else
+{
+ foreach my $type (keys %exttype)
+ {
+ my %thistype = %{$exttype{$type}};
+
+ my $inputfile = "$name.$thistype{in}";
+
+ if (-r $inputfile)
+ {
+ my $outfile;
+
+ if ($opt_o eq "")
+ {
+ $outfile = "$name.$thistype{out}";
+ }
+ else
+ {
+ $outfile = $opt_o;
+ }
+
+ my $transcript;
+
+ if ($opt_t eq "")
+ {
+ $transcript = "$name.$thistype{'log'}";
+ }
+ else
+ {
+ $transcript = $opt_t;
+ }
+
+ &makeindex($inputfile,$outfile,$transcript,
+ $istfile,$mkidxopts,$opt_q);
+ }
+ else
+ {
+ print STDERR "No read access for '$inputfile': $!\n";
+ }
+ }
+}
+
+sub makeindex{
+ my($in,$out,$trans,$ist,$rest,$quiet) = @_;
+ my($name,$cmdstr,$buffer,$n,$i,$j);
+ my(@stuff,@item);
+
+ $cmdstr = "$rest -s \"$ist\" -t \"$trans\" -o \"$out\" \"$in\"";
+
+ unless ($quiet)
+ {
+ print "makeindex $cmdstr\n";
+ }
+
+ `makeindex $cmdstr`;
+}
+
+sub HELP_MESSAGE{
+ print "\nSyntax : makeglossaries [options] <filename>\n\n";
+ print "For use with the glossaries package to pass relevant\n";
+ print "files to makeindex\n\n";
+ print "<filename>\tBase name of glossary file(s). This should\n";
+ print "\t\tbe the name of your main LaTeX document without any\n";
+ print "\t\textension.\n";
+ print "\nOptions:\n";
+ print "-c\t\tCompress intermediate blanks\n";
+ print "-g\t\tEmploy German word ordering\n";
+ print "-l\t\tLetter ordering\n";
+ print "-o <gls>\tUse <gls> as the output file.\n";
+ print "-p <num>\tSet the starting page number to be <num>\n";
+ print "-q\t\tQuiet mode\n";
+ print "-r\t\tDisable implicit page range formation\n";
+ print "-s <sty>\tEmploy <sty> as the style file\n";
+ print "-t <log>\tEmploy <log> as the transcript file\n";
+ print "\nSee makeindex documentation for further details on these ";
+ print "options\n";
+}
+
+sub VERSION_MESSAGE{
+ print "Makeglossaries Version $version\n";
+ print "Copyright (C) 2007 Nicola L C Talbot\n";
+ print "This material is subject to the LaTeX Project Public License.\n";
+}
+
+1;
diff --git a/Build/source/texk/texlive/linked_scripts/mkjobtexmf.pl b/Build/source/texk/texlive/linked_scripts/mkjobtexmf.pl
new file mode 100755
index 00000000000..cfbd60e4625
--- /dev/null
+++ b/Build/source/texk/texlive/linked_scripts/mkjobtexmf.pl
@@ -0,0 +1,804 @@
+#!/usr/bin/env perl
+#
+# ToDos/unsolved problems:
+# * collision of symbol links
+# * texmf.cnf (path settings, variables)
+# * aliases
+# * binaries, libraries
+#
+use strict;
+$^W=1;
+
+my $prj = 'mkjobtexmf';
+my $version = '0.6';
+my $date = '2008/04/05';
+my $author = 'Heiko Oberdiek';
+my $copyright = "Copyright 2007, 2008 $author";
+
+my $cmd_tex = 'pdflatex';
+my $cmd_kpsewhich = 'kpsewhich';
+my $cmd_texhash = 'texhash';
+my $cmd_strace = 'strace';
+my $ext_tex = '.tex';
+my $ext_recorder = '.fls';
+my $ext_strace = '.strace';
+my $ext_mkjobtexmf = '.mjt';
+my $jobname = '';
+my $texname = '';
+my $destdir = '';
+my @args = ();
+my @texopt = ();
+my $verbose = 0;
+my $output = 0;
+my $strace = 0;
+my $copy = 0;
+my $flat = 0;
+my $needs_texhash = 0;
+my @texmf;
+my %files;
+my %links;
+my %flat_ignore = (
+ 'ls-R' => '',
+ 'aliases' => '',
+);
+
+my $title = "\U$prj\E $date v$version, $copyright\n";
+
+print $title;
+
+sub die_error ($) {
+ my $msg = shift;
+ die "!!! Error: $msg!\n";
+}
+
+sub warning ($) {
+ my $msg = shift;
+ print "!!! Warning: $msg!\n";
+}
+
+sub verbose (@) {
+ my @msg = @_;
+ print "* @msg\n" if $verbose;
+}
+
+sub value ($) {
+ my $value = $_[0];
+ "[$value]";
+}
+
+sub die_usage {
+ my $msg = $_[0];
+ pod2usage(
+ -exitstatus => 2,
+ -msg => "\n==> $msg!\n");
+}
+
+use Getopt::Long;
+use Pod::Usage;
+
+my $man = 0;
+my $help = 0;
+
+GetOptions(
+ 'jobname=s' => \$jobname,
+ 'texname=s' => \$texname,
+ 'texopt=s' => \@texopt,
+ 'destdir=s' => \$destdir,
+ 'cmd-tex=s' => \$cmd_tex,
+ 'cmd-kpsewhich=s' => \$cmd_kpsewhich,
+ 'cmd-texhash=s' => \$cmd_texhash,
+ 'strace' => \$strace,
+ 'copy' => \$copy,
+ 'flat' => \$flat,
+ 'verbose' => \$verbose,
+ 'output' => \$output,
+ 'help|?' => \$help,
+ 'man' => \$man,
+) or die_usage('Unknown option');
+pod2usage(1) if $help;
+pod2usage(-exitstatus => 0, -verbose => 2) if $man;
+
+if (@ARGV > 0) {
+ $strace = 1;
+ $texname = '';
+ my @args = @ARGV;
+}
+$jobname or die_usage('Missing jobname');
+$texname = "$jobname$ext_tex" unless $texname;
+$destdir = "$jobname$ext_mkjobtexmf" unless $destdir;
+
+verbose "jobname: " . value $jobname;
+verbose "texname: " . value $texname if $texname;
+verbose "command: " . value "@args" if @args;
+verbose "destdir: " . value $destdir;
+
+if (!$copy) {
+ my $symlink_exists = eval { symlink('', ''); 1 };
+ if ($symlink_exists) {
+ verbose "symbolic linking: supported";
+ }
+ else {
+ $copy = 1;
+ verbose "symbolic linking: unsupported";
+ }
+}
+my $umask = umask;
+if (defined($umask)) {
+ verbose "umask: " . sprintf("%04o", $umask);
+}
+else {
+ $umask = 0;
+ verbose "umask: unsupported";
+}
+
+if ($copy) {
+ use File::Copy;
+}
+if ($flat) {
+ use File::Basename;
+}
+
+sub check_child_error () {
+ if ($? != 0) {
+ if ($? == -1) {
+ die_error "Failed to execute: $!";
+ }
+ elsif ($? & 127) {
+ die_error sprintf "Child died with signal %d, %s coredump",
+ ($? & 127), ($? & 128) ? 'with' : 'without';
+ }
+ else {
+ die_error sprintf "Child exited with value %d", $? >> 8;
+ }
+ }
+ verbose "child exit: ok";
+}
+
+sub run_generic (@) {
+ my @args = @_;
+ my $cmd = $_[0];
+ verbose "exec: " . value "@args";
+ print '>' x 79, "\n";
+ system $cmd @args;
+ print '<' x 79, "\n";
+ check_child_error;
+}
+
+sub run_tex {
+ if ($strace) {
+ my @run_args;
+ if (@args) {
+ @run_args = @args;
+ }
+ else {
+ @run_args = (
+ $cmd_tex,
+ '-interaction=nonstopmode',
+ @texopt,
+ $texname
+ );
+ }
+ run_generic(
+ $cmd_strace,
+ '-f',
+ '-e',
+ 'trace=open,access', # trace=file
+ '-o',
+ "$jobname$ext_strace",
+ @run_args
+ )
+ }
+ else {
+ run_generic(
+ $cmd_tex,
+ '-recorder',
+ "-jobname=$jobname",
+ '-interaction=nonstopmode',
+ @texopt,
+ $texname
+ );
+ }
+}
+
+sub run_texhash {
+ return if $flat;
+ if ($needs_texhash) {
+ run_generic(
+ $cmd_texhash,
+ "$destdir/texmf"
+ );
+ }
+ else {
+ verbose("texhash run skipped, no files added");
+ }
+}
+
+use Cwd 'abs_path', 'getcwd';
+
+sub get_texmf_trees () {
+ return if $flat;
+ my $cmdline = "$cmd_kpsewhich -expand-path='\$TEXMF'";
+ verbose "exec: " . value($cmdline);
+ my $str = `$cmdline`;
+ check_child_error;
+ chomp $str;
+ @texmf = split ':', $str;
+ my %texmf;
+ foreach my $texmf (@texmf) {
+ $texmf{$texmf} = '';
+ $texmf{abs_path($texmf)} = '';
+ }
+ @texmf = sort keys %texmf;
+ if ($verbose) {
+ if (@texmf) {
+ map { verbose 'texmf: ' . value($_) } @texmf;
+ }
+ else {
+ verbose 'texmf: none';
+ }
+ }
+}
+
+sub analyze_recorder {
+ my $pwd = getcwd;
+ verbose "pwd: " . value($pwd);
+
+ my $file_rec = $jobname . ($strace ? $ext_strace : $ext_recorder);
+ verbose 'File with recorded file names: ' . value($file_rec);
+ open(IN, '<', $file_rec)
+ or die_error "Cannot open `$file_rec'";
+ if ($strace) {
+ while (<IN>) {
+ chomp;
+ next if /\)\s+= -\d/; # -1 ENOENT, ...
+ next if /\WO_DIRECTORY\W/; # skip directories
+ my $type = 'INPUT';
+ if ($output) {
+ $type = 'OUTPUT' if /\WO_WRONLY\W/;
+ }
+ else {
+ next if /\WO_WRONLY\W/;
+ }
+ /^\d+\s+\w+\(\"([^"]+)\",/ or warning "Unknown entry `$_'";
+ my $file = $1;
+ $files{$file} = '';
+ }
+ }
+ else {
+ while (<IN>) {
+ chomp;
+ next if /^PWD /;
+ next if not $output and /^OUTPUT /;
+ /^(INPUT|OUTPUT) (.*)$/ or warning "Unknown entry `$_'";
+ my $type = $1;
+ my $file = $2;
+ $files{$file} = '';
+ }
+ }
+ close(IN);
+}
+
+sub map_files {
+ if ($flat) {
+ map_files_flat();
+ }
+ else {
+ map_files_texmf();
+ }
+}
+
+sub map_files_flat {
+ my %abs_files;
+ my %names;
+ my %clashes;
+
+ foreach my $file (keys %files) {
+ $abs_files{abs_path($file)} = '';
+ }
+
+ foreach my $file (keys %abs_files) {
+ my $name = basename($file);
+ next if exists $flat_ignore{$name};
+ if (defined($names{$name})) {
+ push @{$names{$name}}, $file;
+ $clashes{$name} = '';
+ }
+ else {
+ my @a = ($file);
+ $names{$name} = \@a;
+ }
+ }
+
+ foreach my $name (sort keys %clashes) {
+ print "* file name clash for " . value($name) . "\n";
+ my @a = @{$names{$name}};
+ foreach my $file (@a) {
+ print " " . value($file) . "\n";
+ }
+ }
+
+ foreach my $name (sort keys %names) {
+ my $file = @{$names{$name}}[0];
+ my $clash = $clashes{$name} ? ' (clash)' : '';
+ verbose value($name) . ' => ' . value($file) . $clash;
+ $links{$name} = $file;
+ }
+}
+
+sub map_files_texmf {
+ my @failed;
+
+ foreach my $file (sort keys %files) {
+ verbose "file: " . value($file);
+
+ my $abs_file = abs_path($file);
+
+ my $found = '';
+ foreach (@texmf) {
+ my $texmf = "$_/";
+ my $len = length($texmf);
+ my $str = substr $file, 0, $len;
+ if ($texmf eq $str) {
+ $found = 'texmf/' . substr $file, $len;
+ if ($found =~ /(^|\/)\.\.\//) {
+ $found = '';
+ }
+ }
+ last if $found;
+ my $str = substr $abs_file, 0, $len;
+ if ($texmf eq $str) {
+ $found = 'texmf/' . substr $abs_file, $len;
+ last;
+ }
+ }
+ if (not($found)) {
+ if ($file =~ /(^|\/)\.\.\// or $file =~ /^\//) {
+ push @failed, $file;
+ }
+ else {
+ $found = $file;
+ }
+ }
+ if ($found) {
+ $links{$found} = abs_path($file);
+ }
+ }
+
+ if ($verbose) {
+ foreach (sort keys %links) {
+ verbose value($_) . ' => ' . value($links{$_});
+ }
+ }
+
+ foreach (@failed) {
+ print "!!! Failed: " . value($_) . "\n";
+ }
+}
+
+sub make_dirs ($) {
+ my $path = shift;
+ my @elems = split /\/+/, $path;
+ if (@elems <= 1) {
+ return;
+ }
+ pop @elems;
+ my $dir = '';
+ foreach my $elem (@elems) {
+ $dir .= '/' if $dir;
+ $dir .= $elem;
+ next if -d $dir;
+ verbose 'mkdir: ' . value($dir);
+ mkdir $dir or die_error "Cannot make directory `$dir'";
+ }
+}
+
+sub make_links {
+
+ foreach my $key (sort keys %links) {
+ my $source = $links{$key};
+ my $dest = "$destdir/$key";
+ make_dirs $dest;
+ if (-e $dest) {
+ my $type = '';
+ if (-l $dest) {
+ $type .= 'link';
+ }
+ elsif (-f $dest) {
+ $type = 'file';
+ }
+ elsif (-d $dest) {
+ $type = 'directory';
+ }
+ elsif (-b $dest) {
+ $type = 'block device';
+ }
+ elsif (-c $dest) {
+ $type = 'character device';
+ }
+ elsif (-p $dest) {
+ $type = 'pipe';
+ }
+ elsif (-S $dest) {
+ $type = 'socket';
+ }
+ elsif (-t $dest) {
+ $type = 'tty';
+ }
+ $type = " ($type)" if $type;
+ verbose "destination$type exists: " . value($dest);
+ next;
+ }
+ $needs_texhash = 1;
+ do_link_copy($source, $dest);
+ }
+}
+
+sub do_link_copy {
+ my $source = shift;
+ my $dest = shift;
+ my $success = 0;
+
+ if ($copy) {
+ if (copy($source, $dest) == 1) {
+ $success = 1;
+ my ($source_mode, $source_atime, $source_mtime)
+ = (stat($source))[2, 8, 9];
+ my ($dest_mode, $dest_atime, $dest_mtime)
+ = (stat($dest))[2, 8, 9];
+ # preserve executable permissions if necessary
+ my $new_dest_mode = $dest_mode
+ | (($source_mode & 0111) & ~$umask);
+ if ($new_dest_mode != $dest_mode) {
+ if (chmod($new_dest_mode, $dest) < 1) {
+ print "!!! Setting executive mode failed: "
+ . value($dest) . "\n";
+ }
+ }
+ # preserve file times
+ if ($source_atime != $dest_atime
+ || $source_mtime != $dest_mtime) {
+ if (utime($source_atime, $source_mtime, $dest) < 1) {
+ print "!!! Setting file times failed: "
+ . value($dest) . "\n";
+ }
+ }
+ }
+ }
+ else {
+ if (symlink($source, $dest) == 1) {
+ $success = 1;
+ }
+ }
+ if ($success == 0) {
+ my $method = $copy ? 'Copying' : 'Symbolic linking';
+ print "!!! $method failed:\n "
+ . value($dest) . ' => ' . value($source) . "\n";
+ }
+}
+
+run_tex;
+get_texmf_trees;
+analyze_recorder;
+map_files;
+make_links;
+run_texhash;
+
+1;
+
+__DATA__
+
+=head1 NAME
+
+mkjobtexmf -- Generate a texmf tree for a particular job
+
+=head1 SYNOPSIS
+
+The progam B<mkjobtexmf> runs a program and tries to
+find the used file names. Two methods are available,
+option C<-recorder> of TeX (Web2C) or the program B<strace>.
+
+Then it generates a directory with a texmf tree. It checks
+the found files and tries sort them in this texmf tree.
+
+It can be used for archiving purposes or to speed up
+following TeX runs.
+
+ mkjobtexmf [options]
+
+This runs TeX that can be configured by options.
+Both methods for getting the used file names are available.
+
+ mkjobtexmf [options] -- <cmd> [args]
+
+The latter form runs program I<cmd> with arguments I<args>
+instead of TeX. As method only program B<strace> is available.
+
+Options:
+
+ --jobname <name> Name of the job (mandatory).
+ Usually this is the TeX file
+ without extension
+ --texname <file> Input file for TeX. Default is the
+ job name with extension '.tex'
+ --texopt <option> Option for TeX run
+ --destdir <directory> Destination directory,
+ default is `<jobname>.mjt'
+ --output Add also output files
+ --strace Use strace instead of TeX's
+ option -recorder
+ --copy Copy files instead of creating
+ symbol links
+ --flat Junk paths, do not make directories
+ inside the destination directory
+ --cmd-tex <cmd> Command for the TeX compiler
+ --cmd-kpsewhich <cmd> Command for kpsewhich
+ --cmd-texhash <cmd> Command for texhash
+ --cmd-strace <cmd> Command for strace
+ --verbose Verbose output
+ --help Brief help message
+ --man Full documentation
+
+=head1 DESCRIPTION
+
+=head2 Running the program
+
+First B<mkjobtexmf> runs a program, usually TeX. The TeX compiler
+is configured by option B<--cmd-tex>. Option B<--texname> can
+be used, if the file name extension differs from F<.tex>:
+
+ mkjobtexmf --jobname foo --texname foo.ltx
+
+Even more complicate cases are possible:
+
+ mkjobtexmf --jobname foo --texname '\def\abc{...}\input{foo}'
+
+If another program than TeX should be used (dvips, ...),
+then this program can be given after C<-->:
+
+ mkjobtexmf --jobname foo -- dvips foo
+
+=head2 File recording
+
+Two methods are available to get the used file names:
+
+=over
+
+=item Recorder of TeX
+
+Some TeX distributions (e.g. Web2C) support the option B<-recorder>
+for its TeX compilers. Then the TeX compiler generates a file with
+extension F<.fls> that records the used input and output files.
+
+=item Program strace
+
+This program traces system calls and signals. It is used here
+to log the used files.
+
+=back
+
+=head2 Analyze and link/copy found files
+
+The result directory F<I<jobname>.mjt> is generated. Inside the
+result TEXMF tree is created. Each found file is compared against
+a list of paths of TEXMF trees. If a match is found, the file is
+linked/copied into the TEXMF tree. The list of paths is generated by
+program B<kpsewhich>.
+
+If the file cannot be mapped to a TEXMF tree and the file is
+a relative file name, then it is directly linked/copied into the
+result directory F<I<jobname>.mjt>. Absolute file names
+are not supported and neither paths with links to parent directories.
+
+Symbolic links are created by default. The files are copied
+if option --copy is given or symbolic linking is not available.
+
+=head1 OPTIONS
+
+=over
+
+=item B<--jobname>=I<jobname>
+
+It is the name of the job. `<jobname>.tex' serves as default for
+the TeX file and <jobname> is used for naming various directories
+and files. See section L</FILES>.
+
+=item B<--texname>=I<name>
+
+The name of the TeX input file, if it differs from <jobname>.tex.
+
+=item B<--texopt>=I<opt>
+
+Additional option for the TeX compiler, examples are --ini or
+--shell-escape. This option can be given more than once.
+
+=item B<--destdir>=I<directory>
+
+Specifies the name of the destination directory where the result
+is collected. As default a directory is generated in the current
+directory with the job name and extension `.mjt'.
+
+=item B<--output>
+
+Also add output files.
+
+=item B<--strace>
+
+Use method with program B<strace>, see L<"DESCRIPTION">.
+
+=item B<--copy>
+
+Files are copied instead of creating symbolic links.
+
+=item B<--flat>
+
+Files are linked or copied without path elements.
+The destination directory will contain a flat list of
+files or links without directory.
+
+The files `ls-R' and `aliases' are ignored.
+
+=item B<--cmd-tex>=I<cmd>
+
+Command for the TeX compiler. Default is pdflatex.
+
+=item B<--cmd-kpsewhich>=I<cmd>
+
+Command for kpsewhich.
+
+=item B<--cmd-texhash>=I<cmd>
+
+Command for updating the file name database of the generated
+texmf tree. Default is texmf.
+
+=item B<--cmd-strace>=I<cmd>
+
+Command for strace.
+
+=item B<--verbose>
+
+Verbose messages.
+
+=item B<--help>
+
+Display help screen.
+
+=back
+
+=head1 EXAMPLES
+
+TeX file F<test.tex> using TeX's recorder method:
+
+ mkjobtexmf --jobname test
+
+TeX file F<test.tex> using LaTeX:
+
+ mkjobtexmf --jobname test --cmd-tex latex
+
+Format generation:
+
+ mkjobtexmf --jobname test --texopt -ini --texname pdflatex.ini
+
+Example, how the new texmf tree (Linux/bash) can be used:
+
+ TEXMF=!!test.mjt/texmf pdflatex test
+
+Example for generating a zip archive (Linux/bash):
+
+ (cd test.mjt && zip -9r ../test .)
+
+Example for generating a tar archive:
+
+ tar cjhvf test.tar.bz2 -C test.mjt .
+
+=head1 UNSOLVED ISSUES, CAVEATS, TODOS
+
+=over
+
+=item Experimental software
+
+Options, defaults, how the program works might change in
+future versions.
+
+=item F<texmf.cnf>
+
+Currently the method with B<strace> records this files.
+TeX's recorder does not. Useful are F<texmf.cnf> files for
+variable settings. Because we have just one TEXMF tree,
+the path sections should probably rewritten.
+
+=item Settings in environment variables
+
+They are not stored at all.
+
+=item Collisions
+
+The program uses one destination directory and at most
+one TEXMF tree for the result. However, the source files
+can come from different directories and TEXMF trees.
+Therefore name collisions are possible.
+
+The program follows the strategy not to delete files
+in the destination directory. That allows to collect files
+from differnt runs. Thus collisions are resolved
+in the manner that the first entry that is made in
+the destination directory wins.
+
+=item Configuration file
+
+It would save the user from retyping the same options again and again.
+
+=item Uncomplete recording
+
+Bugs in TeX's file recording might result in incomplete
+file recording (e.g. pdfTeX 1.40.3 does not record .pfb and
+.pk files).
+
+=item ...
+
+=back
+
+=head1 FILES
+
+=over
+
+=item F<E<lt>jobnameE<gt>.mjt/>
+
+Directory where the resulting texmf tree and symbol links
+are stored. It can be changed by option --destdir.
+
+=item F<E<lt>jobnameE<gt>.fls>
+
+Name of TeX's recorder file.
+
+=item F<E<lt>jobnameE<gt>.strace>
+
+Log file where the result of B<strace> is stored.
+
+=back
+
+=head1 AUTHOR
+
+Heiko Oberdiek, email: oberdiek at uni-freiburg.de
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007 by Heiko Oberdiek.
+
+This library is free software; you may redistribute it and/or
+modify it under the same terms as Perl itself
+(Perl Artistic License/GNU General Public License, version 2).
+
+=head1 HISTORY
+
+=over
+
+=item 2007/04/16 v0.1
+
+* First experimental version.
+
+=item 2007/05/09 v0.2
+
+* Typo in option name fixed.
+
+=item 2007/09/03 v0.3
+
+* New options: --copy, --flat, --destdir
+
+=item 2007/09/04 v0.4
+
+* Bug fix in map_files_texmf.
+
+=item 2007/09/06 v0.5
+
+* Support for `configure' added.
+ (Thanks to Norbert Preining for writing a first version of
+ the configure stuff.)
+
+=item 2008/04/05 v0.6
+
+* Tiny fix in target `uninstall' in file `Makefile.in'.
+ (Thanks to Karl Berry)
+
+=back
+
+=cut
diff --git a/Build/source/texk/texlive/linked_scripts/pdfcrop.pl b/Build/source/texk/texlive/linked_scripts/pdfcrop.pl
new file mode 100755
index 00000000000..a13ac745439
--- /dev/null
+++ b/Build/source/texk/texlive/linked_scripts/pdfcrop.pl
@@ -0,0 +1,369 @@
+eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}' && eval 'exec perl -S $0 $argv:q'
+ if 0;
+use strict;
+$^W=1; # turn warning on
+#
+# pdfcrop.pl
+#
+# Copyright (C) 2002, 2004, 2005, 2008 Heiko Oberdiek.
+#
+# This program may be distributed and/or modified under the
+# conditions of the LaTeX Project Public License, either version 1.2
+# of this license or (at your option) any later version.
+# The latest version of this license is in
+# http://www.latex-project.org/lppl.txt
+# and version 1.2 or later is part of all distributions of LaTeX
+# version 1999/12/01 or later.
+#
+# See file "README" for a list of files that belong to this project.
+#
+# This file "pdfcrop.pl" may be renamed to "pdfcrop"
+# for installation purposes.
+#
+my $file = "pdfcrop.pl";
+my $program = uc($&) if $file =~ /^\w+/;
+my $version = "1.9";
+my $date = "2008/04/05";
+my $author = "Heiko Oberdiek";
+my $copyright = "Copyright (c) 2002-2008 by $author.";
+#
+# Reqirements: Perl5, Ghostscript
+# History:
+# 2002/10/30 v1.0: First release.
+# 2002/10/30 v1.1: Option --hires added.
+# 2002/11/04 v1.2: "nul" instead of "/dev/null" for windows.
+# 2002/11/23 v1.3: Use of File::Spec module's "devnull" call.
+# 2002/11/29 v1.4: Option --papersize added.
+# 2004/06/24 v1.5: Clear map file entries so that pdfTeX
+# does not touch the fonts.
+# 2004/06/26 v1.6: Use mgs.exe instead of gswin32c.exe for MIKTEX.
+# 2005/03/11 v1.7: Support of spaces in file names
+# (open("-|") is used for ghostscript call).
+# 2008/01/09 v1.8: Fix for moving the temporary file to the output
+# file across file system boundaries.
+# 2008/04/05 v1.9: Options --resolution and --bbox added.
+#
+
+### program identification
+my $title = "$program $version, $date - $copyright\n";
+
+### error strings
+my $Error = "!!! Error:"; # error prefix
+
+### string constants for Ghostscript run
+# get Ghostscript command name
+my $GS = "gs";
+$GS = "gs386" if $^O =~ /dos/i;
+$GS = "gsos2" if $^O =~ /os2/i;
+$GS = "gswin32c" if $^O =~ /mswin32/i;
+$GS = "gswin32c" if $^O =~ /cygwin/i;
+$GS = "mgs" if defined($ENV{"TEXSYSTEM"}) and
+ $ENV{"TEXSYSTEM"} =~ /miktex/i;
+
+# Windows detection (no SIGHUP)
+my $Win = 0;
+$Win = 1 if $^O =~ /mswin32/i;
+$Win = 1 if $^O =~ /cygwin/i;
+
+# "null" device
+use File::Spec::Functions qw(devnull);
+my $null = devnull();
+
+### variables
+my $inputfile = "";
+my $outputfile = "";
+my $tmp = "tmp-\L$program\E-$$";
+
+### option variables
+my @bool = ("false", "true");
+$::opt_help = 0;
+$::opt_debug = 0;
+$::opt_verbose = 0;
+$::opt_gscmd = $GS;
+$::opt_pdftexcmd = "pdftex";
+$::opt_margins = "0 0 0 0";
+$::opt_clip = 0;
+$::opt_hires = 0;
+$::opt_papersize = "";
+$::opt_resolution = "";
+$::opt_bbox = "";
+
+my $usage = <<"END_OF_USAGE";
+${title}Syntax: \L$program\E [options] <input[.pdf]> [output file]
+Function: Margins are calculated and removed for each page in the file.
+Options: (defaults:)
+ --help print usage
+ --(no)verbose verbose printing ($bool[$::opt_verbose])
+ --(no)debug debug informations ($bool[$::opt_debug])
+ --gscmd <name> call of ghostscript ($::opt_gscmd)
+ --pdftexcmd <name> call of pdfTeX ($::opt_pdftexcmd)
+ --margins "<left> <top> <right> <bottom>" ($::opt_margins)
+ add extra margins, unit is bp. If only one number is
+ given, then it is used for all margins, in the case
+ of two numbers they are also used for right and bottom.
+ --(no)clip clipping support, if margins are set ($bool[$::opt_clip])
+ --(no)hires using `%%HiResBoundingBox' ($bool[$::opt_hires])
+ instead of `%%BoundingBox'
+Expert options:
+ --papersize <foo> parameter for gs's -sPAPERSIZE=<foo>,
+ use only with older gs versions <7.32 ($::opt_papersize)
+ --resolution <xres>x<yres> ()
+ --resolution <res> pass argument to ghostscript's option -r
+ Example: --resolution 72
+ --bbox "<left> <top> <right> <bottom>" ()
+ override bounding box found by ghostscript
+Examples:
+ \L$program\E --margins 10 input.pdf output.pdf
+ \L$program\E --margins '5 10 5 20' --clip input.pdf output.pdf
+END_OF_USAGE
+
+### process options
+my @OrgArgv = @ARGV;
+use Getopt::Long;
+GetOptions(
+ "help!",
+ "debug!",
+ "verbose!",
+ "gscmd=s",
+ "pdftexcmd=s",
+ "margins=s",
+ "clip!",
+ "hires!",
+ "papersize=s",
+ "resolution=s",
+ "bbox=s",
+) or die $usage;
+!$::opt_help or die $usage;
+
+$::opt_verbose = 1 if $::opt_debug;
+
+@ARGV >= 1 or die $usage;
+
+print $title;
+
+if ($::opt_bbox) {
+ $::opt_bbox =~ s/^\s+//;
+ $::opt_bbox =~ s/\s+$//;
+ $::opt_bbox =~ s/\s+/ /;
+ if ($::opt_bbox =~ /^-?\d*\.?\d+ -?\d*\.?\d+ -?\d*\.?\d+ -?\d*\.?\d+$/) {
+ print "* Explicite Bounding Box: $::opt_bbox\n" if $::opt_debug;
+ }
+ else {
+ die "$Error Parse error (option --bbox \"$::opt_bbox\")!\n";
+ }
+}
+
+@ARGV <= 2 or die "$Error Too many files!\n";
+
+### input file
+$inputfile = shift @ARGV;
+
+if (! -f $inputfile) {
+ if (-f "$inputfile.pdf") {
+ $inputfile .= ".pdf";
+ }
+ else {
+ die "$Error Input file `$inputfile' not found!\n";
+ }
+}
+
+print "* Input file: $inputfile\n" if $::opt_debug;
+
+### output file
+if (@ARGV) {
+ $outputfile = shift @ARGV;
+}
+else {
+ $outputfile = $inputfile;
+ $outputfile =~ s/\.pdf$//i;
+ $outputfile .= "-crop.pdf";
+}
+
+print "* Output file: $outputfile\n" if $::opt_debug;
+
+### margins
+my ($llx, $lly, $urx, $ury) = (0, 0, 0, 0);
+if ($::opt_margins =~
+ /^\s*([\-\.\d]+)\s+([\-\.\d]+)\s+([\-\.\d]+)\s+([\-\.\d]+)\s*$/) {
+ ($llx, $lly, $urx, $ury) = ($1, $2, $3, $4);
+}
+else {
+ if ($::opt_margins =~ /^\s*([\-\.\d]+)\s+([\-\.\d]+)\s*$/) {
+ ($llx, $lly, $urx, $ury) = ($1, $2, $1, $2);
+ }
+ else {
+ if ($::opt_margins =~ /^\s*([\-\.\d]+)\s*$/) {
+ ($llx, $lly, $urx, $ury) = ($1, $1, $1, $1);
+ }
+ else {
+ die "$Error Parse error (option --margins)!\n";
+ }
+ }
+}
+print "* Margins: $llx $lly $urx $ury\n" if $::opt_debug;
+
+### cleanup system
+my @unlink_files = ();
+my $exit_code = 1;
+sub clean {
+ print "* Cleanup\n" if $::opt_debug;
+ if ($::opt_debug) {
+ print "* Temporary files: @unlink_files\n";
+ }
+ else {
+ for (; @unlink_files>0; ) {
+ unlink shift @unlink_files;
+ }
+ }
+}
+sub cleanup {
+ clean();
+ exit($exit_code);
+}
+$SIG{'INT'} = \&cleanup;
+$SIG{'__DIE__'} = \&clean;
+
+### Calculation of BoundingBoxes
+
+my @gsargs = (
+ "-sDEVICE=bbox",
+ "-dBATCH",
+ "-dNOPAUSE",
+);
+push @gsargs, "-sPAPERSIZE=$::opt_papersize" if $::opt_papersize;
+push @gsargs, "-r$::opt_resolution" if $::opt_resolution;
+push @gsargs,
+ "-c",
+ "save",
+ "pop",
+ "-f",
+ $inputfile
+;
+
+my $tmpfile = "$tmp.tex";
+push @unlink_files, $tmpfile;
+open(TMP, ">$tmpfile") or
+ die "$Error Cannot write tmp file `$tmpfile'!\n";
+print TMP "\\def\\pdffile{$inputfile}\n";
+print TMP <<'END_TMP_HEAD';
+\csname pdfmapfile\endcsname{}
+\def\page #1 [#2 #3 #4 #5]{%
+ \count0=#1\relax
+ \setbox0=\hbox{%
+ \pdfximage page #1{\pdffile}%
+ \pdfrefximage\pdflastximage
+ }%
+ \pdfhorigin=-#2bp\relax
+ \pdfvorigin=#3bp\relax
+ \pdfpagewidth=#4bp\relax
+ \advance\pdfpagewidth by -#2bp\relax
+ \pdfpageheight=#5bp\relax
+ \advance\pdfpageheight by -#3bp\relax
+ \ht0=\pdfpageheight
+ \shipout\box0\relax
+}
+\def\pageclip #1 [#2 #3 #4 #5][#6 #7 #8 #9]{%
+ \count0=#1\relax
+ \dimen0=#4bp\relax \advance\dimen0 by -#2bp\relax
+ \edef\imagewidth{\the\dimen0}%
+ \dimen0=#5bp\relax \advance\dimen0 by -#3bp\relax
+ \edef\imageheight{\the\dimen0}%
+ \pdfximage page #1{\pdffile}%
+ \setbox0=\hbox{%
+ \kern -#2bp\relax
+ \lower #3bp\hbox{\pdfrefximage\pdflastximage}%
+ }%
+ \wd0=\imagewidth\relax
+ \ht0=\imageheight\relax
+ \dp0=0pt\relax
+ \pdfhorigin=#6pt\relax
+ \pdfvorigin=#7bp\relax
+ \pdfpagewidth=\imagewidth
+ \advance\pdfpagewidth by #6bp\relax
+ \advance\pdfpagewidth by #8bp\relax
+ \pdfpageheight=\imageheight\relax
+ \advance\pdfpageheight by #7bp\relax
+ \advance\pdfpageheight by #9bp\relax
+ \pdfxform0\relax
+ \shipout\hbox{\pdfrefxform\pdflastxform}%
+}%
+END_TMP_HEAD
+
+print "* Running ghostscript for BoundingBox calculation ...\n"
+ if $::opt_verbose;
+print "* Ghostscript call: $::opt_gscmd @gsargs\n" if $::opt_debug;
+
+my @bbox;
+if ($::opt_bbox) {
+ $::opt_bbox =~ /([-\d\.]+) ([-\d\.]+) ([-\d\.]+) ([-\d\.]+)/;
+ @bbox = ($1, $2, $3, $4);
+}
+my $page = 0;
+my $pid = open(KID_TO_READ, "-|");
+if ($pid) { # parent
+ while (<KID_TO_READ>) {
+ my $bb = ($::opt_hires) ? "%%HiResBoundingBox" : "%%BoundingBox";
+ next unless
+ /^$bb:\s*([\.\d]+) ([\.\d]+) ([\.\d]+) ([\.\d]+)/o;
+ @bbox = ($1, $2, $3, $4) unless $::opt_bbox;
+ $page++;
+ print "* Page $page: @bbox\n" if $::opt_verbose;
+ if ($::opt_clip) {
+ print TMP "\\pageclip $page [@bbox][$llx $lly $urx $ury]\n";
+ }
+ else {
+ my @bb = ($bbox[0] - $llx, $bbox[1] - $ury,
+ $bbox[2] + $urx, $bbox[3] + $lly);
+ print TMP "\\page $page [@bb]\n";
+ }
+ }
+ close(KID_TO_READ)
+ || die "!!! Error: Execution of ghostscript failed: $?\n";
+}
+else { # child
+ open STDERR, '>&STDOUT' or die "!!! Error: Cannot redirect stderr: $!\n";
+ open STDOUT, ">$null" or die "!!! Error: Cannot write to $null!\n";
+ exec($::opt_gscmd, @gsargs)
+ || die "!!! Error: Ghostscript run failed: $!\n";
+ # NOT REACHED
+}
+
+print TMP "\\csname \@\@end\\endcsname\n\\end\n";
+close(TMP);
+
+### Run pdfTeX
+
+push @unlink_files, "$tmp.log";
+my $cmd;
+if ($::opt_verbose) {
+ $cmd = "$::opt_pdftexcmd -interaction=nonstopmode $tmp";
+}
+else {
+ $cmd = "$::opt_pdftexcmd -interaction=batchmode $tmp";
+}
+print "* Running pdfTeX ...\n" if $::opt_verbose;
+print "* pdfTeX call: $cmd\n" if $::opt_debug;
+if ($::opt_verbose) {
+ system($cmd);
+}
+else {
+ `$cmd`;
+}
+if ($?) {
+ die "$Error pdfTeX run failed!\n";
+}
+
+### Move temp file to output
+if (!rename("$tmp.pdf", $outputfile)) {
+ use File::Copy;
+ move "$tmp.pdf", $outputfile or
+ die "$Error Cannot move `$tmp.pdf' to `$outputfile'!\n";
+}
+
+print "==> $page page", (($page == 1) ? "" : "s"),
+ " written on `$outputfile'.\n";
+
+$exit_code = 0;
+cleanup();
+
+__END__
diff --git a/Build/source/texk/texlive/linked_scripts/pdfthumb.texlua b/Build/source/texk/texlive/linked_scripts/pdfthumb.texlua
new file mode 100755
index 00000000000..3f6f2c56490
--- /dev/null
+++ b/Build/source/texk/texlive/linked_scripts/pdfthumb.texlua
@@ -0,0 +1,44 @@
+#!/usr/bin/env texlua
+--*-Lua-*-
+-- $Id: thumbpdf.texlua 6969 2008-03-14 22:17:00Z reinhardk $
+
+-- Copyright (C) 2008 Reinhard Kotucha.
+-- You may freely use, modify and/or distribute this file.
+
+-- Launch thumbpdf
+
+function fixwin(args_unix)
+ if os.type == 'windows' then
+ local args_win={} -- new table
+ args_win[0]=args_unix[1]
+ for i=1, #args_unix do
+ args_win[i]='"'..args_unix[i]..'"'
+ end
+ return args_win
+ else
+ return args_unix
+ end
+end
+
+kpse.set_program_name('pdfthumb.texlua', 'pdfthumb')
+
+jarfile=kpse.find_file('pp4p.jar', 'texmfscripts')
+
+command={'java', '-cp', jarfile, 'de.tu_darmstadt.sp.pdftools.ThumbGen'}
+
+for i=1, #arg do
+ command[#command+1]=arg[i]
+end
+
+command=fixwin(command)
+
+--[[ prepend an additional hyphen to activate this code
+for i=0, #command do
+ print (command[i])
+end
+os.exit(ret)
+--]]
+
+ret=os.spawn(command)
+os.exit(ret)
+ft \ No newline at end of file
diff --git a/Build/source/texk/texlive/linked_scripts/perltex.pl b/Build/source/texk/texlive/linked_scripts/perltex.pl
new file mode 100755
index 00000000000..9c85ef94500
--- /dev/null
+++ b/Build/source/texk/texlive/linked_scripts/perltex.pl
@@ -0,0 +1,476 @@
+#! /usr/bin/env perl
+
+###########################################################
+# Prepare a LaTeX run for two-way communication with Perl #
+# By Scott Pakin <scott+pt@pakin.org> #
+###########################################################
+
+#-------------------------------------------------------------------
+# This is file `perltex.pl',
+# generated with the docstrip utility.
+#
+# The original source files were:
+#
+# perltex.dtx (with options: `perltex')
+#
+# This is a generated file.
+#
+# Copyright (C) 2007 Scott Pakin <scott+pt@pakin.org>
+#
+# This file may be distributed and/or modified under the conditions
+# of the LaTeX Project Public License, either version 1.3c of this
+# license or (at your option) any later version. The latest
+# version of this license is in:
+#
+# http://www.latex-project.org/lppl.txt
+#
+# and version 1.3c or later is part of all distributions of LaTeX
+# version 2006/05/20 or later.
+#-------------------------------------------------------------------
+
+sub top_level_eval ($)
+{
+ return eval $_[0];
+}
+use Safe;
+use Opcode;
+use Getopt::Long;
+use Pod::Usage;
+use File::Basename;
+use Fcntl;
+use POSIX;
+use warnings;
+use strict;
+my $latexprog;
+my $runsafely = 1;
+my @permittedops;
+my $usepipe = 1;
+my $progname = basename $0;
+my $jobname = "texput";
+my $toperl;
+my $fromperl;
+my $toflag;
+my $fromflag;
+my $doneflag;
+my $logfile;
+my $pipe;
+my @latexcmdline;
+my $styfile;
+my @macroexpansions;
+my $sandbox = new Safe;
+my $sandbox_eval;
+my $latexpid;
+my $pipestring = "\%\%\%\%\% Generated by $progname\n\\endinput\n";
+$latexprog = $ENV{"PERLTEX"} || "latex";
+Getopt::Long::Configure("require_order", "pass_through");
+GetOptions("help" => sub {pod2usage(-verbose => 1)},
+ "latex=s" => \$latexprog,
+ "safe!" => \$runsafely,
+ "pipe!" => \$usepipe,
+ "synctext=s" => \$pipestring,
+ "makesty" => sub {$styfile = "noperltex.sty"},
+ "permit=s" => \@permittedops) || pod2usage(2);
+@latexcmdline = @ARGV;
+my $firstcmd = 0;
+for ($firstcmd=0; $firstcmd<=$#latexcmdline; $firstcmd++) {
+ my $option = $latexcmdline[$firstcmd];
+ next if substr($option, 0, 1) eq "-";
+ if (substr ($option, 0, 1) ne "\\") {
+ $jobname = basename $option, ".tex" ;
+ $latexcmdline[$firstcmd] = "\\input $option";
+ }
+ last;
+}
+push @latexcmdline, "" if $#latexcmdline==-1;
+my $separator = "";
+foreach (1 .. 20) {
+ $separator .= chr(ord("A") + rand(26));
+}
+$toperl = $jobname . ".topl";
+$fromperl = $jobname . ".frpl";
+$toflag = $jobname . ".tfpl";
+$fromflag = $jobname . ".ffpl";
+$doneflag = $jobname . ".dfpl";
+$logfile = $jobname . ".lgpl";
+$pipe = $jobname . ".pipe";
+$latexcmdline[$firstcmd] =
+ sprintf '\makeatletter' . '\def%s{%s}' x 7 . '\makeatother%s',
+ '\plmac@tag', $separator,
+ '\plmac@tofile', $toperl,
+ '\plmac@fromfile', $fromperl,
+ '\plmac@toflag', $toflag,
+ '\plmac@fromflag', $fromflag,
+ '\plmac@doneflag', $doneflag,
+ '\plmac@pipe', $pipe,
+ $latexcmdline[$firstcmd];
+foreach my $file ($toperl, $fromperl, $toflag, $fromflag, $doneflag, $pipe) {
+ unlink $file while -e $file;
+}
+open (LOGFILE, ">$logfile") || die "open(\"$logfile\"): $!\n";
+if (defined $styfile) {
+ open (STYFILE, ">$styfile") || die "open(\"$styfile\"): $!\n";
+}
+if (!$usepipe || !eval {mkfifo($pipe, 0600)}) {
+ sysopen PIPE, $pipe, O_WRONLY|O_CREAT, 0755;
+ print PIPE $pipestring;
+ close PIPE;
+ $usepipe = 0;
+}
+defined ($latexpid = fork) || die "fork: $!\n";
+unshift @latexcmdline, $latexprog;
+if (!$latexpid) {
+ exec {$latexcmdline[0]} @latexcmdline;
+ die "exec('@latexcmdline'): $!\n";
+}
+if ($runsafely) {
+ @permittedops=(":browse") if $#permittedops==-1;
+ $sandbox->permit_only (@permittedops);
+ $sandbox_eval = sub {$sandbox->reval($_[0])};
+}
+else {
+ $sandbox_eval = \&top_level_eval;
+}
+while (1) {
+ my $awaitexists = sub {
+ while (!-e $_[0]) {
+ sleep 0;
+ if (waitpid($latexpid, &WNOHANG)==-1) {
+ foreach my $file ($toperl, $fromperl, $toflag,
+ $fromflag, $doneflag, $pipe) {
+ unlink $file while -e $file;
+ }
+ undef $latexpid;
+ exit 0;
+ }
+ }
+ };
+ $awaitexists->($toflag);
+ my $entirefile;
+ {
+ local $/ = undef;
+ open (TOPERL, "<$toperl") || die "open($toperl): $!\n";
+ $entirefile = <TOPERL>;
+ close TOPERL;
+ }
+ my ($optag, $macroname, @otherstuff) =
+ map {chomp; $_} split "$separator\n", $entirefile;
+ $macroname =~ s/^[^A-Za-z]+//;
+ $macroname =~ s/\W/_/g;
+ $macroname = "latex_" . $macroname;
+ if ($optag eq "USE") {
+ foreach (@otherstuff) {
+ s/\\/\\\\/g;
+ s/\'/\\\'/g;
+ $_ = "'$_'";
+ }
+ }
+ my $perlcode;
+ if ($optag eq "DEF") {
+ $perlcode =
+ sprintf "sub %s {%s}\n",
+ $macroname, $otherstuff[0];
+ }
+ elsif ($optag eq "USE") {
+ $perlcode = sprintf "%s (%s);\n", $macroname, join(", ", @otherstuff);
+ }
+ elsif ($optag eq "RUN") {
+ $perlcode = $otherstuff[0];
+ }
+ else {
+ die "${progname}: Internal error -- unexpected operation tag \"$optag\"\n";
+ }
+ print LOGFILE "#" x 31, " PERL CODE ", "#" x 32, "\n";
+ print LOGFILE $perlcode, "\n";
+ undef $_;
+ my $result;
+ {
+ my $warningmsg;
+ local $SIG{__WARN__} =
+ sub {chomp ($warningmsg=$_[0]); return 0};
+ $result = $sandbox_eval->($perlcode);
+ if (defined $warningmsg) {
+ $warningmsg =~ s/at \(eval \d+\) line \d+\W+//;
+ print LOGFILE "# ===> $warningmsg\n\n";
+ }
+ }
+ $result = "" if !$result || $optag eq "RUN";
+ if ($@) {
+ my $msg = $@;
+ $msg =~ s/at \(eval \d+\) line \d+\W+//;
+ $msg =~ s/\s+/ /;
+ $result = "\\PackageError{perltex}{$msg}";
+ my @helpstring;
+ if ($msg =~ /\btrapped by\b/) {
+ @helpstring =
+ ("The preceding error message comes from Perl. Apparently,",
+ "the Perl code you tried to execute attempted to perform an",
+ "`unsafe' operation. If you trust the Perl code (e.g., if",
+ "you wrote it) then you can invoke perltex with the --nosafe",
+ "option to allow arbitrary Perl code to execute.",
+ "Alternatively, you can selectively enable Perl features",
+ "using perltex's --permit option. Don't do this if you don't",
+ "trust the Perl code, however; malicious Perl code can do a",
+ "world of harm to your computer system.");
+ }
+ else {
+ @helpstring =
+ ("The preceding error message comes from Perl. Apparently,",
+ "there's a bug in your Perl code. You'll need to sort that",
+ "out in your document and re-run perltex.");
+ }
+ my $helpstring = join ("\\MessageBreak\n", @helpstring);
+ $helpstring =~ s/\. /.\\space\\space /g;
+ $result .= "{$helpstring}";
+ }
+ push @macroexpansions, $result if defined $styfile && $optag eq "USE";
+ print LOGFILE "%" x 30, " LATEX RESULT ", "%" x 30, "\n";
+ print LOGFILE $result, "\n\n";
+ $result .= '\endinput';
+ open (FROMPERL, ">$fromperl") || die "open($fromperl): $!\n";
+ syswrite FROMPERL, $result;
+ close FROMPERL;
+ unlink $toflag while -e $toflag;
+ unlink $toperl while -e $toperl;
+ unlink $doneflag while -e $doneflag;
+ open (FROMFLAG, ">$fromflag") || die "open($fromflag): $!\n";
+ close FROMFLAG;
+ if (open (PIPE, ">$pipe")) {
+ print PIPE $pipestring;
+ close PIPE;
+ }
+ $awaitexists->($toperl);
+ unlink $fromflag while -e $fromflag;
+ open (DONEFLAG, ">$doneflag") || die "open($doneflag): $!\n";
+ close DONEFLAG;
+ if (open (PIPE, ">$pipe")) {
+ print PIPE $pipestring;
+ close PIPE;
+ }
+}
+END {
+ close LOGFILE;
+ if (defined $latexpid) {
+ kill (9, $latexpid);
+ exit 1;
+ }
+
+ if (defined $styfile) {
+ print STYFILE <<"STYFILEHEADER1";
+\\NeedsTeXFormat{LaTeX2e}[1999/12/01]
+\\ProvidesPackage{noperltex}
+ [2007/09/29 v1.4 Perl-free version of PerlTeX specific to $jobname.tex]
+STYFILEHEADER1
+ ;
+ print STYFILE <<'STYFILEHEADER2';
+\RequirePackage{filecontents}
+
+\let\noperltex@PackageError=\PackageError
+\renewcommand{\PackageError}[3]{}
+\RequirePackage{perltex}
+\let\PackageError=\noperltex@PackageError
+
+\newcount\plmac@macro@invocation@num
+\gdef\plmac@show@placeholder#1#2\@empty{%
+ \ifx#1U\relax
+ \endgroup
+ \advance\plmac@macro@invocation@num by 1\relax
+ \global\plmac@macro@invocation@num=\plmac@macro@invocation@num
+ \input{noperltex-\the\plmac@macro@invocation@num.tex}%
+ \else
+ \endgroup
+ \fi
+}
+STYFILEHEADER2
+ ;
+ foreach my $e (0 .. $#macroexpansions) {
+ print STYFILE "\n";
+ printf STYFILE "%% Invocation #%d\n", 1+$e;
+ printf STYFILE "\\begin{filecontents}{noperltex-%d.tex}\n", 1+$e;
+ print STYFILE $macroexpansions[$e], "\\endinput\n";
+ print STYFILE "\\end{filecontents}\n";
+ }
+ print STYFILE "\\endinput\n";
+ close STYFILE;
+ }
+
+ exit 0;
+}
+
+__END__
+
+=head1 NAME
+
+perltex - enable LaTeX macros to be defined in terms of Perl code
+
+=head1 SYNOPSIS
+
+perltex
+[B<--help>]
+[B<--latex>=I<program>]
+[B<-->[B<no>]B<safe>]
+[B<--permit>=I<feature>]
+[B<--makesty>]
+[I<latex options>]
+
+=head1 DESCRIPTION
+
+LaTeX -- through the underlying TeX typesetting system -- produces
+beautifully typeset documents but has a macro language that is
+difficult to program. In particular, support for complex string
+manipulation is largely lacking. Perl is a popular general-purpose
+programming language whose forte is string manipulation. However, it
+has no typesetting capabilities whatsoever.
+
+Clearly, Perl's programmability could complement LaTeX's typesetting
+strengths. B<perltex> is the tool that enables a symbiosis between
+the two systems. All a user needs to do is compile a LaTeX document
+using B<perltex> instead of B<latex>. (B<perltex> is actually a
+wrapper for B<latex>, so no B<latex> functionality is lost.) If the
+document includes a C<\usepackage{perltex}> in its preamble, then
+C<\perlnewcommand> and C<\perlrenewcommand> macros will be made
+available. These behave just like LaTeX's C<\newcommand> and
+C<\renewcommand> except that the macro body contains Perl code instead
+of LaTeX code.
+
+=head1 OPTIONS
+
+B<perltex> accepts the following command-line options:
+
+=over 4
+
+=item B<--help>
+
+Display basic usage information.
+
+=item B<--latex>=I<program>
+
+Specify a program to use instead of B<latex>. For example,
+C<--latex=pdflatex> would typeset the given document using
+B<pdflatex> instead of ordinary B<latex>.
+
+=item B<-->[B<no>]B<safe>
+
+Enable or disable sandboxing. With the default of B<--safe>,
+B<perltex> executes the code from a C<\perlnewcommand> or
+C<\perlrenewcommand> macro within a protected environment that
+prohibits ``unsafe'' operations such as accessing files or executing
+external programs. Specifying B<--nosafe> gives the LaTeX document
+I<carte blanche> to execute any arbitrary Perl code, including that
+which can harm the user's files. See L<Safe> for more information.
+
+=item B<--permit>=I<feature>
+
+Permit particular Perl operations to be performed. The B<--permit>
+option, which can be specified more than once on the command line,
+enables finer-grained control over the B<perltex> sandbox. See
+L<Opcode> for more information.
+
+=item B<--makesty>
+
+Generate a LaTeX style file called F<noperltex.sty>. Replacing the
+document's C<\usepackage{perltex}> line with C<\usepackage{noperltex}>
+produces the same output but does not require PerlTeX, making the
+document suitable for distribution to people who do not have PerlTeX
+installed. The disadvantage is that F<noperltex.sty> is specific to
+the document that produced it. Any changes to the document's PerlTeX
+macro definitions or macro invocations necessitates rerunning
+B<perltex> with the B<--makesty> option.
+
+=back
+
+These options are then followed by whatever options are normally
+passed to B<latex> (or whatever program was specified with
+C<--latex>), including, for instance, the name of the F<.tex> file to
+compile.
+
+=head1 EXAMPLES
+
+In its simplest form, B<perltex> is run just like B<latex>:
+
+ perltex myfile.tex
+
+To use B<pdflatex> instead of regular B<latex>, use the B<--latex>
+option:
+
+ perltex --latex=pdflatex myfile.tex
+
+If LaTeX gives a ``C<trapped by operation mask>'' error and you trust
+the F<.tex> file you're trying to compile not to execute malicious
+Perl code (e.g., because you wrote it yourself), you can disable
+B<perltex>'s safety mechansisms with B<--nosafe>:
+
+ perltex --nosafe myfile.tex
+
+The following command gives documents only B<perltex>'s default
+permissions (C<:browse>) plus the ability to open files and invoke the
+C<time> command:
+
+ perltex --permit=:browse --permit=:filesys_open
+ --permit=time myfile.tex
+
+=head1 ENVIRONMENT
+
+B<perltex> honors the following environment variables:
+
+=over 4
+
+=item PERLTEX
+
+Specify the filename of the LaTeX compiler. The LaTeX compiler
+defaults to ``C<latex>''. The C<PERLTEX> environment variable
+overrides this default, and the B<--latex> command-line option (see
+L</OPTIONS>) overrides that.
+
+=back
+
+=head1 FILES
+
+While compiling F<jobname.tex>, B<perltex> makes use of the following
+files:
+
+=over 4
+
+=item F<jobname.lgpl>
+
+log file written by Perl; helpful for debugging Perl macros
+
+=item F<jobname.topl>
+
+information sent from LaTeX to Perl
+
+=item F<jobname.frpl>
+
+information sent from Perl to LaTeX
+
+=item F<jobname.tfpl>
+
+``flag'' file whose existence indicates that F<jobname.topl> contains
+valid data
+
+=item F<jobname.ffpl>
+
+``flag'' file whose existence indicates that F<jobname.frpl> contains
+valid data
+
+=item F<jobname.dfpl>
+
+``flag'' file whose existence indicates that F<jobname.ffpl> has been
+deleted
+
+=item F<noperltex-#.tex>
+
+file generated by F<noperltex.sty> for each PerlTeX macro invocation
+
+=back
+
+=head1 NOTES
+
+B<perltex>'s sandbox defaults to what L<Opcode> calls ``C<:browse>''.
+
+=head1 SEE ALSO
+
+latex(1), pdflatex(1), perl(1), Safe(3pm), Opcode(3pm)
+
+=head1 AUTHOR
+
+Scott Pakin, I<scott+pt@pakin.org>
diff --git a/Build/source/texk/texlive/linked_scripts/pkfix.pl b/Build/source/texk/texlive/linked_scripts/pkfix.pl
new file mode 100755
index 00000000000..1429889b9ec
--- /dev/null
+++ b/Build/source/texk/texlive/linked_scripts/pkfix.pl
@@ -0,0 +1,860 @@
+eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}' && eval 'exec perl -S $0 $argv:q'
+ if 0;
+use strict;
+$^W=1; # turn warning on
+#
+# pkfix.pl
+#
+# Copyright (C) 2001, 2005 Heiko Oberdiek.
+#
+# This work may be distributed and/or modified under the
+# conditions of the LaTeX Project Public License, either version 1.3
+# of this license or (at your option) any later version.
+# The latest version of this license is in
+# http://www.latex-project.org/lppl.txt
+# and version 1.3 or later is part of all distributions of LaTeX
+# version 2003/12/01 or later.
+# This work has the LPPL maintenance status "maintained".
+# This Current Maintainer of this work is Heiko Oberdiek.
+#
+# See file "README" for a list of files that belongs to this project.
+#
+# This file "pkfix.pl" may be renamed to "pkfix"
+# for installation purposes.
+#
+my $file = "pkfix.pl";
+my $program = uc($&) if $file =~ /^\w+/;
+my $project = lc($program);
+my $version = "1.3";
+my $date = "2005/02/25";
+my $author = "Heiko Oberdiek";
+my $copyright = "Copyright (c) 2001, 2005 by $author.";
+#
+# Reqirements: Perl5, dvips
+# History:
+# 2001/04/12 v0.1:
+# * First try.
+# 2001/04/13 v0.2:
+# * TeX/dvips is called for each font for the case of errors.
+# * First release.
+# 2001/04/15 v0.3:
+# * Call of kpsewhich with option --progname.
+# * Extracting of texps.pro from temporary PostScript file,
+# if kpsewhich failed.
+# * Option -G0 for dvips run added.
+# 2001/04/16 v0.4:
+# * Support for merging PostScript fonts added.
+# * \special{!...}/@fedspecial detection added.
+# * Bug fix: I detection.
+# 2001/04/17 v0.5:
+# * Redirection of stderr (dvips run) if possible.
+# 2001/04/20 v0.6:
+# * Bug fix: dvips font names can contain numbers.
+# 2001/04/21 v0.7:
+# * Bug fix: long dvi file name in ps file.
+# 2001/04/23 v0.8:
+# * Bug fix: post string parsing.
+# 2001/04/26 v0.9:
+# * Check of version number of dvips in PostScript file.
+# 2001/06/30 v1.0:
+# * Problem with DOS line endings fixed.
+# 2005/01/28 v1.1:
+# * Bug fix: encoding files are now included also.
+# * The intermediate DVI files are written directly.
+# * LPPL 1.3
+# 2005/01/29 v1.2:
+# * Merging is now based on type 1 names. This solves
+# the problem, if different bitmap fonts maps to the
+# same type 1 font, eg. (ecrm1000, larm1000) -> SFRM1000.
+# * Suppression of PK generation, if environment variable
+# MKTEXPK is supported.
+# * If output file is "-" (standard output) then messages of
+# pkfix are written to standard error output.
+# 2005/02/25 v1.3:
+# * Bug fix: Detection of "@fedspecial end" improved.
+# * Bug fix: Typo corrected (PRT -> $PRT).
+#
+
+### program identification
+my $title = "$program $version, $date - $copyright\n";
+
+### error strings
+my $Error = "!!! Error:"; # error prefix
+my $Warning = "!!! Warning:"; # warning prefix
+
+### variables
+my $envvar = uc($project);
+my $infile = "";
+my $outfile = "";
+my $texpsfile = "texps.pro";
+my $prefix = "_${project}_$$";
+# my $prefix = "_${project}_";
+my $tempfile = "$prefix";
+my $texfile = "$tempfile.tex";
+my $dvifile = "$tempfile.dvi";
+my $logfile = "$tempfile.log";
+my $psfile = "$tempfile.ps";
+my $missfile = "missfont.log";
+my @cleanlist = ($dvifile, $psfile);
+push(@cleanlist, $missfile) unless -f $missfile;
+
+my $err_redirect = " 2>&1";
+$err_redirect = "" if $^O =~ /dos/i ||
+ $^O =~ /os2/i ||
+ $^O =~ /mswin32/i ||
+ $^O =~ /cygwin/i;
+
+my $x_resolution = 0;
+my $y_resolution = 0;
+my $blocks_found = 0;
+my $fonts_converted = 0;
+my $fonts_merged = 0;
+my $fonts_misses = 0;
+my $PRT = \*STDOUT;
+
+### option variables
+my @bool = ("false", "true");
+$::opt_tex = "tex";
+$::opt_dvips = "dvips";
+$::opt_kpsewhich = "kpsewhich --progname $project";
+$::opt_options = "-Ppdf -G0";
+$::opt_usetex = 0;
+$::opt_help = 0;
+$::opt_quiet = 0;
+$::opt_debug = 0;
+$::opt_verbose = 0;
+$::opt_clean = 1;
+
+my $usage = <<"END_OF_USAGE";
+${title}Syntax: \L$program\E [options] <inputfile.ps> <outputfile.ps>
+Function: This program tries to replace pk fonts in <inputfile.ps>
+ by the type 1 versions. The result is written in <outputfile.ps>.
+Options: (defaults:)
+ --help print usage
+ --(no)quiet suppress messages ($bool[$::opt_quiet])
+ --(no)verbose verbose printing ($bool[$::opt_verbose])
+ --(no)debug debug informations ($bool[$::opt_debug])
+ --(no)clean clear temp files ($bool[$::opt_clean])
+ --(no)usetex use TeX for generating the DVI file ($bool[$::opt_usetex])
+ --tex texcmd tex command name (plain format) ($::opt_tex)
+ --dvips dvipscmd dvips command name ($::opt_dvips)
+ --options opt dvips options ($::opt_options)
+END_OF_USAGE
+
+### environment variable PKFIX
+if ($ENV{$envvar}) {
+ unshift(@ARGV, split(/\s+/, $ENV{$envvar}));
+}
+
+### process options
+my @OrgArgv = @ARGV;
+use Getopt::Long;
+GetOptions(
+ "help!",
+ "quiet!",
+ "debug!",
+ "verbose!",
+ "clean!",
+ "usetex!",
+ "tex=s",
+ "dvips=s",
+ "options=s"
+) or die $usage;
+!$::opt_help or die $usage;
+@ARGV < 3 or die "$usage$Error Too many files!\n";
+@ARGV == 2 or die "$usage$Error Missing file names!\n";
+
+$::opt_quiet = 0 if $::opt_verbose;
+$::opt_clean = 0 if $::opt_debug;
+
+push(@cleanlist, $texfile, $logfile) if $::opt_usetex;
+
+### get file names
+$infile = $ARGV[0];
+$outfile = $ARGV[1];
+
+### suppress PK generation
+$ENV{'MKTEXPK'} = "0";
+
+$PRT = \*STDERR if $outfile eq "-";
+
+print $PRT $title unless $::opt_quiet;
+
+print $PRT "*** input file: `$infile'\n" if $::opt_verbose;
+print $PRT "*** output file: `$outfile'\n" if $::opt_verbose;
+
+if ($::opt_debug) {
+ print $PRT <<"END_DEB";
+*** OSNAME: $^O
+*** PERL_VERSION: $]
+*** ARGV: @OrgArgv
+END_DEB
+}
+
+### get texps.pro
+my $texps_data = 0;
+my $texps_string = get_texps_pro();
+
+### Encoding definitions
+my %encoding_files = ();
+my $encoding_string = "";
+
+### open input and output files
+open(IN, $infile) or die "$Error Cannot open `$infile'!\n";
+open(OUT, ">$outfile") or die "$Error Cannot write `$outfile'!\n";
+
+##################################
+# expected format:
+# ...
+# %%DVIPSParameters:... dpi=([\dx]+)...
+# ...
+# TeXDict begin \d+ \d+ \d+ \d+ \d+ \(\S+\)
+# @start ...
+# ...
+# %DVIPSBitmapFont: (\S+) (\S+) ([\d\.]+) (\d+)
+# /(\S+) ...
+# ...
+# %EndDVIPSBitmapFont
+# ...
+# ... end
+# %%EndProlog
+#
+# or if \special{!...} was used, the lines with TeXDict:
+# TeXdict begin @defspecial
+#
+# ...
+#
+# @fedspecial end TeXDict begin
+# \d+ \d+ \d+ \d+ \d+ \(\S+\) @start
+#
+# or
+# @fedspecial end
+# ...
+#
+# bitmap font:
+# start:
+# %%DVIPSBitmapFont: {dvips font} {font name} {at x pt} {chars}
+# /{dvips font} {chars} {max. char number + 1} df
+# character, variant a:
+# <{hex code}>{char number} D
+# character, variant b:\
+# [<{hex code}>{num1} {num2} {num3} {num4} {num5} {char number} D
+# end:
+# E
+# %%EndDVIPSBitmapFont
+#
+# type 1 font:
+# before TeXDict line:
+# %%BeginFont: CMR10
+# ...
+# %%EndFont
+# after @start:
+# /Fa ... /CMR10 rf
+#
+# Font names: /[F-Z][a-zA-Z0-9]
+#
+# Encoding files before texps.pro:
+# %%BeginProcSet: {file name}.enc 0 0
+# ...
+# %%EndProcSet
+###################################
+
+my $x_comment_resolution = 0;
+my $y_comment_resolution = 0;
+my $start_string = "";
+my $post_string = "";
+my $dvips_resolution = "";
+my $texps_found = 0;
+my @font_list = ();
+my %font_txt = ();
+my %font_count = ();
+my %font_entry = ();
+
+sub init {
+ $x_comment_resolution = 0;
+ $y_comment_resolution = 0;
+ $x_resolution = 0;
+ $y_resolution = 0;
+ $start_string = "";
+ $texps_found = 0;
+ @font_list = ();
+ %font_txt = ();
+ %font_count = ();
+ %font_entry = ();
+}
+
+init();
+
+while (<IN>) {
+
+ if (/^%%Creator: (dvips\S*) (\S+)\s/) {
+ print $PRT "*** %%Creator: $1 $2\n" if $::opt_debug;
+ my $foundversion = $2;
+ if ($foundversion =~ /(\d+\.\d+)/) {
+ $foundversion = $1;
+ # 5.62 is ok, 5.58 does not produce font comments
+ if ($foundversion <= 5.58) {
+ print $PRT "$Warning dvips version $1 does not generate " .
+ "the required font comments!\n";
+ }
+ }
+ }
+
+ if (/^%%BeginProcSet:\s*(.+)\.enc/) {
+ $encoding_files{$1} = "";
+ }
+
+ if (/^%DVIPSParameters:.*dpi=([\dx]+)/) {
+ print OUT;
+ my $str = $1;
+ $x_comment_resolution = 0;
+ $y_comment_resolution = 0;
+ if ($str =~ /^(\d+)x(\d+)$/) {
+ $x_comment_resolution = $1;
+ $y_comment_resolution = $2;
+ }
+ if ($str =~ /^(\d+)$/) {
+ $x_comment_resolution = $1;
+ $y_comment_resolution = $1;
+ }
+ print $PRT "*** %DVIPSParameters: dpi=$str " .
+ "(x=$x_comment_resolution, y=$y_comment_resolution)\n"
+ if $::opt_debug;
+ $x_comment_resolution > 0 && $y_comment_resolution > 0 or
+ die "$Error Wrong resolution value " .
+ "($x_comment_resolution x $y_comment_resolution)!\n";
+ next;
+ }
+
+ if (/^%%BeginProcSet: texps.pro/) {
+ $texps_found = 1;
+ print $PRT "*** texps.pro found\n" if $::opt_debug;
+ }
+
+ if (/^TeXDict begin \@defspecial/) {
+ my $saved = $_;
+ print $PRT "*** \@defspecial found.\n" if $::opt_debug;
+ $start_string = $_;
+ while (<IN>) {
+ $start_string .= $_;
+ if (/^\@fedspecial end/) {
+ s/^\@fedspecial end\s*(\S)/$1/;
+ last;
+ }
+ }
+ }
+ elsif (/^TeXDict begin \d+ \d+ \d+ \d+ \d+/) {
+ print $PRT "*** TeXDict begin <5 nums> found.\n" if $::opt_debug;
+ $start_string = $_;
+ }
+ if ($start_string ne "") {
+ # look for @start
+ unless (/\@start/) {
+ while (<IN>) {
+ $start_string .= $_;
+ last if /\@start/;
+ }
+ }
+
+ # divide post part
+ $start_string =~ /^([\s\S]*\@start)\s*([\s\S]*)$/ or
+ die "$Error Parse error (\@start)!\n";
+ $start_string = "$1\n";
+ $post_string = $2;
+ $post_string =~ s/\s*$//;
+ $post_string .= "\n" unless $post_string eq "";
+
+ $start_string =~
+ /\d+\s+\d+\s+\d+\s+(\d+)\s+(\d+)\s+\((.*)\)\s+\@start/ or
+ die "$Error Parse error (\@start parameters)!\n";
+
+ $blocks_found++;
+ print $PRT "*** dvi file: $3\n" if $::opt_debug;
+
+ # get and check resolution values
+ $x_resolution = $1;
+ $y_resolution = $2;
+ print $PRT "*** resolution: $x_resolution x $y_resolution\n"
+ if $::opt_debug;
+ $x_comment_resolution > 0 or
+ die "$Error Missing comment `%DVIPSParameters'!\n";
+ $x_resolution == $x_comment_resolution &&
+ $y_resolution == $y_comment_resolution or
+ die "$Error Resolution values in comment and PostScript " .
+ "does not match!\n";
+ # setting dvips resolution option(s)
+ if ($x_resolution == $y_resolution) {
+ $dvips_resolution = "-D $x_resolution";
+ }
+ else {
+ $dvips_resolution = "-X $x_resolution -Y $y_resolution";
+ }
+
+ while (<IN>) {
+ if (/^%%EndProlog/) {
+ print OUT $encoding_string;
+ $texps_data > 0 or die "$Error File `texps.pro' not found!\n";
+ print OUT $texps_string unless $texps_found;
+ foreach (@font_list) {
+ my $fontname = $_;
+ print $PRT "*** Adding font `$fontname'\n"
+ if $::opt_debug;
+ my ($dummy1, $dummy2, $err);
+ if ($font_count{$fontname} > 1) {
+ $fonts_merged++;
+ print $PRT "*** Merging font `$fontname' ($font_count{$fontname}).\n"
+ unless $::opt_quiet;
+ ($dummy1, $font_txt{$fontname}, $dummy2, $err) =
+ get_font($font_entry{$fontname});
+ $err == 0 or die "$Error Cannot merge font `$fontname'!\n";
+ }
+ print OUT $font_txt{$fontname};
+ }
+ print OUT $start_string,
+ $post_string,
+ $_;
+ print $PRT "*** %%EndProlog\n" if $::opt_debug;
+ init();
+ last;
+ }
+
+ if (/^%DVIPSBitmapFont: (\S+) (\S+) ([\d.]+) (\d+)/) {
+ my $bitmap_string = $_;
+ my $dvips_fontname = $1;
+ my $fontname = $2;
+ my $entry = "\\Font\{$1\}\{$2\}\{$3\}\{";
+ print $PRT "*** Font $1: $2 at $3pt, $4 chars\n" if $::opt_verbose;
+ my $line = "";
+ my $num = -1;
+ my $chars = $4;
+ my $count = 0;
+ while (<IN>) {
+ $bitmap_string .= $_;
+ last if /^%EndDVIPSBitmapFont/;
+ s/\r$//; # remove \r of possible DOS line ending
+ chomp;
+ $line .= " " . $_;
+ }
+ $line =~ s/<[0-9A-F ]*>/ /g;
+
+ print $PRT "*** <Font> $line\n" if $::opt_debug;
+
+ while ($line =~ /\s(\d+)\s+D(.*)/) {
+ $num = $1;
+ $count++;
+ $entry .= "$num,";
+ $line = $2;
+ while ($line =~ /^[\s\d\[]*I(.*)/) {
+ $num++;
+ $count++;
+ $entry .= "$num,";
+ $line = $1;
+ }
+ }
+ $chars == $count or
+ die "$Error Parse error, $count chars of $chars found " .
+ "($fontname)!\n";
+
+ $entry =~ s/,$//;
+ $entry .= "\}";
+
+ print $PRT "*** Font conversion of `$fontname' started.\n"
+ if $::opt_verbose;
+ my ($newfontname, $font_part, $start_part, $err) = get_font($entry);
+ if ($err == 0) {
+ print $PRT "*** Font conversion: `$fontname' -> `$newfontname'.\n"
+ unless $::opt_quiet;
+ if (defined($font_count{$newfontname})) {
+ $font_count{$newfontname}++;
+ $font_entry{$newfontname} .= "\n$entry";
+ }
+ else {
+ push @font_list, $newfontname;
+ $font_txt{$newfontname} = $font_part;
+ $font_count{$newfontname} = 1;
+ $font_entry{$newfontname} = $entry;
+ }
+ $start_part =~ s/\/Fa/\/$dvips_fontname/;
+ $start_string .= $start_part;
+ $fonts_converted++;
+ }
+ else {
+ print $PRT "!!! Failed font conversion of `$fontname'!\n";
+ $start_string .= $bitmap_string;
+ $fonts_misses++;
+ }
+
+ next;
+ }
+
+ $post_string .= $_;
+ }
+ next;
+ }
+
+ print OUT;
+}
+
+close(IN);
+close(OUT);
+
+if ($::opt_clean) {
+ print $PRT "*** clear temp files\n" if $::opt_verbose;
+ foreach (@cleanlist) {
+ unlink;
+ }
+}
+
+if (!$::opt_quiet) {
+ if ($blocks_found > 1) {
+ print $PRT "==> $blocks_found blocks.\n";
+ }
+ if ($fonts_misses) {
+ print $PRT "==> $fonts_misses font conversion",
+ (($fonts_misses > 1) ? "s" : ""),
+ " failed.\n";
+ }
+ if ($fonts_converted) {
+ print $PRT "==> ",
+ (($fonts_converted > 0) ? $fonts_converted : "No"),
+ " converted font",
+ (($fonts_converted > 1) ? "s" : ""),
+ ".\n";
+ if ($fonts_merged) {
+ print $PRT "==> $fonts_merged merged font",
+ (($fonts_merged > 1) ? "s" : ""),
+ ".\n";
+ }
+ }
+ else {
+ print $PRT "==> no fonts converted\n";
+ }
+}
+
+
+# get type 1 font
+# param: $entry: font entry as TeX string
+# return: $name: type 1 font name
+# $font: font file as string
+# $start: font definition after @start
+# $err: error indication
+sub get_font {
+ my $entry = shift;
+ my $name = "";
+ my $font = "";
+ my $start = "";
+ my $err = 0;
+ my @err = ("", "", "", 1);
+ local *OUT;
+ local *IN;
+
+ if ($::opt_usetex) {
+ ### write temp tex file
+ open(OUT, ">$texfile") or die "$Error Cannot write `$texfile'!\n";
+ print OUT <<'TEX_HEADER';
+\nonstopmode
+\nopagenumbers
+\def\Font#1#2#3#4{%
+ \expandafter\font\csname font@#1\endcsname=#2 at #3pt\relax
+ \csname font@#1\endcsname
+ \hbox to 0pt{%
+ \ScanChar#4,\NIL
+ \hss
+ }%
+}
+\def\ScanChar#1,#2\NIL{%
+ \char#1\relax
+ \ifx\\#2\\%
+ \else
+ \ReturnAfterFi{%
+ \ScanChar#2\NIL
+ }%
+ \fi
+}
+\long\def\ReturnAfterFi#1\fi{\fi#1}
+\noindent
+TEX_HEADER
+
+ print OUT "$entry\n\\bye\n";
+ close(OUT);
+
+ ### run tex
+ {
+ print $PRT "*** run TeX\n" if $::opt_verbose;
+
+ my $cmd = "$::opt_tex $tempfile";
+ print $PRT ">>> $cmd\n" if $::opt_verbose;
+ my @capture = `$cmd`;
+ if (!defined(@capture)) {
+ print $PRT "$Warning Cannot execute TeX!\n";
+ return @err;
+ }
+ if ($::opt_verbose) {
+ print $PRT @capture;
+ }
+ else {
+ foreach (@capture) {
+ print $PRT if /^!\s/;
+ }
+ }
+ if ($?) {
+ my $exitvalue = $?;
+ if ($exitvalue > 255) {
+ $exitvalue >>= 8;
+ print $PRT "$Warning Closing TeX (exit status: $exitvalue)!\n";
+ return @err;
+ }
+ print $PRT "$Warning Closing TeX ($exitvalue)!\n";
+ return @err;
+ }
+ }
+ }
+ else {
+ # write dvi directly
+
+ # DVI format description: dvitype.web
+ my $DVI_pre = 247;
+ my $DVI_id_byte = 2;
+ my $DVI_num = 25400000;
+ my $DVI_den = 473628672; # 7227 * 2^16
+ my $DVI_mag = 1000;
+ my @t = localtime(time);
+ my $DVI_comment = "$program $version output "
+ . sprintf("%04d/%02d/%02d %02d:%02d:%02d",
+ ($t[5] + 1900), ($t[4] + 1), $t[3], $t[2], $t[1], $t[0]);
+ my $DVI_comment_len = length($DVI_comment);
+ my $DVI_bop = 139;
+ my $DVI_eop = 140;
+ my $DVI_fontdef1 = 243;
+ my $DVI_fontdef2 = 244;
+ my $DVI_fontdef4 = 246;
+ my $DVI_design_size = 10; # an arbitrary value
+ # A wrong value will trigger a dvips warning
+ # (it can be seen in verbose mode):
+ # dvips: Design size mismatch in [...].tfm
+ # But other consequences could not be noticed.
+ # Thus a TFM lookup will be saved.
+ my $DVI_checksum = 0; # because of unknown checksum
+ my $DVI_fnt_num_0 = 171;
+ my $DVI_fnt1 = 235;
+ my $DVI_fnt2 = 236;
+ my $DVI_fnt4 = 238;
+ my $DVI_set1 = 128;
+ my $DVI_push = 141;
+ my $DVI_pop = 142;
+ my $DVI_post = 248;
+ my $DVI_u = 67108864; # 1024 pt, an arbitrary value
+ my $DVI_l = 67108864; # 1024 pt, an arbitrary value
+ my $DVI_post_post = 249;
+ my $DVI_trailing = 223;
+
+ open(OUT, ">$dvifile") or die "$Error Cannot write `$dvifile'!\n";
+ binmode(OUT);
+
+ # Preamble (pre)
+ print OUT pack("C2N3Ca$DVI_comment_len",
+ $DVI_pre, $DVI_id_byte, $DVI_num, $DVI_den, $DVI_mag,
+ $DVI_comment_len, $DVI_comment);
+ # Begin of page (bop)
+ my $pos_bop = tell(OUT);
+ print OUT pack("CN1x[N9]l", $DVI_bop, 1, -1);
+
+ my $font_defs = "";
+ my $font_num = 0;
+ foreach(split("\n", $entry)) {
+ my $font_def = "";
+ /\\Font\{[^}]*\}\{([^}]*)\}\{([^}]*)\}\{([^}]*)\}/ or
+ die "!!! Error: Internal parsing error!\n";
+ my $font_name = $1;
+ my $font_name_len = length($font_name);
+ my $font_size = $2;
+ my $font_chars = $3;
+
+ # define font
+ if ($font_num < 256) {
+ $font_def = pack("CC", $DVI_fontdef1, $font_num);
+ }
+ # The other cases are very unlikely, especially there are
+ # more than one font in the merging case only.
+ elsif ($font_num < 65536) {
+ $font_def = pack("Cn", $DVI_fontdef2, $font_num);
+ }
+ else {
+ $font_def = pack("CN", $DVI_fontdef4, $font_num);
+ }
+ $font_def .= pack("x[N]N2xCa$font_name_len",
+ ($font_size * 65536), $DVI_design_size,
+ $font_name_len, $font_name);
+ print OUT $font_def;
+ $font_defs .= $font_def;
+
+ # use font
+ my $fnt_num;
+ if ($font_num < 64) {
+ $fnt_num = pack("C", $DVI_fnt_num_0 + $font_num);
+ }
+ # Other cases are unlikely, see above.
+ elsif ($font_num < 256) {
+ $fnt_num = pack("CC", $DVI_fnt1, $font_num);
+ }
+ elsif ($font_num < 65536) {
+ $fnt_num = pack("Cn", $DVI_fnt2, $font_num);
+ }
+ else {
+ $fnt_num = pack("CN", $DVI_fnt4, $font_num);
+ }
+ print OUT $fnt_num;
+
+ # print characters
+ print OUT pack("C", $DVI_push);
+ foreach (split(",", $font_chars)) {
+ if ($_ < 128) {
+ print OUT pack("C", $_);
+ }
+ else {
+ print OUT pack("CC", $DVI_set1, $_);
+ }
+ }
+ print OUT pack("C", $DVI_pop);
+
+ $font_num++;
+ }
+
+ print OUT pack("C", $DVI_eop);
+
+ # Begin of postamble (post)
+ my $pos_post = tell(OUT);
+ print OUT pack("CN6n2",
+ $DVI_post, $pos_bop, $DVI_num, $DVI_den, $DVI_mag,
+ $DVI_l, $DVI_u, 1, 1);
+ print OUT $font_defs;
+ # End of postamble (post_post)
+ print OUT pack("CNC5",
+ $DVI_post_post, $pos_post, $DVI_id_byte,
+ $DVI_trailing, $DVI_trailing, $DVI_trailing, $DVI_trailing);
+ my $t_num = (4 - (tell(OUT) % 4)) % 4;
+ print OUT pack("C", $DVI_trailing) x $t_num;
+ close(OUT);
+ }
+
+ ### run dvips
+ {
+ print $PRT "*** run dvips\n" if $::opt_verbose;
+
+ my $cmd = "$::opt_dvips $::opt_options $dvips_resolution $tempfile";
+ print $PRT ">>> $cmd\n" if $::opt_verbose;
+ # dvips writes on stderr :-(
+ my @capture = `$cmd$err_redirect`;
+ if ($::opt_verbose) {
+ print $PRT @capture;
+ }
+ if ($?) {
+ my $exitvalue = $?;
+ if ($exitvalue > 255) {
+ $exitvalue >>= 8;
+ print $PRT "$Warning Closing dvips (exit status: $exitvalue)!\n";
+ return @err;
+ }
+ print $PRT "$Warning Closing dvips ($exitvalue)!\n";
+ return @err;
+ }
+ }
+
+ ### get font and start part
+ open(IN, $psfile) or die "$Error Cannot open `$psfile'!\n";
+
+ while (<IN>) {
+ ### get possible encoding files
+ if (/^%%BeginProcSet:\s*(.+)\.enc/) {
+ my $encoding_file = $1;
+ print $PRT "*** encoding file `$encoding_file.enc' found.\n"
+ if $::opt_debug;
+ next if defined($encoding_files{$encoding_file});
+ $encoding_files{$encoding_file} = "";
+ $encoding_string .= $_;
+ while (<IN>) {
+ $encoding_string .= $_;
+ last if /^%%EndProcSet/;
+ }
+ next;
+ }
+
+ ### get texps.pro if get_texps_pro() has failed
+ if ($texps_data == 0 && /^%%BeginProcSet: texps.pro/) {
+ $texps_string = $_;
+ while (<IN>) {
+ $texps_string .= $_;
+ last if /^%%EndProcSet/;
+ }
+ $texps_data = 1;
+ print $PRT "*** texps.pro extracted.\n" if $::opt_debug;
+ next;
+ }
+
+ if (/^%%BeginFont:\s*(\S+)/) {
+ $name = $1;
+ $font .= $_;
+ while (<IN>) {
+ $font .= $_;
+ last if /^%%EndFont/;
+ }
+ next;
+ }
+ if (/^\@start/) {
+ s/^\@start\s*//;
+ $start .= $_;
+ while (<IN>) {
+ last if /^%%EndProlog/;
+ $start .= $_;
+ }
+ if (($start =~ s/\s*end\s*$/\n/) != 1) {
+ $err = 1;
+ print $PRT "$Warning Parse error, `end' not found!\n";
+ }
+ print $PRT "*** start: $start" if $::opt_debug;
+ last;
+ }
+ }
+ close(IN);
+
+ if ($font eq "") {
+ print $PRT "$Warning `%%BeginFont' not found!\n";
+ return @err;
+ }
+ return ($name, $font, $start, $err);
+}
+
+
+# get_texps_pro
+# return: string with content of texps.pro
+sub get_texps_pro {
+ $texps_data = 0;
+ # get file name
+ my $backupWarn = $^W;
+ $^W = 0;
+ my $file = `$::opt_kpsewhich $texpsfile`;
+ $^W = $backupWarn;
+ if (!defined($file) or $file eq "") {
+ print $PRT "$Warning: Cannot find `$texpsfile' with kpsewhich!\n"
+ if $::opt_debug;
+ return "";
+ }
+ chomp $file;
+ print $PRT "*** texps.pro: $file\n" if $::opt_debug;
+
+ # read file
+ local *IN;
+ open(IN, $file) or die "$Error: Cannot open `$file'!\n";
+ my @lines = <IN>;
+ @lines > 0 or die "$Error: Empty file `$file'!\n";
+ chomp $lines[@lines-1];
+ my $str = "%%BeginProcSet: texps.pro\n";
+ $"="";
+ $str .= "@lines\n";
+ $"=" ";
+ $str .= "%%EndProcSet\n";
+ $texps_data = 1;
+ return $str;
+}
+
+__END__
diff --git a/Build/source/texk/texlive/linked_scripts/ppower4.texlua b/Build/source/texk/texlive/linked_scripts/ppower4.texlua
new file mode 100755
index 00000000000..06e6ff454ff
--- /dev/null
+++ b/Build/source/texk/texlive/linked_scripts/ppower4.texlua
@@ -0,0 +1,43 @@
+#!/usr/bin/env texlua
+--*-Lua-*-
+-- $Id$
+
+-- Copyright (C) 2008 Reinhard Kotucha.
+-- You may freely use, modify and/or distribute this file.
+
+-- Launch ppower4
+
+function fixwin(args_unix)
+ if os.type == 'windows' then
+ local args_win={} -- new table
+ args_win[0]=args_unix[1]
+ for i=1, #args_unix do
+ args_win[i]='"'..args_unix[i]..'"'
+ end
+ return args_win
+ else
+ return args_unix
+ end
+end
+
+kpse.set_program_name('ppower4.texlua', 'ppower4')
+
+jarfile=kpse.find_file('pp4p.jar', 'texmfscripts')
+
+command={'java', '-jar', jarfile}
+
+for i=1, #arg do
+ command[#command+1]=arg[i]
+end
+
+command=fixwin(command)
+
+--[[ prepend an additional hyphen to activate this code
+for i=0, #command do
+ print (command[i])
+end
+os.exit(ret)
+--]]
+
+ret=os.spawn(command)
+os.exit(ret)
diff --git a/Build/source/texk/texlive/linked_scripts/ps2eps.pl b/Build/source/texk/texlive/linked_scripts/ps2eps.pl
new file mode 100755
index 00000000000..fd00ba9faca
--- /dev/null
+++ b/Build/source/texk/texlive/linked_scripts/ps2eps.pl
@@ -0,0 +1,930 @@
+eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}' && eval 'exec perl -S $0 $argv:q' # -*-perl-*-
+ if 0;
+# The expression in the previous line replaces the unix specific line
+# {#!/usr/bin/perl}.
+# ps2eps - convert PostScript to EPS (Encapsulated PostScript) files
+# -------------------------------------------------------------------
+# $Id: ps2eps,v 1.61 2006/12/28 16:34:06 bless Exp $
+# -------------------------------------------------------
+# (C)opyright 1999-2006 Roland Bless
+#
+# This program 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.
+#
+# This program 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, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+# Author: Roland Bless
+# Send bug reports to roland <at> bless.de
+# -------------------------------------------------------------------
+# Additional filtering is performed when Windows generated PostScript files
+# are processed. Some instructions will otherwise lead to bad output
+# if EPS-file gets embedded into other PostScript files.
+#
+# Requirements:
+# + perl
+# + gs (ghostscript supporting pbm output)
+# + bbox (a little C program [ANSI-C - should work on every platform]
+# for calculation of the actual BoundingBox)
+
+use POSIX;
+
+#use warnings;
+
+#use Getopt package
+use Getopt::Long;
+Getopt::Long::Configure("no_ignore_case");
+
+$prgname= "ps2eps";
+
+if (! -d "/usr/bin")
+{ # we assume that we are running under native windows
+ $ghostscriptname = "gswin32c";
+ $NULLDEV = "nul";
+}
+else
+{ # Unix or cygwin
+ $ghostscriptname = "gs";
+ $NULLDEV = "/dev/null 2>&1";
+}
+
+$bboxver=`bbox >$NULLDEV -V`;
+$bboxname= ($?== -1) ? "" : "bbox";
+$version= '$Id: ps2eps,v 1.61 2006/12/28 16:34:06 bless Exp $'; #'
+$insertPScode= 1; # Insert surrounding Postscript code
+$infhandle = STDIN; # Standard input is the default input file
+$outfhandle = STDOUT; # Standard output is default output if STDIN is input
+$infname= '-';
+$outfname= '-';
+$forceoverwrite=0; # do not overwrite existing files
+$ignoreBB= 0; # ignore existing Bounding Box comment
+$removeDSC= 1; # remove Adobe document structure comments
+$removeADO= 1; # remove Adobe printer Driver console Output [Page: ...]
+$ignoreEOFDSC= 0; # ignore %%EOF DSC hint
+$removePreview= 0; # remove preview
+$quiet= 0; # write progress to stdout
+$resolution= 144; # resolution for bounding box calculation is 2x72 dpi
+$trytofixps= 1; # try to fix postscript code
+$forcefixps= 0; # fix postscript code unconditionally if eq 1
+$filterorientation= 1;# filter Orientation line
+$looseBB=''; # default: tight bounding box
+$clip=0; # do not clip
+$warnings=0; # do not print warnings concerning postscript sanity
+$debuggs=0; # no debugging of ghostscript call, turn this on if you want to see the gs call
+$inch=2.54; # one inch is 2.54cm
+$fullcolors= 1; # use ppm format (24-bit full color)
+$trailerseen= 0; # Trailer comment seen?
+$PSversion="2.0"; # default Postscript Version
+$PSDSCversion="2.0"; # default Postscript DSC Version
+$translate_x= 0; # translate by x postscript points
+$translate_y= 0; # translate by y postscript points
+
+$defaultext = '(ps|prn)'; # default extension
+$defaultoutext = '.eps'; # default output extension
+$envname_size = 'PS2EPS_SIZE';
+$envname_gsbbox = 'PS2EPS_GSBBOX';
+
+$gpar="";
+$known_papersizes="11x17|ledger|legal|letter(small)?|arch[A-E]|a([0-9]|10)|isob[0-6]|b[0-5]|c[0-6]|jisb[0-6]|fls(a|e)|halfletter";
+$papersize_help="11x17,ledger,legal,letter,lettersmall,archA,archB,archC,archD,archE\
+a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,isob0,isob1,isob2,isob3,isob4,isob5,isob6,\
+b0,b1,b2,b3,b4,b5,c0,c1,c2,c3,c4,c5,c6,\
+jisb0,jisb1,jisb2,jisb3,jisb4,jisb5,jisb6,flsa,flse,halfletter\n";
+$trigger= 0;
+$notsane= 0;
+$dummy="";
+
+@ver= split(/ /,$version);
+
+# filename for temporary files
+if ($^O =~ /MSWin32/i or $^O =~ /cygwin/i)
+{
+ # it is less trouble to use the current directory if working on
+ # cygwin and nevertheless using gswin32c.
+ $tmpfname= "$prgname.$$";
+ $win=1;
+}
+elsif (defined($ENV{'TMP'}))
+{
+ $tmpdir= $ENV{'TMP'};
+ $filesep= ($tmpdir =~ /^?\:\\/) ? '\\' : '/';
+ if ($tmpdir =~ /$filesep$/)
+ { $tmpfname= $tmpdir . "$prgname.$$"; }
+ else
+ { $tmpfname= $tmpdir . "$filesep$prgname.$$"; }
+ $win=1;
+}
+else #assume we're on a UNIXBOX
+{
+ $tmpfname= "/tmp/" . "$prgname.$$";
+ $win=0;
+}
+
+
+$licensetxt= "\
+ This program 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.\
+\
+ This program 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, write to the Free Software\
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA\n";
+
+@prgidtxt= ( "$prgname - convert PostScript to EPS (Encapsulated PostScript) files\n",
+ "(C)opyright 1998-2006 Roland Bless\n\n" );
+
+@helptxt= ("Version: $ver[2]\n",
+ "Operation:\n",
+ " Without any argument, $prgname reads from standard input\n",
+ " and writes to standard output.\n",
+ " If filenames are given as arguments they are processed\n",
+ " one by one and output files are written to filenames\n",
+ " with extension '$defaultoutext'. If input filenames have the extension\n",
+ " '.ps' or '.prn', this extension is replaced with '$defaultoutext'.\n",
+ " In all other cases '$defaultoutext' is appended to the input filename.\n",
+ " Please note that PostScript files for input should contain\n",
+ " only one single page.\n\n",
+ " If BoundingBox in output seems to be wrong, please try options --size or --ignoreBB.\n\n" );
+
+@usagetxt= ("Syntax:\n",
+ " $prgname [-f] [-q] [-N] [-O] [-n] [-P] [-c] [-C] [-m] [-B] [-E] [-s <pagedim>] [-R +|-|^] [-t <x,y>] [-l] [-g] [-d] [-H] [-h|--help] [-g] [-W] [-L] [-V|--version] [--] [psfile1] [psfile2] [...]\n",
+ "Options:\n",
+ " -f, --force force overwriting existing files\n",
+ " -q, --quiet quiet operation (no output while processing files)\n",
+ " -N, --noinsert do not insert any postscript code\n",
+ " -O, --preserveorientation do not filter Orientation: header comment\n",
+ " -n, --nofix do not try to fix postscript code\n",
+ " -P, --removepreview remove preview image (smaller file, but no preview)\n",
+ " -F, --fixps fix postscript code unconditionally\n",
+ " -c, --comments preserve document structure comments\n",
+ " -C, --clip insert postscript code for clipping\n",
+ " -m, --mono use black/white bitmap as base for calculation\n",
+ " -s, --size=<pagedim> page size (a0-a10,letter,...) or in format XxY[cm|in] (default:cm), where X and Y are numbers\n",
+ " use --size=list to list pre-defined page sizes\n",
+ " -R, --rotate=<direction> rotate resulting EPS. <direction>: +=+90 (clockw.),-=-90 (counter-clockw.) ^=180 degrees\n",
+ " -t, --translate specify x,y offset (may be negative) in postscript points (1/72 dpi)\n",
+ " -r, --resolution specify dpi resolution to render with ghostscript (default 144)",
+ " -l, --loose expand the original bounding box by one point in each direction\n",
+ " -B, --ignoreBB do not use existing bounding box as page size for rendering\n",
+ " -E, --ignoreEOF do not use %%EOF as hint for end of file\n",
+ " -g, --gsbbox use internal bbox device of ghostscript\n",
+ " -H, --no-hires do not use a HiResBoundingBox\n",
+ " -h, --help help information\n",
+ " -L, --license show licensing information\n",
+ " -V, --version show version information\n",
+ " -d, --debuggs show ghostscript call\n",
+ " -W, --warnings show warnings about sanity of generated eps file\n",
+ " -- all following arguments are treated as files\n",
+ " (allows filenames starting with -)\n",
+ "\n",
+ "Arguments:\n",
+ " One or more names of PostScript files for input\n");
+
+## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+## -- argument checking --
+## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+#environment variable for papersize
+if (defined($ENV{"$envname_size"}))
+{
+ $opt_s= $ENV{"$envname_size"};
+}
+else
+{
+ $opt_s = ''; # for s-option
+}
+
+if (defined($ENV{"$envname_gsbbox"}))
+{
+ $bboxname="";
+}
+
+$opt_t = ''; # for t-option
+$opt_R = ''; # for R-option
+$opt_r = ''; # for r-option
+$stopnow = 0;
+die "Wrong option(s), please check usage with $prgname --help\n" unless
+GetOptions('f|force' => \$forceoverwrite,
+ 'q|quiet' => \$quiet,
+ 'm|mono' => sub { $fullcolors = 0 },
+ 'n|nofix' => sub { $trytofixps = 0 },
+ 'F|fixps' => \$forcefixps,
+ 'N|noinsert' => sub { $insertPScode = 0 },
+ 'O|preserveorientation' => sub { $filterorientation= 0 },
+ 'P|removepreview' => \$removePreview,
+ 'c|comments' => sub { $removeDSC = 0 },
+ 'C|clip' => \$clip,
+ 'l|loose' => sub { $looseBB = '-l' },
+ 'B|ignoreBB' => \$ignoreBB,
+ 'E|ignoreEOF'=> \$ignoreEOFDSC,
+ 's|size=s' => \$opt_s,
+ 't|translate=s' => \$opt_t,
+ 'r|resolution=s' => \$opt_r,
+ 'R|rotate=s' => \$opt_R,
+ 'g|gsbbox' => sub { $bboxname=""; },
+ 'H|nohires' => \$nohires,
+ 'h|help' => sub { $stopnow = 1; print @prgidtxt,@helptxt,@usagetxt,"\nAuthor: Roland Bless (roland\@bless.de)\n\n"; },
+ 'L|license' => sub { $stopnow = 1; print @prgidtxt,$licensetxt,"\nAuthor: Roland Bless (roland\@bless.de)\n\n"; },
+ 'd|debuggs' => \$debuggs,
+ 'W|warnings' => \$warnings,
+ 'V|version' => sub { $stopnow = 1; print @prgidtxt,"Version: $ver[2]\n"; });exit if ($stopnow);
+
+## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+## -- wildcard processing --
+## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+## internal wildcard processing for current directory,
+## only used for non UNIX-based OSs (which may lack shell wildcard expansion)
+@filenames = ();
+foreach $object (@ARGV) {
+ if ($win && $object =~ m/\*/o) # asterisk is present in filename
+ {
+ $wildcard = $object;
+ $wildcard =~ s/\./\\\./g; # replace . in pattern with \.
+ $wildcard =~ s/\*/\(\.\*\)/g; # replace * in pattern with (.*)
+ opendir(DIR,'.') || die 'Unable to open current directory, stopped'; # open current directory
+ print STDERR $wildcard;
+ @fid = grep { /$wildcard(\.$defaultext)?/i } readdir(DIR);
+ foreach (@fid) { push @filenames, $_; }
+ closedir DIR;
+ }
+ else { push @filenames, $object; }
+} # end foreach
+$filenames[0]= '-' if (scalar(@filenames) == 0); # no file arguments, use STDIN as input
+
+print STDERR "Input files: @filenames\n" if (!$quiet);
+
+if ($opt_r ne '')
+{
+ $resolution=$opt_r;
+}
+
+# papersize stuff
+if ($opt_s ne '')
+{
+ # if explicit size is given, ignore existing BoundingBox always
+ $ignoreBB = 1;
+ $pagedimension = $opt_s;
+ if ($opt_s eq "list")
+ {
+ print STDERR "Available paper sizes: $papersize_help";
+ exit 0;
+ }
+
+ #explicit format XxY[cm|in]
+ if ($pagedimension =~ /(\d*\.?\d+)x(\d*\.?\d+)/)
+ {
+ ($x_dim, $dummy, $y_dim, $unit)= split(/(x|cm|in)/,$pagedimension);
+ if ( $x_dim !~ /^\d*\.?\d+$/ )
+ { die "$x_dim in $arg is not a valid number, stopped"; }
+ if ( $y_dim !~ /^\d*\.?\d+$/ )
+ { die "$y_dim in $arg is not a valid number, stopped"; }
+
+ #print STDERR "xdim: $x_dim ydim: $y_dim unit:$unit\n" ;
+ if (!defined($unit) )
+ {
+ $unit='cm';
+ $opt_s=$opt_s . $unit;
+ }
+ if ( $unit ne 'in' ) # assume centimeters
+ { # calculate dimension in pixels (remember: resolution is in dpi)
+ $xpixels= int(($x_dim * $resolution) / $inch)+1;
+ $ypixels= int(($y_dim * $resolution) / $inch)+1;
+ $gpar= "-g${xpixels}x${ypixels}";
+ }
+ else
+ {
+ $xpixels= int($x_dim * $resolution)+1;
+ $ypixels= int($y_dim * $resolution)+1;
+ $gpar= "-g${xpixels}x${ypixels}";
+ }
+ } #endif XxY in opt_s
+ else
+ {
+ if ($opt_s =~ /$known_papersizes/)
+ {
+ $gpar="-sPAPERSIZE=$opt_s";
+ }
+ else
+ {
+ print STDERR "Error: Unknown paper size: $opt_s\n Acceptable papersizes are:$papersize_help\n";
+ exit 1;
+ }
+ }
+}
+
+#translate option
+if ($opt_t ne '')
+{
+ ($translate_x,$translate_y)= split(/\,/,$opt_t);
+}
+
+#rotate
+$rotright='-90 rotate';
+$rotleft='90 rotate';
+$rotupsidedown='180 rotate';
+$rotate='';
+if ($opt_R ne '')
+{
+ if ($opt_R eq '+') { $rotate=$rotright; }
+ elsif ($opt_R eq '-') { $rotate=$rotleft; }
+ elsif ($opt_R eq '^') { $rotate=$rotupsidedown; }
+ else { die "Wrong parameter for option -R: Valid are only +,-,^\n"; };
+}
+
+$device= $fullcolors ? "ppmraw" : "pbmraw";
+
+## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+## -- iterate over different input files --
+## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+PROCESSFILE:
+while ($infname= (shift @filenames))
+{
+ # reset filter definitions for each file
+ undef $linefilter;
+ undef $rangefilter_begin;
+ undef $rangefilter_end;
+ $fixthisps= $trytofixps;
+ $fixmsgprinted= 0;
+
+ if (!$quiet) { print STDERR "Processing: $infname\n"; }
+ unless (open($infhandle,"<$infname"))
+ { # skip over this file
+ print STDERR "$prgname: Can't open $infname: $!\n";
+ next PROCESSFILE;
+ }
+
+ # buffer input from stdin into temporary file, because it has to be read twice
+ # one time for ghostscript processing, the second time for generating output
+ if ($infname eq '-') # input is stdin
+ {
+ $tmpfhandle='';
+ open($tmpfhandle,">$tmpfname") or
+ die "Cannot open temporary file $tmpfname for writing: $!\n";
+ }
+ else # input is not stdin
+ {
+ undef $tmpfhandle;
+ #if filename ends with $defaultext usually .ps or .prn, replace the extension with $defaultoutext
+ if ($infname =~ /\.$defaultext$/i)
+ {
+ $outfname= $infname; $outfname =~ s/\.$defaultext$/$defaultoutext/i;
+ }
+ else # otherwise simply append the extension $defaultoutext
+ {
+ $outfname= $infname . "$defaultoutext";
+ }
+ if (!$forceoverwrite and -s "$outfname")
+ {
+ die "$prgname: Sorry, file named $outfname already exists,",
+ " will not overwrite it.\n",
+ " You will have to use the -f option, delete it or rename it",
+ " before running $prgname again.\n";
+ }
+ else
+ {
+ open($outfhandle,">$outfname") or die "Can't open file $outfname for writing: $!\n";
+ }
+ } #end else input is not stdin
+
+ ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ ## -- process input file --
+ ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ $linefilter= '^$'; #'# filter empty lines by default
+ while (<$infhandle>)
+ {
+ # get postscript and DSC version
+ if (/%!PS-Adobe-(\S+).*EPSF-(\S+)/)
+ {
+ $PSversion=$1;
+ $PSDSCversion=$2;
+ if (! ($PSversion =~ /\d+\.\d+/))
+ {
+ $PSDSCversion="2.0";
+ }
+ if (! ($PSDSCversion =~ /\d+\.\d+/))
+ {
+ $PSDSCversion="2.0";
+ }
+ }
+
+ # check for existing BoundingBox parameters
+ if ( /^%%\s*BoundingBox:\s*(.*)/ && !defined($eBBllx) )
+ {
+ $BBarg= $1;
+ # accept even negative and fractional BBs
+ if ( $BBarg =~ /(\-?\d+\.?\d*\s+){3,}\d+/ ) # ignore %% BoundingBox: (atend) comments
+ {
+ ($eBBllx,$eBBlly,$eBBurx,$eBBury,$dummy)= split /\s/,$BBarg;
+ #print STDERR "Existing BB: $eBBllx,$eBBlly,$eBBurx,$eBBury\n";
+ if (int($eBBllx) < 0) { $translate_x= - int($eBBllx-0.5); }
+ if (int($eBBlly) < 0) { $translate_y= - int($eBBlly-0.5); }
+
+ $xpixels= int((($eBBurx-$eBBllx) * $resolution)/72)+1;
+ $ypixels= int((($eBBury-$eBBlly) * $resolution)/72)+1;
+ if (!$ignoreBB)
+ {
+ $gpar= "-g${xpixels}x${ypixels}";
+ # check for meaningful values
+ if (($xpixels <= 1) || ($ypixels <= 1))
+ {
+ $gpar=""; undef $eBBllx; undef $eBBlly;
+ }
+ else
+ {
+ if (!$quiet)
+ {
+ print STDERR "Rendering with existing $_";
+ if (int($eBBllx) < 0 || int($eBBlly) < 0)
+ {
+ print STDERR "WARNING: existing Bounding Box shows negative values - shifting\n";
+ }
+ }
+ }
+ } #endif !$ignoreBB
+ } #endif $BBarg =~
+ }
+
+
+ if ($fixthisps) # try to fix bad postscript code
+ {
+ # check for Windows 3.x output
+ if ( /^Win.*Dict/ )
+ {
+ if (!$quiet && !$fixmsgprinted)
+ { print STDERR "Windows 3.5 generated Postscript file detected, fixing\n"; }
+ $linefilter= '^(EJ|RS)';
+ $rangefilter_begin= '^statusdict';
+ $rangefilter_end= 'cvx\ settransfer$'; #'
+ $fixmsgprinted= 1; # stop printing message
+ }
+ else
+ {
+ if ( /^%%Creator:\s*Wind.U\s*Xprinter/ )
+ {
+ if (!$quiet && !$fixmsgprinted)
+ { print STDERR "Star/OpenOffice generated Postscript file detected, fixing\n"; }
+ $linefilter= '^rs';
+ $fixmsgprinted= 1; # stop printing message
+ }
+ else
+ {
+ if ( $forcefixps ||
+ /^\/NTPS/ ||
+ /Creator:\s*(AdobePS|Pscript|.*Windows)/i ) #check for NT generated output
+ {
+ if (!$quiet && !$fixmsgprinted)
+ {
+ if ($forcefixps)
+ {
+ print STDERR "Postscript filtering requested, fixing\n";
+ }
+ else
+ {
+ print STDERR "Windows generated Postscript file detected, fixing\n";
+ }
+ }
+ $rangefilter_begin= '^((\[\{)|(featurebegin\{))$'; #'
+ $rangefilter_end= '^(\} stopped cleartomark|\}featurecleanup)';
+ $exclude_rangefilter_begin= '^(?i)%%BeginNonPPDFeature'; #'
+ $exclude_rangefilter_end= '^(?i)%%EndNonPPDFeature';
+ #$triggered_rangefilter_begin= ''; #'
+ #$triggered_rangefilter_end= ''; #'
+ $fixsearchpat='(^|\s)(initmatrix|initclip|initgraphics)(\s|$)';
+ $fixreplacepat=' ';
+ $fixmsgprinted= 1; # stop printing message
+ } # end if NTPS
+ } #end else
+ }
+ } #end if trytofixps
+
+ if (defined($tmpfhandle))
+ {
+ print $tmpfhandle $_ or die "$prgname: Failure during writing to temporary file $tmpfname";
+ }
+
+ if (/^%%EOF\s*$/)
+ {
+ $totalEOFDSC++
+ }
+ } #end while <$infhandle>
+
+ if (defined($tmpfhandle))
+ {
+ close($tmpfhandle);
+ }
+ else
+ {
+ $tmpfhandle= $infhandle;
+ $tmpfname= $infname;
+ }
+
+ ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ ## -- calculate the bounding box --
+ ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ if ($translate_x!=0 || $translate_y!=0)
+ {
+ $translation="$translate_x $translate_y translate";
+ $translatecmd="-c $translation";
+ }
+ else
+ {
+ $translation="";
+ $translatecmd="";
+ }
+
+ if (!$quiet)
+ {
+ print STDERR "Calculating Bounding Box...";
+ if ($opt_s)
+ {
+ print STDERR "using page size $opt_s...";
+ }
+ }
+
+ $rotatecmd='';
+ if ($rotate ne '')
+ {
+ $rotatecmd="-c \"$rotate\""
+ }
+ if ($bboxname ne '')
+ {
+ $cmdline="$ghostscriptname -dSAFER -dNOPAUSE -q $gpar -r$resolution -sDEVICE=$device -sOutputFile=- $translatecmd -f $tmpfname -c showpage -c quit | $bboxname -r $resolution";
+ }
+ else
+ {
+ if (!$quiet) {
+ print STDERR "...using bbox device of $ghostscriptname...";
+ }
+ $cmdline = "$ghostscriptname -dSAFER -dBATCH -dNOPAUSE -q $gpar -r$resolution -sDEVICE=bbox -sOutputFile=- -c \"/setpagedevice {pop} def\" $translatecmd -f $tmpfname -c quit 2>&1";
+ }
+
+ if ($debuggs) { print STDERR "\nCalling: $cmdline\n"; }
+
+ # actual ghostscript call
+ $boundingbox=`$cmdline`;
+ if ($debuggs) { print STDERR "Call result: $boundingbox"; }
+
+ # check result of gs call
+ if ($boundingbox !~ /^%%BoundingBox/m)
+ {
+ print STDERR "Error: Could not determine bounding box!\n",
+ "I suppose $ghostscriptname had some trouble interpreting the postscript-file\n";
+ }
+
+ $boundingbox =~ /^%%HiResBoundingBox:\s*(.*)/m;
+ if (defined($1)) # HiResBoundingBox given
+ {
+ ($hcBBllx,$hcBBlly,$hcBBurx,$hcBBury,$dummy)= split(/\s/,$1);
+ $hiresboundingbox="%%HiResBoundingBox: $hcBBllx $hcBBlly $hcBBurx $hcBBury\n";
+ $cBBllx = floor($hcBBllx);
+ $cBBlly = floor($hcBBlly);
+ $cBBurx = ceil($hcBBurx);
+ $cBBury = ceil($hcBBury);
+ }
+ else
+ { #use normal BoundingBox
+ $boundingbox =~ /^%%.*BoundingBox:\s*(.*)/;
+ ($cBBllx,$cBBlly,$cBBurx,$cBBury,$dummy)= split(/\s/,$1);
+ }
+ # if loose BB should be performed by ps2eps
+ # apply changes to resulting bounding box if needed
+ if ($looseBB ne '')
+ {
+ if ($cBBllx > 0) { $cBBllx--; }
+ if ($cBBlly > 0) { $cBBlly--; }
+ $cBBurx++; $cBBury++;
+ }
+ # extend clipping box by 1 point
+ if ($clip)
+ {
+ if ($cBBllx > 0) { $cBBllx--; }
+ if ($cBBlly > 0) { $cBBlly--; }
+ $cBBurx++; $cBBury++;
+ }
+ if ($cBBllx < 0 || $cBBlly < 0)
+ {
+ if (!$quiet)
+ {
+ print STDERR "WARNING! Your drawing had a negative Bounding Box which is deprecated and may cause problems!. I'll shift it.\n";
+ }
+ $translate_x= -int($cBBllx);
+ $translate_y= -int($cBBlly);
+ $cBBllx=0;
+ $cBBurx= $cBBurx + $translate_x;
+ $cBBlly=0;
+ $cBBury= $cBBury + $translate_y;
+
+ $hcBBurx= $hcBBurx + $hcBBllx;
+ $hcBBury= $hcBBury + $hcBBlly;
+ $hcBBllx= 0;
+ $hcBBlly= 0;
+
+ $hiresboundingbox="%%HiResBoundingBox: $hcBBllx $hcBBlly $hcBBurx $hcBBury\n";
+
+ $translation="$translate_x $translate_y translate";
+ $translatecmd="-c \'$translation\'";
+ }
+ $boundingbox = "%%BoundingBox: $cBBllx $cBBlly $cBBurx $cBBury\n";
+
+ if (!$quiet) { print STDERR "ready. $boundingbox" };
+
+ $before_startps= 1;
+ $inserted_prolog= 0;
+ $prolog_passed= 0;
+
+ ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ ## -- Create output file --
+ ## %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ if (!$quiet) { print STDERR "Creating output file $outfname..."; }
+
+ open($tmpfhandle,"<$tmpfname") or die "Cannot open file $tmpfname for reading";
+ CREATEOUTPUT:
+ while (<$tmpfhandle>)
+ {
+ # check whether we are in a binary section
+
+ $binarysection=(/^(%%BeginBinary)|(beginimage)\r?\n?$/ ... /^(%%EndBinary)|^(endimage)/) ||
+ (/^(doNimage)|(doclutimage)\r?\n?$/ ... /(^|~> )Z\r?\n?$/) || # Pscript_Win_Dib_L2 5.0 0
+ (/^beginjpeg / ... /~> endjpeg\r?\n?$/) || # Pscript_Win_Dib_L2 5.0 0
+ (/^pdfIm/ ... /^%-EOD-/);
+
+ if ( !$binarysection )
+ {
+ s/\r?\n?$//; # remove CR and/or LF at end of line if not in binary section
+ }
+
+ # check where magic Postscript header starts - skip leading binary stuff, e.g., HP PCL/PJL code
+ if ($before_startps)
+ {
+ if ( /%!/ ) # This is usually the smallest magic sequence
+ { # Note: Adobe Photoshop generated a binary heading, so ^ is not applicable
+ if (! /%!PS-Adobe.*/i) # some strange programs use other magics
+ {
+ print STDERR "** Warning **: Weird heading line -- ",$_," -- ";
+ }
+ $before_startps= 0;
+ }
+ next CREATEOUTPUT;
+ }
+ else # we are hopefully in regular postscript code now
+ {
+ # count %%EOFs as we want to know when we got the last EOF
+ if ( /^%%EOF\s*$/ )
+ {
+ $seenEOF++;
+ }
+
+ # We should insert our own prologue including the newly calculated BoundingBox
+ if (! $inserted_prolog)
+ {
+ print $outfhandle "%!PS-Adobe-$PSversion EPSF-$PSDSCversion\n";
+ # check if we need to rotate
+ $transrotcmd='';
+ if ($rotatecmd)
+ {
+ if ($rotate eq $rotright)
+ {
+ $transrotcmd="-$cBBlly $cBBurx translate";
+ $boundingbox='%%BoundingBox: 0 0 ' . ($cBBury-$cBBlly) . ' ' . ($cBBurx-$cBBllx) . "\n";
+ if ($hiresboundingbox ne "")
+ {
+ $hiresboundingbox='%%HiResBoundingBox: 0 0 ' . ($hcBBury-$hcBBlly) . ' ' . ($hcBBurx-$hcBBllx) . "\n";
+ }
+
+ }
+ elsif ($rotate eq $rotleft)
+ {
+ $transrotcmd="$cBBury -$cBBllx translate";
+ $boundingbox='%%BoundingBox: 0 0 ' . ($cBBury-$cBBlly) . ' ' . ($cBBurx-$cBBllx) . "\n";
+ if ($hiresboundingbox ne "")
+ {
+ $hiresboundingbox= '%%HiResBoundingBox: 0 0 ' . ($hcBBury-$hcBBlly) . ' ' . ($hcBBurx-$hcBBllx) . "\n";
+ }
+ }
+ elsif ($rotate eq $rotupsidedown)
+ {
+ $transrotcmd="$cBBurx $cBBury translate";
+ $boundingbox='%%BoundingBox: 0 0 ' . ($cBBurx-$cBBllx) . ' ' . ($cBBury-$cBBlly) . "\n";
+ if ($hiresboundingbox ne "")
+ {
+ $hiresboundingbox='%%HiResBoundingBox: 0 0 ' . ($hcBBurx-$hcBBllx) . ' ' . ($hcBBury-$hcBBlly) . "\n";
+ }
+ }
+ }
+ print $outfhandle $boundingbox;
+ if (!defined($hiresboundingbox))
+ {
+ $nohires=1;
+ }
+ if (defined($hiresboundingbox) && !defined($nohires)) { print $outfhandle $hiresboundingbox; }
+ $inserted_prolog= 1;
+ redo CREATEOUTPUT;
+ }
+ else # already inserted_prolog
+ {
+ if (! $prolog_passed)
+ {
+ #ignore the following lines in the prologue
+ if ( /^%%(HiRes)?BoundingBox/ ||
+ /^%%Pages/ ||
+ /^%%BeginProlog/ ||
+ /^%%EndProlog/ ||
+ ($filterorientation && /^%%Orientation/) ||
+ ($removeDSC && /^%%.*: \(atend\)/) ||
+ ($removePreview && (/^%%BeginPreview/ ... /^%%EndPreview/)) )
+ {
+ next CREATEOUTPUT;
+ }
+ else
+ {
+ if ( /^[^%].*/ ||
+ /^%%EndComments/ ) # line is not a comment
+ {
+ #output postscript code for proper EPS file
+ if ($insertPScode)
+ {
+ print $outfhandle "%%EndComments\n",
+ "% EPSF created by ps2eps $ver[2]\n",
+ "%%BeginProlog\n";
+ }
+ # Insert own postscript code for clipping
+ if ($clip)
+ {
+ if (!defined($nohires))
+ {
+ printf $outfhandle "newpath %f %f moveto %f %f lineto %f %f lineto %f %f lineto closepath clip\n",$hcBBllx-0.1,$hcBBlly-0.1,$hcBBurx+0.1,$hcBBlly-0.1,$hcBBurx+0.1,$hcBBury+0.1,$hcBBllx-0.1,$hcBBury+0.1;
+ }
+ else
+ {
+ printf $outfhandle "newpath %d %d moveto %d %d lineto %d %d lineto %d %d lineto closepath clip\n",$cBBllx,$cBBlly,$cBBurx,$cBBlly,$cBBurx,$cBBury,$cBBllx,$cBBury;
+ }
+ } #endif clip
+
+ if ($rotate ne '')
+ {
+ print $outfhandle "$transrotcmd\n";
+ print $outfhandle "$rotate\n";
+ }
+ if ($translation ne '')
+ {
+ print $outfhandle "$translation\n";
+ }
+
+ #insert surrounding postscript code
+ if ($insertPScode)
+ {
+ print $outfhandle "save\n",
+ "countdictstack\n",
+ "mark\n",
+ "newpath\n",
+ "/showpage {} def\n",
+ "/setpagedevice {pop} def\n",
+ "%%EndProlog\n",
+ "%%Page 1 1\n";
+ }
+ $prolog_passed= 1;
+ if (/^%%EndComments/) { next CREATEOUTPUT; }
+ } #endif line is not a comment
+ } #end else
+ } #endif (we are in the prologue section)
+ else #we are in the main part of postscript file
+ {
+ #end of postscript file reached?
+ #Usually the DSC %%EOF signifies the end
+ if ( eof($tmpfhandle) ||
+ ($ignoreEOFDSC == 0 && /^%%EOF\s*$/ && $seenEOF == $totalEOFDSC)
+ || ( $trailerseen && /^II\*\000.*/ )
+ )
+ {
+ #do not forget to print last line if not terminated by LF
+ if ( eof($tmpfhandle) && !/^$/ && !/^%%EOF\s*$/ ) # do not insert %%EOF twice
+ {
+ print $outfhandle $_,"\n";
+ }
+ #add appropriate trailer
+ if ($insertPScode)
+ {
+ print $outfhandle "%%Trailer\n",
+ "cleartomark\n",
+ "countdictstack\n",
+ "exch sub { end } repeat\n",
+ "restore\n",
+ "%%EOF\n";
+ }
+ last CREATEOUTPUT;
+ } # stop output
+
+ # Trailer comment seen?
+ if ( /^%%Trailer\s*$/ )
+ {
+ $trailerseen=1;
+ }
+ else
+ {
+ if (!/^\s*$/) #non empty lines follow
+ {
+ $trailerseen=0;
+ }
+ }
+
+ # check for trigger
+ if (defined($triggerstring) && /^$triggerstring$/)
+ {
+ $trigger= 1;
+ };
+
+ # remove complete lines if one of the expression matches
+ if ( !$binarysection # only when not in binary section
+ &&
+ (
+ ($removePreview && (/^%%BeginPreview/ ... /^%%EndPreview/))
+ || # no preview
+ (defined($rangefilter_begin) &&
+ (/$rangefilter_begin/ ... /$rangefilter_end/) &&
+ (!(/$exclude_rangefilter_begin/ ... /$exclude_rangefilter_end/))
+ )
+ ||
+ (defined($triggered_rangefilter_begin) && defined($triggered_rangefilter_end) &&
+ $trigger &&
+ (/$triggered_rangefilter_begin/ ... /$triggered_rangefilter_end/)
+ )
+ ||
+ /$linefilter/ # lines by linefilter
+ ||
+ ($removeDSC && (/^%( |!)(\w )+/ || /^%%/)) # any type of structured comment
+ ||
+ ($removeADO &&
+ (/^statusdict begin.*ProductName.*print product print.*flush end\r?\n?$/ ||
+ /^\(%%\[\s*(Page:.*|LastPage)\s*\]%%\)\s*=\s*\w*\s*\r?\n?/ ))
+ ||
+ /^$/ # empty lines
+ )
+ )
+ {
+ next CREATEOUTPUT;
+ }
+
+ # replacement
+ if ( defined($fixsearchpat) )
+ {
+ #if (/$fixsearchpat/) { print STDERR "**filter** before:",$_,"\n"; }
+ #if (s/$fixsearchpat/$fixreplacepat/) { print STDERR "**filter** after:",$_,"\n";}
+ s/$fixsearchpat/$fixreplacepat/;
+ }
+
+ # sanity check for potential dangerous commands
+ if ( /(^|\s)(clear|erasepage|initmatrix|initclip|initgraphics|startjob|cleardictstack|setmatrix|setpagedevice|copypage|grestoreall|exitserver|quit)(\s|$)/ )
+ {
+ $notsane= 1;
+ #print STDERR "Warning: dangerous command in line: ",$_,"\n";
+ }
+ } # end else (this is main part)
+
+ # Output the postscript line to result file
+ print $outfhandle $_;
+
+ if (!$binarysection)
+ {
+ print $outfhandle "\n"; # terminate line with LF
+ }
+ } # end else prolog_passed
+ } # end else inserted_prolog
+ } # end while CREATEOUTPUT
+
+ close($tmpfhandle);
+
+ if ($tmpfname ne $infname) { unlink "$tmpfname"; } #remove temporary file
+
+ close ($outfhandle);
+
+ # print warning if magic sequence not found
+ if ( $before_startps )
+ {
+ print STDERR "\n ** Error!! **: could not identify begin of postscript code in file $infname, please check header line!\n First line should start with %!. No output generated.\n";
+ }
+
+ if (!$quiet) { print STDERR "ready.\n"; }
+ if ($warnings and $notsane and !$quiet)
+ {
+ print STDERR "** Warning **: EPS-output for $infname is not sane, at least one\n",
+ "of the following commands was still present:\n",
+ "clear erasepage initmatrix initclip initgraphics startjob\n",
+ "cleardictstack setmatrix setpagedevice copypage grestoreall\n",
+ "exitserver quit\n";
+ }
+} #end while PROCESSFILE
+
+# ---- end of perl-script -------
diff --git a/Build/source/texk/texlive/linked_scripts/ps4pdf b/Build/source/texk/texlive/linked_scripts/ps4pdf
new file mode 100755
index 00000000000..cbdcb022926
--- /dev/null
+++ b/Build/source/texk/texlive/linked_scripts/ps4pdf
@@ -0,0 +1,133 @@
+#!/bin/sh
+
+# Copyright (C) 2004, Thomas Esser. Public domain.
+# 2005-03-08: New option "--crop", Rolf Niepraschk.
+# dvips call only if the dvi file exist (RN).
+# 2005-06-27: ps2pdf call only if the ps file exist (RN).
+# 2006-04-05: "\RequirePackage{pst-pdf}" added to the (pdf)LaTeX calls
+# as suggested by Niall Murphy.
+# 2006-07-14: Better temp dir handling (suggested by Karl Berry) (RN).
+# 2006-07-23: New option --Xps2pdf and code cleanup (thanks to Karl Berry) (RN).
+
+# First, work around bugs/limitations in some shells on some systems:
+test -f /bin/sh5 && test -z "$RUNNING_SH5" \
+ && { UNAMES=`uname -s`; test "x$UNAMES" = xULTRIX; } 2>/dev/null \
+ && { RUNNING_SH5=true; export RUNNING_SH5; exec /bin/sh5 $0 ${1+"$@"}; }
+unset RUNNING_SH5
+
+test -f /bin/bsh && test -z "$RUNNING_BSH" \
+ && { UNAMES=`uname -s`; test "x$UNAMES" = xAIX; } 2>/dev/null \
+ && { RUNNING_BSH=true; export RUNNING_BSH; exec /bin/bsh $0 ${1+"$@"}; }
+unset RUNNING_BSH
+
+# hack around a bug in zsh:
+test -n "${ZSH_VERSION+set}" && alias -g '${1+"$@"}'='"$@"'
+
+###############################################################################
+# cleanup()
+# clean up the temp area and exit with proper exit status
+###############################################################################
+cleanup()
+{
+ rc=$?
+ $needsCleanup && test -n "$tmpdir" && test -d "$tmpdir" \
+ && { rm -f "$tmpdir"/*; cd /; rmdir "$tmpdir"; }
+
+ # set exit code in a portable way; see the autoconf manual for details:
+ (exit $rc); exit $rc
+}
+
+###############################################################################
+# setupTmpDir()
+# set up a temp directory and a trap to remove it
+###############################################################################
+setupTmpDir()
+{
+ $needsCleanup && return
+
+ trap 'cleanup' 1 2 3 7 13 15
+ needsCleanup=true
+ (umask 077; mkdir "$tmpdir") \
+ || abort "could not create directory \`$tmpdir'"
+}
+###############################################################################
+# myexec(args)
+# execute the command given as "args"; abort on error; redirect messages to
+# log in "silent" mode; redirect stdin (</dev/null) in silent mode
+###############################################################################
+myexec()
+{
+ if $silent; then
+ echo "$0: running $@"
+ "$@" >$log 2>&1 </dev/null
+ rc=$?
+ else
+ "$@"
+ rc=$?
+ fi
+ if test $rc != 0; then
+ echo "$0: command $@ returned with code $rc"
+ cat <$log
+ (exit $rc) # set return value
+ cleanup
+ fi
+}
+
+# some initializations
+progname=pdflatexps
+silent=true # default setting; change if you like
+crop=false
+needsCleanup=false
+ps2pdf_opts="-dAutoRotatePages=/None"
+tmpdir=${TMPDIR-${TEMP-${TMP-/tmp}}}/.$progname$$
+log=$tmpdir/log
+version="1.0"
+
+# look for optional things first
+while
+ case $1 in
+ --help|-h) echo "$0 [-v|-q|--crop|--version|--Xps2pdf OPT] FILE"
+ echo "Process LaTeX document FILE using the pst-pdf package,"
+ echo "including running latex, dvips, and ps2pdf as necessary."
+ echo "--Xps2pdf OPT passes OPT to ps2pdf."
+ echo " (-dAutoRotatePages=/None is always passed.)"
+ echo "--crop runs pdfcrop on ps2pdf output."
+ exit 0;;
+ --version) echo "$progname version $version"; exit 0;;
+ --crop|-c) crop=true;;
+ --Xps2pdf|-Xps2pdf) shift; ps2pdf_opts="$ps2pdf_opts $1";;
+ -q) silent=true;;
+ -v) silent=false;;
+ -*) echo "$progname: unknown option $1 ignored";;
+ *) break;;
+ esac
+do
+ shift
+done
+
+# remaining option: filename
+file=$1
+if test -z "$file"; then
+ echo "$0: no file to process, try --help for more information." >&2
+ exit 1
+fi
+
+# jobname von TeX: Verzeichnisse entfernen, evtl. vorhandene Extension
+# entfernen.
+job=`echo "x$1" | sed 's@x@@; s@.*/@@; s@\.[^.]*$@@'`
+
+setupTmpDir
+myexec latex \
+ "\AtBeginDocument{\RequirePackage{pst-pdf}} \input{$file}"
+test -f "$job.dvi" && myexec dvips -Ppdf -o "$job-pics.ps" "$job.dvi"
+test -f "$job-pics.ps" && myexec ps2pdf \
+ "$ps2pdf_opts" "$job-pics.ps" "$job-pics.pdf"
+if $crop; then
+ myexec pdfcrop "$job-pics.pdf" "$job-pics-crop.pdf"
+ mv "$job-pics-crop.pdf" "$job-pics.pdf"
+fi
+myexec pdflatex \
+ "\AtBeginDocument{\RequirePackage{pst-pdf}} \input{$file}"
+true
+cleanup
+
diff --git a/Build/source/texk/texlive/linked_scripts/texdoc.tlu b/Build/source/texk/texlive/linked_scripts/texdoc.tlu
new file mode 100755
index 00000000000..7c66896497d
--- /dev/null
+++ b/Build/source/texk/texlive/linked_scripts/texdoc.tlu
@@ -0,0 +1,345 @@
+#!/usr/bin/env texlua
+-- $Id$
+--[[ Written in lua by Frank Küster (2007) based on the shell script by
+Thomas Esser, David Aspinall, and Simon Wilkinson.
+Public domain.]]
+--[[ Changelog
+ 0.3 2007-06-28
+ - added changelog
+ - better OS detection for default viewer settings
+ - removed some debugging code
+ - -s now works in dirs without ls-R, too
+
+ 0.2 2007-06-28
+ - implemented reading of configuration from texmf.cnf
+ - fixed "-s" option
+
+ 0.1
+ - initial public release
+]]
+
+progname = 'texdoc';
+version = '0.3';
+usage = ' Usage: ' .. progname ..' [-h|--help] name\
+ -h|--help\t\t Show this help\
+ -V|--version\t\t Print the version of the program\
+ -v|--verbose\t\t Show the command being used to display the documentation\
+ -l|--list\t\t List matching files, do not start a viewer.\
+ -s|--search\t\t search for name as a pattern';
+
+
+if not arg[1] then
+ print (usage);
+ return
+end
+
+mode = 'view';
+verbose = false;
+while table.maxn(arg) > 0 and string.match(arg[1],'^%-') do
+ curr_arg = table.remove(arg,1)
+ if string.match (curr_arg,'-h') or string.match (curr_arg,'--help') then
+ print (usage);
+ os.exit(0);
+ elseif string.match (curr_arg,'-V') or string.match (curr_arg,'--version') then
+ print (progname .. ' version: ' .. version );
+ os.exit(0);
+ elseif string.match (curr_arg,'-v') or string.match (curr_arg,'--verbose') then
+ verbose = true;
+ elseif string.match (curr_arg,'-l') or string.match (curr_arg,'--list' ) then
+ mode = 'list';
+ elseif string.match (curr_arg,'-s') or string.match (curr_arg,'--search' ) then
+ mode = 'search';
+ end
+end
+
+--[[ function definitions ]]
+function list_iter (t)
+ local i = 0
+ local n = table.getn(t)
+ return function ()
+ i = i + 1
+ if i <= n then return t[i] end
+ end
+end
+
+
+-- [[ functions for the search option ]]
+no_lsr_doctrees = {};
+function get_lsr_files ()
+ local lsr_files = {};
+ local pathlist = kpse.expand_braces('$TEXDOCS');
+ for path in string.gmatch(pathlist, "[^:;]+") do
+ path = string.gsub(path,'//$','')
+ local tree_root
+ tree_root = string.gsub(path,'doc$','')
+ tree_root = string.gsub(tree_root,'^!!','')
+ if lfs.isfile(tree_root .. "ls-R") then
+ table.insert(lsr_files,tree_root .. "ls-R")
+ else
+ if not string.match(path,'^%.$') and lfs.isdir(path) then
+ table.insert(no_lsr_doctrees,path)
+ end
+ end -- does lsRfile exist?
+ end -- for path
+ local i = 0
+ local n = table.getn(lsr_files)
+ -- TODO: We completely ignore trees without ls-R files. Since I
+ -- don't know how to get the output of "find" without resorting to
+ -- temporary files, anyway, I don't care.
+ return function ()
+ i = i +1
+ if i <= n then return lsr_files[i] end
+ end
+
+end -- get_lsr_files()
+
+function deluaficate(oldpat)
+ local newpat
+ -- better use long strings here, no escaping of \ needed there.
+ newpat = string.gsub(oldpat,'([^\\])%-','%1%%%-')
+ newpat = string.gsub(newpat,'\\','')
+ return newpat
+end --deluaficate
+
+docdirs = {}
+docfiles = {}
+function pattern_search (pattern)
+ pattern = deluaficate(pattern)
+ -- populate docdirs and doclines list
+ for database in get_lsr_files() do
+ local texmf_tree = string.gsub(database,'ls%-R$','')
+ is_docline = false
+ local this_dir -- changed to each individual docdir
+ for line in io.lines(database) do
+ if string.match(line,'^./') then
+ -- a directory
+ this_dir = string.gsub(line,'^./',texmf_tree)
+ this_dir = string.gsub(this_dir,':$','/')
+ if string.match(line,'^./doc') then
+ -- the next file lines are in docdir "this_dir"
+ is_docline = true
+ -- save it in the docdirs table
+ table.insert(docdirs,this_dir)
+ else
+ is_docline = false
+ end -- docdir
+ elseif string.match(line,'^%s*$') then
+ -- empty line, do nothing
+ -- now we have only file lines left, are they a docline?
+ elseif is_docline then
+ local fullpath = this_dir .. line
+-- print(fullpath)
+ table.insert(docfiles,fullpath)
+ end -- line starting with ./
+ end -- for line
+ end -- for database
+ for no_lsr_dir in list_iter(no_lsr_doctrees) do
+ recurse_tree(no_lsr_dir)
+ end
+
+ print("Directories that match:")
+ for dir in list_iter(docdirs) do
+ if string.match(dir,pattern) then
+ print (dir)
+ end
+ end -- for dir
+ print()
+ print("Files that match:")
+ for file in list_iter(docfiles) do
+ if string.match(file,pattern) then
+ print (file)
+ end
+ end -- for file
+
+end -- function pattern_search()
+
+function recurse_tree (path)
+ for file in lfs.dir(path) do
+ if file ~= "." and file ~= ".." then
+ local f = path..'/'..file
+ local attr = lfs.attributes (f)
+ if attr then -- else stale symlink
+ if attr.mode == "directory" then
+ table.insert(docdirs,f)
+ recurse_tree (f)
+ else
+ table.insert(docfiles,f)
+ end
+ end
+ end
+ end
+ end --function recurse_tree
+
+
+--[[ functions for parsing texmf.cnf ]]
+function set_var_from_texmf(oldvalue,texmfvar)
+ local newvalue
+ newvalue = kpse.var_value(texmfvar)
+ if newvalue then
+ return newvalue
+ else
+ return oldvalue
+ end
+end
+function set_listvar_from_texmf(oldvalue,texmfvar)
+ local list_as_string
+ local templist = {}
+ list_as_string = set_var_from_texmf('',texmfvar)
+ for element in string.gmatch(list_as_string,'[^,;:]+') do
+ table.insert(templist,element)
+ end
+ if table.maxn(templist) > 0 then
+ return templist
+ else
+ return oldvalue
+ end
+end -- set_listvar_from_texmf
+
+function set_listvar_from_expand_braces(oldvalue,texmfvar)
+ local list_as_string
+ local templist = {}
+ list_as_string = kpse.expand_braces(texmfvar)
+ for element in string.gmatch(list_as_string,'[^,;:]*:') do
+ element = string.gsub(element,':','')
+ table.insert(templist,element)
+ end
+ if table.maxn(templist) > 0 then
+ return templist
+ else
+ return oldvalue
+ end
+end -- set_listvar_from_expand_braces
+
+--[[ initialize kpathsea ]]
+kpse.set_program_name("texdoc")
+
+-- [[ initialize some variables ]]
+texdoc_formats = {'dvi','pdf','ps','txt','html'}
+
+-- can be done with: if (os.type == "windows") then
+if string.find(os.getenv("PATH"),";") then
+ -- probably Windows (or OS/2)
+ -- which commands should we use for unzipping?
+ texdoc_unzip = {
+ gz = "gzip -d -c ",
+ bz2 = "bzip2 -d -c "
+ };
+ texdoc_viewer = {
+ dvi = '(start /wait %s ) &',
+ html = '(start /wait %s) &',
+ pdf = '(start /wait %s) &',
+ ps = '(start /wait %s) &',
+ txt = '(start /wait %s) &',
+ tex = '(start /wait %s) &'
+ };
+ rmfile_command = 'del /F ';
+ rmdir_command = 'rmdir ';
+else
+ -- probably UNIX-like
+ texdoc_unzip = {
+ gz = "gzip -d -c ",
+ bz2 = "bzip2 -d -c "
+ };
+ texdoc_viewer = {
+ dvi = '(xdvi %s ) &',
+ html = '(see %s) &',
+ pdf = '(xpdf %s) &',
+ ps = '(gv %s) &',
+ txt = '(less %s )',
+ tex = '(less %s )'
+ };
+ rmfile_command = 'rm -f ';
+ rmdir_command = 'rmdir ';
+end
+
+texdoc_zipformats = {'','gz','bz2'};
+texdoc_formats = {'','dvi','html','pdf','ps','txt','tex'};
+extlist = {'','.dvi', '.dvi.gz', '.dvi.bz2', '.pdf', '.pdf.gz', '.pdf.bz2', '.ps', '.ps.gz', '.ps.bz2', '.txt', '.txt.gz', '.txt.bz2', '.html'};
+
+-- [[ override hardcoded variables with values from texmf.cnf ]]
+rmfile_command = set_var_from_texmf(rmfile_command,'TEXDOC_RMFILE')
+rmdir_command = set_var_from_texmf(rmdir_command,'TEXDOC_RMDIR')
+texdoc_formats = set_listvar_from_texmf(texdoc_formats,'TEXDOC_FORMATS')
+for format in list_iter(texdoc_formats) do
+ viewer_var = 'TEXDOC_VIEWER_' .. string.upper(format)
+ texdoc_viewer[format] = set_var_from_texmf(texdoc_viewer[format],viewer_var)
+end
+texdoc_zipformats = set_listvar_from_texmf(texdoc_zipformats,'TEXDOC_ZIPFORMATS')
+for zipext in list_iter(texdoc_zipformats) do
+ viewer_var = 'TEXDOC_UNZIP_' .. string.upper(zipext)
+ texdoc_unzip[zipext] = set_var_from_texmf(texdoc_unzip[zipext],viewer_var)
+end
+extlist = set_listvar_from_expand_braces(extlist,'$TEXDOCEXT');
+-- we want an empty string for ext at the beginning, so that it works
+-- to specify the complete filename. Doesn't matter when there's one
+-- more empty string, but we can easily avoid two in a row
+if not extlist[1] == '' then
+ insert(extlist,1,'')
+end
+
+
+for docname in list_iter (arg) do
+ if string.match(mode,'search') then
+ pattern_search(docname);
+ elseif string.match(mode,'view') or string.match(mode,'list') then
+ for ext in list_iter(extlist) do
+ filename = kpse.find_file(docname .. ext , "TeX system documentation")
+
+ if filename then
+ if string.match (mode, 'list') then
+ print(filename);
+ else
+ -- mode is view, is unzipping needed?
+ zipext = string.match(ext,'%..*%.(.*)');
+ if zipext then
+ unzip_command = texdoc_unzip[zipext];
+ viewext = string.match(ext,'%.(.*)%..*$');
+ basebame_pattern = '.*/(.*%.' .. viewext .. ')';
+ basename = string.match(filename,basebame_pattern);
+
+ -- uncompress only once per file, in case it is given more
+ -- than once (dvi besides ps or so)
+ -- TODO: to be done
+
+ tmpdir = os.tmpdir("/tmp/texdoc.XXXXXX");
+
+ unzip_commandline = unzip_command .. filename .. " > " .. tmpdir .. "/" .. basename;
+ if os.execute(unzip_commandline) then
+ filename = tmpdir .. "/" .. basename;
+ else
+ print("Error executing \n" .. unzip_commandline);
+ end
+ viewer_replacement = filename .. ';' .. rmfile_command .. filename .. ';' .. rmdir_command .. tmpdir;
+ else
+ if ext == '' then
+ -- fallback if complete filename has been specified
+ ext = string.match(filename,'.*(%..*)$')
+ if not ext then
+ -- still no extension for filenames like README
+ ext = 'txt';
+ end
+ end
+ viewer_replacement = filename;
+ viewext = string.match(ext,'%.(.*)$');
+ if not viewext or not texdoc_viewer[viewext] then
+ -- complete filename specified, unknown extension, use "txt"
+ viewext = 'txt'
+ end
+ end -- zipped or not
+ view_command = string.gsub(texdoc_viewer[viewext],'%%s',viewer_replacement)
+ if verbose then
+ print(view_command);
+ end
+ view_result = os.execute(view_command);
+ if view_result then
+ do break end;
+ else
+ print("Error executing \n" .. view_command);
+ end
+ end -- list or view
+ end -- found a filename with that extension or not?
+ end -- for ext
+ end -- if construct "case mode in"
+end -- for docname
+
+-- cleanup_tmpdir();
diff --git a/Build/source/texk/texlive/linked_scripts/texdoctk.pl b/Build/source/texk/texlive/linked_scripts/texdoctk.pl
new file mode 100755
index 00000000000..147553a1a1c
--- /dev/null
+++ b/Build/source/texk/texlive/linked_scripts/texdoctk.pl
@@ -0,0 +1,1794 @@
+#! /usr/bin/env perl
+###############################################################################
+# texdoctk v.0.6.0 (Nov 5, 2004) - GUI for TeX documentation access
+# Copyright (C) 2000-2004 Thomas Ruedas
+# This program is provided under the GNU Public License; see the file
+# README.texdoctk for details about requirements, installation, configuration,
+# and the full disclaimer.
+###############################################################################
+use strict;
+use Tk;
+use Getopt::Long;
+Getopt::Long::config('bundling');
+use File::Basename;
+
+my $IsWin32 = ($^O =~ /MSWin32/i);
+
+if ($IsWin32) {
+ require Win32::API;
+# Win32::API->import( qw(
+# &something
+# ));
+}
+
+# initialization of some internal variables
+$|=1;
+my $quiet=1;
+my $autoview;
+my $xfmt_viewer=1,
+my @tdcolors;
+my %butcol;
+my $srchentry;
+my $srchflag=0;
+my $tmpfno;
+# system variables
+my ($texmfmain,$texmfdist,$texmfdoc,$texmflocal,$texmfhome,
+ $texdocpath,$distdocpath,$docdocpath,$localdocpath,$homedocpath,
+ $datadir,
+ $dvi_viewer,$dvips_conv,$ps_viewer,$pdf_viewer,
+ $pdfps_conv,$html_viewer,$htmlps_conv,$htmlps_redir,
+ $txt_viewer,$txtps_conv,$txtps_redir,$print_cmd);
+
+# defaults: unix values
+my $qq="'";
+my $HomeEnv=$ENV{HOME};
+my $TeXDocRcDefaults="texdocrc.defaults";
+my $TempDir; $TempDir=$ENV{TMPDIR} or $TempDir="/tmp";
+my $CmdConsole="xterm -e ";
+
+if ($IsWin32) {
+ $qq = "\"";
+ $HomeEnv = &GetHomeDir;
+ chomp $HomeEnv;
+ $TeXDocRcDefaults = "texdocrc-win32.defaults";
+ $TempDir = &GetTempPath;
+ $CmdConsole = "command /c ";
+}
+
+my $myrc="${HomeEnv}/.texdocrc"; # optional personal settings file
+
+my ($line,@dummy);
+my @tmpfiles;
+# read system-wide defaults from texdocrc.defaults
+my $sysrc=`kpsewhich --progname=texdoctk --format=${qq}other text files${qq} ${TeXDocRcDefaults}`;
+my $database=`kpsewhich --progname=texdoctk --format=${qq}other text files${qq} texdoctk.dat`;
+my $locdatabase=`kpsewhich --progname=texdoctk --format=${qq}other text files${qq} texdoctk-local.dat`;
+my $homedatabase=`kpsewhich --progname=texdoctk --format=${qq}other text files${qq} texdoctk-pers.dat`;
+chomp $locdatabase;
+chomp $homedatabase;
+chomp $sysrc;
+&readrc($sysrc,1);
+@dummy=split("/",$sysrc);
+pop @dummy;
+$datadir=join('/',@dummy);
+# possibly use personal settings instead of defaults
+if (-e $myrc) { &readrc($myrc,2); }
+# command line options
+GetOptions('v'=>\$quiet,'a'=>\$autoview);
+my $special=0;
+my @button;
+$button[17]="Miscellaneous";
+my (@packname,@topic,@doc,@keywords,@maxind,%stydoc);
+# read database file
+my $i=-1;
+my $j;
+open(DATABASE,"$database") || &fatalmsg("Couldn't open database $database.\n");
+while ($line = <DATABASE>) {
+ LINETYPE: {
+ ($line =~ /^\@/) && do { # category
+ ++$i;
+ if ($i == $#button) {
+ pop @button;
+ push @button,(substr($line,1,-1));
+ $special=1;
+ } else {
+ $button[$i]=substr($line,1,-1);
+ }
+ $j=0;
+ last LINETYPE;
+ };
+ ($line =~ /^(#|$)/) && do { # comment or empty line
+ last LINETYPE;
+ };
+# list item
+ @dummy=split(";",$line);
+ $packname[$i][$j]=$dummy[0];
+ $topic[$i][$j]=$dummy[1];
+ $doc[$i][$j]=$dummy[2];
+ $keywords[$i][$j]=$dummy[3];
+ if ($doc[$i][$j] =~ /sty$/ && $keywords[$i][$j]) {
+ $stydoc{"$doc[$i][$j]"}=substr($keywords[$i][$j],1,1);
+ unless ($stydoc{"$doc[$i][$j]"} =~ /^\d$/) {
+ $stydoc{"$doc[$i][$j]"}=0;
+ }
+ }
+ $maxind[$i]=$j;
+ ++$j;
+ };
+}
+close(DATABASE);
+# Read site-local and user's database(s) if it/they exist(s)
+foreach my $dbfile ($locdatabase,$homedatabase) {
+ if (-e "$dbfile") {
+ open(DATABASE,"$dbfile") ||
+ print "Couldn't open additional database $dbfile.\n";
+ $i=17; # local/user: if no category is specified in database, add to "Misc"
+ while ($line = <DATABASE>) {
+ LINETYPE: {
+ ($line =~ /^\@/) && do { # category
+ $i=&arrindex(@button,substr($line,1,-1));
+ if ($i >= $#button) {
+ $i=$#button;
+ pop @button;
+ push @button,(substr($line,1,-1));
+ $special=1;
+ }
+ last LINETYPE;
+ };
+ ($line =~ /^(#|$)/) && do { # comment or empty line
+ last LINETYPE;
+ };
+# list item
+ @dummy=split(";",$line);
+ $j=&arrindex(@{$packname[$i]},$dummy[0]);
+ if ($j > $#{$packname[$i]}) {
+ $packname[$i][$j]=$dummy[0];
+ $topic[$i][$j]=$dummy[1];
+ $doc[$i][$j]=$dummy[2];
+ $keywords[$i][$j]=$dummy[3];
+ if ($doc[$i][$j] =~ /sty$/ && $keywords[$i][$j]) {
+ $stydoc{"$doc[$i][$j]"}=substr($keywords[$i][$j],1,1);
+ unless ($stydoc{"$doc[$i][$j]"} =~ /^\d$/) {
+ $stydoc{"$doc[$i][$j]"}=0;
+ }
+ }
+ $maxind[$i]=$j;
+ ++$j;
+ }
+ };
+ }
+ close(DATABASE);
+ $special=1 if ($i == 17 && $j > 0);
+ }
+}
+
+# Tk
+# hash table for toplevel windows; used to avoid multiple calls of same window
+my %tlwins;
+my %buttonlist;
+# create frames for main window: commands on top, frame for buttons below
+my $main=new MainWindow;
+$tlwins{'mainwindow'}{'addr'}=$main;
+$main->resizable(0,0);
+$main->title("TeX Documentation Browser");
+$main->bind('all','<Control-q>'=>\&clean_exit);
+$main->bind('all','<Control-m>'=>sub { $main->raise(); });
+$main->bind('all','<Control-h>'=>\&helptext);
+$main->bind('all','<Control-s>'=>sub { $main->raise(); &mksrch; });
+$main->bind('all','<Control-t>'=>\&settings);
+my $cmdframe=$main->Frame(-background=>"#ffcc99");
+my $buttonframe=$main->Frame;
+$cmdframe->pack(-side=>'top',-fill=>'x');
+$buttonframe->pack(-side=>'bottom');
+# normal cursor
+my $defcursor=$main->cget(-cursor);
+# make buttons for command frame
+my $Qbut=$cmdframe->Button(-text=>'Quit',%butcol,
+ -command=>\&clean_exit)->pack(-side=>'left');
+$tlwins{'mainwindow'}{'buttons'}[0]=$Qbut;
+# define common default font for labels and text explicitly
+my $deffont=$Qbut->cget(-font);
+# ensure readability on high-res screens (suggested by R.Kotucha)
+$deffont='Helvetica -16 bold' if &x_resolution > 1200;
+$Qbut->configure(-font=>$deffont);
+$tlwins{'mainwindow'}{'buttons'}[1]=$cmdframe->Button(-text=>'Search',
+ -font=>$deffont,%butcol,
+ -command=>\&mksrch
+ )->pack(-side=>'left');
+$tlwins{'mainwindow'}{'buttons'}[2]=$cmdframe->Button(-text=>'Help/About',
+ -font=>$deffont,%butcol,
+ -command=>\&helptext
+ )->pack(-side=>'right');
+$tlwins{'mainwindow'}{'buttons'}[3]=$cmdframe->Button(-text=>'Settings',
+ -font=>$deffont,%butcol,
+ -command=>\&settings
+ )->pack(-side=>'right');
+# make buttons for category button frame
+my $lbut=0;
+my $l;
+foreach (@button) { $l=length $_; $lbut=$l if ( $l > $lbut) }
+my @catg;
+my ($i2,$i3);
+my $nbutt=scalar @button;
+my $ncols=$nbutt/3-1;
+foreach (0..$ncols) {
+ $i=$_;
+ $i2=$i+$nbutt/3;
+ $i3=$i+2*$nbutt/3;
+ $catg[$i]=$buttonframe->Button(-text=>$button[$i],
+ -font=>$deffont,%butcol,
+ -width=>$lbut,
+ -command=>[\&tpslct,$i,\@dummy])->grid
+ ($catg[$i2]=$buttonframe->Button(-text=>$button[$i2],
+ -font=>$deffont,%butcol,
+ -width=>$lbut,
+ -command=>[\&tpslct,$i2,\@dummy]),
+ $catg[$i3]=$buttonframe->Button(-text=>$button[$i3],
+ -font=>$deffont,%butcol,
+ -width=>$lbut,
+ -command=>[\&tpslct,$i3,\@dummy]));
+}
+# disable last button (lower right) if no local specials are found in list
+my $ncat;
+if ($special == 0) {
+ $catg[$#button]->configure(-state=>'disabled');
+ $ncat=$nbutt-1;
+} else {
+ $ncat=$nbutt;
+}
+for ($i=0,$j=4; $i<@catg; ++$i,++$j) {
+ $tlwins{'mainwindow'}{'buttons'}[$j]=$catg[$i];
+}
+MainLoop;
+
+########## SUBROUTINES ########################################################
+# toplevel for selecting a topic of a category for viewing or printing
+sub tpslct {
+ my($opt,@srchitems)=@_;
+ my (@lbitems,@lbdocs,$dspselect,$docselect,$wtitle);
+ if ($opt >= 0) {
+# main window buttons
+# see if toplevel window is already there
+ if (Exists($tlwins{$opt}{'addr'})) {
+ $tlwins{$opt}{'addr'}->deiconify();
+ $tlwins{$opt}{'addr'}->raise();
+ return;
+ }
+ for ($j=0; $j <= $maxind[$opt]; ++$j) {
+ push @lbitems,$topic[$opt][$j];
+ push @lbdocs,$doc[$opt][$j];
+ }
+ $wtitle=$button[$opt];
+ } else {
+# search results
+ my $spec_wtitle=shift @srchitems;
+ for ($j=0; $j < $#srchitems; $j+=2) {
+ my $k=$j+1;
+ push @lbitems,$topic[$srchitems[$j]][$srchitems[$k]];
+ push @lbdocs,$doc[$srchitems[$j]][$srchitems[$k]];
+ }
+ $wtitle="Search results for $spec_wtitle";
+ }
+# toplevel window of category $opt with two frames
+ my $tpwin=$main->Toplevel(-title=>$wtitle);
+ $tlwins{$opt}{'addr'}=$tpwin;
+ my $tpdsp=$tpwin->Frame(-relief=>'groove')->pack(-side=>'top');
+ my $tpslc=$tpwin->Frame()->pack(-side=>'top');
+# selection frame with listbox and buttons
+# label for listbox
+ my $tplabel=$tpslc->Label(-text=>'Topics',
+ -font=>$deffont)->pack(-anchor=>'w',
+ -side=>'top');
+# listbox with optional scrollbar
+ my $tplist=$tpslc->Scrolled("Listbox",
+ -font=>$deffont,
+ -scrollbars=>'osoe',
+# -height=>0,
+ -width=>0,
+ -selectmode=>'single',
+ -exportselection=>0,
+ -cursor=>'hand2')->pack(-side=>'left',
+ -fill=>'y',
+ -expand=>1);
+ $tplist->insert('end',@lbitems); # fill topics into listbox
+# buttons frame
+ my $tpbframe=$tpslc->Frame(-borderwidth=>8);
+ $tpbframe->pack(-side=>'right');
+# make buttons for command frame
+ my $n_buttons = 0;
+ $tlwins{$opt}{'buttons'}[$n_buttons++]=
+ $tpbframe->Button(-text=>'View',
+ -font=>$deffont,%butcol,
+ -command=>sub{ &viewslc($docselect,$tpbframe);},
+ -width=>6)->pack(-side=>'top');
+ if (! $IsWin32) {
+ $tlwins{$opt}{'buttons'}[$n_buttons++]=
+ $tpbframe->Button(-text=>'Print',
+ -font=>$deffont,%butcol,
+ -command=>sub{ &prtslc($docselect,$tpbframe);},
+ -width=>6)->pack(-side=>'top');
+ }
+ $tlwins{$opt}{'buttons'}[$n_buttons++]=
+ $tpbframe->Button(-text=>'Cancel',
+ -font=>$deffont,%butcol,
+ -command=>sub{ destroy $tpwin; undef $tlwins{$opt};},
+ -width=>6)->pack(-side=>'bottom');
+# if only 1 item is in the list (most likely in search results), select it
+ if (scalar @lbitems == 1) {
+ $tplist->selectionSet(0);
+ $dspselect=$lbitems[0];
+ $docselect=$lbdocs[0];
+ &viewslc($docselect,$tpbframe)
+ if ($autoview && $wtitle =~ /^Search results/);
+ }
+# display frame
+ my $dsplabel=$tpdsp->Label(-text=>'Selection:',
+ -font=>$deffont)->pack(-anchor=>'w',,
+ -fill=>'x',
+ -side=>'left');
+ my $dspslc=$tpdsp->Label(-textvariable=>\$dspselect,
+ -font=>$deffont,
+ -borderwidth=>2)->pack(-anchor=>'w',
+ -fill=>'x',
+ -side=>'right');
+# handle selection; only one selection possible
+ $tplist->bind('<Button-1>'=>sub{my ($slctind)=$tplist->curselection();
+ $dspselect=$lbitems[$slctind];
+ $docselect=$lbdocs[$slctind];});
+# key bindings
+ $tplist->bind('<Double-Button-1>'=>sub{
+ &viewslc($docselect,$tpbframe);});
+ $tpwin->bind('<Control-v>'=>sub{
+ &viewslc($docselect,$tpbframe);});
+ $tpwin->bind('<Control-p>'=>sub{
+ &prtslc($docselect,$tpbframe);});
+ $tpwin->bind('<Control-c>'=>sub{destroy $tpwin; undef $tlwins{$opt};});
+ $tplist->bind('<Button-3>'=>sub{
+ if ($docselect) {
+ &showpath($docselect,$tpbframe);
+ } else {
+ &popmsg(2,"No selection;\nuse left mouse button.",$tpbframe);
+ }});
+}
+
+# view document selected in listbox
+sub viewslc {
+ my($slc,$parframe)=@_;
+ my $viewer;
+ my $itype=-1;
+ my $browser=0;
+ my $styflag=0;
+ unless (defined $slc) {
+ &popmsg(2,"No selection was made.",$parframe);
+ return;
+ }
+ $parframe->configure(-cursor=>'watch');
+ chomp $slc;
+ my @dummy=split('\.',$slc);
+ DOC_FORMAT: { # determine document type
+ ($dummy[-1] =~ /dvi/) && do { $viewer=$dvi_viewer; last DOC_FORMAT; };
+ ($dummy[-1] =~ /ps/) && do { $viewer=$ps_viewer; last DOC_FORMAT; };
+ ($dummy[-1] =~ /pdf/) && do { $viewer=$pdf_viewer; last DOC_FORMAT; };
+ ($dummy[-1] =~ /txt/ || $dummy[-1] =~ /faq$/) && do {
+ $viewer=($txt_viewer eq "TDK_OWN" ||
+ $txt_viewer =~ /xterm/) ?
+ $txt_viewer : "${CmdConsole} $txt_viewer";
+ last DOC_FORMAT;
+ };
+ ($dummy[-1] =~ /README/i || $dummy[-2] =~ /\/README$/i) && do {
+ $viewer=($txt_viewer eq "TDK_OWN" ||
+ $txt_viewer =~ /xterm/) ?
+ $txt_viewer : "${CmdConsole} $txt_viewer";
+ last DOC_FORMAT;
+ };
+ ($dummy[-1] =~ /htm/) && do {
+ $viewer=$html_viewer;
+ if ($html_viewer =~ /netscape/i) { # check if Netscape is open
+ my $lockfile="${HomeEnv}/.netscape/lock";
+ $browser=1 if (-e $lockfile || -l $lockfile);
+ } elsif ($html_viewer =~ /mozilla/i) { # check if Mozilla is open
+ my $mozcheck=
+ `mozilla -remote 'openFile($texmfmain/doc/index.html)'`;
+ $browser=1 unless ($?);
+ }
+ last DOC_FORMAT;
+ };
+# some packages have no normal documentation but useful info in the .sty
+ ($dummy[-1] =~ /sty$/) && do {
+ $viewer=($txt_viewer eq "TDK_OWN" ||
+ $txt_viewer =~ /xterm/) ?
+ $txt_viewer : "${CmdConsole} $txt_viewer";
+ $slc="../tex/$slc"; # .sty files are in ${tex,local}docpath/../tex/
+ $styflag=1;
+ last DOC_FORMAT;
+ };
+ $parframe->configure(-cursor=>$defcursor);
+ if ($xfmt_viewer != 1) {
+ &popmsg(2,"$dummy[-1]: not a known document format",$parframe);
+ return;
+ }
+ };
+ if ($viewer eq "") {
+ if ($xfmt_viewer == 1) {
+ &popmsg(-1,'Unknown format; assuming plain text.',$parframe);
+ $viewer=($txt_viewer eq "TDK_OWN" ||
+ $txt_viewer =~ /xterm/) ?
+ $txt_viewer : "${CmdConsole} $txt_viewer";
+ } else {
+ &popmsg(2,"$dummy[-1]: no viewer available/specified for this format",
+ $parframe);
+ $parframe->configure(-cursor=>$defcursor);
+ return;
+ }
+ }
+# build complete path and start viewer if file exists
+ my $slcdoc;
+ $slcdoc=&finddoc($slcdoc,$slc,$parframe);
+ if ($slcdoc ne "") {
+# change to doc directory in case there are pictures
+ my $docpath=substr($slcdoc,0,(rindex($slcdoc,'/',(length $slcdoc))));
+ chomp $slcdoc;
+ chdir ($docpath);
+# try to get doc out of .sty file
+ if ($styflag) {
+ &popmsg(-1,'Trying to extract documentation out of .sty file;
+might be cluttered with program comments.',
+ $parframe);
+ $slcdoc=&stripsty($slcdoc,substr($slc,7));
+ }
+# for text files use built-in text viewer if set
+ if ($IsWin32) {
+ if ($viewer eq "TDK_OWN") {
+ &ShellExecute('open', $slcdoc);
+ $parframe->configure(-cursor=>$defcursor);
+ return;
+ }
+ else {
+ system("$viewer $slcdoc");
+ }
+ }
+ else {
+ if ($viewer eq "TDK_OWN") {
+ &textview($slcdoc);
+ $parframe->configure(-cursor=>$defcursor);
+ return;
+ }
+ if ($quiet == 0) { # show messages
+ if ($browser == 0) { # normal viewers or new Netscape/Mozilla
+ system("$viewer $slcdoc &");
+ } else { # open doc in existing Netscape/Mozilla window
+ system("$viewer -remote 'openFile($slcdoc)' &");
+ &popmsg(-1,"Opening document in existing $viewer window.",
+ $parframe);
+ }
+ } else { # viewer messages written to /dev/null instead of terminal
+ if ($browser == 0) { # normal viewers or new Netscape/Mozilla
+ system("perl -we 'use strict; \
+my \$dump=\"\"; \
+open(NULL,\">/dev/null\"); \
+open (VIEWQ,\"$viewer $slcdoc |\"); \
+while (\$dump=<VIEWQ>) { print NULL \$dump; } \
+close(VIEWQ); \
+close(NULL);' &");
+ } else { # open doc in existing window (Netscape or Mozilla)
+ # not quiet; I didn't get an inline perl call like in
+ # the other branch working
+ system("$viewer -remote 'openFile($slcdoc)' &");
+ &popmsg(-1,"Opening document in existing $viewer window.",
+ $parframe);
+ }
+ }
+ }
+ }
+ $parframe->configure(-cursor=>$defcursor);
+}
+
+# Tk widget for text document
+sub textview {
+ my($txtfile)=@_;
+# see if toplevel window with this file is already there
+ if (Exists($tlwins{$txtfile}{'addr'})) {
+ $tlwins{$txtfile}{'addr'}->deiconify();
+ $tlwins{$txtfile}{'addr'}->raise();
+ return;
+ }
+ my $tfv_tk=$main->Toplevel(-title=>"Text file viewer");
+ $tfv_tk->resizable(0,1);
+ $tlwins{$txtfile}{'addr'}=$tfv_tk;
+ $tfv_tk->Label(-text=>"File: $txtfile",
+ -font=>$deffont,
+ -relief=>'ridge',
+ -borderwidth=>3)->pack(-side=>'top',
+ -fill=>'x',
+ -ipady=>10,
+ -anchor=>'s');
+ my $txtbody=$tfv_tk->Scrolled("Text",
+ -relief=>'flat',
+ -font=>$deffont,
+ -height=>20,
+ -width=>80,
+ -scrollbars=>"e")->pack(-side=>'top',
+ -fill=>'y',
+ -expand=>1);
+ open(TXTFILE,"$txtfile");
+ while (<TXTFILE>) { $txtbody->insert('end',$_); }
+ close(TXTFILE);
+ $txtbody->configure(-state=>'disabled');
+ $tlwins{$txtfile}{'buttons'}[0]=
+ $tfv_tk->Button(-text=>'Close',
+ -font=>$deffont,%butcol,
+ -command=>sub{ destroy $tfv_tk;
+ undef $tlwins{$txtfile};
+ })->pack(-side=>'bottom',
+ -fill=>'x');
+ $tfv_tk->bind('<Control-c>'=>sub{destroy $tfv_tk;
+ undef $tlwins{$txtfile};
+ });
+}
+
+# print document selected in listbox
+sub prtslc {
+ my($slc,$parframe)=@_;
+ $tmpfno=&randname;
+ my $pstmpfile="${TempDir}/texdoc_$tmpfno.ps";
+ push @tmpfiles,$pstmpfile;
+ my $status;
+ chomp $slc;
+ unless (defined $slc) {
+ &popmsg(2,"No selection was made.",$parframe);
+ return;
+ }
+ if ($print_cmd eq "") {
+ &popmsg(2,"No printer specified.",$parframe);
+ return;
+ }
+# build complete path and check existence of file
+ my @dummy=split('\.',$slc);
+ if ($dummy[-1] =~ /sty$/) {
+ $slc="../tex/$slc"; # .sty files are in ${tex,local,home}docpath/../tex
+ }
+ my $slcdoc;
+ $slcdoc=&finddoc($slcdoc,$slc,$parframe);
+ return if ($slcdoc eq "");
+# change to doc directory in case there are pictures
+ my $docpath=substr($slcdoc,0,(rindex($slcdoc,'/',(length $slcdoc))));
+ chdir ($docpath);
+ DOC_FORMAT: { # determine document type
+# convert dvi files to ps before printing
+ ($dummy[-1] =~ /dvi/) && do {
+ if ($dvips_conv eq "") {
+ &popmsg(2,"No converter available for dvi->ps conversion.",
+ $parframe);
+ return;
+ }
+ &popmsg(-1,"Converting dvi to ps for printing and sending file to print...",$parframe);
+ $status=system("$dvips_conv $slcdoc -o $pstmpfile");
+ if ($status != 0) {
+ &popmsg(2,"Error: Conversion dvi->ps failed!",$parframe);
+ }
+ last DOC_FORMAT;
+ };
+# PostScript is printed directly
+ ($dummy[-1] =~ /ps/) && do {
+ &popmsg(-1,"Sending file to $print_cmd...",$parframe);
+ $pstmpfile=$slcdoc;
+ last DOC_FORMAT;
+ };
+# convert pdf files to ps before printing
+ ($dummy[-1] =~ /pdf/) && do {
+ if ($pdfps_conv eq "") {
+ &popmsg(2,"No converter available for pdf->ps conversion.",
+ $parframe);
+ return;
+ }
+ &popmsg(-1,"Converting pdf to ps for printing and sending file to print...",$parframe);
+ system("$pdfps_conv $slcdoc $pstmpfile");
+ last DOC_FORMAT;
+ };
+# convert html files to ps before printing
+ ($dummy[-1] =~ /htm/) && do {
+ if ($htmlps_conv eq "") {
+ &popmsg(2,"No converter available for html->ps conversion.",
+ $parframe);
+ return;
+ }
+ &popmsg(-1,"Converting html to ps for printing and sending file to print...",$parframe);
+ my $htmlps_redir_sign=($htmlps_redir == 1) ? ">" :"";
+ system("$htmlps_conv $slcdoc $htmlps_redir_sign $pstmpfile");
+ last DOC_FORMAT;
+ };
+# convert txt files to ps before printing
+ ($dummy[-1] =~ /txt/ || $dummy[-1] =~ /faq$/
+ || $dummy[-1] =~ /README/i) && do {
+ if ($txtps_conv eq "") {
+ &popmsg(2,"No converter available for txt->ps conversion.",
+ $parframe);
+ return;
+ }
+ &popmsg(-1,"Converting txt to ps for printing and sending file to print...",$parframe);
+ my $txtps_redir_sign=($txtps_redir == 1) ? ">" :"";
+ system("$txtps_conv $slcdoc $txtps_redir_sign $pstmpfile");
+ last DOC_FORMAT;
+ };
+# convert extracted comments from sty files to ps before printing
+ ($dummy[-1] =~ /sty$/) && do {
+ if ($txtps_conv eq "") {
+ &popmsg(2,"No converter available for sty(txt)->ps conversion.",
+ $parframe);
+ return;
+ }
+ &popmsg(-1,"Converting sty(txt) to ps for printing and sending file to print...",$parframe);
+# try to get doc out of .sty file
+ &popmsg(-1,'Trying to extract documentation out of .sty file;
+might be cluttered with program comments.',
+ $parframe);
+ $slcdoc=&stripsty($slcdoc,substr($slc,7));
+ my $txtps_redir_sign=($txtps_redir == 1) ? ">" :"";
+ system("$txtps_conv $slcdoc $txtps_redir_sign $pstmpfile");
+ last DOC_FORMAT;
+ };
+ &popmsg(2,"$dummy[-1]: cannot print document format",$parframe);
+ return;
+ };
+ system("$print_cmd $pstmpfile");
+}
+
+# test existence and search a documentation which is not in specified place
+sub finddoc {
+ my($slcdoc,$slc,$parframe)=@_;
+ my ($dummy,$status);
+ SLCDOCFIND: foreach ($texdocpath,$distdocpath,$docdocpath) {
+ $slcdoc="$_/$slc";
+ if (-e $slcdoc) {
+# found where it should be
+ return $slcdoc;
+ } else {
+# see if the documentation file is in the local doc tree...
+ my @srchslcdoc=($slcdoc);
+ if ($localdocpath) {
+ push @srchslcdoc,"$localdocpath/$slc";
+ return $srchslcdoc[-1] if (-e $srchslcdoc[-1]);
+ }
+# ... or the user's doc tree...
+ if ($homedocpath) {
+ push @srchslcdoc,"$homedocpath/$slc";
+ return $srchslcdoc[-1] if (-e $srchslcdoc[-1]);
+ }
+# ... otherwise proceed with searching
+ $status=-1;
+# see if the documentation file is compressed
+ CMPREND: foreach my $cmprtype ("gz","bz2","zip") {
+ foreach (@srchslcdoc) {
+ $dummy="$_.$cmprtype";
+ if (-e $dummy) { # yes, it is compressed
+ $tmpfno=&randname;
+ my $rawname=basename($slc,"");
+ $slcdoc="${TempDir}/texdoc_$tmpfno$rawname";
+ push @tmpfiles,$slcdoc;
+ my ($dcmp,$dcmp_opt);
+ COMPRESS: { # determine compression type
+ ($cmprtype eq "gz") && do {
+ $dcmp="gzip";
+ $dcmp_opt="-cd";
+ last COMPRESS;
+ };
+ ($cmprtype eq "bz2") && do {
+ $dcmp="bzip2";
+ $dcmp_opt="-cd";
+ last COMPRESS;
+ };
+ ($cmprtype eq "zip") && do {
+ $dcmp="zip";
+ $dcmp_opt="-p";
+ last COMPRESS;
+ };
+ };
+# try to decompress
+ $status=system("$dcmp $dcmp_opt $dummy > $slcdoc");
+ if ($status != 0) { # failure
+ &popmsg(2,
+ "$dcmp: Couldn't decompress file, cancelling.",
+ $parframe);
+ $slcdoc="";
+ return $slcdoc;
+ }
+# last CMPREND; does not work, what we need is:
+ return $slcdoc;
+ }
+ }
+ }
+ }
+ }
+ if ($status != 0) {
+ $parframe->configure(-cursor=>'watch');
+# try to find it elsewhere with kpsewhich
+ my $rawname=basename($slc,"");
+ $slcdoc=($slcdoc =~ /\.sty$/) ?
+ `kpsewhich $rawname` :
+ `kpsewhich --format=${qq}TeX system documentation${qq} $rawname`;
+ if ($slcdoc eq "") { # nothing found; cancel
+ &popmsg(2,"$rawname not found, cancelling.",$parframe);
+ $slcdoc="";
+ }
+ $parframe->configure(-cursor=>$defcursor);
+ }
+ return $slcdoc;
+}
+
+# determine existence and show paths of files (Button-3)
+sub showpath {
+ my ($docselect,$tpbframe)=@_;
+ my $found=0;
+ if ($docselect =~ /\.sty$/) {
+ STYPATH: foreach my $fullpath ("$texmfmain/tex/$docselect",
+ "$texmfdist/tex/$docselect",
+ "$texmflocal/tex/$docselect",
+ "$texmfhome/tex/$docselect") {
+ if (-e $fullpath) {
+ &popmsg(0,"Selected file:\n$fullpath",$tpbframe);
+ $found=1;
+ last STYPATH;
+ }
+ }
+ if (!$found) {
+ &popmsg(2,"Selected file:\n$docselect\ndoes not exist.",$tpbframe) }
+ } else {
+ DOCPATH: foreach my $fullpath ("$texdocpath/$docselect",
+ "$distdocpath/$docselect",
+ "$docdocpath/$docselect",
+ "$localdocpath/$docselect",
+ "$homedocpath/$docselect") {
+ foreach ('','.gz','.bz2','.zip') {
+ my $fullpathext="$fullpath$_";
+ if (-e $fullpathext) {
+ &popmsg(0,"Selected file:\n$fullpathext",$tpbframe);
+ $found=1;
+ last DOCPATH;
+ }
+ }
+ }
+ if (!$found) {
+ &popmsg(2,"Selected file:\n$docselect\ndoes not exist (neither in normal form nor compressed).",$tpbframe) }
+ }
+}
+
+# make or destroy search entry widget
+sub mksrch {
+ if ($srchflag == 1) {
+ destroy $srchentry;
+ $srchflag=0;
+ } else {
+# get the search string
+ $srchentry=$cmdframe->Entry(-cursor=>'xterm',
+ -font=>$deffont,
+ -width=>20,
+ -takefocus=>1)->pack(-side=>'left');
+ $srchentry->focus();
+ $srchentry->bind('<Return>'=>[\&srchstr, $srchentry]);
+ $srchflag=1;
+# key binding
+ $srchentry->bind('<Control-c>'=>sub{destroy $srchentry; $srchflag=0;});
+ }
+}
+
+# search a string in @packname, @topic and @keywords
+sub srchstr {
+ my ($i,$j,$string);
+ my (@results,@reslist);
+ $main->configure(-cursor=>'watch');
+ $string=$srchentry->get();
+# search
+ if ($string) {
+ for ($i=0; $i<$ncat; ++$i) {
+ for ($j=0; $j<$maxind[$i]+1; ++$j) {
+ SRCH: {
+ ($topic[$i][$j] =~ /$string/i) && do {
+ push @results,($i,$j);
+ last SRCH;
+ };
+ (defined $keywords[$i][$j]) && do {
+ if ($keywords[$i][$j] =~ /$string/i) {
+ push @results,($i,$j);
+ last SRCH;
+ }
+ };
+ ($packname[$i][$j] =~ /$string/i) && do {
+ push @results,($i,$j);
+ last SRCH;
+ };
+ };
+ }
+ }
+ } else { # return full database
+ $string='all database entries';
+ for ($i=0; $i<$ncat; ++$i) {
+ for ($j=0; $j<$maxind[$i]+1; ++$j) { push @results,($i,$j); }
+ }
+ }
+# destroy entry widget and show results
+ destroy $srchentry;
+ $srchflag=0;
+ if (scalar @results == 0) {
+ &popmsg(0,"Search for $string: no matches found.",$cmdframe);
+ } else {
+# cancel multiple entries
+ my ($omit,$pack1,$pack2);
+ @reslist=($results[0],$results[1]);
+ for ($i=0; $i<$#results; $i+=2) {
+ $omit=0;
+ $pack1=$packname[$results[$i]][$results[$i+1]];
+ for ($j=0; $j<$#reslist; $j+=2) {
+ $pack2=$packname[$reslist[$j]][$reslist[$j+1]];
+ if ($pack1 eq $pack2) { $omit=1; last; }
+ }
+ if ($omit == 0) { push @reslist,($results[$i],$results[$i+1]); }
+ }
+ unshift @reslist,$string;
+ &tpslct(-1,@reslist);
+ }
+ $main->configure(-cursor=>$defcursor);
+}
+
+# extract documentation of .sty files; a flag in the @keywords array shows
+# where the doc is located:
+# -0-: no specific place; -1-: at end, behind \endinput; -2-: at beginning,
+# terminated by %%%%%%; -3-: at beginning, terminated with blank line
+sub stripsty {
+ my ($slcdoc,$slc)=@_;
+ my @stydoc;
+ $tmpfno=&randname;
+ my $tmpslcdoc="${TempDir}/texdoc_$tmpfno.txt";
+ push @tmpfiles,$tmpslcdoc;
+ open (STY,"$slcdoc");
+ LOC: {
+ ($stydoc{$slc} == 0) && do { # no specific place, suck in everything :-(
+ while ($line = <STY>) { push @stydoc,$line if ($line =~ /^%/); }
+ last LOC;
+ };
+ ($stydoc{$slc} == 1) && do { # at end, behind \endinput
+ while ($line = <STY>) {
+ last if ($line =~ /^\s*\\endinput/ && !($line =~ /^%/));
+ }
+ while ($line = <STY>) { push @stydoc,$line; }
+ last LOC;
+ };
+ ($stydoc{$slc} == 2) && do { # up to a certain %%%%%%%, hopefully the 1st
+ for (my $i=0; $i<9; ++$i) { $stydoc[$i]=<STY>; } # after the 8th line
+ while ($line = <STY>) {
+ last if ($line =~ /^%{4,}/);
+ push @stydoc,$line;
+ }
+ last LOC;
+ };
+ ($stydoc{$slc} == 3) && do { # up to 1st blank/apparently empty line
+ while ($line = <STY>) {
+ last if ($line =~ /^\s*$/);
+ push @stydoc,$line;
+ }
+ last LOC;
+ };
+ };
+ close(STY);
+ open(TMPSTY,">$tmpslcdoc");
+ foreach (@stydoc) { print TMPSTY $_; }
+ close(TMPSTY);
+ return $tmpslcdoc;
+}
+
+# pop up a note or an error or warning message toplevel window
+sub popmsg {
+ my($level,$msg,$parframe)=@_;
+ my $degree;
+ LEVEL: {
+ ($level == -1) && do { $degree="Info"; last LEVEL; };
+ ($level == 0) && do { $degree="Note"; last LEVEL; };
+ ($level == 1) && do {
+ return if ($quiet == 1);
+ $degree="Warning";
+ last LEVEL
+ };
+ ($level == 2) && do { $degree="Error"; last LEVEL; };
+ };
+ my $msgwin=$parframe->Toplevel(-title=>$degree);
+ my $lbl=$msgwin->Label(-text=>uc($degree),
+ -font=>$deffont)->pack(-side=>'top', -fill=>'x');
+# get size of message text
+ my @dummy=split("\n",$msg);
+ my $nline=scalar @dummy;
+ my $msgwidth=0;
+ my $lline;
+ foreach (@dummy) {
+ $lline=length $_;
+ if ($lline > $msgwidth) { $msgwidth=$lline; }
+ }
+ my $message=$msgwin->Text(-relief=>'flat',
+ -font=>$deffont,
+ -height=>$nline,
+ -width=>$msgwidth)->pack(-side=>'top');
+ $message->insert('end',$msg);
+ $message->configure(-state=>'disabled');
+ if ($level < 0) { # transient message window
+ $msgwin->after(3000,sub{destroy $msgwin});
+ } else { # persistent message window
+ $msgwin->Button(-text=>'Close',
+ -font=>$deffont,%butcol,
+ -command=>sub{destroy $msgwin})->pack(-side=>'bottom',
+ -fill=>'x');
+ $msgwin->bind('<Control-c>'=>sub{destroy $msgwin});
+ }
+}
+
+# show/change settings (don't show this to an expert :-/ )
+sub settings {
+ my ($homedocpath_tmp,$quiet_tmp,$autoview_tmp,$xfmt_viewer_tmp,
+ $dvi_viewer_tmp,$dvips_conv_tmp,
+ $ps_viewer_tmp,$pdf_viewer_tmp,$pdfps_conv_tmp,
+ $html_viewer_tmp,$htmlps_conv_tmp,$htmlps_redir_tmp,
+ $txt_viewer_tmp,$txtps_conv_tmp,$txtps_redir_tmp,$print_cmd_tmp)=
+ ($homedocpath,$quiet,$autoview,$xfmt_viewer,
+ $dvi_viewer,$dvips_conv,$ps_viewer,
+ $pdf_viewer,$pdfps_conv,$html_viewer,
+ $htmlps_conv,$htmlps_redir,$txt_viewer,
+ $txtps_conv,$txtps_redir,$print_cmd);
+ my @tdcolors_tmp=@tdcolors;
+# see if toplevel window is already there
+ if (Exists($tlwins{"setmenu"}{'addr'})) {
+ $tlwins{"setmenu"}{'addr'}->deiconify();
+ $tlwins{"setmenu"}{'addr'}->raise();
+ return;
+ }
+ my $setmenu=$main->Toplevel(-title=>'Settings');
+ $setmenu->resizable(0,0);
+ $tlwins{"setmenu"}{'addr'}=$setmenu;
+# documentation path
+ my $datlabel;
+ $datlabel="Database file(s) used: teTeX";
+ $datlabel.=", local database" if (-e $locdatabase);
+ $datlabel.=", user database" if (-e $homedatabase);
+ my $docframe=$setmenu->Frame(-relief=>'groove',
+ -borderwidth=>2)->pack(-side=>'top',
+ -fill=>'x',
+ -expand=>1);
+ my $docframestring="\nDistribution documentation root path(s):\n$texdocpath";
+ $docframestring.=", $distdocpath" if (-e $distdocpath);
+ $docframestring.=", $docdocpath" if (length $docdocpath);
+ if ($localdocpath && $localdocpath ne $texdocpath) {
+ $docframestring.="\nLocal documentation root path: $localdocpath\n";
+ }
+ $docframe->Label(-text=>"$docframestring",
+ -font=>$deffont)->pack(-side=>'top',
+ -anchor=>'w',
+ -fill=>'x',
+ -expand=>1);
+ if (defined $texmfhome && -d $texmfhome) {
+ $homedocpath_tmp=basename($homedocpath_tmp,"");
+ my $usrdocframe=$docframe->Frame(-relief=>'flat')->pack(-side=>'top',
+ -fill=>'x');
+ my $usrdoclabel=$usrdocframe->Label(-text=>"User's documentation root path: $texmfhome/",
+ -font=>$deffont)->pack(-side=>'left');
+ my $usrdocentry=$usrdocframe->Entry(-textvariable=>\$homedocpath_tmp,
+ -font=>$deffont)->pack(-side=>'left');
+ }
+ $docframe->Label(-text=>"$datlabel.",
+ -font=>$deffont)->pack(-side=>'top',
+ -anchor=>'w',
+ -ipady=>2,
+ -fill=>'x',
+ -expand=>1);
+# General viewer behaviour
+ my $genvframe=$setmenu->Frame(-label=>'General viewer behaviour',
+ -relief=>'groove',
+ -borderwidth=>2)->pack(-side=>'top',
+ -fill=>'x',
+ -ipady=>6,
+ -expand=>1);
+ my $genvframe1=$genvframe->Frame()->pack(-side=>'left');
+ my $genvsub1=$genvframe1->Frame()->pack(-side=>'top',
+ -anchor=>'w',
+ -ipady=>3);
+ my $genvecbut=$genvsub1->
+ Checkbutton(-variable=>\$quiet_tmp)->pack(-side=>'left',
+ -anchor=>'sw');
+ my $genvelabel=$genvsub1->Label(-text=>'Suppress error messages',
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'sw');
+ my $genvsub2=$genvframe1->Frame()->pack(-side=>'top',
+ -anchor=>'w');
+ my $genvscbut=$genvsub2->
+ Checkbutton(-variable=>\$autoview_tmp)->pack(-side=>'left',
+ -anchor=>'sw');
+ my $genvslabel=$genvsub2->Label(-text=>'Autostart viewer for one-item listboxes',
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'sw');
+ my $genvsub3=$genvframe1->Frame()->pack(-side=>'top',
+ -anchor=>'w');
+ my $genvxcbut=$genvsub3->
+ Checkbutton(-variable=>\$xfmt_viewer_tmp)->pack(-side=>'left',
+ -anchor=>'sw');
+ my $genvxlabel=$genvsub3->Label(-text=>'Use text viewer for unknown file format',
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'sw');
+# colours of GUI
+ my @tdcolors_d=@tdcolors_tmp;
+ $tlwins{'setmenu'}{'buttons'}[0]=
+ $genvframe->Button(-text=>'Change viewer colours',
+ -command=>sub {
+ @tdcolors_tmp=&popcolor($setmenu,@tdcolors_tmp);
+ @tdcolors_d=@tdcolors_tmp;
+ },
+ -font=>$deffont,%butcol)->pack(-side=>'right');
+# DVI
+ my $dviframe=$setmenu->Frame(-label=>'DVI',
+ -relief=>'groove',
+ -borderwidth=>2)->pack(-side=>'top',
+ -fill=>'x',
+ -ipady=>6,
+ -expand=>1);
+ my $dvisub1=$dviframe->Frame()->pack(-side=>'top',
+ -anchor=>'w');
+ my $dvisub2=$dviframe->Frame()->pack(-side=>'top',
+ -anchor=>'w',
+ -ipady=>6);
+ my $dvivlabel=$dvisub1->Label(-text=>'Viewer command',
+ -anchor=>'w',
+ -font=>$deffont)->pack(-side=>'left');
+ my $dviventry=$dvisub1->Entry(-textvariable=>\$dvi_viewer_tmp,
+ -font=>$deffont)->pack(-side=>'left');
+ my $dviclabel=$dvisub2->Label(-text=>'DVI->PS converter command',
+ -anchor=>'w',
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'sw');
+ my $dvilbwidth=length 'DVI->PS converter command';
+ $dvivlabel->configure(-width=>1.1*$dvilbwidth);
+ $dviclabel->configure(-width=>1.1*$dvilbwidth);
+ my $dvicentry=$dvisub2->Entry(-textvariable=>\$dvips_conv_tmp,
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'sw');
+# PostScript
+ my $psframe=$setmenu->Frame(-label=>'PostScript',
+ -relief=>'groove',
+ -borderwidth=>2)->pack(-side=>'top',
+ -fill=>'x',
+ -ipady=>10,
+ -expand=>1);
+ my $psvlabel=$psframe->Label(-text=>'Viewer command',
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'w');
+ my $psventry=$psframe->Entry(-textvariable=>\$ps_viewer_tmp,
+ -font=>$deffont)->pack(-side=>'left');
+# PDF
+ my $pdfframe=$setmenu->Frame(-label=>'PDF',
+ -relief=>'groove',
+ -borderwidth=>2)->pack(-side=>'top',
+ -fill=>'x',
+ -ipady=>6,
+ -expand=>1);
+ my $pdfsub1=$pdfframe->Frame()->pack(-side=>'top',
+ -anchor=>'w');
+ my $pdfsub2=$pdfframe->Frame()->pack(-side=>'top',
+ -anchor=>'w',
+ -ipady=>6);
+ my $pdfvlabel=$pdfsub1->Label(-text=>'Viewer command',
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'w');
+ my $pdfventry=$pdfsub1->Entry(-textvariable=>\$pdf_viewer_tmp,
+ -font=>$deffont)->pack(-side=>'left');
+ my $pdfclabel=$pdfsub2->Label(-text=>'PDF->PS converter command',
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'sw');
+ my $pdfcentry=$pdfsub2->Entry(-textvariable=>\$pdfps_conv_tmp,
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'sw');
+# HTML
+ my $htmlframe=$setmenu->Frame(-label=>'HTML',
+ -relief=>'groove',
+ -borderwidth=>2)->pack(-side=>'top',
+ -fill=>'x',
+ -ipady=>6,
+ -expand=>1);
+ my $htmlsub1=$htmlframe->Frame()->pack(-side=>'top',
+ -anchor=>'w');
+ my $htmlsub2=$htmlframe->Frame()->pack(-side=>'top',
+ -anchor=>'w',
+ -ipady=>6);
+ my $htmlvlabel=$htmlsub1->Label(-text=>'Viewer command',
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'w');
+ my $htmlventry=$htmlsub1->Entry(-textvariable=>\$html_viewer_tmp,
+ -font=>$deffont)->pack(-side=>'left');
+ my $htmlclabel=$htmlsub2->Label(-text=>'HTML->PS converter command',
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'sw');
+ my $htmlcentry=$htmlsub2->Entry(-textvariable=>\$htmlps_conv_tmp,
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'sw');
+ my $htmlrlabel=$htmlsub2->Label(-text=>'Output redirect needed',
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'sw');
+ my $htmlrcbut=$htmlsub2->
+ Checkbutton(-variable=>\$htmlps_redir_tmp)->pack(-side=>'left',
+ -anchor=>'sw');
+# plain text
+ my $txtframe=$setmenu->Frame(-label=>'Plain text',
+ -relief=>'groove',
+ -borderwidth=>2)->pack(-side=>'top',
+ -fill=>'x',
+ -ipady=>6,
+ -expand=>1);
+ my $txtsub1=$txtframe->Frame()->pack(-side=>'top',
+ -anchor=>'w');
+ my $txtsub2=$txtframe->Frame()->pack(-side=>'top',
+ -anchor=>'w',
+ -ipady=>6);
+ my $txtvlabel=$txtsub1->Label(-text=>'Viewer command',
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'w');
+ my $txtventry=$txtsub1->Entry(-textvariable=>\$txt_viewer_tmp,
+ -font=>$deffont)->pack(-side=>'left');
+ my $txt_view_flag;
+ if ($txt_viewer_tmp eq "TDK_OWN") {
+ $txt_view_flag=1;
+ $txtventry->configure(-state=>'disabled');
+ } else {
+ $txt_view_flag=0;
+ $txtventry->configure(-state=>'normal');
+ }
+ my $txtvilabel=$txtsub1->Label(-text=>"\tUse texdoctk\'s own viewer",
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'sw');
+ my $txtvcbut=$txtsub1->
+ Checkbutton(-variable=>\$txt_view_flag,
+ -command=>sub {
+ if ($txt_view_flag == 1) {
+ $txt_viewer_tmp="TDK_OWN";
+ $txtventry->configure(-state=>'disabled');
+ } else {
+ $txt_viewer_tmp=$txt_viewer;
+ $txtventry->configure(-state=>'normal');
+ $txtventry->focus();
+ }
+ })->pack(-side=>'left',
+ -anchor=>'sw');
+ my $txtclabel=$txtsub2->Label(-text=>'Text->PS converter command',
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'sw');
+ my $txtcentry=$txtsub2->Entry(-textvariable=>\$txtps_conv_tmp,
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'sw');
+ my $txtrlabel=$txtsub2->Label(-text=>'Output redirect needed',
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'sw');
+ my $txtrcbut=$txtsub2->
+ Checkbutton(-variable=>\$txtps_redir_tmp)->pack(-side=>'left',
+ -anchor=>'sw');
+# printer
+ my $prtframe=$setmenu->Frame(-label=>'Printer',
+ -relief=>'groove',
+ -borderwidth=>2)->pack(-side=>'top',
+ -fill=>'x',
+ -ipady=>10,
+ -expand=>1);
+ my $prtclabel=$prtframe->Label(-text=>'Command',
+ -font=>$deffont)->pack(-side=>'left',
+ -anchor=>'w');
+ my $prtcentry=$prtframe->Entry(-textvariable=>\$print_cmd_tmp,
+ -font=>$deffont)->pack(-side=>'left');
+# buttons and key bindings
+ my $setbfr=$setmenu->Frame()->pack(-side=>'bottom');
+ $tlwins{'setmenu'}{'buttons'}[1]=
+ $setbfr->Button(-text=>'OK',
+ -font=>$deffont,%butcol,
+ -command=>sub{
+ $homedocpath="$texmfhome/$homedocpath_tmp";
+ ($quiet,$autoview,$xfmt_viewer,
+ $dvi_viewer,$dvips_conv,
+ $ps_viewer,$pdf_viewer,
+ $pdfps_conv,$html_viewer,
+ $htmlps_conv,$htmlps_redir,
+ $txt_viewer,$txtps_conv,$txtps_redir,$print_cmd)=
+ ($quiet_tmp,$autoview_tmp,$xfmt_viewer_tmp,
+ $dvi_viewer_tmp,$dvips_conv_tmp,
+ $ps_viewer_tmp,
+ $pdf_viewer_tmp,$pdfps_conv_tmp,
+ $html_viewer_tmp,
+ $htmlps_conv_tmp,$htmlps_redir_tmp,
+ $txt_viewer_tmp,$txtps_conv_tmp,
+ $txtps_redir_tmp,$print_cmd_tmp);
+ @tdcolors=@tdcolors_tmp;
+ %butcol=('-background'=>$tdcolors[0],
+ '-foreground'=>$tdcolors[1],
+ '-activebackground'=>$tdcolors[2],
+ '-activeforeground'=>$tdcolors[3]);
+ foreach my $tlkey (keys %tlwins) {
+ foreach (@{$tlwins{$tlkey}{'buttons'}}) {
+ $_->configure(%butcol);
+ }
+ }
+ if ($txt_viewer eq "" &&
+ defined $ENV{PAGER}) {
+ $txt_viewer=$ENV{PAGER};
+ }
+ destroy $setmenu},
+ -width=>6)->pack(-side=>'left',
+ -padx=>10,
+ -pady=>10);
+ $tlwins{'setmenu'}{'buttons'}[2]=
+ $setbfr->Button(-text=>'Save',
+ -font=>$deffont,%butcol,
+ -command=>sub{
+ $setmenu->configure(-cursor=>'watch');
+ &popmsg(-1,"Writing settings to $myrc",$setmenu);
+ my $tdcolors_tmp=join(' ',@tdcolors_tmp);
+ &writerc($homedocpath_tmp,
+ $quiet_tmp,$autoview_tmp,$xfmt_viewer_tmp,
+ $tdcolors_tmp,
+ $dvi_viewer_tmp,$dvips_conv_tmp,
+ $ps_viewer_tmp,
+ $pdf_viewer_tmp,$pdfps_conv_tmp,
+ $html_viewer_tmp,
+ $htmlps_conv_tmp,$htmlps_redir_tmp,
+ $txt_viewer_tmp,$txtps_conv_tmp,
+ $txtps_redir_tmp,$print_cmd_tmp,$setmenu);
+ $setmenu->configure(-cursor=>$defcursor);
+ })->pack(-side=>'left',
+ -padx=>10);
+ $tlwins{'setmenu'}{'buttons'}[3]=
+ $setbfr->Button(-text=>'Cancel',
+ -font=>$deffont,%butcol,
+ -command=>sub{destroy $setmenu;
+ undef $tlwins{"setmenu"};
+ })->pack(-side=>'left',
+ -padx=>10);
+ $setmenu->bind('<Control-c>'=>sub{destroy $setmenu;
+ undef $tlwins{"setmenu"};});
+}
+
+# dialog toplevel for color settings
+sub popcolor {
+ my ($parframe,@entryvar)=@_;
+# see if toplevel window is already there
+ if (Exists($tlwins{'chngcol'}{'addr'})) {
+ $tlwins{'chngcol'}{'addr'}->deiconify();
+ $tlwins{'chngcol'}{'addr'}->raise();
+ return;
+ }
+ my $dlgwin=$parframe->Toplevel(-title=>'Change colours');
+ $dlgwin->resizable(0,0);
+ $tlwins{'chngcol'}{'addr'}=$dlgwin;
+# entry widgets for default/active back/foreground
+ $dlgwin->Label(-text=>'Enter colours as names or RGB #xxxxxx values',
+ -font=>$deffont)->pack(-side=>'top');
+ my $dlgdef=$dlgwin->Frame()->pack(-side=>'top');
+ my $dlgact=$dlgwin->Frame()->pack(-side=>'top');
+ my $dlgdef1=$dlgdef->Frame()->pack(-side=>'left');
+ my $dlgtfr0=$dlgdef1->Frame()->pack(-side=>'top');
+ my $dlgtfr1=$dlgdef1->Frame()->pack(-side=>'top');
+ my $dlgact1=$dlgact->Frame()->pack(-side=>'left');
+ my $dlgtfr2=$dlgact1->Frame()->pack(-side=>'top');
+ my $dlgtfr3=$dlgact1->Frame()->pack(-side=>'top');
+ $dlgtfr0->Label(-text=>"Default background",
+ -anchor=>'w',
+ -width=>18,
+ -font=>$deffont)->pack(-side=>'left');
+ $dlgtfr0->Entry(-textvariable=>\$entryvar[0],
+ -font=>$deffont)->pack(-side=>'left');
+ $dlgtfr1->Label(-text=>"Default foreground",
+ -anchor=>'w',
+ -width=>18,
+ -font=>$deffont)->pack(-side=>'left');
+ $dlgtfr1->Entry(-textvariable=>\$entryvar[1],
+ -font=>$deffont)->pack(-side=>'left');
+ my $deflabel=$dlgdef->Label(-text=>'Default',
+ -relief=>'ridge',
+ -width=>10,
+ -height=>2)->pack(-side=>'right',
+ -padx=>7);
+ $dlgtfr2->Label(-text=>"Active background",
+ -anchor=>'w',
+ -width=>18,
+ -font=>$deffont)->pack(-side=>'left');
+ $dlgtfr2->Entry(-textvariable=>\$entryvar[2],
+ -font=>$deffont)->pack(-side=>'left');
+ $dlgtfr3->Label(-text=>"Active foreground",
+ -anchor=>'w',
+ -width=>18,
+ -font=>$deffont)->pack(-side=>'left');
+ $dlgtfr3->Entry(-textvariable=>\$entryvar[3],
+ -font=>$deffont)->pack(-side=>'left');
+ my $actlabel=$dlgact->Label(-text=>'Active',
+ -background=>$entryvar[2],
+ -foreground=>$entryvar[3],
+ -relief=>'ridge',
+ -width=>10,
+ -height=>2)->pack(-side=>'right',
+ -padx=>7);
+# buttons
+ my $setbfr=$dlgwin->Frame()->pack(-side=>'bottom');
+ my $chngflag=0;
+ $tlwins{'chngcol'}{'buttons'}[0]=
+ $setbfr->Button(-text=>'OK',
+ -font=>$deffont,%butcol,
+ -command=>sub {
+ foreach (@entryvar) { # RGB form with leading #
+ $_="#$_" if (/^[A-Fa-f0-9]{6}$/);
+ }
+ $chngflag=1 if (&colcheck($dlgwin,@entryvar));
+ },
+ -width=>6)->pack(-side=>'left',
+ -padx=>5,
+ -pady=>10);
+ $tlwins{'chngcol'}{'buttons'}[1]=
+ $setbfr->Button(-text=>'Preview',
+ -font=>$deffont,%butcol,
+ -command=>sub {
+ foreach (@entryvar) { # RGB form with leading #
+ $_="#$_" if (/^[A-Fa-f0-9]{6}$/);
+ }
+ if (&colcheck($dlgwin,@entryvar)) {
+ $deflabel->
+ configure(-background=>$entryvar[0],
+ -foreground=>$entryvar[1]);
+ $actlabel->
+ configure(-background=>$entryvar[2],
+ -foreground=>$entryvar[3]);
+ }
+ },
+ -width=>6)->pack(-side=>'left',
+ -padx=>5,
+ -pady=>10);
+ $tlwins{'chngcol'}{'buttons'}[2]=
+ $setbfr->Button(-text=>'Cancel',
+ -font=>$deffont,%butcol,
+ -command=>sub{destroy $dlgwin;
+ undef $tlwins{'chngcol'};
+ })->pack(-side=>'right',
+ -padx=>5,
+ -pady=>10);
+ $dlgwin->bind('<Control-c>'=>sub{destroy $dlgwin;
+ undef $tlwins{'chngcol'}; });
+ $dlgwin->waitVariable(\$chngflag);
+ destroy $dlgwin;
+ undef $tlwins{'chngcol'};
+ return @entryvar;
+}
+
+# check colours set in popcolor; relies on the existence of X11's showrgb
+sub colcheck {
+ my ($dlgwin,@entryvar)=@_;
+ my $ecnt=0;
+ foreach (@entryvar) { # all colours defined?
+ last unless ($_);
+ ++$ecnt;
+ }
+ &popmsg(2,'Some colours undefined.',$dlgwin) if ($ecnt != 4);
+ my $defcol=0;
+ if (`which showrgb`) { # test for proper name
+ my @rgb=`showrgb`;
+ my @norgb;
+ foreach my $colour (@entryvar) {
+ if ($colour =~ /^#[A-Fa-f0-9]{6}$/ || grep /\b$colour\b/i,@rgb) {
+ ++$defcol;
+ } else {
+ push @norgb,$colour;
+ }
+ }
+ if ($defcol != 4) {
+ my $norgb=join("\n",@norgb);
+ &popmsg(2,"Some colours invalid:\n$norgb",$dlgwin);
+ }
+ } else { $defcol=4; }
+ return ($ecnt == 4 && $defcol == 4) ? 1 : 0;
+}
+
+# write user's ~/.texdocrc
+sub writerc {
+ use File::Copy qw/cp mv/;
+ my ($homedocpath_tmp,$quiet_tmp,$autoview_tmp,$xfmt_viewer_tmp,
+ $tdcolors_tmp,
+ $dvi_viewer_tmp,$dvips_conv_tmp,
+ $ps_viewer_tmp,
+ $pdf_viewer_tmp,$pdfps_conv_tmp,
+ $html_viewer_tmp,
+ $htmlps_conv_tmp,$htmlps_redir_tmp,
+ $txt_viewer_tmp,$txtps_conv_tmp,
+ $txtps_redir_tmp,$print_cmd_tmp,$parframe)=@_;
+ my $err=0;
+ mv $myrc,"$myrc.save" if (-e $myrc);
+ open(MYRC,">$myrc");
+ print MYRC "# user's .texdocrc, generated by program\n
+# root of user's doc directory (from \$HOMETEXMF)
+# can be left empty if \$TEXMFHOME is undefined
+HOMEDOCPATH=$homedocpath_tmp
+# general viewer behaviour (y or yes to make active)
+QUIET=$quiet_tmp
+AUTOVIEW=$autoview_tmp
+XFMT_VIEWER=$xfmt_viewer_tmp
+# button colours: default and active back-/foreground
+# names and RGB values are both allowed; use the form #xxxxxx for RGB
+TDCOLORS=$tdcolors_tmp
+# the following variables contain whole commands, i.e. options can be given
+# DVI settings
+DVI_VIEWER=$dvi_viewer_tmp
+DVIPS_CONV=$dvips_conv_tmp
+# PostScript handling
+PS_VIEWER=$ps_viewer_tmp
+# PDF handling
+PDF_VIEWER=$pdf_viewer_tmp
+PDFPS_CONV=$pdfps_conv_tmp
+# HTML handling
+HTML_VIEWER=$html_viewer_tmp
+HTMLPS_CONV=$htmlps_conv_tmp
+# HTMLPS_REDIR must be on, if the html->ps converter normally writes its output
+# to stdout instead of a file (e.g. as html2ps) (y or yes to make active)
+HTMLPS_REDIR=$htmlps_redir_tmp
+# Plain text handling
+# TDK_OWN is texdoctk's own text file viewer
+TXT_VIEWER=$txt_viewer_tmp
+TXTPS_CONV=$txtps_conv_tmp
+# TXTPS_REDIR must be on, if the txt->ps converter normally writes its output
+# to stdout instead of a file (e.g. as a2ps) (y or yes to make active)
+TXTPS_REDIR=$txtps_redir_tmp
+# printer
+PRINT_CMD=$print_cmd_tmp
+\n# end of config\n";
+ close(MYRC);
+}
+
+# help window (toplevel)
+sub helptext {
+# see if toplevel window is already there
+ if (Exists($tlwins{"helptext"}{'addr'})) {
+ $tlwins{"helptext"}{'addr'}->deiconify();
+ $tlwins{"helptext"}{'addr'}->raise();
+ return;
+ }
+ my $help=$main->Toplevel(-title=>'Help/About');
+ $help->resizable(0,1);
+ $tlwins{'helptext'}{'addr'}=$help;
+ $help->Label(-text=>"texdoctk
+TeX documentation browser
+ v.0.6.0a (Nov 5, 2004)",
+ -font=>$deffont)->pack(-side=>'top',
+ -ipady=>10,
+ -anchor=>'s');
+ my $helpbody=$help->Scrolled("Text",
+ -relief=>'flat',
+ -font=>$deffont,
+ -height=>20,
+ -width=>60,
+ -scrollbars=>"e")->pack(-side=>'top',
+ -fill=>'y',
+ -expand=>1);
+ my $pos=tell DATA;
+ while (<DATA>) {
+ $_ =~ s/\$sysrc/$sysrc/;
+ last if (/^#/);
+ $helpbody->insert('end',$_);
+ }
+ seek(DATA,$pos,0);
+ $helpbody->configure(-state=>'disabled');
+ $tlwins{'helptext'}{'buttons'}[0]=
+ $help->Button(-text=>'Close',
+ -font=>$deffont,%butcol,
+ -command=>sub{destroy $help;
+ undef $tlwins{"helptext"};
+ })->pack(-side=>'bottom',
+ -fill=>'x');
+ $help->bind('<Control-c>'=>sub{destroy $help; undef $tlwins{"helptext"};});
+}
+
+# read config file; personal settings override the default settings
+sub readrc {
+ my($rcfile,$icall)=@_;
+ my ($var,$val);
+ my $pathflag=0;
+ my $pathflagl=0;
+ my $pathflagh=0;
+ my $tdcolors='';
+# for backward compatibility of converter/printer options
+ my ($dvips_opts,$pdfps_opts,$print_opts);
+# read defaults resp. local/personal settings
+ CALL: {
+ ($icall == 1) && do {
+ open (RC,"$rcfile") ||
+ &fatalmsg("Couldn't open system-wide default config file ${TeXDocRcDefaults}.\n");
+ last CALL;
+ };
+ ($icall == 2) && do {
+ open (RC,"$rcfile") ||
+ &fatalmsg("Couldn't open personal config file ~/.texdocrc.\n");
+ last CALL;
+ };
+ };
+ while ($line = <RC>) {
+ next if ($line =~ /^($|#)/);
+ chomp $line;
+ ($var,$val)=split("=",$line,2);
+ RCVARS: {
+ ($var =~ /texdocpath/i) && do { # TEXDOCPATH
+ if (length $val > 0) {
+ $pathflag=1;
+ eval(join("",("\$",lc($var),"=\$val")));
+ }
+ last RCVARS;
+ };
+ ($var =~ /localdocpath/i) && do { # LOCALDOCPATH
+ if (length $val > 0) {
+ $pathflagl=1;
+ eval(join("",("\$",lc($var),"=\$val")));
+ }
+ last RCVARS;
+ };
+ ($var =~ /homedocpath/i) && do { # HOMEDOCPATH
+ if ($icall == 2 && length $val > 0) { # set only in ~/.texdocrc
+ $pathflagh=1;
+ eval(join("",("\$",lc($var),"=\$val")));
+ }
+ last RCVARS;
+ };
+ # other variables
+ eval(join("",("\$",lc($var),"=\$val")));
+ };
+ }
+ close(RC);
+# find texmf/doc, and possibly other distribution texmf trees
+ if ($rcfile eq $sysrc || $pathflag == 1) {
+ $texmfmain=`kpsewhich --expand-path=${qq}\$TEXMFMAIN${qq}`;
+ chomp $texmfmain;
+ $texdocpath="$texmfmain/$texdocpath";
+ $texmfdist=`kpsewhich --expand-path=${qq}\$TEXMFDIST${qq}`;
+ chomp $texmfdist;
+ $distdocpath=join('/',"$texmfdist",basename($texdocpath,""))
+ if (length $texmfdist);
+ # TeXLive has this texmf-doc
+ $texmfdoc=join('/',"$texmfmain-doc",basename($texdocpath,""));
+ if (-e $texmfdoc) {
+ chomp $texmfdoc;
+ $docdocpath="$texmfdoc/$docdocpath";
+ }
+ }
+# find texmf-local/doc, if there is one
+ if ($rcfile eq $sysrc || $pathflagl == 1) {
+ $texmflocal=`kpsewhich --expand-path=${qq}\$TEXMFLOCAL${qq}`;
+ chomp $texmflocal;
+ if (length $texmflocal) {
+ # if LOCALDOCPATH is not explicitly defined, it equals TEXDOCPATH
+ unless (defined $localdocpath) {
+ $localdocpath=basename($texdocpath,"");
+ }
+ $localdocpath="$texmflocal/$localdocpath";
+ }
+ }
+# find user's $HOMETEXMF/doc, if there is one
+ if ($icall == 2 || $pathflagh == 1) {
+ $texmfhome=`kpsewhich --expand-path=${qq}\$HOMETEXMF${qq}`;
+ chomp $texmfhome;
+ if (length $texmfhome) {
+ # if HOMEDOCPATH is not explicitly defined, it equals TEXDOCPATH
+ unless (defined $homedocpath) {
+ $homedocpath=basename($texdocpath,"");
+ }
+ $homedocpath="$texmfhome/$homedocpath";
+ }
+ }
+# colours: create array
+ @tdcolors=split(' ',$tdcolors);
+ if (scalar @tdcolors != 4) { # if old texdocrc file is used
+ if (!(-e $myrc) || (-e $myrc && $icall == 2)) {
+ print "NOTE: Button colours not set in $rcfile; using defaults.\n";
+ @tdcolors=('#d9d9d9','Black','#ececec','red');
+ }
+ }
+ %butcol=('-background'=>$tdcolors[0],
+ '-foreground'=>$tdcolors[1],
+ '-activebackground'=>$tdcolors[2],
+ '-activeforeground'=>$tdcolors[3]);
+# viewer: suppress viewer warnings/use $PAGER if no $txt_viewer is defined
+ $quiet=($quiet =~ /y/i || $quiet eq "1") ? 1 : 0;
+ if (!(defined $txt_viewer) && defined $ENV{PAGER}) {
+ $txt_viewer=$ENV{PAGER};
+ }
+# viewer: autostart viewer if listbox of search results contains only 1 item
+ $autoview=($autoview =~ /y/i || $autoview eq "1") ? 1 : 0;
+# viewer: use text viewer to open files with unrecognized format
+ $xfmt_viewer=($xfmt_viewer =~ /y/i || $xfmt_viewer eq "1") ? 1 : 0;
+# converter: output redirection flags for HTML/Text->PS converters
+ $htmlps_redir=($htmlps_redir =~ /(y|1)/i) ? 1 : 0;
+ $txtps_redir=($txtps_redir =~ /(y|1)/i) ? 1 : 0;
+# for backward compatibility of converter/printer options
+ $dvips_conv.=" $dvips_opts" if ($dvips_opts);
+ $pdfps_conv.=" $pdfps_opts" if ($pdfps_opts);
+ $print_cmd.=" $print_opts" if ($print_opts);
+}
+
+# determine resolution if xwininfo is available
+# slightly modified from a patch contributed by Reinhard Kotucha
+sub x_resolution {
+ my $x_res;
+ if ($IsWin32) {
+ $x_res = &GetScreenWidth;
+ }
+ else {
+ open(XINF,"xwininfo -root|") or return 1200;
+ while (<XINF>) {
+ chop;
+ if (/Width:/) { ($x_res=$_)=/Width:\s+(\d+)/; last; }
+ }
+ close(XINF);
+ }
+ return $x_res;
+}
+
+# generate a random name for temporary files
+sub randname {
+ my $namestr;
+ my @chars=("A","B","C","D","E","F","G","H","I","J","K","L","M","N","O","P","Q","R","S","T","U","V","W","X","Y","Z","a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t","u","v","w","x","y","z");
+ my $time=time;
+ my $maxcnt=3+substr($time,-1);
+ for (my $i=0; $i<=$maxcnt; $i++) { $namestr.=$chars[rand(51)] }
+ my @tmp=split(/./,$time/$$);
+ $namestr.=$tmp[1];
+ until (length($namestr) > 16) { $namestr.=int(rand(1000000)) }
+ return $namestr;
+}
+
+# find index of an array entry
+sub arrindex {
+ my @array=@_;
+ my $item=pop @array;
+ my $i=0;
+ foreach (@array) {
+ last if ($_ eq $item);
+ ++$i;
+ }
+ return $i;
+}
+
+# clean up and exit
+sub clean_exit {
+ foreach (@tmpfiles) { if (-e $_) { unlink $_; } }
+ exit;
+}
+
+# alternative main window, launched for fatal error messages on startup
+sub fatalmsg {
+ my($msg)=@_;
+ print STDERR $msg; # also print to stderr
+# create frame for main window
+ my $main=new MainWindow;
+ $main->resizable(0,0);
+ $main->title("TeX Documentation Browser");
+ $main->bind('<Control-q>'=>sub { exit });
+ $main->bind('<Control-k>'=>sub { exit });
+ my $msgframe=$main->Frame(-background=>"#ffcc99");
+ my $cmdframe=$main->Frame;
+ $msgframe->pack(-side=>'top');
+ $cmdframe->pack(-side=>'bottom',-fill=>'x');
+# make buttons for command frame
+ my $Qbut=$cmdframe->Button(-text=>'Kill',%butcol,
+ -command=>sub { exit })->pack(-fill=>'x');
+# define common default font for labels and text explicitly
+ my @deffont=$Qbut->configure(-font);
+# ensure readability on high-res screens (suggested by R.Kotucha)
+ $deffont='Helvetica -16 bold' if &x_resolution > 1200;
+ $Qbut->configure(-font=>$deffont);
+ $msgframe->Label(-text=>'FATAL ERROR',
+ -font=>$deffont)->pack(-side=>'top', -fill=>'x');
+# get size of message text
+ my @dummy=split("\n",$msg);
+ my $nline=scalar @dummy;
+ my $msgwidth=0;
+ my $lline;
+ foreach (@dummy) {
+ $lline=length $_;
+ if ($lline > $msgwidth) { $msgwidth=$lline; }
+ }
+ my $message=$msgframe->Text(-relief=>'flat',
+ -font=>$deffont,
+ -height=>$nline,
+ -width=>$msgwidth)->pack(-side=>'top');
+ $message->insert('end',$msg);
+ $message->configure(-state=>'disabled');
+ MainLoop;
+}
+
+if ($IsWin32) {
+ sub GetScreenWidth {
+ my $GetDeviceCaps = new Win32::API('gdi32', 'GetDeviceCaps', 'NN', 'N');
+ my $HORZRES = 8; # from WinGDI.h
+ if(not defined $GetDeviceCaps) {
+ die "Can't import API GetDeviceCaps: $!\n";
+ }
+ return $GetDeviceCaps->Call(0, $HORZRES);
+ }
+
+ sub GetTempPath {
+ my $GetTempPath = new Win32::API('kernel32', 'GetTempPath', 'NP', 'N');
+ if(not defined $GetTempPath) {
+ die "Can't import API GetTempPath: $!\n";
+ }
+ my $lpBuffer = " " x 260;
+
+ $GetTempPath->Call(80, $lpBuffer);
+ }
+
+ sub ShellExecute {
+ my ($command, $file) = @_;
+ my $ShellExecute = new Win32::API('shell32', 'ShellExecute', 'NPPPPN', 'N');
+ if(not defined $ShellExecute) {
+ die "Can't import API ShellExecute: $!\n";
+ }
+ $ShellExecute->Call(0, $command, $file, '', '', 0);
+ }
+
+ sub GetHomeDir {
+ my $home = $ENV{'HOME'};
+ # Should check for CSIDL_...
+ return $home;
+ }
+}
+__END__
+Many TeX programmers provide more or less detailed manuals for
+their programs or packages. They are usually available as .dvi,
+.ps, .pdf, .html or plain text files (sometimes included in the
+.sty files instead of a separate documentation file) and can be
+accessed with this browser, which is simply an interface to find a
+documentation more easily. It starts the respective viewer for
+reading the selected documentation making use of a database file
+which contains the path entries according to the current teTeX
+texmf/doc structure; additional usage of a system-wide local and
+of individual user texmf trees with corresponding databases is also
+possible.
+The documentations are grouped in several categories shown in the
+main window; pressing one of its buttons lists all documentations
+belonging to this topic.
+The topic window lets you select one documentation file, view or
+send it to the default printer. By right-clicking on the selected
+item you get the complete path of the file.
+The search button of the main window allows you to search the
+database for a string; it does not search file names. Enter the
+string and hit <Return> to start the search or <Control-c> to
+cancel. Just hitting <Return> without typing something in will
+show the full list of files in the database.
+Defaults for the documentation root directory, the viewers, the
+converters, certain options and the printer are set in the global
+configuration file $sysrc.
+However, each user can put a copy of it as .texdocrc into his home
+directory to modify them according to his needs; modification or
+generation of ~/.texdocrc can also be done with the Settings menu.
+Additionally, the settings can be changed temporarily with this
+menu.
+
+The following key shortcuts are defined for use with the browser:
+ <Ctrl-q> Quit browser
+ <Ctrl-m> Raise the Main window to the foreground
+ <Ctrl-s> Search a keyword in database (case insensitive)
+ <Ctrl-c> Cancel/close subwindow or search entry widget
+ <Ctrl-v> View selected document (topic windows)
+ <Ctrl-p> Print selected document (topic windows)
+ <Ctrl-t> Open settings menu
+ <Ctrl-k> Kill fatal error message window (same as
+ <Ctrl-q>)
+ <Ctrl-h> Open this help
+ <Return> Equivalent to button press;
+ OK in selection menu and search
+ <Tab> Next/previous widget
+
+There are the following command line options:
+ -a autostart viewer if a listbox of search results
+ contains only one item; can also be set in a
+ configuration file
+ -v disable suppression of viewer messages sent to
+ stderr and of certain permanent message popup
+ windows, in case this was not set in a
+ configuration file; default: off
+
+Some more information is available in the manpage of texdoctk.
+
+Comments and suggestions to:
+Thomas Ruedas
+tr@dlc.ku.dk or tex-k@tug.org
+# Local Variables:
+# mode: perl
+# auto-fill-hook: do-auto-fill
+# End:
diff --git a/Build/source/texk/texlive/linked_scripts/thumbpdf.pl b/Build/source/texk/texlive/linked_scripts/thumbpdf.pl
new file mode 100755
index 00000000000..02ed86e190f
--- /dev/null
+++ b/Build/source/texk/texlive/linked_scripts/thumbpdf.pl
@@ -0,0 +1,1565 @@
+eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}' && eval 'exec perl -S $0 $argv:q'
+ if 0;
+use strict;
+$^W=1; # turn warning on
+#
+# thumbpdf.pl
+#
+# Copyright (C) 1999-2008 Heiko Oberdiek.
+#
+# This work may be distributed and/or modified under the
+# conditions of the LaTeX Project Public License, either version 1.3
+# of this license or (at your option) any later version.
+# The latest version of this license is in
+# http://www.latex-project.org/lppl.txt
+# and version 1.3 or later is part of all distributions of LaTeX
+# version 2003/12/01 or later.
+#
+# This work has the LPPL maintenance status "maintained".
+#
+# This Current Maintainer of this work is Heiko Oberdiek.
+#
+# See file "readme.txt" for a list of files that belong to this project.
+#
+# This file "thumbpdf.pl" may be renamed to "thumbpdf"
+# for installation purposes.
+#
+my $file = "thumbpdf.pl";
+my $program = uc($&) if $file =~ /^\w+/;
+my $version = "3.10";
+my $date = "2008/04/16";
+my $author = "Heiko Oberdiek";
+my $copyright = "Copyright (c) 1999-2008 by $author.";
+#
+# Reqirements: Perl5, Ghostscript
+# History:
+# 1999/02/14 v1.0: First release.
+# 1999/02/23 v1.1:
+# * Looking for the media box to calculate the resolution
+# for Ghostscript
+# * new option --resolution
+# 1999/03/01 v1.2:
+# * optimization: indirect objects for length values removed.
+# * "first line" from epstopdf
+# 1999/03/12 v1.3:
+# * Copyright: LPPL
+# 1999/05/05 v1.4:
+# * Detecting of cygwin32 environment.
+# * Minor corrections of output of error messages.
+# * Sharing RGB objects.
+# 1999/06/13 v1.5:
+# * gs detection extended.
+# 1999/07/27 v1.6
+# 1999/08/08 v1.7:
+# * \immediate before \pdfobj (pdfTeX 0.14a)
+# 1999/09/09 v1.8
+# 1999/09/06 v1.9:
+# * Check for direct /Length values (for jpg images)
+# 2000/01/11 v1.10:
+# * Bug fix: /Length (direct) as last entry.
+# * Direct /Length in RGB objects supported.
+# 2000/01/19 v1.11:
+# * "for (my $j=0;...;...)" replaced by "my $j; for($j=0;...;...)",
+# because there exist perl versions that have problems with.
+# 2000/02/11 v1.12:
+# * Option `clean' added.
+# * The name of thumbnail data file: jobname.tnd,
+# if thumbpdf is called: thumbpdf jobname[.pdf] [options]
+# 2000/02/22 v2.0:
+# * pdfmark support for dvips/ps2pdf route added.
+# * <jobname>.tpt replaces thumbdta.tex (for pdfTeX)
+# <jobname>.tpm (for pdfmark)
+# <jobname>.top replaces thumbopt.tex
+# * Options `useps', `modes' added,
+# `makedef' renamed to `makedata'.
+# 2000/02/28 v2.1:
+# * Environment variable `THUMBPDF' supported.
+# 2000/03/07 v2.2:
+# * Support for Distiller 3 and 4, the streams are uncompressed.
+# * Call of gs is changed in order to show the currently processed
+# page number of the pdf file.
+# * Option --printgscmd creates the command line file `thumbpdf.gs'
+# for the Ghostscript call.
+# 2000/03/22 v2.3:
+# * Bug fix: --useps now works.
+# 2000/04/10 v2.4:
+# * Fix for ActiveState Perl 5.6.0: uc line changed, fork removed.
+# (Thanks to Andreas Buehmann <andreas.buehmann@gmx.de>.)
+# * Version test for thumbpdf.tex added for users that
+# mix versions, sigh.
+# 2000/07/29 v2.5:
+# * `save' trick in call of ghostscript.
+# * Undocumented option --gspages added.
+# 2000/09/27 v2.6
+# 2000/10/27 v2.7:
+# * -dFIXEDMEDIA=0 added in gs call
+# 2001/01/12 v2.8:
+# * Bug fix in dvips mode and active option `level2':
+# pack parameter corrected for little-endian machines.
+# * /Rotate in pdf pages:
+# ghostscript versions around 6.01 have added a hack
+# in /pdfshowpage_setpage, that ignores the /Rotate entry.
+# A patch is added to disable the hack.
+# * Ghostscript uses the MediaBox for calculating the
+# page size. For version 6.50 a patch is added to use
+# the /CropBox instead.
+# 2001/03/29 v2.9:
+# * Option --password added.
+# 2001/04/02 v2.10
+# 2001/04/26 v2.11
+# * Option --antialias added (suggestion of Juergen Bausa).
+# 2002/01/11 v3.0
+# * Syntax of option --antialias changed (see readme.txt).
+# * Support for VTeX's PS mode added.
+# * Greek mode added (see readme.txt).
+# * Signal handlers added for cleanup.
+# 2002/05/26 v3.1
+# * SIG_HUP unkown in Windows.
+# * Bug fix: The signal function for __DIE__ "cleanup" aborts
+# before the error message of "die" is printed.
+# Replaced by "clean" that does not contain "exit 1".
+# * Small bug fix in mode detection and mode "vtex"
+# removed from list. "vtexpdfmark" was detected,
+# "vtex" did not work and perhaps it will be used
+# later for VTeX in PDF mode.
+# 2002/05/26 v3.2
+# * Fix: "MacOS/X: darwin" is now not interpreted as
+# Windows.
+# 2003/03/19 v3.3
+# * Fix for gs 8.00 in mode dvips:
+# THB_DistillerPatch also applied to ghostscript >= 8.00.
+# 2003/06/06 v3.4
+# * Bug fix, two forgotten "pop"s added for Distiller case.
+# 2004/10/24 v3.5
+# * Revert Cygwin detection: is unix (request by Jan Nieuwenhuizen).
+# * LPPL 1.3.
+# 2004/11/19 v3.6
+# * Bug fix for dvips mode and gs < 8.00 (/stackunderflow in pop).
+# 2004/11/19 v3.7:
+# * For easier debugging, the special thumbpdf objects of
+# thumbpdf.pdf are now valid PDF objects (dictionaries).
+# * Remove of extra '\n' before "endstream" that is added
+# by pdfTeX 1.20a.
+# 2005/07/06 v3.8:
+# * Fix because of pdfTeX 1.30.
+# 2007/11/07 v3.9:
+# * Deprecation warning of perl 5.8.8 fixed.
+# 2008/04/16 v3.10
+#
+
+### program identification
+my $title = "$program $version, $date - $copyright\n";
+
+### error strings
+my $Error = "!!! Error:"; # error prefix
+
+### string constants for Ghostscript run
+# get Ghostscript command name
+my $GS = "gs";
+$GS = "gs386" if $^O =~ /dos/i;
+$GS = "gsos2" if $^O =~ /os2/i;
+$GS = "gswin32c" if $^O =~ /mswin32/i;
+
+# Windows detection (no SIGHUP)
+my $Win = 0;
+$Win = 1 if $^O =~ /mswin32/i;
+
+my $gspages = 1;
+$gspages = 0 if $^O =~ /dos/i;
+
+### variables
+my $jobname = "";
+my $jobfile = "";
+my $pdftexfile = "";
+my $pdfmarkfile = "";
+my $psext = ".ps";
+my $pdfext = ".pdf";
+my $pdftexext = ".tpt";
+my $pdfmarkext = ".tpm";
+my $thumbprefix = "thb";
+my $envvar = "THUMBPDF";
+my $pdffile = "thumbpdf.pdf";
+my $logfile = "thumbpdf.log";
+my $texfile = "thumbpdf";
+my $package = "thumbpdf.sty";
+my $readme = "readme.txt";
+my $gscnffile = "thumbpdf.gs";
+my $gssection = "section I. `Known Problems'";
+my @cleanlist = ();
+my $resolution = 9;
+my $mode_pdftex = 0;
+my $mode_pdfmark = 0;
+my $antialias_default = "4";
+my @arglist = @ARGV;
+my $gskidrunning = 0;
+
+### option variables
+my @bool = ("false", "true");
+$::opt_device = "png16m";
+$::opt_compress = "10";
+$::opt_resolution = "";
+$::opt_modes = "pdftex";
+$::opt_gscmd = "";
+$::opt_level2 = 0;
+$::opt_help = 0;
+$::opt_quiet = 0;
+$::opt_debug = 0;
+$::opt_verbose = 0;
+$::opt_useps = 0;
+$::opt_printgscmd = 0;
+$::opt_gspages = $gspages; # undocumented
+$::opt_makepng = 1;
+$::opt_makepdf = 1;
+$::opt_makedata = 1;
+$::opt_clean = 1;
+$::opt_password = "";
+$::opt_antialias = $antialias_default;
+$::opt_greek = 0;
+
+my $usage = <<"END_OF_USAGE";
+${title}Syntax: \L$program\E [options] <jobname[.pdf|.ps]>
+Function: Support of thumbnails for pdfTeX or dvips/ps2pdf (pdfmark).
+ Thumbnails are generated by Ghostscript and the result is
+ written to data files for package `$package':
+ `<jobname>$pdftexext' (pdfTeX), `<jobname>$pdfmarkext' (pdfmark)
+Options: (defaults:)
+ --help print usage
+ --(no)quiet suppress messages ($bool[$::opt_quiet])
+ --(no)verbose verbose printing ($bool[$::opt_verbose])
+ --(no)debug debug informations ($bool[$::opt_debug])
+ --(no)makepng make thumbnails `$thumbprefix*.png' ($bool[$::opt_makepng])
+ --(no)makepdf make `$pdffile' with thumbnails as images ($bool[$::opt_makepdf])
+ --(no)makedata make data file(s) for package `$package' ($bool[$::opt_makedata])
+ --(no)clean clear temp files ($bool[$::opt_clean])
+ --(no)useps `makepng' uses `.ps' instead of `.pdf' file ($bool[$::opt_useps])
+ --(no)level2 `<jobname>.tpm' with ps level 2 features ($bool[$::opt_level2])
+ --(no)greek text in greek style (experimental) ($bool[$::opt_greek])
+ --antialias <num1>[num2] anti-aliasing, 0 = disable, 4 = max ($::opt_antialias)
+ --device|png [png]<dev> Ghostscript device for thumbnails,
+ dev = mono, gray, 16, 256, 16m ($::opt_device)
+ --resolution <res> thumbnail resolution for makepng ($resolution)
+ --compress <n> thumbnail compress level, n = 0..10 ($::opt_compress)
+ --modes <mode>[,mode] mode=pdftex|pdfmark|dvips|ps2pdf|
+ vtexpdfmark|all ($::opt_modes)
+ --password apassword for an encrypted pdf file ($::opt_password)
+END_OF_USAGE
+
+### environment variable THUMBPDF
+if ($ENV{$envvar}) {
+ unshift(@ARGV, split(/\s+/, $ENV{$envvar}));
+}
+
+### process options
+my @OrgArgv = @ARGV;
+use Getopt::Long;
+GetOptions(
+ "help!",
+ "quiet!",
+ "debug!",
+ "verbose!",
+ "device|png=s",
+ "gscmd=s",
+ "level2!",
+ "compress=i",
+ "resolution=f",
+ "modes=s",
+ "useps!",
+ "printgscmd!",
+ "gspages!",
+ "makepng!",
+ "makepdf!",
+ "makedata!",
+ "clean!",
+ "password=s",
+ "antialias=s",
+ "greek!"
+) or die $usage;
+!$::opt_help or die $usage;
+@ARGV < 2 or die "$usage$Error Too many files!\n";
+@ARGV == 1 or die "$usage$Error Missing jobname!\n";
+
+$::opt_device = "png$::opt_device" unless $::opt_device =~ /^png/;
+$::opt_quiet = 0 if $::opt_verbose;
+$::opt_clean = 0 if $::opt_debug or !$::opt_makepdf or !$::opt_makedata;
+
+$::opt_compress = 0 if $::opt_compress < 0;
+$::opt_compress = 10 if $::opt_compress > 10;
+my $J = "^^J";
+$J = "" if $::opt_compress == 10;
+
+$::opt_antialias = $antialias_default if $::opt_antialias eq "";
+$::opt_antialias =~ /^[0124][0124]?$/ or
+ die "$usage$Error Wrong value for option --antialias!\n";
+$::opt_antialias .= $::opt_antialias if length($::opt_antialias) < 2;
+my $AntiAliasText = substr($::opt_antialias, 0, 1);
+my $AntiAliasGraphics = substr($::opt_antialias, 1, 1);
+$AntiAliasText = "1" if $AntiAliasText eq "0";
+$AntiAliasGraphics = "1" if $AntiAliasGraphics eq "0";
+
+$GS = $::opt_gscmd if $::opt_gscmd;
+$gspages = $::opt_gspages;
+
+### get modes
+$::opt_modes = "\L$::opt_modes\E";
+$::opt_modes =~ s/dvips/pdfmark/g;
+$::opt_modes =~ s/ps2pdf/pdfmark/g;
+$::opt_modes =~ s/vtexpdfmark/pdfmark/g;
+$::opt_modes =~ s/vtexpdfmark/pdfmark/g;
+if ($::opt_modes =~ /pdftex/)
+{
+ $mode_pdftex = 1;
+ $::opt_modes =~ s/pdftex//g;
+}
+if ($::opt_modes =~ /pdfmark/)
+{
+ $mode_pdfmark = 1;
+ $::opt_modes =~ s/pdfmark//g;
+}
+if ($::opt_modes =~ /all/)
+{
+ $mode_pdftex = 1;
+ $mode_pdfmark = 1;
+ $::opt_modes =~ s/all//g;
+}
+$::opt_modes =~ s/\s+//g;
+$::opt_modes =~ s/,+/,/g;
+$::opt_modes =~ s/^,//;
+$::opt_modes =~ s/,$//;
+if ($::opt_modes ne "")
+{
+ die "$usage$Error Unknown mode(s): `$::opt_modes'\n";
+}
+if ($::opt_makedata)
+{
+ $mode_pdftex or $mode_pdfmark or
+ die "$usage$Error Missing mode!\n";
+}
+
+### get jobname
+$jobname = $ARGV[0];
+if ($::opt_useps)
+{
+ $jobname =~ s/\.ps$//i;
+ $jobname =~ s/\\/\//g;
+ $jobfile = $jobname . $psext;
+}
+else
+{
+ $jobname =~ s/\.pdf$//i;
+ $jobname =~ s/\\/\//g;
+ $jobfile = $jobname . $pdfext;
+}
+$pdftexfile = $jobname . $pdftexext;
+$pdfmarkfile = $jobname . $pdfmarkext;
+
+print $title unless $::opt_quiet;
+
+print "* jobname: `$jobname'\n" if $::opt_verbose;
+
+if ($::opt_debug) {
+ print <<"END_DEB";
+* OSNAME: $^O
+* PERL_VERSION: $]
+* ARGV: @OrgArgv
+END_DEB
+}
+
+### set signals
+$SIG{__DIE__} = \&clean;
+setsignals(\&cleanup);
+
+my $MaxThumb = 0;
+
+###
+### make thumbnails
+###
+if ($::opt_makepng)
+{
+ print "*** make png files / run Ghostscript ***\n"
+ unless $::opt_quiet or $::opt_printgscmd;
+ if ($::opt_useps)
+ {
+ print "* ps file: $jobfile\n" if $::opt_verbose;
+ }
+ else
+ {
+ print "* pdf file: $jobfile\n" if $::opt_verbose;
+ }
+ print "* Ghostscript command: `$GS'\n" .
+ "* Ghostscript png device: `$::opt_device'\n" if $::opt_verbose;
+
+ if ($::opt_resolution)
+ {
+ $resolution = $::opt_resolution
+ }
+ else
+ {
+ # looking for MediaBox
+
+ my $max_x = 0;
+ my $max_y = 0;
+ {
+ my $MB = $jobfile;
+ open(MB, $MB) or die "$Error Cannot open `$MB'!\n";
+ binmode(MB);
+ my $xy_patt = '[\-\.\d]';
+ while (<MB>)
+ {
+ if (/\/MediaBox\s*\[\s*($xy_patt+)\s+($xy_patt+)\s+($xy_patt+)\s+($xy_patt+)\s*\]/)
+ {
+ my $x = $3 - $1;
+ my $y = $4 - $2;
+ $max_x = $x if $x > $max_x;
+ $max_y = $y if $y > $max_y;
+ }
+ }
+ close(MB);
+ }
+ if ($max_x <= 0 || $max_y <= 0)
+ {
+ print "!!! Warning: MediaBox not found, " .
+ "using default resolution: $resolution DPI\n";
+ }
+ else
+ {
+ print "* Max. Size of MediaBox: $max_x x $max_y\n" if $::opt_verbose;
+
+ my $rx = 106 * 72 / $max_x;
+ my $ry = 106 * 72 / $max_y;
+ $resolution = $rx;
+ $resolution = $ry if $ry < $rx;
+ print "* Resolution: $resolution DPI\n" if $::opt_verbose;
+ }
+ }
+
+# Ghostscript's pdfshowpage_setpage is patched for solving
+# some problems:
+# * gs6.0* includes a hack that ignores the /Rotate entry
+# in the PDF page, if OutputFile is set.
+# gs6.50 does not need a fix and it is not applied,
+# because pdfshowpage_setpage does not contain /OutputFile.
+# * If /CropBox is set, then it should be used instead
+# of the /MediaBox entry. Because the CropBox area should
+# be part of the MediaBox, the MediaBox is overwritten
+# with the CropBox values for generating the thumbnails.
+# The fixes are only applied for versions >= 6.0, because
+# gs5.50 gets a /PageSize problem with this fix.
+#
+ my $SetPageHack = <<'SET_PAGE_HACK';
+currentglobal true setglobal
+false
+/product where {
+ pop
+ product (Ghostscript) search {
+ pop pop pop
+ revision 600 ge {
+ pop true
+ } if
+ }{pop} ifelse
+} if
+{ /pdfdict where {
+ pop
+ pdfdict begin
+ /pdfshowpage_setpage
+ [ pdfdict /pdfshowpage_setpage get
+ { dup type /nametype eq
+ { dup /OutputFile eq
+ { pop /AntiRotationHack
+ }{
+ dup /MediaBox eq revision 650 ge and
+ { /THB.CropHack {
+ 1 index /CropBox pget
+ { 2 index exch /MediaBox exch put
+ } if
+ } def
+ /THB.CropHack cvx
+ } if
+ } ifelse
+ } if
+ } forall
+ ] cvx def
+ end
+ } if
+} if
+setglobal
+SET_PAGE_HACK
+
+ my $Greek = "";
+ $Greek = <<'END_GREEK' if $::opt_greek;
+currentglobal true setglobal
+userdict begin
+ % * Patch for `show'
+ /THB_ORG_show {show} bind def
+ /THB_greekstring
+ /.charboxpath where
+ {
+ pop
+ {
+ currentpoint newpath moveto
+ true .charboxpath closepath fill
+ } bind def
+ }{
+ {
+ {
+ 1 string dup 0 4 -1 roll put
+ dup stringwidth pop exch
+ true charpath flattenpath pathbbox
+ 2 index sub exch 3 index sub exch rectfill
+ 0 rmoveto
+ } forall
+ } bind def
+ } ifelse
+ /show {
+ currentfont /FontType get 1 eq
+ {
+ dup
+ gsave
+ % assuming white background
+ [ currentrgbcolor ]
+ { 1 add 2 div } forall
+ setrgbcolor
+ THB_greekstring
+ grestore
+ stringwidth pop 0 rmoveto
+ }{
+ THB_ORG_show
+ } ifelse
+ } bind def
+
+ % * Patch for the PDF case
+ userdict /GS_PDF_ProcSet known
+ {
+ % GS_PDF_ProcSet is readonly, so it will be copied first
+ GS_PDF_ProcSet length 10 add dict dup
+ GS_PDF_ProcSet {
+ put dup
+ } forall
+ /GS_PDF_ProcSet exch def
+ dup
+ begin
+ % `setshowstate' contains the use of `show', so it has to
+ % be overwritten, because it was defined with `bind'.
+ % The definition is taken from `pdf_ops.ps'.
+ revision 710 lt
+ { % 5.50, 6.51, 7.00, 7.02
+
+/setshowstate
+ { WordSpacing 0 eq TextSpacing 0 eq and
+ { TextRenderingMode 0 eq
+ { { setfillstate show } }
+ { { false charpath textrenderingprocs TextRenderingMode get exec } }
+ ifelse
+ }
+ { TextRenderingMode 0 eq
+ { WordSpacing 0 eq
+ { { setfillstate TextSpacing exch 0 exch ashow } }
+ { TextSpacing 0 eq
+ { { setfillstate WordSpacing exch 0 exch 32 exch widthshow } }
+ { { setfillstate WordSpacing exch TextSpacing exch 0 32 4 2 roll 0 exch awidthshow } }
+ ifelse
+ }
+ ifelse
+ }
+ { { WordSpacing TextSpacing
+ % Implement the combination of t3 and false charpath.
+ % Note that we must use cshow for this, because we
+ % can't parse multi-byte strings any other way.
+ % Stack: string xword xchar
+ { pop pop (x) dup 0 3 index put false charpath
+ % Stack: xword xchar ccode
+ 3 copy 32 eq { add } { exch pop } ifelse 0 rmoveto pop
+ }
+ 4 -1 roll cshow pop pop
+ textrenderingprocs TextRenderingMode get exec
+ }
+ }
+ ifelse
+ }
+ ifelse /Show gput
+ } bdef
+
+ }{ % 7.10
+
+/setshowstate
+ { WordSpacing 0 eq TextSpacing 0 eq and
+ { TextRenderingMode 0 eq
+ { { setfillstate show } }
+ { { false charpath textrenderingprocs TextRenderingMode get exec } }
+ ifelse
+ }
+ { TextRenderingMode 0 eq
+ { WordSpacing 0 eq
+ { { setfillstate TextSpacing 0 Vexch 3 -1 roll ashow } }
+ { TextSpacing 0 eq
+ { { setfillstate WordSpacing 0 Vexch 32 4 -1 roll widthshow } }
+ { { setfillstate WordSpacing 0 Vexch 32
+ TextSpacing 0 Vexch 6 -1 roll awidthshow } }
+ ifelse
+ }
+ ifelse
+ }
+ { { WordSpacing TextSpacing
+ % Implement the combination of t3 and false charpath.
+ % Note that we must use cshow for this, because we
+ % can't parse multi-byte strings any other way.
+ % Stack: string xword xchar
+ { pop pop (x) dup 0 3 index put false charpath
+ % Stack: xword xchar ccode
+ 3 copy 32 eq { add } { exch pop } ifelse 0 Vexch rmoveto pop
+ }
+ 4 -1 roll cshow pop pop
+ textrenderingprocs TextRenderingMode get exec
+ }
+ }
+ ifelse
+ }
+ ifelse /Show gput
+ } bdef
+
+ } ifelse
+ end
+ readonly pop
+ } if
+end
+setglobal
+END_GREEK
+
+ my $SetPassword = "";
+ $SetPassword = "/PDFPassword($::opt_password)def" if $::opt_password;
+
+ my $PSHeader = "save pop $SetPassword $SetPageHack $Greek";
+ $PSHeader =~ s/%\s.*\n/ /g;
+ $PSHeader =~ s/\s+/ /g;
+ $PSHeader =~ s/\s+([\(\/\[\]\{\}])/$1/g;
+ $PSHeader =~ s/([\)\[\]\{\}])\s+/$1/g;
+ $PSHeader =~ s/\s+$//;
+
+ my $AntiAlias = "";
+ $AntiAlias = "\n-dTextAlphaBits=$AntiAliasText\n" .
+ "-dGraphicsAlphaBits=$AntiAliasGraphics"
+ if $::opt_antialias;
+
+ my $gs_cmd = <<"GS_CMD_END";
+$GS$AntiAlias
+-dNOPAUSE
+-dBATCH
+-sDEVICE=$::opt_device
+-r$resolution
+-sOutputFile=$thumbprefix%d.png
+-c "$PSHeader"
+-f $jobfile
+GS_CMD_END
+ # The trick with `save' comes from `ps2pdf':
+ # Doing an initial `save' helps keep fonts from being flushed
+ # between pages.
+
+ if ($::opt_printgscmd)
+ {
+ open(GSCNF, ">$gscnffile") or die "$Error Cannot open `$gscnffile'!\n";
+ $gs_cmd =~ s/^[^\r\n]+[\r\n]+//;
+ print GSCNF $gs_cmd;
+ close(GSCNF);
+ my $options = "@arglist";
+ $options =~ s/\s*--?pr[intgscmd]*\s*/ /i;
+ $options =~ s/^\s+//;
+ $options =~ s/\s+$//;
+ print <<"END_PERL" if $::opt_verbose;
+* Perl interpreter: $^X
+* Perl script: $0
+END_PERL
+ print <<"END_GS";
+1. Run `Ghostscript' manually:
+ ==> $GS \@$gscnffile
+2. Call `thumbpdf' again with the additional option `--nomakepng':
+ ==> thumbpdf --nomakepng $options
+END_GS
+ exit(0);
+ }
+
+ chomp($gs_cmd);
+ $gs_cmd =~ s/\n/ /mg;
+ print "> $gs_cmd\n" if $::opt_verbose;
+
+ if ($::opt_debug)
+ {
+ if ($gspages)
+ {
+ print "* Ghostscript with page numbers\n";
+ }
+ else
+ {
+ print "* Ghostscript without page numbers\n";
+ }
+ }
+
+ setsignals(\&gscleanup);
+ my $capture = "";
+ if ($gspages)
+ {
+ my $newline = 0;
+ open(KID, "$gs_cmd|") or die "$Error Cannot open Ghostscript ($!)!\n";
+ *::GSKID = *KID;
+ $gskidrunning = 1;
+ my $orgbar = $|;
+ $|=1;
+ while (<KID>)
+ {
+ $capture .= $_;
+ if ($::opt_verbose)
+ {
+ print;
+ }
+ else
+ {
+ if (!$::opt_quiet)
+ {
+ print if /^Processing pages/;
+ if (/^Page\s+(\d+)/)
+ {
+ print " " if $newline;
+ $newline = 1;
+ print "[$1]";
+ }
+ }
+ }
+ }
+ $gskidrunning =0;
+ if (!close(KID))
+ {
+ if ($!)
+ {
+ die "$Error Closing Ghostscript ($!)!\n";
+ }
+ else
+ {
+ my $exitvalue = $? >> 8;
+ die "$Error Closing Ghostscript (exit status: $exitvalue)!\n";
+ }
+ }
+ print "\n" if $newline;
+ $| = $orgbar;
+ }
+ else # without pages
+ {
+ $capture = `$gs_cmd`;
+ if (!defined($capture))
+ {
+ die "$Error Cannot execute Ghostscript!\n";
+ }
+ print $capture if $::opt_verbose;
+ }
+
+ if ($capture =~ /Error:\s*(.*)\n/)
+ {
+ die <<"END_DIE";
+$Error `$1' (Ghostscript)!
+See `$readme', $gssection, for further information.
+END_DIE
+ }
+ if ($capture =~ /Unknown device:\s*(.*)\n/)
+ {
+ die "$Error Unknown device `$1' (Ghostscript)!\n";
+ }
+ if ($?)
+ {
+ my $exitvalue = $?;
+ if ($exitvalue > 255)
+ {
+ $exitvalue >>= 8;
+ die "$Error Closing Ghostscript (exit status: $exitvalue)!\n";
+ }
+ die "$Error Closing Ghostscript ($exitvalue)!\n";
+ }
+ if ($capture =~ /Processing pages \d+ through (\d+)./)
+ {
+ $MaxThumb = $1;
+ }
+ print "* max. page: $MaxThumb\n" if $::opt_debug;
+ setsignals(\&cleanup);
+}
+
+###
+### make thumbpdf.pdf file
+###
+if ($::opt_makepdf)
+{
+ print "*** make `$pdffile' / run pdfTeX ***\n" unless $::opt_quiet;
+
+ if ($MaxThumb > 0)
+ {
+ my $i;
+ for ($i=1; $i<=$MaxThumb; $i++)
+ {
+ push(@cleanlist, "$thumbprefix$i.png");
+ }
+ }
+ else
+ {
+ # get max thumb number to speed up the pdfTeX run
+ $MaxThumb = 0;
+ foreach (glob("$thumbprefix*.png"))
+ {
+ next unless /$thumbprefix(\d+).png/;
+ $MaxThumb = $1 if $1 > $MaxThumb;
+ push(@cleanlist, $_);
+ }
+ }
+
+ push(@cleanlist, $logfile);
+ push(@cleanlist, $pdffile);
+
+ my $compress = $::opt_compress;
+ $compress = 9 if $::opt_compress == 10;
+ my $cmd = "pdftex \"" .
+ "\\nonstopmode" .
+ "\\pdfcompresslevel$compress" .
+ "\\def\\thumbjob{$jobname}" .
+ "\\def\\thumbmax{$MaxThumb}" .
+ "\\input $texfile" .
+ "\"";
+ print "> $cmd\n" if $::opt_verbose;
+ my @capture = `$cmd`;
+ if (!@capture)
+ {
+ die "$Error Cannot execute pdfTeX!\n";
+ }
+ if ($::opt_verbose)
+ {
+ print @capture;
+ }
+ else
+ {
+ foreach (@capture)
+ {
+ print if /^!\s/;
+ }
+ }
+ if ($?)
+ {
+ my $exitvalue = $?;
+ if ($exitvalue > 255)
+ {
+ $exitvalue >>= 8;
+ die "$Error Closing pdfTeX (exit status: $exitvalue)!\n";
+ }
+ die "$Error Closing pdfTeX ($exitvalue)!\n";
+ }
+ # test version
+ my $versionfound = 0;
+ foreach (@capture)
+ {
+ if (/File:.*thumbpdf.*(\d\d\d\d\/\d\d\/\d\d)\s+v(\d+\.\d+)/)
+ {
+ $versionfound = 1;
+ if ($1 ne $date or $2 ne $version) {
+ print <<"END_WARN";
+!!! Warning: Version of `thumbpdf.tex' does not match with perl script!
+ Current `thumbpdf.tex': $1 v$2
+ Please install version: $date v$version
+END_WARN
+ }
+ }
+ }
+ print "!!! Warning: Version of `thumbpdf.tex' not found!\n"
+ if !$versionfound;
+
+ $_ = pop(@cleanlist);
+}
+
+###
+### parse thumbpdf.pdf
+###
+
+if ($::opt_makedata)
+{
+ push(@cleanlist, $pdffile);
+
+ print "*** parse `$pdffile' ***\n" unless $::opt_quiet;
+
+### reading file and parse obj structure
+
+ my @objno = (); # obj number
+ my @objdict = (); # boolean, object is dict
+ my @objtext = (); # text of object
+ my @objstream = (); # stream of object if any
+ my $maxobj = 0;
+
+ my @getobjindex = (); # $getobj[obj number] ==> index for $obj...[index]
+
+ # open file
+ my $PDF = $pdffile;
+ open(PDF, $PDF) or die "$Error Cannot open `$PDF'!\n";
+ binmode(PDF);
+ my $lineno = 0;
+
+ # read header
+ $_ = <PDF>; $lineno++;
+ $_ or die "$Error Cannot read header of `$PDF' or file is empty!\n";
+ /^%PDF/ or die "$Error No PDF specification found!\n";
+ print "* pdf header: $_" if ($::opt_debug);
+
+ # read body objects
+ my $count = 0;
+ while (<PDF>)
+ {
+ $lineno++;
+
+ # continue, if comment line (2nd line of PDF output by pdfTeX 1.30)
+ next if /^%/;
+
+ # stop at xref
+ last if /^xref$/;
+
+ # scan first obj line
+ /^(\d+)\s+0\s+obj\s*(<<)?$/ or
+ die "$Error `obj' expected on line $lineno!\n";
+ $objno[$count] = $1;
+ $getobjindex[$1] = $count;
+ $objdict[$count] = ($2); # boolean (if $2 exists)
+ my $stream = 0;
+ print "* obj $objno[$count]" .
+ (($objdict[$count]) ? " (dict)" : "") .
+ "\n" if $::opt_debug;
+
+ # get obj
+ $objtext[$count] = "";
+ while (<PDF>)
+ {
+ $lineno++;
+
+ if ($objdict[$count])
+ {
+ if (/^>>/)
+ {
+ last if /^>>\s+endobj$/; # obj without stream
+
+ # get stream
+ $_ = <PDF>; $lineno++;
+ /^stream$/ or die "$Error `stream' expected on line $lineno!\n";
+
+ print "* stream\n" if $::opt_debug;
+ $objstream[$count] = "";
+ while (<PDF>)
+ {
+ $lineno++;
+
+ if (/(.*)endstream$/)
+ {
+ $objstream[$count] .= $1;
+ last;
+ }
+ $objstream[$count] .= $_;
+ }
+
+ $_ = <PDF>; $lineno++;
+ /^endobj$/ or die "$Error `endobj' expected on line $lineno!\n";
+ last;
+ }
+ }
+ else # no dict
+ {
+ last if /^endobj$/;
+ }
+ $objtext[$count] .= $_;
+ }
+ $count++;
+ }
+ close(PDF);
+ $maxobj = $count;
+ print "* $maxobj objects found.\n" if $::opt_debug;
+
+### get thumbnail page numbers
+ my @thumbpageno = ();
+ my $found = 0;
+ foreach (@objtext)
+ {
+ if (/^<<\/ListThumbs\s+(.+)>>$/)
+ {
+ $_ = $1;
+ chomp;
+ @thumbpageno = split / /; # split(/ /, $_);
+ print "* ListThumbs: @thumbpageno\n" if $::opt_debug;
+ $found = 1;
+ last;
+ }
+ }
+ $found or die "$Error `/ListThumbs' not found!\n";
+ {
+ my $j;
+ for ($j=0; $j<@thumbpageno; $j++)
+ {
+ $thumbpageno[$j] = $1 if $thumbpageno[$j] =~ /^{(.+)}$/;
+ }
+ }
+
+### identify thumb objects
+
+ my @thumbobj = (); # index for @obj... with image stream
+ my @thumblength = (); # stream length values
+ my @thumbrgbobj = (); # index for @obj... with rgb stream
+ my @thumbrgblength = (); # rgb stream length values
+ my $maxthumb = 0;
+
+ $count = 0;
+ my $i;
+ for ($i=0; $i<$maxobj; $i++)
+ {
+ if ($objtext[$i] =~
+ /^\/Type\s+\/XObject\n\/Subtype\s+\/Image\n/m)
+ {
+ $thumbobj[$count] = $i;
+ $_ = $';
+ $objtext[$i] = $_;
+
+ # check width and height
+ /\/Width\s+(\d+)\n\/Height\s+(\d+)/m or
+ die "$Error width/height of thumbnail not found!\n";
+ print "* Size: $1x$2\n" if $::opt_debug;
+ print "==> Width ($1) " .
+ "of thumbnail `$thumbpageno[$count]' " .
+ "is larger than recommended (106).\n"
+ if $1 > 106;
+ print "==> Height ($2) " .
+ "of thumbnail `$thumbpageno[$count]' " .
+ "is larger than recommended (106).\n"
+ if $2 > 106;
+
+ # get stream length
+ if (/\/Length\s+(\d+)\s+([\/\>]|$)/m)
+ {
+ $thumblength[$count] = $1;
+ print "* Length (direct): $1\n" if $::opt_debug;
+ # remove whitespace after length obj
+ $objtext[$i] =~ s/(\/Length\s+\d+)\s+\n/$1\n/;
+ }
+ else # looking for indirect reference
+ {
+ /\/Length\s+(\d+)\s+0\s+R/m or
+ die "$Error `/Length' entry not found!\n";
+ # save obj text for later correction
+ my $objpre = $`;
+ my $objpost = $';
+ # look for length obj
+ $getobjindex[$1] or die "$Error Length obj not found!\n";
+ $objtext[$getobjindex[$1]] =~ /^(\d+)$/m or
+ die "$Error length value not found!\n";
+ $thumblength[$count] = $1;
+ print "* Length (indirect): $1\n" if $::opt_debug;
+ # insert obj length directly:
+ $objtext[$i] = $objpre . "/Length $1" . $objpost;
+ }
+
+ # remove \n from end of stream
+ if ($thumblength[$count] < length($objstream[$i])) {
+ chop($objstream[$i]);
+ }
+
+ # check /Indexed /DeviceRGB
+ if ($objtext[$i] =~
+ /\/ColorSpace\s+\[\/Indexed\s+\/DeviceRGB\s+(\d+)\s+(\d+)\s+0\s+R\]/m)
+ {
+ # correct thumb object text
+ $objtext[$i] =
+ "$`/ColorSpace [/Indexed /DeviceRGB $1 \\the\\pdflastobj\\ 0 R]$'";
+ # get RGB obj number
+ $getobjindex[$2] or die "$Error RGB object not found!\n";
+ $_ = $getobjindex[$2];
+ $thumbrgbobj[$count] = $_;
+ # get stream length
+ if ($objtext[$_] =~ /\/Length\s+(\d+)\s+([\/\>]|$)/m)
+ {
+ $thumbrgblength[$count] = $1;
+ print "* RGB length (direct): $1\n" if $::opt_debug;
+ $objtext[$_] =~ s/(\/Length\s+\d+)\s+\n/$1\n/;
+ }
+ else # looking for indirect reference
+ {
+ $objtext[$_] =~ /\/Length\s+(\d+)\s+0\s+R/m or
+ die "$Error Length entry of rgb object not found\n";
+ # save obj text for later correction
+ my $objrgbpre = $`;
+ my $objrgbpost = $';
+ # get rgb stream length
+ $getobjindex[$1] or die "$Error RGB length object not found!\n";
+ $objtext[$getobjindex[$1]] =~ /^(\d+)$/m or
+ die "$Error length value not found!\n";
+ $thumbrgblength[$count] = $1;
+ print "* RGB length (indirect): $1\n" if $::opt_debug;
+ # insert RGB object length directly:
+ $objtext[$_] = $objrgbpre . "/Length $1" . $objrgbpost;
+ }
+ }
+
+ $count++;
+ }
+ }
+ $maxthumb = $count;
+
+ if ($maxthumb != @thumbpageno)
+ {
+ my $pagecount = @thumbpageno;
+ die "$Error $maxthumb thumbnails found, but there should be $pagecount!\n";
+ }
+ print "* $maxthumb thumbnails found.\n" if $::opt_verbose;
+
+
+###
+### write data files
+###
+
+ my $timestamp;
+ {
+ my ($sec, $min, $hour, $mday, $mon, $year) = localtime();
+ $mon++;
+ $year += 1900;
+ $timestamp = sprintf("%04d/%02d/%02d %02d:%02d:%02d",
+ $year, $mon, $mday, $hour, $min, $sec);
+ }
+ if ($mode_pdftex)
+ {
+ print "*** write `$pdftexfile' (pdfTeX thumbnail data) ***\n"
+ unless $::opt_quiet;
+ my $DTA_PT = $pdftexfile;
+ open(DTA_PT, ">$DTA_PT") or die "$Error Cannot open `$DTA_PT'!\n";
+ binmode(DTA_PT);
+ print DTA_PT <<"END_DTA";
+% File: $DTA_PT
+% Producer: $program $version
+% Mode: pdftex
+% Date: $timestamp
+END_DTA
+ }
+ my $maxpagethumb;
+ my $dictbegin;
+ if ($mode_pdfmark)
+ {
+ print "*** write `$pdfmarkfile' (pdfmark thumbnail data) ***\n"
+ unless $::opt_quiet;
+ my $DTA_PM = $pdfmarkfile;
+ open(DTA_PM, ">$DTA_PM") or die "$Error Cannot open `$DTA_PM'!\n";
+ binmode(DTA_PM);
+
+ # write tex part
+ print DTA_PM <<"END_DTA";
+% \\iffalse
+% File: $DTA_PM
+% Producer: $program $version
+% Mode: pdfmark
+% Date: $timestamp
+% \\fi
+END_DTA
+
+ # looking for max. number of regular thumbnails
+ $maxpagethumb = $maxthumb;
+ for ($i=0; $i<$maxobj; $i++)
+ {
+ if ($objtext[$i] =~ /<<\/MaxThumbNumber\s+(\d+)>>/)
+ {
+ $maxpagethumb = $1;
+ last;
+ }
+ }
+
+ # write TeX part
+ for ($i=$maxpagethumb; $i<$maxthumb; $i++)
+ {
+ print DTA_PM "% \\DefThisThumb{$thumbpageno[$i]}\n";
+ }
+
+ # write PostScript header
+ my $dictstart = <<'END_DICT';
+ 4 dict begin
+ /enddict {
+ counttomark 2 idiv dup dict begin {def} repeat pop
+ currentdict end
+ } bind def
+END_DICT
+ chomp($dictstart);
+ $dictbegin = "[";
+ my $dictend = "enddict";
+ my $filter = "";
+ my $read = "readhexstring";
+ if ($::opt_level2)
+ {
+ $dictstart = " 3 dict begin";
+ $dictbegin = "<<";
+ $dictend = ">>";
+ $filter = " /ASCII85Decode filter";
+ $read = "readstring";
+ }
+
+ print DTA_PM <<"END_DTA";
+% \\endinput
+% TeX part ends here
+
+% PostScript definitions
+END_DTA
+
+ my $PS_Header = <<"END_HEAD";
+%
+% Default definition of pdfmark
+/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse
+%
+% Check the version of Ghostscript. If it is below 6.0,
+% the commands, that produce the thumbnails, are defined
+% to be dummies.
+%
+true
+/product where {
+ pop
+ product (Ghostscript) search {
+ pop pop pop
+ revision 600 lt {
+ (!!! Warning (thumbpdf): Ghostscript 6.0 required for thumbnails!\\n)
+ print pop false
+ } if
+ }{pop} ifelse
+} if
+{
+% Syntax: <thumb object> thisTHB -
+% thisTHB is used globally, so it is defined in the current
+% dictionary (perhaps userdict should explicitly be set).
+ /thisTHB {[ exch /Thumb exch /PAGE pdfmark} bind def
+$dictstart
+% Syntax: <page object> <thumb object> pagethumb -
+ /pagethumb {
+ [ 3 1 roll $dictbegin exch /Thumb exch $dictend /PUT pdfmark
+ } bind def
+% Syntax: <thumb object> <stream length>
+% <mark> <key value pairs> streamobj -
+%
+% Distiller ignores the compression of previously compressed
+% streams and uses its own settings. Therefore for Distiller
+% the streams are uncompressed.
+% Now ghostscript versions greater than 8 behave in the same way
+% as Distiller. Therefore detection for this versions is added.
+% The detection and patch for distiller require features of level 2
+% and the filter /FlateDecode (level 3), that is used by pdfTeX's
+% compression.
+ /THB_DistillerPatch false def
+ /languagelevel where {
+ pop
+ languagelevel 2 ge {
+ product (Distiller) search {pop pop pop true}{pop false} ifelse
+ product (Ghostscript) search {
+ pop pop pop
+ revision 800 ge
+ }{pop false} ifelse
+ or
+ {
+ (FlateDecode) {
+ pop
+% Syntax: <dict> THB_DistillerPatch <dict> false
+% <dict> THB_DistillerPatch <dict> <filter>
+ /THB_DistillerPatch {
+ dup /Filter known {
+ dup dup /Filter get exch /Filter undef
+ }{false} ifelse
+ } bind def
+ } (FlateDecode) /Filter resourceforall
+ } if
+ } if
+ } if
+ /streamobj {
+ $dictend exch
+% Stack: <thumb> <dict> <length>
+ 3 -1 roll dup
+% Stack: <dict> <length> <thumb> <thumb>
+ [ /_objdef 3 -1 roll /type /stream /OBJ pdfmark
+% Stack: <dict> <length> <thumb>
+ dup dup 5 -1 roll
+% Stack: <length> <thumb> <thumb> <thumb> <dict>
+ THB_DistillerPatch
+% Stack: <length> <thumb> <thumb> <thumb> <dict> <filter/false>
+ [ 4 -2 roll /PUT pdfmark
+% Stack: <length> <thumb> <thumb> <filter/false>
+ [ 3 1 roll currentfile${filter}
+% Stack: <length> <thumb> [ <thumb> <filter/false> <file>
+ 6 -1 roll string $read pop
+% Stack: <thumb> [ <thumb> <filter/false> <string>
+ exch dup type /booleantype ne {true} if {filter} if
+% Stack: <thumb> [ <thumb> <file>
+ /PUT pdfmark
+% Stack: <thumb>
+ [ exch /CLOSE pdfmark
+ } bind def
+}{
+% Syntax: <thumb object> thisTHB -
+ /thisTHB {pop} bind def
+ 2 dict begin
+% Syntax: <page object> <thumb object> pagethumb -
+ /pagethumb {pop pop} bind def
+% Syntax: <thumb object> <stream length>
+% <mark> <key value pairs> streamobj -
+ /streamobj {
+ cleartomark exch pop
+ string currentfile${filter}
+ exch $read pop pop
+ } bind def
+} ifelse
+END_HEAD
+ $PS_Header =~ s/%[^\r\n]*[\r\n]+//gm;
+ print DTA_PM $PS_Header;
+ print DTA_PM <<"END_DTA";
+
+% adding thumbnails to pages
+END_DTA
+
+ for ($i=0; $i<$maxpagethumb; $i++)
+ {
+ print DTA_PM <<"END_DTA";
+{Page$thumbpageno[$i]} {THB$thumbpageno[$i]} pagethumb
+END_DTA
+ }
+ print DTA_PM "\n% thumbnail data\n";
+ }
+
+ for ($i=0; $i<$maxthumb; $i++)
+ {
+ # rgb object
+ if ($thumbrgbobj[$i])
+ {
+ # find the same rgb object
+ my $j;
+ for ($j=0; $j<$i; $j++)
+ {
+ next unless $thumbrgbobj[$j];
+ next unless $objtext[$thumbrgbobj[$j]] eq
+ $objtext[$thumbrgbobj[$i]];
+ next unless $objstream[$thumbrgbobj[$j]] eq
+ $objstream[$thumbrgbobj[$i]];
+ last;
+ }
+ if ($j==$i) # not found
+ {
+ if ($mode_pdftex)
+ {
+ {
+ my $rgbstream = pdftexstream($objstream[$thumbrgbobj[$i]]);
+ my $dict = $objtext[$thumbrgbobj[$i]];
+ if ($::opt_compress == 10)
+ {
+ chomp($dict);
+ $dict =~ s/\n([^\/])/^^J\n$1/mg;
+ $dict =~ s/[ ]+\//\//mg;
+ }
+ else
+ {
+ $dict =~ s/\n/^^J\n/mg;
+ }
+ print DTA_PT <<"END_DTA";
+\\immediate\\pdfobj{<<$J
+$dict>>$J
+stream^^J
+$rgbstream
+endstream}
+\\DefRGB{$i}
+END_DTA
+ }
+ }
+ if ($mode_pdfmark)
+ {
+ {
+ my $rgbstream = pdfmarkstream($objstream[$thumbrgbobj[$i]]);
+ my $rgblength = $thumbrgblength[$i];
+ my $dict = $objtext[$thumbrgbobj[$i]];
+ $dict =~ s/\/Length\s+\d+\s*//;
+ $dict =~ s/^\s+//;
+ $dict =~ s/\s+$//;
+ print DTA_PM <<"END_DTA";
+{RGB_$i} $rgblength $dictbegin
+$dict
+streamobj
+$rgbstream
+END_DTA
+ }
+ }
+ }
+ else # $j with same rgb obj
+ {
+ $objtext[$thumbobj[$i]] =~
+ s/\\the\\pdflastobj/\\UseRGB{$j}/;
+ print "* Reuses RGB object $j for $i\n" if $::opt_debug;
+ }
+ }
+
+ # thumb object
+ if ($mode_pdftex)
+ {
+ {
+ my $dict = $objtext[$thumbobj[$i]];
+ if ($::opt_compress == 10)
+ {
+ chomp($dict);
+ $dict =~ s/\n([^\/])/^^J\n$1/mg;
+ $dict =~ s/[ ]+\//\//mg;
+ $dict =~ s/[ ]+\[/\[/mg;
+ }
+ else
+ {
+ $dict =~ s/\n/^^J\n/mg;
+ }
+ my $stream = pdftexstream($objstream[$thumbobj[$i]]);
+ print DTA_PT <<"END_DTA";
+\\immediate\\pdfobj{<<$J
+$dict>>$J
+stream^^J
+$stream
+endstream}
+\\DefThumb{$thumbpageno[$i]}
+END_DTA
+ }
+ }
+ if ($mode_pdfmark)
+ {
+ {
+ my $stream = pdfmarkstream($objstream[$thumbobj[$i]]);
+ my $length = $thumblength[$i];
+ my $dict = $objtext[$thumbobj[$i]];
+ $dict =~ s/\\the\\pdflastobj\\\s*\d+\s*R/{RGB_$i}/;
+ $dict =~ s/\\UseRGB{(\d+)}\\\s*\d+\s*R/{RGB_$1}/;
+ $dict =~ s/\/Length\s+\d+\s*//;
+ $dict =~ s/^\s+//;
+ $dict =~ s/\s+$//;
+ my $thismarker = "";
+ $thismarker = "_", if $i >= $maxpagethumb;
+ print DTA_PM <<"END_DTA";
+{THB$thismarker$thumbpageno[$i]} $length $dictbegin
+$dict
+streamobj
+$stream
+END_DTA
+ }
+ }
+ }
+
+ if ($mode_pdftex)
+ {
+ print DTA_PT "\\endinput\n";
+ close(DTA_PT);
+ }
+ if ($mode_pdfmark)
+ {
+ print DTA_PM <<"END_DTA";
+end
+% end of thumbnail data file
+END_DTA
+ close(DTA_PM);
+ }
+}
+
+sub pdftexstream
+{
+ my $str = "";
+ my $mod = 0;
+ foreach (split(//, $_[0]))
+ {
+ my $num = ord($_);
+ if ($num == 13) { $str .= '\\/'; }
+ elsif ($num < 32) { $str .= '^^' . chr($num + 64); }
+ elsif ($num == 32) { $str .= '\\~'; } # space
+ elsif ($num == 37) { $str .= '\\%'; } # percent
+ elsif ($num == 92) { $str .= '\\\\'; } # backslash
+ elsif ($num == 94) { $str .= '\\+'; } # caret
+ elsif ($num == 123) { $str .= '\\{'; } # curly brace left
+ elsif ($num == 125) { $str .= '\\}'; } # curly brace right
+ else { $str .= $_; }
+ $mod++;
+ if ($mod == 26)
+ {
+ $mod = 0;
+ $str .= "\n";
+ }
+ }
+ chomp $str;
+ return $str;
+}
+
+sub pdfmarkstream
+{
+ my $str;
+ if ($::opt_level2)
+ {
+ my $s = $_[0];
+ my $len = length($s);
+ $str = "";
+ my $i;
+ for ($i=0; $i<$len-4; $i+=4)
+ {
+ $_ = ASCII85Encode(substr($s, $i, 4));
+ s/!!!!!/z/;
+ $str .= $_;
+ }
+ my $r = $len % 4;
+ if ($r)
+ {
+ $_ = substr($s, $i, $r) . "\000\000\000";
+ $_ = ASCII85Encode(substr($_, 0, 4));
+ $str .= substr($_, 0, $r+1);
+ }
+ $str =~ s/(.{60})/$1\n/g;
+ chomp($str);
+ $str .= "~>";
+ }
+ else
+ {
+ $str = uc(unpack('H*', $_[0]));
+ $str =~ s/(.{60})/$1\n/g;
+ chomp($str);
+ }
+ return $str;
+}
+
+sub ASCII85Encode
+{
+ my $val = unpack("N", $_[0]);
+ my @c;
+ $c[4] = $val % 85 + 33;
+ $val = int($val/85);
+ $c[3] = $val % 85 + 33;
+ $val = int($val/85);
+ $c[2] = $val % 85 + 33;
+ $val = int($val/85);
+ $c[1] = $val % 85 + 33;
+ $c[0] = int($val/85) + 33;
+ return pack("C*", @c);
+}
+
+sub setsignals {
+ my $func = $_[0];
+ $SIG{'HUP'} = $func unless $Win;
+ $SIG{'INT'} = $func;
+ $SIG{'QUIT'} = $func;
+ $SIG{'TERM'} = $func;
+}
+
+sub clean {
+ if ($::opt_clean) {
+ print "*** clear temp files ***\n" unless $::opt_quiet;
+ foreach (@cleanlist) {
+ unlink;
+ }
+ }
+}
+
+sub cleanup {
+ print "\n" unless $::opt_quiet;
+ clean();
+ exit 1;
+}
+
+sub gscleanup {
+ print "\n" unless $::opt_quiet;
+ clean();
+ close(::GSKID) if $gskidrunning;
+ foreach (glob("$thumbprefix*.png")) {
+ unlink;
+ }
+ exit 1;
+}
+
+clean();
+
+print "*** ready. ***\n" unless $::opt_quiet;
+
+__END__
diff --git a/Build/source/texk/texlive/linked_scripts/tlmgr.pl b/Build/source/texk/texlive/linked_scripts/tlmgr.pl
new file mode 100755
index 00000000000..84dd1cbc426
--- /dev/null
+++ b/Build/source/texk/texlive/linked_scripts/tlmgr.pl
@@ -0,0 +1,1440 @@
+#!/usr/bin/env perl
+# $Id: tlmgr.pl 6381 2008-01-23 17:50:54Z preining $
+#
+# Copyright 2008 Norbert Preining
+# This file is licensed under the GNU General Public License version 2
+# or any later version.
+#
+# TODO:
+# - ordering or collections removal (see below for details)
+# - (?) removal does not remove created format files from TEXMFSYSVAR
+# - other features: dependency check?, ...?
+
+my $Master;
+
+BEGIN {
+ $^W = 1;
+ $Master = `kpsewhich -var-value=SELFAUTOPARENT`;
+ chomp($Master);
+ unshift (@INC, "$Master/tlpkg");
+}
+
+use TeXLive::TLPOBJ;
+use TeXLive::TLPDB;
+use TeXLive::TLConfig;
+use TeXLive::TLMedia;
+use TeXLive::TLUtils;
+use TeXLive::TLWinGoo;
+use TeXLive::TLPostActions;
+TeXLive::TLUtils->import( qw(kpsewhich member win32 merge_into) );
+use Cwd qw/abs_path/;
+use Pod::Usage;
+use Getopt::Long qw(:config no_autoabbrev require_order);
+use strict;
+
+# used variables
+# the TLMedia from which we install/update
+my $tlmediasrc;
+# the tlpdb of the install media
+my $tlpdb;
+# the local tlpdb
+my $localtlpdb;
+# a hash for saving the options saved into the local tlpdb
+my %options;
+# the location from where we install
+my $location;
+
+# option handling
+my $opt_location;
+my $opt_help = 0;
+my $opt_netarchive;
+my $opt_diskarchive;
+my $opt_gui = 0;
+
+TeXLive::TLUtils::process_logging_options();
+
+GetOptions("location=s" => \$opt_location,
+ "netarchive=s" => \$opt_netarchive,
+ "diskarchive=s" => \$opt_diskarchive,
+ "gui" => \$opt_gui,
+ "h|help|?" => \$opt_help) or pod2usage(2);
+
+my $action = shift;
+
+if (!defined($action) && !$opt_help) {
+ print "missing action\ntry 'tlmgr help' for more information.\n";
+ exit 1;
+}
+
+if (defined($action) && ($action =~ m/^help/i)) {
+ $opt_help = 1;
+}
+
+$NetArchive = $opt_netarchive if (defined($opt_netarchive));
+$DiskArchive = $opt_diskarchive if (defined($opt_diskarchive));
+
+if ($^O=~/^MSWin(32|64)$/i) {
+ pod2usage(-exitstatus => 0, -verbose => 2, -noperldoc => 1) if $opt_help;
+} else {
+ pod2usage(-exitstatus => 0, -verbose => 2) if $opt_help;
+}
+
+my $loadmediasrcerror = "Cannot load TeX Live Database from ";
+my %ret;
+
+if ($action =~ m/^generate$/i) {
+ merge_into(\%ret, action_generate());
+} elsif ($action =~ m/^gui$/i) {
+ action_gui();
+} elsif ($action =~ m/^arch$/i) {
+ merge_into(\%ret, action_arch());
+} elsif ($action =~ m/^option$/i) {
+ merge_into(\%ret, action_option());
+ # should we do postinstall stuff?
+ exit(0);
+} elsif ($action =~ m/^list$/i) {
+ merge_into(\%ret, action_list());
+ # should we do postinstall stuff?
+ exit(0);
+} elsif ($action =~ m/^install$/i) {
+ merge_into(\%ret, action_install());
+} elsif ($action =~ m/^update$/i) {
+ merge_into(\%ret, action_update());
+} elsif ($action =~ m/^backup$/i) {
+ merge_into(\%ret, action_backup());
+} elsif ($action =~ m/^restore$/i) {
+ merge_into(\%ret, action_restore());
+} elsif ($action =~ m/^search$/i) {
+ merge_into(\%ret, action_search());
+ exit(0);
+} elsif ($action =~ m/^show$/i) {
+ merge_into(\%ret, action_show());
+ exit(0);
+} elsif ($action =~ m/^remove$/i) {
+ merge_into(\%ret, action_remove());
+} elsif (($action eq "paper") || ($action eq "dvips") || ($action eq "xdvi") ||
+ ($action eq "pdftex") || ($action eq "dvipdfm") ||
+ ($action eq "dvipdfmx")) {
+ if ($opt_gui) {
+ action_gui("config");
+ }
+ my $TEXMFMAIN = `kpsewhich -var-value=TEXMFMAIN`;
+ chomp $TEXMFMAIN;
+ system("texlua", "$TEXMFMAIN/scripts/texlive/texconf.tlu", "--prog", "tlmgr", "--sys", $action, @ARGV);
+} elsif ($action =~ m/^uninstall$/i) {
+ merge_into(\%ret, action_uninstall());
+ exit(0);
+} else {
+ die "Unknown action: $action";
+}
+
+
+######################################
+
+#
+# checking the %ret hash
+if (defined($ret{'mktexlsr'})) {
+ print "running mktexlsr\n";
+ system("mktexlsr");
+}
+my $TEXMFSYSVAR = `kpsewhich -var-value=TEXMFSYSVAR`;
+chomp $TEXMFSYSVAR;
+my $TEXMFLOCAL = `kpsewhich -var-value=TEXMFLOCAL`;
+chomp $TEXMFLOCAL;
+if (defined($ret{'map'})) {
+ foreach my $m (@{$ret{'map'}}) {
+ print "$m\n";
+ system("updmap-sys --nomkmap --nohash --$m");
+ }
+ system("mktexlsr");
+ system("updmap-sys");
+}
+if (defined($ret{'format'})) {
+ print "regenerating fmtutil.cnf\n";
+ TeXLive::TLUtils::create_fmtutil($localtlpdb,
+ "$TEXMFSYSVAR/web2c/fmtutil.cnf",
+ "$TEXMFLOCAL/web2c/fmtutil-local.cnf");
+ # system("texconfig-sys", "generate", "fmtutil");
+ # running fmtutil-sys only in case that at installation time the
+ # option for building formats was selected
+ if ($localtlpdb->option_formats) {
+ print "running fmtutil-sys --missing\n";
+ system("fmtutil-sys", "--missing");
+ }
+}
+if (defined($ret{'language'})) {
+ print "regenerating language.dat\n";
+ TeXLive::TLUtils::create_language($localtlpdb,
+ "$TEXMFSYSVAR/tex/generic/config/language.dat",
+ "$TEXMFLOCAL/tex/generic/config/language-local.dat");
+ # system("texconfig-sys", "generate", "language");
+ #
+ # win32 fmtutil needs language.dat WITHOUT full specification
+ if (TeXLive::TLUtils::win32()) {
+ print "running fmtutil-sys --byhyphen language.dat\n";
+ system("fmtutil-sys", "--byhyphen", "language.dat");
+ } else {
+ print "running fmtutil-sys --byhyphen $TEXMFSYSVAR/tex/generic/config/language.dat\n";
+ system("fmtutil-sys", "--byhyphen", "$TEXMFSYSVAR/tex/generic/config/language.dat");
+ }
+}
+
+exit(0);
+
+#
+# remove_package removes a single package with all files (including the
+# tlpobj files) and the entry from the tlpdb.
+#
+sub remove_package {
+ my ($pkg, $localtlpdb, $force) = @_;
+ my $tlp = $localtlpdb->get_package($pkg);
+ my %ret;
+ if (!defined($tlp)) {
+ print "Package $pkg not present, cannot remove it!\n";
+ } else {
+ if (!$force) {
+ # do some checking
+ my @needed = $localtlpdb->needed_by($pkg);
+ if (@needed) {
+ print "$pkg: not removed, referenced in @needed\n";
+ return;
+ }
+ }
+ print "remove: $pkg\n";
+ # we have to chdir to $localtlpdb->root
+ my $Master = $localtlpdb->root;
+ chdir ($Master) || die "chdir($Master) failed: $!";
+ my @files = $tlp->all_files;
+ # also remove the .tlpobj file
+ push @files, "tlpkg/tlpobj/$pkg.tlpobj";
+ # and the ones from src/doc splitting
+ if (-r "tlpkg/tlpobj/$pkg.src.tlpobj") {
+ push @files, "tlpkg/tlpobj/$pkg.src.tlpobj";
+ }
+ if (-r "tlpkg/tlpobj/$pkg.doc.tlpobj") {
+ push @files, "tlpkg/tlpobj/$pkg.doc.tlpobj";
+ }
+ my @removals = &removed_dirs (@files);
+ foreach my $entry (@files) {
+ unlink $entry;
+ }
+ foreach my $entry (@removals) {
+ rmdir $entry;
+ }
+ $localtlpdb->remove_package($pkg);
+ merge_into(\%ret, $tlp->make_return_hash_from_executes("disable"));
+ # remove those bin dependencies .ARCH
+ foreach my $d ($tlp->depends) {
+ if ($d eq "$pkg.ARCH") {
+ foreach my $a ($localtlpdb->available_architectures) {
+ merge_into(\%ret,
+ &remove_package("$pkg.$a", $localtlpdb, $force));
+ }
+ }
+ }
+ # should we save at each removal???
+ # advantage: the tlpdb actually reflects what is installed
+ # disadvantage: removing a collection calls the save routine several times
+ # still I consider it better that the tlpdb is in a consistent state
+ $localtlpdb->save;
+ # do the post removal actions
+ if (defined($PostRemove{$pkg})) {
+ info("running post remove action for $pkg\n");
+ &{$PostRemove{$pkg}}($localtlpdb->root);
+ }
+ }
+ return \%ret;
+}
+
+sub action_remove {
+ if ($opt_gui) {
+ action_gui("remove");
+ }
+ # we do the following:
+ # - (not implemented) order collections such that those depending on
+ # other collections are first removed, and then those which only
+ # depend on packages. Otherwise
+ # remove collection-latex collection-latexrecommended
+ # will not succeed
+ # - first loop over all cmd line args and consider only the collections
+ # - for each to be removed collection:
+ # . check that no other collections/scheme asks for that collection
+ # . remove the collection
+ # . remove all dependencies
+ # - for each normal package not already removed (via the above)
+ # . check that no collection/scheme still depends on this package
+ # . remove the package
+ #
+ my %ret;
+ my $opt_nodepends = 0;
+ my $opt_force = 0;
+ my $opt_dry = 0;
+ Getopt::Long::Configure(qw(no_pass_through));
+ GetOptions("no-depends" => \$opt_nodepends,
+ "force" => \$opt_force,
+ "dry-run" => \$opt_dry) or pod2usage(2);
+ my %already_removed;
+ my @more_removal;
+ init_local_db();
+ foreach my $pkg (@ARGV) {
+ my $tlp = $localtlpdb->get_package($pkg);
+ next if defined($already_removed{$pkg});
+ if (!defined($tlp)) {
+ print "Package $pkg not present, cannot remove it!\n";
+ } else {
+ # in the first round we only remove collections, nothing else
+ # but removing collections will remove all dependencies, too
+ # save the information of which packages have already been removed
+ # into %already_removed.
+ if ($tlp->category eq "Collection") {
+ # for collections we also remove all dependencies which are
+ # not Collections or Schemes
+ my %foo;
+ if ($opt_dry) {
+ print "remove: $pkg\n";
+ # we need to set $foo to something positive otherwise
+ # the rest will not be run in dry_run mode
+ $foo{'mktexlsr'} = 1;
+ } else {
+ merge_into(\%foo, &remove_package($pkg, $localtlpdb, $opt_force));
+ }
+ if (keys %foo) {
+ # removal was successful, so the return is at least 0x0001 mktexlsr
+ # remove dependencies, too
+ merge_into(\%ret, \%foo);
+ $already_removed{$pkg} = 1;
+ if (!$opt_nodepends) {
+ foreach my $d ($tlp->depends) {
+ my $tlpdd = $localtlpdb->get_package($d);
+ if (defined($tlpdd)) {
+ if ($tlpdd->category !~ m/$MetaCategoriesRegexp/) {
+ if ($opt_dry) {
+ print "remove: $d\n";
+ } else {
+ merge_into(\%ret, &remove_package($d, $localtlpdb, $opt_force));
+ }
+ $already_removed{$d} = 1;
+ }
+ }
+ }
+ }
+ }
+ } else {
+ # save all the other packages into the @more_removal list to
+ # be removed at the second state. Note that if a package has
+ # already been removed due to a removal of a collection
+ # it will be marked as such in %already_removed and not tried again
+ push @more_removal, $pkg;
+ }
+ }
+ }
+ foreach my $pkg (@more_removal) {
+ if (!defined($already_removed{$pkg})) {
+ if ($opt_dry) {
+ print "remove: $pkg\n";
+ } else {
+ my %foo;
+ merge_into(\%foo, &remove_package($pkg, $localtlpdb, $opt_force));
+ if (keys %foo) {
+ # removal was successful
+ merge_into(\%ret, \%foo);
+ $already_removed{$pkg} = 1;
+ }
+ }
+ }
+ }
+ if ($opt_dry) {
+ # stop here, don't do any postinstall actions
+ return;
+ } else {
+ $localtlpdb->save;
+ my @foo = sort ( keys %already_removed);
+ print "Actually removed packages: @foo\n";
+ return(\%ret);
+ }
+}
+
+sub action_show {
+ if ($opt_gui) {
+ action_gui("config");
+ }
+ init_local_db();
+ foreach my $pkg (@ARGV) {
+ my $tlmediatlpdb;
+ my $tlp = $localtlpdb->get_package($pkg);
+ my $installed = 0;
+ if (!$tlp) {
+ if (!$tlmediatlpdb) {
+ $tlmediasrc = TeXLive::TLMedia->new($location);
+ die($loadmediasrcerror . $location) unless defined($tlmediasrc);
+ $tlmediatlpdb = $tlmediasrc->tlpdb;
+ }
+ $tlp = $tlmediatlpdb->get_package($pkg);
+ } else {
+ $installed = 1;
+ }
+ if ($tlp) {
+ print "Package: ", $tlp->name, "\n";
+ print "Category: ", $tlp->category, "\n";
+ print "ShortDesc: ", $tlp->shortdesc, "\n" if ($tlp->shortdesc);
+ print "LongDesc: ", $tlp->longdesc, "\n" if ($tlp->longdesc);
+ print "Installed: ", ($installed?"Yes\n":"No\n");
+ print "\n";
+ } else {
+ printf STDERR "Cannot find $pkg\n";
+ }
+ }
+ return;
+}
+
+sub action_search {
+ my $opt_global = 0;
+ my $opt_file = 0;
+ Getopt::Long::Configure(qw(no_pass_through));
+ GetOptions("global" => \$opt_global,
+ "file" => \$opt_file) or pod2usage(2);
+ my $r = shift @ARGV;
+ my $ret = "";
+ my $tlpdb;
+ init_local_db();
+ if ($opt_global) {
+ $tlmediasrc = TeXLive::TLMedia->new($location);
+ die($loadmediasrcerror . $location) unless defined($tlmediasrc);
+ $tlpdb = $tlmediasrc->tlpdb;
+ } else {
+ $tlpdb = $localtlpdb;
+ }
+ foreach my $pkg ($tlpdb->list_packages) {
+ if ($opt_file) {
+ my @ret = grep(m;$r;, $tlpdb->get_package($pkg)->all_files);
+ if (@ret) {
+ print "$pkg:\n";
+ foreach (@ret) {
+ print "\t$_\n";
+ }
+ }
+ } else {
+ next if ($pkg =~ m/\./);
+ my $t = $tlpdb->get_package($pkg)->shortdesc;
+ $t |= "";
+ my $lt = $tlpdb->get_package($pkg)->longdesc;
+ $lt |= "";
+ if (($pkg =~ m/$r/) || ($t =~ m/$r/) || ($lt =~ m/$r/)) {
+ $ret .= " $pkg - $t\n";
+ }
+ }
+ }
+ print "$ret";
+ return;
+}
+
+sub action_restore {
+ # tlmgr restore --backupdir dir
+ # lists all packages with all revisions
+ # tlmgr restore --backupdir dir pkg
+ # lists all revisions of pkg
+ # tlmgr restore --backupdir dir pkg rev
+ # restores pkg to revision rev
+ my $opt_backupdir;
+ my $opt_force;
+ my $opt_dry = 0;
+ Getopt::Long::Configure(qw(no_pass_through));
+ GetOptions("backupdir=s" => \$opt_backupdir,
+ "dry-run" => \$opt_dry,
+ "force" => \$opt_force) or pod2usage(2);
+ if (!defined($opt_backupdir)) {
+ die "restore needs --backupdir\n";
+ }
+ # initialize the hash(packages) of hash(revisions)
+ my %backups;
+ opendir (DIR, $opt_backupdir) || die "opendir($opt_backupdir) failed: $!";
+ my @dirents = readdir (DIR);
+ closedir (DIR) || warn "closedir($opt_backupdir) failed: $!";
+ for my $dirent (@dirents) {
+ next if (-d $dirent);
+ next if ($dirent !~ m/^(.*)\.r([0-9]+)\.tar\.lzma$/);
+ $backups{$1}->{$2} = 1;
+ }
+ my $ret;
+ my ($pkg, $rev) = @ARGV;
+ if (!defined($pkg)) {
+ if (keys %backups) {
+ print "Available backups:\n";
+ foreach my $p (sort keys %backups) {
+ print "$p: ";
+ my @rs = sort (keys %{$backups{$p}});
+ print "@rs\n";
+ }
+ } else {
+ print "No backups available in $opt_backupdir\n";
+ }
+ exit 0;
+ }
+ if (!defined($rev)) {
+ print "Available backups for $pkg: ";
+ my @rs = sort (keys %{$backups{$pkg}});
+ print "@rs\n";
+ exit 0;
+ }
+ # we did arrive here, so we try to restore ...
+ if (defined($backups{$pkg}->{$rev})) {
+ if (!$opt_force) {
+ print "Do you really want to restore $pkg to revision $rev (y/N): ";
+ my $yesno = <STDIN>;
+ if ($yesno !~ m/^y(es)?$/i) {
+ print "Ok, cancelling the restore!\n";
+ exit(0);
+ }
+ }
+ print "Restoring $pkg, $rev from $opt_backupdir/${pkg}_r${rev}.tar.lzma\n";
+ if (!$opt_dry) {
+ init_local_db();
+ # first remove the package, then reinstall it
+ # this way we get rid of useless files
+ # force the deinstallation since we will reinstall it
+ $opt_backupdir = abs_path($opt_backupdir);
+ merge_into(\%ret, &remove_package($pkg, $localtlpdb, 1));
+ TeXLive::TLMedia->_install_package("$opt_backupdir/${pkg}_r${rev}.tar.lzma" , [] ,$localtlpdb);
+ # now we have to read the .tlpobj file and add it to the DB
+ my $tlpobj = TeXLive::TLPOBJ->new;
+ $tlpobj->from_file($localtlpdb->root . "/tlpkg/tlpobj/$pkg.tlpobj");
+ $localtlpdb->add_tlpobj($tlpobj);
+ $ret = $localtlpdb->get_package($pkg)->make_return_hash_from_executes("enable");
+ $localtlpdb->save;
+ }
+ } else {
+ print "revision $rev for $pkg is not present in $opt_backupdir\n";
+ }
+ return $ret;
+}
+
+sub action_backup {
+ init_local_db();
+ my $opt_dry = 0;
+ my $opt_all = 0;
+ my $opt_backupdir;
+ Getopt::Long::Configure(qw(no_pass_through));
+ GetOptions("all" => \$opt_all,
+ "backupdir=s" => \$opt_backupdir,
+ ) or pod2usage(2);
+ my %ret;
+ my @todo;
+ die ("tlmgr backup needs an obligatory argument --backupdir")
+ unless (defined($opt_backupdir));
+ if ($opt_all) {
+ @todo = $localtlpdb->list_packages;
+ } else {
+ @todo = @ARGV;
+ }
+ if (!@todo) {
+ printf "tlmgr backup takes either a list of packages or --all\n";
+ }
+ foreach my $pkg (@todo) {
+ $opt_backupdir = abs_path($opt_backupdir);
+ if (! -d $opt_backupdir) {
+ printf STDERR "backupdir argument must be an existing directory!\n";
+ } else {
+ my $tlp = $localtlpdb->get_package($pkg);
+ $tlp->make_container("lzma", $localtlpdb->root,
+ $opt_backupdir, "${pkg}.r" . $tlp->revision);
+ }
+ }
+ return(\%ret);
+}
+
+
+sub action_update {
+ if ($opt_gui) {
+ action_gui("update");
+ }
+ init_local_db();
+ # initialize the TLMedia from $location
+ my $opt_nodepends = 0;
+ my $opt_dry = 0;
+ my $opt_all = 0;
+ my $opt_list = 0;
+ my $opt_backupdir;
+ Getopt::Long::Configure(qw(no_pass_through));
+ GetOptions("no-depends" => \$opt_nodepends,
+ "all" => \$opt_all,
+ "list" => \$opt_list,
+ "backupdir=s" => \$opt_backupdir,
+ "dry-run" => \$opt_dry) or pod2usage(2);
+ my %ret;
+ $tlmediasrc = TeXLive::TLMedia->new($location);
+ die($loadmediasrcerror . $location) unless defined($tlmediasrc);
+ my $mediatlpdb = $tlmediasrc->tlpdb;
+ my @todo;
+ if ($opt_all || $opt_list) {
+ @todo = $localtlpdb->list_packages;
+ } else {
+ @todo = @ARGV;
+ }
+ if (!@todo) {
+ printf "tlmgr update takes either a list of packages or --all\n";
+ }
+ foreach my $pkg (@todo) {
+ next if ($pkg =~ m/^00texlive/);
+ if (win32() && (($pkg eq "texlive-infra") || ($pkg eq "bin-texlive"))) {
+ info("We cannot upgrade $pkg on win32, since we are running it!\n");
+ next;
+ }
+ my $tlp = $localtlpdb->get_package($pkg);
+ if (!defined($tlp)) {
+ printf STDERR "Strange, $pkg cannot be found!\n";
+ next;
+ }
+ my $rev = $tlp->revision;
+ my $mediatlp = $mediatlpdb->get_package($pkg);
+ if (!defined($mediatlp)) {
+ print "$pkg cannot be found in $location\n";
+ next;
+ }
+ my $mediarev = $mediatlp->revision;
+ if ($rev < $mediarev) {
+ if ($opt_list) {
+ print "$pkg: local: $rev, source: $mediarev\n";
+ } elsif ($opt_dry) {
+ print "Installing $pkg\n";
+ } else {
+ # first remove the package, then reinstall it
+ # this way we get rid of useless files
+ # force the deinstallation since we will reinstall it
+ if ($opt_backupdir) {
+ $opt_backupdir = abs_path($opt_backupdir);
+ if (! -d $opt_backupdir) {
+ printf STDERR "backupdir argument must be an existing directory!\n";
+ } else {
+ my $tlp = $localtlpdb->get_package($pkg);
+ $tlp->make_container("lzma", $localtlpdb->root,
+ $opt_backupdir, "${pkg}.r" . $tlp->revision);
+ }
+ }
+ print "update: $pkg (first remove old, then install new)\n";
+ merge_into(\%ret, &remove_package($pkg, $localtlpdb, 1));
+ merge_into(\%ret, $tlmediasrc->install_package($pkg, $localtlpdb, $opt_nodepends, 0));
+ print "update: $pkg done\n";
+ }
+ } elsif ($rev > $mediarev) {
+ print "$pkg: revision in $location is less then local revision, not updating!\n";
+ next;
+ }
+ }
+ return(\%ret);
+}
+
+sub action_install {
+ if ($opt_gui) {
+ action_gui("install");
+ }
+ init_local_db();
+ # initialize the TLMedia from $location
+ my $opt_nodepends = 0;
+ my $opt_dry = 0;
+ Getopt::Long::Configure(qw(no_pass_through));
+ GetOptions("no-depends" => \$opt_nodepends,
+ "dry-run" => \$opt_dry) or pod2usage(2);
+ my %ret;
+ $tlmediasrc = TeXLive::TLMedia->new($location);
+ die($loadmediasrcerror . $location) unless defined($tlmediasrc);
+ foreach my $pkg (@ARGV) {
+ if ($opt_dry) {
+ print "install: $pkg\n";
+ } else {
+ # install the packages and run postinstall actions (that is the 0)
+ merge_into(\%ret, $tlmediasrc->install_package($pkg, $localtlpdb, $opt_nodepends, 0));
+ }
+ }
+ if ($opt_dry) {
+ # stop here, don't do any postinstall actions
+ return(0);
+ }
+ return(\%ret);
+}
+
+sub action_list {
+ init_local_db();
+ my $what = shift @ARGV;
+ $what || ($what = "");
+ $tlmediasrc = TeXLive::TLMedia->new($location);
+ die($loadmediasrcerror . $location) unless defined($tlmediasrc);
+ my @whattolist;
+ if ($what =~ m/^collection/i) {
+ @whattolist = $tlmediasrc->tlpdb->collections;
+ } elsif ($what =~ m/^scheme/i) {
+ @whattolist = $tlmediasrc->tlpdb->schemes;
+ } else {
+ @whattolist = $tlmediasrc->tlpdb->list_packages;
+ }
+ foreach (@whattolist) {
+ if (defined($localtlpdb->get_package($_))) {
+ print "i ";
+ } else {
+ print " ";
+ }
+ my $foo = $tlmediasrc->tlpdb->get_package($_)->shortdesc;
+ print "$_: ", defined($foo) ? $foo : "(shortdesc missing)" , "\n";
+ }
+ return;
+}
+
+sub action_option {
+ if ($opt_gui) {
+ action_gui("config");
+ }
+ my $what = shift @ARGV;
+ $what = "show" unless defined($what);
+ init_local_db();
+ if ($what =~ m/^location$/i) {
+ # changes the default location
+ my $loc = shift @ARGV;
+ if ($loc) {
+ print "Setting default installation source to $loc!\n";
+ $localtlpdb->option_location($loc);
+ $localtlpdb->save;
+ } else {
+ print "Default installation source: ", $localtlpdb->option_location, "\n";
+ }
+ } elsif ($what =~ m/^docfiles$/i) {
+ # changes the default docfiles
+ my $loc = shift @ARGV;
+ if (defined($loc)) {
+ print "Defaulting to", ($loc ? "" : " not"), " install documentation files!\n";
+ $localtlpdb->option_docfiles($loc);
+ $localtlpdb->save;
+ } else {
+ print "Install documentation files: ", $localtlpdb->option_docfiles, "\n";
+ }
+ } elsif ($what =~ m/^srcfiles$/i) {
+ # changes the default srcfiles
+ my $loc = shift @ARGV;
+ if (defined($loc)) {
+ print "Defaulting to", ($loc ? "" : " not"), " install source files!\n";
+ $localtlpdb->option_srcfiles($loc);
+ $localtlpdb->save;
+ } else {
+ print "Install source files: ", $localtlpdb->option_srcfiles, "\n";
+ }
+ } elsif ($what =~ m/^formats$/i) {
+ # changes the default formats
+ my $loc = shift @ARGV;
+ if (defined($loc)) {
+ print "Defaulting to", ($loc ? "" : " not"), " generate format files on installation!\n";
+ $localtlpdb->option_formats($loc);
+ $localtlpdb->save;
+ } else {
+ print "Create formats on installation: ", $localtlpdb->option_formats, "\n";
+ }
+ } elsif ($what =~ m/^show$/i) {
+ print "Default installation source: ", $localtlpdb->option_location, "\n";
+ print "Create formats on installation: ", ($localtlpdb->option_formats ? "yes": "no"), "\n";
+ print "Install documentation files: ", ($localtlpdb->option_docfiles ? "yes": "no"), "\n";
+ print "Install source files: ", ($localtlpdb->option_srcfiles ? "yes": "no"), "\n";
+ } else {
+ warn "Setting other options currently not supported, please edit texlive.tlpdb!";
+ }
+ return;
+}
+
+sub action_arch {
+ if ($^O=~/^MSWin(32|64)$/i) {
+ printf STDERR "action `arch' not supported on Windows\n";
+ }
+ if ($opt_gui) {
+ action_gui("arch");
+ }
+ my $what = shift @ARGV;
+ my %ret;
+ my $opt_dry = 0;
+ Getopt::Long::Configure(qw(no_pass_through));
+ GetOptions("dry-run" => \$opt_dry) or pod2usage(2);
+ init_local_db();
+ $what || ($what = "list");
+ if ($what =~ m/^list$/i) {
+ # list the available architectures
+ # initialize the TLMedia from $location
+ $tlmediasrc = TeXLive::TLMedia->new($location);
+ die($loadmediasrcerror . $location) unless defined($tlmediasrc);
+ my $mediatlpdb = $tlmediasrc->tlpdb;
+ my @already_installed_arch = $localtlpdb->available_architectures;
+ print "Available architectures:\n";
+ foreach my $a ($mediatlpdb->available_architectures) {
+ if (member($a,@already_installed_arch)) {
+ print "(i) $a\n";
+ } else {
+ print " $a\n";
+ }
+ }
+ print "Already installed architectures are marked with (i)\n";
+ print "You can add new architectures with tlmgr arch add arch1 arch2\n";
+ exit(0);
+ } elsif ($what =~ m/^add$/i) {
+ $tlmediasrc = TeXLive::TLMedia->new($location);
+ die($loadmediasrcerror . $location) unless defined($tlmediasrc);
+ my $mediatlpdb = $tlmediasrc->tlpdb;
+ my @already_installed_arch = $localtlpdb->available_architectures;
+ my @available_arch = $mediatlpdb->available_architectures;
+ my @todoarchs;
+ foreach my $a (@ARGV) {
+ if (TeXLive::TLUtils::member($a, @already_installed_arch)) {
+ print "Arch $a is already installed\n";
+ next;
+ }
+ if (!TeXLive::TLUtils::member($a, @available_arch)) {
+ print "Arch $a not available, use 'tlmgr available_archs'!\n";
+ next;
+ }
+ push @todoarchs, $a;
+ }
+ foreach my $pkg ($localtlpdb->list_packages) {
+ next if ($pkg =~ m/^00texlive/);
+ my $tlp = $localtlpdb->get_package($pkg);
+ foreach my $dep ($tlp->depends) {
+ if ($dep =~ m/^(.*)\.ARCH$/) {
+ # we have to install something
+ foreach my $a (@todoarchs) {
+ if ($opt_dry) {
+ print "Installing $pkg.$a\n";
+ } else {
+ merge_into(\%ret, $tlmediasrc->install_package("$pkg.$a", $localtlpdb, 0, 0));
+ }
+ }
+ }
+ }
+ }
+ if (TeXLive::TLUtils::member('win32', @todoarchs)) {
+ # install the necessary win32 stuff
+ merge_into (\%ret, $tlmediasrc->install_package("bin-tlperl.win32", $localtlpdb, 1, 0));
+ merge_into (\%ret, $tlmediasrc->install_package("bin-tlgs.win32", $localtlpdb, 1, 0));
+ merge_into (\%ret, $tlmediasrc->install_package("bin-tlpsv.win32", $localtlpdb, 1, 0));
+ }
+ # update the option_archs list of installed archs
+ my @larchs = $localtlpdb->option_archs;
+ push @larchs, @todoarchs;
+ $localtlpdb->option_archs(@larchs);
+ $localtlpdb->save;
+ } else {
+ die "Unknown option for arch: $what";
+ }
+ return(\%ret);
+}
+
+sub action_generate {
+ my $what = shift @ARGV;
+ my $localconf = "";
+ my $dest = "";
+ Getopt::Long::Configure(qw(no_pass_through));
+ GetOptions("localcfg=s" => \$localconf, "dest=s" => \$dest,) or pod2usage(2);
+ init_local_db();
+ if ($what =~ m/^language$/i) {
+ $dest || ($dest = kpsewhich ("TEXMFSYSVAR") . "/tex/generic/config/language.dat");
+ $localconf || ($localconf = kpsewhich ("TEXMFLOCAL") . "/tex/generic/config/language-local.dat");
+ info("$0: writing language data to $dest\n");
+ TeXLive::TLUtils::create_language ($localtlpdb, $dest, $localconf);
+ } elsif ($what =~ m/^fmtutil$/i) {
+ $dest || ($dest = kpsewhich("TEXMFSYSVAR") . "/web2c/fmtutil.cnf");
+ $localconf || ($localconf = kpsewhich("TEXMFLOCAL") . "/web2c/fmtutil-local.cnf");
+ info("writing fmtutil.cnf data to $dest\n");
+ TeXLive::TLUtils::create_fmtutil($localtlpdb, $dest, $localconf);
+ } elsif ($what =~ m/^updmap$/i) {
+ $dest || ($dest = kpsewhich("TEXMFSYSVAR") . "/web2c/updmap.cfg");
+ $localconf || ($localconf = kpsewhich("TEXMFLOCAL") . "/web2c/updmap-local.cfg");
+ info("$0: writing new updmap.cfg to $dest\n");
+ TeXLive::TLUtils::create_updmap ($localtlpdb, $dest, $localconf);
+ } else {
+ die "Unknown option for generate: $what";
+ }
+ return;
+}
+
+sub init_local_db {
+ $localtlpdb = TeXLive::TLPDB->new ("root" => "$Master");
+ die("cannot find tlpdb!") unless (defined($localtlpdb));
+ # setup the programs, for win32 we need the shipped wget/lzma etc, so we
+ # pass the location of these files to setup_programs.
+ setup_programs("$Master/tlpkg/installer", $localtlpdb->option_platform);
+ # let cmd line options override the settings in localtlpdb
+ my $loc = $localtlpdb->option_location;
+ if (defined($loc)) {
+ $location = $loc;
+ }
+ if (defined($opt_location)) {
+ $location = $opt_location;
+ }
+ if (!defined($location)) {
+ die("No installation source found, nor in the texlive.tlpdb nor on the cmd line.\nPlease specify one!");
+ }
+}
+
+sub action_gui {
+ my ($screen) = @_;
+ my $perlbin = "perl";
+ my $perlbinquote = "perl";
+ my $perlscript = "$Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui.pl";
+ if ($^O=~/^MSWin(32|64)$/i) {
+ $ENV{'PERL5LIB'} = "$Master/tlpkg/tlperl/lib";
+ $perlbin = "$Master/tlpkg/tlperl/bin/perl.exe";
+ $perlbinquote = "\"$Master/tlpkg/tlperl/bin/perl.exe\"";
+ $perlbinquote =~ s!/!\\!g;
+ $perlscript = "\"$perlscript\"";
+ $perlscript =~ s!/!\\!g;
+ }
+ my @cmdline;
+ push @cmdline, $perlbinquote, $perlscript;
+ push @cmdline, "--location", "$opt_location"
+ if (defined($opt_location));
+ push @cmdline, "--netarchive", "$opt_netarchive"
+ if (defined($opt_netarchive));
+ push @cmdline, "--diskarchive", "$opt_diskarchive"
+ if (defined($opt_diskarchive));
+ if (defined($screen)) {
+ push @cmdline, "--screen", $screen;
+ }
+ exec $perlbin @cmdline;
+ die("Cannot execute the GUI script\n");
+}
+
+sub action_uninstall {
+ if (win32()) {
+ printf STDERR "Please use \"Add/Remove Programs\" from the Control Panel to removing TeX Live!\n";
+ exit 1;
+ }
+ if ($opt_gui) {
+ action_gui("uninstall");
+ }
+ my $force = 0;
+ Getopt::Long::Configure(qw(no_pass_through));
+ GetOptions("force" => \$force) or pod2usage(2);
+ if (!$force) {
+ print("If you answer yes here the whole TeX Live installation will be removed!\n");
+ print "Remove TeX Live (y/N): ";
+ my $yesno = <STDIN>;
+ if ($yesno !~ m/^y(es)?$/i) {
+ print "Ok, cancelling the removal!\n";
+ exit(0);
+ }
+ }
+ print ("Ok, removing the whole installation:\n");
+ init_local_db;
+ my $tlpdb = $localtlpdb;
+ my $opt_symlinks = 0;
+ my ($sys_bin,$sys_info,$sys_man);
+ my ($texdir,$texmflocal,$texmfhome,$texmfsysvar);
+ if ($tlpdb) {
+ $sys_bin = $tlpdb->option_sys_bin;
+ $sys_man = $tlpdb->option_sys_man;
+ $sys_info= $tlpdb->option_sys_info;
+ $opt_symlinks = $tlpdb->option_symlinks;
+ $texdir = $Master;
+ $texmfhome = `kpsewhich -var-value=TEXMFHOME`; chomp($texmfhome);
+ $texmfsysvar = `kpsewhich -var-value=TEXMFSYSVAR`; chomp($texmfsysvar);
+ $texmflocal = `kpsewhich -var-value=TEXMFLOCAL`; chomp($texmflocal);
+ } else {
+ die("Cannot find tlpdb in $Master!");
+ }
+ # remove the links missing
+ if ($opt_symlinks) {
+ my @files;
+ if ((-d "$sys_bin") && (-w "$sys_bin")) {
+ my $plat_bindir;
+ if (-l "$sys_bin/pdftex") {
+ my $fullpath = readlink("$sys_bin/pdftex");
+ if ($fullpath =~ m;^$Master/bin/(.*)/[^/]*$;) {
+ $plat_bindir = $1;
+ }
+ } else {
+ warn "$sys_bin/pdftex not present or not a link, not removing any link of binaries!\n";
+ }
+ if ($plat_bindir) {
+ @files = `ls "$Master/bin/$plat_bindir"`;
+ chomp(@files);
+ foreach my $f (@files) {
+ next if (! -r "$sys_bin/$f");
+ if ((-l "$sys_bin/$f") &&
+ (readlink("$sys_bin/$f") =~ m;^$Master/bin/$plat_bindir/;)) {
+ unlink("$sys_bin/$f");
+ } else {
+ warn ("not removing $sys_bin/$f, not a link or wrong destination!\n");
+ }
+ }
+ }
+ `rmdir "$sys_bin" 2>/dev/null`;
+ } else {
+ warn "destination of bin symlink $sys_bin not writable, no removal of links of bin files done!\n";
+ }
+ # info files
+ if (-w $sys_info) {
+ @files = `ls "$Master/texmf/doc/info"`;
+ chomp(@files);
+ foreach my $f (@files) {
+ next if (! -r "$sys_info/$f");
+ if ((-l "$sys_info/$f") &&
+ (readlink("$sys_info/$f") =~ m;^$Master/texmf/doc/info/;)) {
+ unlink("$sys_info/$f");
+ } else {
+ warn ("not removing $sys_info/$f, not a link or wrong destination!\n");
+ }
+ }
+ `rmdir "$sys_info" 2>/dev/null`;
+ } else {
+ warn "destination of info symlink $sys_info not writable, no removal of links of info files done!\n";
+ }
+ # man files
+ if (-w $sys_man) {
+ my $foo = `(cd "$Master/texmf/doc/man" && echo *)`;
+ my @mans = split ' ', $foo;
+ chomp(@mans);
+ foreach my $m (@mans) {
+ my $mandir = "$Master/texmf/doc/man/$m";
+ next unless -d $mandir;
+ next unless -d "$sys_man/$m";
+ @files = `ls "$mandir"`;
+ chomp(@files);
+ foreach my $f (@files) {
+ next if (! -r "$sys_man/$m/$f");
+ if ((-l "$sys_man/$m/$f") &&
+ (readlink("$sys_man/$m/$f") =~ m;^$Master/texmf/doc/man/$m/;)) {
+ unlink("$sys_man/$m/$f");
+ } else {
+ warn ("not removing $sys_man/$m/$f, not a link or wrong destination!\n");
+ }
+ }
+ # ignore errors, it might be not empty
+ `rmdir "$sys_man/$m" 2>/dev/null`;
+ }
+ `rmdir "$sys_man" 2>/dev/null`;
+ } else {
+ warn "destination of man symlink $sys_man not writable, no removal of links of man files done!\n";
+ }
+ }
+ #
+ # now do remove the rest
+ system("rm", "-rf", "$texdir/texmf-dist");
+ system("rm", "-rf", "$texdir/texmf-doc");
+ system("rm", "-rf", "$texdir/texmf-var");
+ system("rm", "-rf", "$texdir/texmf");
+ system("rm", "-rf", "$texdir/tlpkg");
+ system("rm", "-rf", "$texdir/bin");
+ if (-d "$texdir/temp") {
+ system("rmdir", "--ignore-fail-on-non-empty", "$texdir/temp");
+ }
+ unlink("$texdir/install-tl.log");
+ # should we do that????
+ system("rm", "-rf", "$texdir/texmf-config");
+ system("rmdir", "--ignore-fail-on-non-empty", "$texdir");
+}
+
+
+#
+# return all the directories from which all content will be removed
+#
+# idea:
+# - create a hashes by_dir listing all files that should be removed
+# by directory, i.e., key = dir, value is list of files
+# - for each of the dirs (keys of by_dir and ordered deepest first)
+# check that all actually contained files are removed
+# and all the contained dirs are in the removal list. If this is the
+# case put that directory into the removal list
+# - return this removal list
+#
+sub removed_dirs
+{
+ my (@files) = @_;
+ my %removed_dirs;
+ my %by_dir;
+
+ # construct hash of all directories mentioned, values are lists of the
+ # files/dirs in that directory.
+ for my $f (@files) {
+ # what should we do with not existing entries????
+ next if (! -r "$f");
+ my $abs_f = abs_path ($f);
+ if (!$abs_f) {
+ warn ("oops, no abs_path($f) from " . `pwd`);
+ next;
+ }
+ (my $d = $abs_f) =~ s,/[^/]*$,,;
+ my @a = exists $by_dir{$d} ? @{$by_dir{$d}} : ();
+ push (@a, $abs_f);
+ $by_dir{$d} = \@a;
+ }
+
+ # for each of our directories, see if we are removing everything in
+ # the directory. if so, return the directory; else return the
+ # individual files.
+ for my $d (reverse sort keys %by_dir) {
+ opendir (DIR, $d) || die "opendir($d) failed: $!";
+ my @dirents = readdir (DIR);
+ closedir (DIR) || warn "closedir($d) failed: $!";
+
+ # initialize test hash with all the files we saw in this dir.
+ # (These idioms are due to "Finding Elements in One Array and Not
+ # Another" in the Perl Cookbook.)
+ my %seen;
+ my @rmfiles = @{$by_dir{$d}};
+ @seen{@rmfiles} = ();
+
+ # see if everything is the same.
+ my $cleandir = 1;
+ for my $dirent (@dirents) {
+ next if $dirent =~ /^\.(\.|svn)?$/; # ignore . .. .svn
+ my $item = "$d/$dirent"; # prepend directory for comparison
+ if (
+ ((-d $item) && (defined($removed_dirs{$item})))
+ ||
+ (exists $seen{$item})
+ ) {
+ # do nothing
+ } else {
+ $cleandir = 0;
+ last;
+ }
+ }
+ if ($cleandir) {
+ $removed_dirs{$d} = 1;
+ }
+ }
+ return keys %removed_dirs;
+}
+
+__END__
+
+=head1 NAME
+
+tlmgr - the TeX Live Manager
+
+=head1 SYNOPSIS
+
+tlmgr [I<options>] I<action> [I<option>]... [I<operand>]...
+
+=head1 DESCRIPTION
+
+B<tlmgr> manages an existing TeX Live installation, both packages and
+options.
+
+=head1 OPTIONS
+
+The following options have to be given I<before> you specify the action.
+
+=over 8
+
+=item B<--location> I<location>
+
+Specifies the location from which packages should be installed or
+updated, overriding the location found in the installation's TLPDB.
+
+=item B<--gui>
+
+Instead of starting the GUI via the B<gui> action, you can also give this
+option together with an action from above and will be brought directly
+into the respective screen of the GUI. So calling
+
+ tlmgr --gui update
+
+will bring you directly into the update screen.
+
+=item B<--netarchive> I<dir>
+
+Overrides the default settings for netarchive. Should be used with care.
+
+=item B<--diskarchive> I<dir>
+
+Overrides the default settings for diskarchive. Should be used with care.
+
+=back
+
+The standard options B<--help/-h/-?> and B<--debug> are also accepted.
+
+=head1 ACTIONS
+
+=over 8
+
+=item B<help>
+
+Gives this help page.
+
+=item B<gui>
+
+Run using a graphical interface.
+
+=item B<install [I<option>]... I<pkg>...>
+
+Install all I<pkg>s given on the command line. By default this installs
+all packages that the given I<pkg>s are dependent on, also. Options:
+
+=over 8
+
+=item B<--no-depends>
+
+Do not install dependencies. Bydefault, installing a package ensures
+that all dependencies of this package are fulfilled.
+
+=item B<--dry-run>
+
+Nothing is actually installed; instead, the actions to be performed are
+written to the terminal.
+
+=back
+
+
+=item B<update [I<option>] [pkg [pkg ...]]>
+
+Updates the packages given as arguments to the latest version available
+at the installation source. Options:
+
+=over 8
+
+=item B<--list>
+
+List only which packages could be updated.
+
+=item B<--all>
+
+Update all package.
+
+=item B<--dry-run>
+
+Nothing is actually installed; instead, the actions to be performed are
+written to the terminal.
+
+=item B<--backupdir directory>
+
+If this option is given it must specify an existing directory where a
+snapshot of the current package as installed will be saved before
+the packages is updated. This way one can go back in case an update
+turned out as not working. See the action B<restore> for details.
+
+=back
+
+=item B<backup --backupdir dir [--all] [pkg [pkg]]>
+
+Makes a backup of the given packages (or all packages with B<--all>) to
+the directory specified with B<--backupdir> (must exist and be a writable).
+
+Warning: Making a backup of I<all> packages will need quite some space and
+time.
+
+Options:
+
+=over 8
+
+=item B<--backupdir directory>
+
+This is an obligatory argument and has to specify a directory where
+backups are to be found.
+
+=item B<--all>
+
+Make a backup of all packages in the texlive.tlpdb
+
+=back
+
+
+=item B<restore --backupdir dir [pkg [rev]]>
+
+If no B<pkg> and B[rev] is given list all packages the available
+backup revisions.
+
+With B<pkg> given but without B<rev> lists all available backup revisions
+of B<pkg>.
+
+With both B<pkg> an B<rev> given tries to restore the package from its
+backup.
+
+The option B<--backupdir dir> is obligatory and has to specify a directory
+with backups.
+
+Options:
+
+=over 8
+
+=item B<--dry-run>
+
+Nothing is actually restored; instead, the actions to be performed are
+written to the terminal.
+
+=item B<--backupdir directory>
+
+This is an obligatory argument and has to specify a directory where
+backups are to be found.
+
+=back
+
+
+=item B<remove [I<option>]... I<pkg>...>
+
+Remove all I<pkg>s given on the command line. Removing a collection
+will remove all package dependencies (but not collection dependencies)
+in that collection, unless C<--no-depends> is specified. However, when
+removing a package, dependencies are never removed.
+
+Removing a package which is referenced as a dependency in another
+collection or scheme is disallowed, unless C<--force> is specified.
+
+Options:
+
+=over 8
+
+=item B<--no-depends>
+
+Do not remove dependent packages.
+
+=item B<--force>
+
+By default, when removing a package or collection would invalidate a
+dependency of another collection/scheme, the package will not be removed
+and a warning issued. With this option, the package will be removed
+unconditionally. Use with care.
+
+=item B<--dry-run>
+
+Nothing is actually installed; instead, the actions to be performed are
+written to the terminal.
+
+=back
+
+
+=item B<option [show]>
+
+=item B<option I<key> [I<value>]>
+
+The first form shows the settings currently saved in the TLPDB.
+
+In the second form, if I<value> is missing the setting for I<key> is
+displayed. If I<value> is present, I<key> is set to I<value>.
+
+Possible values for I<key> are:
+C<location> (default installation source),
+C<formats> (create formats at installation time),
+C<docfiles> (install documentation files),
+C<srcfiles> (install source files).
+
+=item B<paper a4>
+
+=item B<paper letter>
+
+=item B<[xdvi|dvips|pdftex|dvipdfm|dvipdfmx] paper [help|papersize]>
+
+Configures the system wide paper settings, either for all programs in
+one go, or just for the specified program.
+
+
+=item B<arch list>
+
+Prints the names of the systems available at the default install location.
+
+=item B<arch add I<arch>...>
+
+Add executables for the specified I<arch>es to the installation.
+Options:
+
+=over 8
+
+=item B<--dry-run>
+
+Nothing is actually installed; instead, the actions to be performed are
+written to the terminal.
+
+=back
+
+
+=item B<search [I<option>...] I<what>>
+
+By default searches the names, short and long descriptions of all
+locally installed packages for the given argument (interpreted as
+regexp). Options:
+
+=over 8
+
+=item B<--file>
+
+List all filenames containing I<what>.
+
+=item B<--global>
+
+Search the TeX Live Database of the installation medium, instead of the
+local installation.
+
+=back
+
+=item B<show I<pkg>...>
+
+Shows information about I<pkg>: the name, category, installation status,
+short and long description. Searches in the remote installation source
+for the package if it is not locally installed.
+
+
+=item B<list [collections|schemes]>
+
+With no argument, lists all packages available at the default install
+location, prefixing those already installed with C<i >.
+
+With an argument lists only collections or schemes, as requested.
+
+=item B<uninstall>
+
+Uninstalls the entire TeX Live installation. Options:
+
+=over 8
+
+=item B<--force>
+
+Do not ask for confirmation, remove immediately.
+
+=back
+
+
+=item B<generate language>
+
+=item B<generate fmtutil>
+
+=item B<generate updmap>
+
+B<WARNING:> This action overwrites any user changes made in
+the respective files, by regenerating them from scratch.
+
+This is especially questionable with updmap, because the result will be
+to disable all maps which have been manually installed (via C<updmap-sys
+--enable>), e.g., for proprietary or local fonts. Be sure that's what
+you want to do.
+
+This action regenerates any of the three config files C<language.dat>,
+C<fmtutil.cnf>, and C<updmap.cfg> from the information present in the
+local TLPDB. If the files C<language-local.dat>, C<fmtutil-local.cnf>,
+or C<updmap-local.cfg> are present under C<TEXMFLOCAL> in the respective
+directories, their contents will be simply merged into the final files,
+with no error checking of any kind.
+
+Options:
+
+=over 8
+
+=item B<--dest> I<output file>
+
+specifies the output file (defaults to the respective location in
+C<TEXMFSYSVAR>).
+
+=item B<--localcfg> I<local conf file>
+
+specifies the (optional) local additions (defaults to the respective
+location in C<TEXMFSYSVAR>).
+
+=back
+
+=back
+
+
+=head1 AUTHORS AND COPYRIGHT
+
+This script and its documentation were written for the TeX Live
+distribution (L<http://tug.org/texlive>) and both are licensed under the
+GNU General Public License Version 2 or later.
+
+=cut
+
+### Local Variables:
+### perl-indent-level: 2
+### tab-width: 2
+### indent-tabs-mode: nil
+### End:
+# vim:set tabstop=2 expandtab: #
diff --git a/Build/source/texk/texlive/linked_scripts/vpe.pl b/Build/source/texk/texlive/linked_scripts/vpe.pl
new file mode 100755
index 00000000000..9eb52b69e3c
--- /dev/null
+++ b/Build/source/texk/texlive/linked_scripts/vpe.pl
@@ -0,0 +1,421 @@
+eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}' && eval 'exec perl -S $0 $argv:q'
+ if 0;
+use strict;
+#
+# vpe.pl
+#
+# Copyright (C) 2000 Heiko Oberdiek.
+#
+# This program may be distributed and/or modified under the
+# conditions of the LaTeX Project Public License, either version 1.2
+# of this license or (at your option) any later version.
+# The latest version of this license is in
+# http://www.latex-project.org/lppl.txt
+# and version 1.2 or later is part of all distributions of LaTeX
+# version 1999/12/01 or later.
+#
+# See file "vpe.txt" for a list of files that belong to this project.
+#
+# This file "vpe.pl" may be renamed to "vpe"
+# for installation purposes.
+#
+my $file = "vpe.pl";
+my $program = uc($&) if $file =~ /^\w+/;
+my $version = "0.1";
+my $date = "2000/09/15";
+my $author = "Heiko Oberdiek";
+my $copyright = "Copyright (c) 2000 by $author.";
+#
+# History:
+# 2000/09/15 v0.1: First release.
+#
+
+### program identification
+my $title = "$program $version, $date - $copyright\n";
+
+### editor call
+# %F: file name
+# %L: line number
+my $EditorCall = "xterm -e joe +%d %s";
+$EditorCall = $ENV{TEXEDIT} if $ENV{TEXEDIT};
+$EditorCall = $ENV{VPE} if $ENV{VPE};
+
+### error strings
+my $Error = "!!! Error:"; # error prefix
+
+my $usage = <<"END_OF_USAGE";
+${title}
+Depending on the name of the script `vpe' works in four modes:
+
+* [vpe] Syntax: vpe <pdf file>[.pdf]
+ The pdf file is scanned for actions created by VTeX,
+ that start an editor with the source file at the
+ specified line under Windows.
+ A symbol link is made from the source file name
+ extended by the extension `.vpe' to this script.
+ The line number is encoded in the path and the
+ action is changed to start this script.
+
+* [sty] Internal for vpe.sty:
+ Syntax: vpe --sty [--progname=...] <latex file> <vpe file>
+
+* [system] Internal for vpe.sty:
+ Syntax: vpe --system <vpe file>
+
+* [launch] Syntax: <source file name>.vpe
+ The script decodes the line number in the path of
+ the source file name and starts an editor with
+ this file at that line number.
+
+Options:
+ --help: print usage.
+ --verbose: print additional informations during running.
+ --force: force symbol links
+ --delete: delete symbol links
+ --sty: internal for `vpe.sty' (get absolute file name and lines)
+ --system: internal for `vpe.sty' (get system info linux or win)
+ --progname: latex, pdflatex, elatex, pdfelatex
+END_OF_USAGE
+
+### options
+$::opt_verbose = 0;
+$::opt_help = 0;
+$::opt_force = 0;
+$::opt_delete = 0;
+$::opt_sty = 0;
+$::opt_system = 0;
+$::opt_progname = "latex";
+use Getopt::Long;
+GetOptions(
+ "help!",
+ "verbose!",
+ "force!",
+ "delete!",
+ "sty!",
+ "system!",
+ "progname=s",
+) or die $usage;
+if ($::opt_help) {
+ die $usage;
+}
+
+if ($::opt_sty and $::opt_system) {
+ die "$usage" .
+ "$Error Options --sty and --system cannot used together!\n";
+}
+
+###################
+### launch mode ###
+###################
+if ($0 =~ /\.vpe/) {
+
+ @ARGV == 0 or
+ die "$usage$Error Too many arguments [launch mode]!\n";
+
+ my $file = "";
+ $0 =~ m|(^[\./]+\./)(.+)\.vpe$| or
+ die "$Error Cannot extract line number ($0)!\n";
+ my $str = $1;
+ $file = "/$2";
+
+ my $line = "";
+ while ($str ne "") {
+ $str =~ m|^(/*)(\.?)\./(.*)$| or
+ die "$Error Parse error!\n";
+ $line .= length($1) + (($2 eq ".") ? 5 : 0);
+ $str = $3;
+ }
+
+ my $callstr = $EditorCall;
+ $EditorCall =~ s/%s/$file/;
+ $EditorCall =~ s/%d/$line/;
+ print "File: $file, line: $line\n" if $::opt_verbose;
+ exec($EditorCall);
+ exit 1;
+}
+
+###
+### used by both sty and system mode:
+###
+my $system = "linux";
+$system = "" if $^O =~ /os2/i;
+$system = "" if $^O =~ /mac/i;
+$system = "win" if $^O =~ /dos/i;
+$system = "win" if $^O =~ /win/i;
+
+################
+### sty mode ###
+################
+if ($::opt_sty) {
+
+ @ARGV == 2 or
+ die "$usage$Error Wrong arguments [sty mode]!\n";
+
+ my $vpefile = $ARGV[1];
+ print "VPE file: $vpefile\n" if $::opt_verbose;
+
+ my $file = `kpsewhich -progname=$::opt_progname $ARGV[0]`;
+ chomp $file;
+ if (!($file =~ m|^/| or $file =~ m|^\w:|)) {
+ use Cwd;
+ $file = cwd() . "/" . $file;
+ $file =~ s|/[^/]+/\.\./|/|g;
+ $file =~ s|/\./|/|g;
+ }
+ -f $file or
+ die "$Error Cannot find file `$file' [sty mode]!\n";
+ print "File: $file\n" if $::opt_verbose;
+
+ my $last = 0;
+ if (open(IN, $file)) {
+ while (<IN>) {
+ $last++;
+ }
+ }
+ if ($last == 0) {
+ $last = 10000;
+ }
+ print "Last line: $last\n" if $::opt_verbose;
+
+ open(OUT, ">>$vpefile") or
+ die "$Error Cannot open file `$vpefile`!\n";
+ print OUT "\\vpeentry{$file}{$last}\n";
+
+ exit 1;
+}
+
+###################
+### system mode ###
+###################
+if ($::opt_system) {
+
+ @ARGV == 1 or
+ die "$usage$Error Wrong arguments [system mode]!\n";
+
+ my $vpefile = $ARGV[0];
+ print "VPE file: $vpefile\n" if $::opt_verbose;
+
+ open(OUT, ">>$vpefile") or
+ die "$Error Cannot open file `$vpefile`!\n";
+ print OUT "\\vpesystem{$system}\n";
+
+ exit 1;
+}
+
+################
+### vpe mode ###
+################
+if (@ARGV < 1) {
+ die "$usage$Error Missing pdf file [vpe mode]!\n";
+}
+if (@ARGV > 2) {
+ die "$usage$Error Too many arguments [vpe mode]!\n";
+}
+
+my $pdffile = $ARGV[0];
+if (!-f $pdffile) {
+ my $name = $pdffile;
+ $pdffile .= ".pdf";
+ -f $pdffile or
+ die "$Error File `$name' not found [vpe mode]!\n";
+}
+
+open(IN, "+<$pdffile") or
+ die "$Error Cannot open `$pdffile' [vpe mode]!\n";
+binmode(IN);
+my %symlinks = ();
+while (<IN>) {
+
+ if (m|/F\([\./]*(/.*)\.vpe\)|) {
+ $symlinks{$1} = 1;
+ next;
+ }
+
+ my $do = 0;
+ my ($action, $file, $line, $type);
+ # my $color; # only for debugging
+
+ if (m|^
+ /A \s* << \s*
+ /Type \s* /Action \s*
+ /S \s* /Launch \s*
+ /Win \s* << \s*
+ /F \s* \(aftcomp.exe\) \s*
+ /P \s* \("(.*)\" \s+ \d+\-(\d+)\) \s*
+ >> \s*
+ >> \s*
+ $
+ |x
+ ) {
+ $action = $_;
+ $file = $1;
+ $line = $2;
+ # $color = "/C[0 0 1]"; # only for debugging
+ $type = "aftcomp";
+ $do = 1;
+ }
+
+ if (m|^
+ /A \s* << \s*
+ /Type \s* /Action \s*
+ /S \s* /Launch \s*
+ /Win \s* << \s*
+ /F \s* \(repos.exe\) \s*
+ /P \s* \(
+ "(.*)" \s*
+ "(\d+)" \s*
+ "(.*)" \s*
+ "(\d+)"
+ \) \s*
+ >> \s*
+ >> \s*
+ $
+ |x
+ ) {
+ $action = $_;
+ if ($3 eq "") {
+ $file = $1;
+ $line = $2;
+ }
+ else {
+ # ???
+ $file = $1;
+ $line = $2;
+ }
+ # $color = "/C[1 0 0]"; # only for debugging
+ $type = "repos";
+ $do = 1;
+ }
+
+ if ($do) {
+ my $length = length($action);
+ print "* File: $file, line: $line, type: $type\n" if $::opt_verbose;
+
+ if (!($file =~ m|^/|)) {
+ print STDERR "$Error File `$file' lacks of absolute path!\n";
+ next;
+ }
+
+ if (!$::opt_delete) {
+ if ($line <= 0) {
+ $line = 1;
+ }
+
+ my $newaction = "";
+ {
+ my $digit = substr($line, 0, 1);
+ if ($digit <= 5) {
+ $newaction .= "/" x $digit;
+ }
+ else {
+ $newaction .= "/" x ($digit - 5) . ".";
+ }
+ $newaction .= "./";
+ my $rest = $line;
+ while (($rest = substr($rest, 1)) ne "") {
+ $digit = substr($rest, 0, 1);
+ if ($digit < 5) {
+ $newaction .= "/" x $digit;
+ }
+ else {
+ $newaction .= "/" x ($digit - 5) . ".";
+ }
+ $newaction .= "./";
+ }
+ }
+ $newaction .= substr($file, 1) . ".vpe";
+ $newaction = # $color . # only for debugging
+ "/A<</Type/Action/S/Launch/F($newaction)>>";
+ $newaction .= " " x ($length - length($newaction) - 1);
+ if (length($newaction) > $length) {
+ print STDERR "$Error Action too long!\n";
+ next;
+ }
+
+ seek(IN, -length($action), 1);
+ print IN $newaction;
+ }
+
+ $symlinks{$file} = 1;
+ }
+}
+
+if (keys(%symlinks)) {
+
+ my $this = $0;
+ if (!$::opt_delete) {
+ if (!-f $0 or !-x $0) {
+ $this = `which $0`;
+ ($this ne "") or die "$Error Cannot find this script!\n";
+ }
+ if (!($this =~ m|^/|)) {
+ use Cwd;
+ $this = cwd() . "/" . $this;
+ }
+ $this =~ s|/[^/]+/\.\./|/|g;
+ $this =~ s|/\./|/|g;
+ }
+
+ if ($::opt_delete) {
+ print "Delete symlinks:\n";
+ }
+ else {
+ if ($::opt_force) {
+ print "Forced symlinks to $this:\n";
+ }
+ else {
+ print "Symlinks to $this:\n";
+ }
+ }
+
+ foreach (keys(%symlinks)) {
+ my $sym = $_ . ".vpe";
+ print " $sym [";
+
+ if ($::opt_delete) {
+ if (!-l $sym) {
+ print "ok, not existing]\n";
+ next;
+ }
+ unlink($sym);
+ if (!-l $sym) {
+ print "ok, deleted]\n";
+ next;
+ }
+ print "failed]\n";
+ next;
+ }
+ if ($::opt_force) {
+ if (-l $sym) {
+ unlink($sym);
+ if (-l $sym) {
+ print "deletion failed]\n";
+ next;
+ }
+ if (symlink($this, $sym)) {
+ print "ok, deleted and created]\n";
+ next;
+ }
+ print "deleted, creation failed]\n";
+ next;
+ }
+ if (symlink($this, $sym)) {
+ print "ok, created]\n";
+ next;
+ }
+ print "creation failed]\n";
+ next;
+ }
+ if (-f $sym) {
+ print "exists]\n";
+ next;
+ }
+ if (symlink($this, $sym)) {
+ print "ok, created]\n";
+ next;
+ }
+ print "failed]\n";
+ next;
+ }
+}
+__END__