diff options
| author | Vladimir Volovich <vvv@vsu.ru> | 2008-05-26 09:52:43 +0000 |
|---|---|---|
| committer | Vladimir Volovich <vvv@vsu.ru> | 2008-05-26 09:52:43 +0000 |
| commit | f3c03b631382b9331ea7292aa1a637204ab70001 (patch) | |
| tree | 50b9212eb937044622bc49e2264cf639499e2857 /Build | |
| parent | 7cf2257799dd7bb3e8051d6e188477aa541176a1 (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')
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__ |