summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/scripts/context/perl
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2006-01-09 01:54:09 +0000
committerKarl Berry <karl@freefriends.org>2006-01-09 01:54:09 +0000
commit50b347972956e0bfbe7029305e0f459e5ce3ac0c (patch)
treed1b824bbc33a30bf7fcf54b866a1cff949d2e0bf /Master/texmf-dist/scripts/context/perl
parent52f01b2f769ac290674a469d46f149985042ee2e (diff)
trunk/Master/texmf-dist/scripts
git-svn-id: svn://tug.org/texlive/trunk@92 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/texmf-dist/scripts/context/perl')
-rw-r--r--Master/texmf-dist/scripts/context/perl/cont_mis.pm69
-rw-r--r--Master/texmf-dist/scripts/context/perl/cont_set.pm670
-rw-r--r--Master/texmf-dist/scripts/context/perl/fdf2tan.pl121
-rw-r--r--Master/texmf-dist/scripts/context/perl/fdf2tex.pl213
-rw-r--r--Master/texmf-dist/scripts/context/perl/makempy.pl365
-rw-r--r--Master/texmf-dist/scripts/context/perl/mptopdf.pl123
-rw-r--r--Master/texmf-dist/scripts/context/perl/path_tre.pm36
-rw-r--r--Master/texmf-dist/scripts/context/perl/texexec.pl3252
-rw-r--r--Master/texmf-dist/scripts/context/perl/texexec.rme169
-rw-r--r--Master/texmf-dist/scripts/context/perl/texfind.pl270
-rw-r--r--Master/texmf-dist/scripts/context/perl/texfont.pl1154
-rw-r--r--Master/texmf-dist/scripts/context/perl/texshow.pl936
-rw-r--r--Master/texmf-dist/scripts/context/perl/texutil.pl2902
-rw-r--r--Master/texmf-dist/scripts/context/perl/utiplug.pm30
14 files changed, 10310 insertions, 0 deletions
diff --git a/Master/texmf-dist/scripts/context/perl/cont_mis.pm b/Master/texmf-dist/scripts/context/perl/cont_mis.pm
new file mode 100644
index 00000000000..6bd449bf045
--- /dev/null
+++ b/Master/texmf-dist/scripts/context/perl/cont_mis.pm
@@ -0,0 +1,69 @@
+#D \module
+#D [ file=cont\_mis.pm,
+#D version=1999.05.05,
+#D title=General modules,
+#D subtitle=all kind of subs,
+#D author=Hans Hagen,
+#D date=\currentdate,
+#D copyright={PRAGMA / Hans Hagen \& Ton Otten}]
+#C
+#C This module is part of the \CONTEXT\ macro||package and is
+#C therefore copyrighted by \PRAGMA. See licen-en.pdf for
+#C details.
+
+#D Not yet documented, source will be cleaned up.
+
+package cont_mis ;
+
+use strict ;
+
+my ($message, $separator, $content) ;
+
+format =
+@>>>>>>>>>>>>>>>>>>>>> @ @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+$message,$separator,$content
+.
+
+sub report
+ { ($message, $separator, $content) = @_ ; write }
+
+sub crlf { print "\n" }
+sub banner { crlf ; report (shift , '/', shift) ; crlf }
+sub message { report (shift , ':', shift) }
+sub help { report (shift , ' ', shift) }
+sub status { message ('status' , shift) }
+sub warning { message ('warning' , shift) }
+sub error { message ('error' , shift) }
+sub continue { message ('' , shift) }
+
+sub hex_color
+ { my ($r,$g,$b) = @_ ;
+ if ($r>1) { $r=0xffff } else { $r = 0xffff*$r }
+ if ($g>1) { $g=0xffff } else { $g = 0xffff*$g }
+ if ($b>1) { $b=0xffff } else { $b = 0xffff*$b }
+ local $_ = sprintf "%4x%4x%4x", $r, $g, $b ;
+ s/ /0/go ;
+ return $_ }
+
+sub InterfaceFound
+ { local $_ = shift ;
+ if (/^\%.*interface=(.*?)\b/)
+ { return $1 }
+ elsif (/\\(starttekst|stoptekst|startonderdeel)/)
+ { return 'nl' }
+ elsif (/\\(stelle|verwende|umgebung|benutze)/)
+ { return 'de' }
+ elsif (/\\(stel|gebruik|omgeving)/)
+ { return 'nl' }
+ elsif (/\\(use|setup|environment)/)
+ { return 'en' }
+ elsif (/(hoogte|breedte|letter)=/)
+ { return 'nl' }
+ elsif (/(height|width|style)=/)
+ { return 'en' }
+ elsif (/(hoehe|breite|schrift)=/)
+ { return 'de' }
+ else
+ { return '' } }
+
+1;
diff --git a/Master/texmf-dist/scripts/context/perl/cont_set.pm b/Master/texmf-dist/scripts/context/perl/cont_set.pm
new file mode 100644
index 00000000000..41c62e75440
--- /dev/null
+++ b/Master/texmf-dist/scripts/context/perl/cont_set.pm
@@ -0,0 +1,670 @@
+#D \module
+#D [ file=cont\_set.pm,
+#D version=1999.04.01,
+#D title=General modules,
+#D subtitle=showing \CONTEXT\ commands,
+#D author=Hans Hagen,
+#D date=\currentdate,
+#D copyright={PRAGMA / Hans Hagen \& Ton Otten},
+#D suggestions={Tobias Burnus \& Taco Hoekater}]
+#C
+#C This module is part of the \CONTEXT\ macro||package and is
+#C therefore copyrighted by \PRAGMA. See licen-en.pdf for
+#C details.
+
+# todo: tacos speed patch
+
+#D As always: thanks to Taco and Tobias for testing this
+#D module and providing suggestions and code snippets as
+#D well as haunting bugs.
+
+package cont_set ;
+
+#D This module (package) deals with providing help information
+#D about the \CONTEXT\ commands. The data needed is derived
+#D from the setup files by \CONTEXT\ itself. The data is
+#D stored in files with suffix \type {tws} (tex work setup).
+#D This module introduces some subroutines:
+#D
+#D \starttabulatie[|Tl|p|]
+#D \NC \type {set\_setup\_interface} \NC sets the primary interface
+#D to search in \NC \NR
+#D \NC \type {set\_setup\_title} \NC sets the title of the main
+#D window title \NC \NR
+#D \NC \type {setups\_found} \NC locate the \type {tws} files
+#D using the \type {kpsewhich}
+#D program \NC \NR
+#D \NC \type {show\_setups} \NC allocate the radio buttons
+#D that can be used to select a
+#D command set \NC \NR
+#D \NC \type {load\_setup(filename)} \NC load the names \type {tws}
+#D file \NC \NR
+#D \NC \type {load\_setups} \NC all found command files can
+#D be loaded at once \NC \NR
+#D \NC \type {setup\_found(filename)} \NC this routine returns~1 when
+#D the file is loaded \NC \NR
+#D \NC \type {update\_setup} \NC when we browse the list with
+#D commands, this routine takes care
+#D of updating the text area \NC \NR
+#D \NC \type {change\_setup} \NC we can manually set the
+#D command set we want to browse,
+#D and this routine takes care of
+#D this \NC \NR
+#D \NC \type {show\_setup(command)} \NC context sensitive help can be
+#D provided by calling this sub \NC \NR
+#D \stoptabulatie
+#D
+#D First we load some packages and set some constants.
+
+use Tk ;
+use Tk::ROText ;
+use Config ;
+
+use strict;
+
+use subs qw/ update_setup / ;
+
+my $dosish = ($Config{'osname'} =~ /dos|win/i) ;
+my $default_size = $dosish ? 9 : 12 ;
+
+my $textfont = "Courier $default_size " ;
+my $userfont = "Courier $default_size italic" ;
+my $buttonfont = "Helvetica $default_size bold " ;
+
+unless ($dosish)
+ { $textfont = "-adobe-courier-bold-r-normal--$default_size-120-75-75-m-70-iso8859-1" ;
+ $userfont = "-adobe-courier-bold-o-normal--$default_size-120-75-75-m-70-iso8859-1" ;
+ $buttonfont = "-adobe-helvetica-bold-r-normal--$default_size-120-75-75-p-69-iso8859-1" }
+
+my $s_vertical = 30 ;
+my $s_horizontal = 72 ;
+my $c_horizontal = 24 ;
+
+#D The main window is not resizable, but the text area and
+#D command list will have scrollbars.
+
+my %lw ; # stack of lists
+
+my $mw = MainWindow -> new ( -title => 'ConTeXt commands' ) ;
+
+$mw -> withdraw() ; $mw -> resizable ('y', 'y') ;
+
+sub SetupWindow { return $mw } ;
+
+my $bw = $mw -> Frame () ; # buttons
+my $tw = $mw -> Frame () ; # sw + fw
+my $fw = $tw -> Frame () ; # string + list
+
+my $request = $fw -> Entry ( -font => $textfont ,
+ -background => 'ivory1' ,
+ -width => $c_horizontal ) ;
+
+my $cw = $fw -> Scrolled ( 'Listbox' ,
+ -scrollbars => 'e' ,
+ -font => $textfont ,
+ -width => $c_horizontal ,
+ -selectbackground => 'gray' ,
+ -background => 'ivory1' ,
+ -selectmode => 'browse' ) ;
+
+$cw -> pack ( -side => 'bottom' , -fill => 'both' , -expand => 1 ) ;
+$request -> pack ( -side => 'top' , -fill => 'x' ) ;
+
+my $sw = $tw -> Scrolled ( 'ROText' ,
+ -scrollbars => 'se' ,
+ -height => $s_vertical ,
+ -width => $s_horizontal ,
+ -wrap => 'none' ,
+ -background => 'ivory1' ,
+ -font => $textfont ) ;
+
+
+#D And the whole bunch of widgets are packed in the main
+#D window.
+
+sub pack_them_all
+ { $sw -> pack ( -side => 'left' , -fill => 'both' , -expand => 1 ) ;
+ $fw -> pack ( -side => 'right' , -fill => 'y' , -expand => 0 ) ;
+ $bw -> pack ( -side => 'top' , -fill => 'x' , -anchor => 'w' , -expand => 1 ) ;
+ $tw -> pack ( -side => 'bottom', -fill => 'both' , -expand => 1 ) }
+
+sub unpack_them_all
+ { }
+
+pack_them_all ;
+
+#D We scan for available setup files, with suffix \type {tws}.
+#D These should be somewhere on the system, grouped in one
+#D directory. At least the english file \type {cont-en.tws}
+#D should be found.
+
+my $tws_path = '' ;
+my @setup_files = ('cont-en.tws') ;
+my $setup_file = $setup_files[0] ;
+my $setup_interface = 'en' ;
+my $old_setup_file = '' ;
+
+sub set_setup_interface
+ { $setup_interface = shift }
+
+sub set_setup_title
+ { $mw -> configure ( -title => shift ) }
+
+sub setups_found
+ { $tws_path = `kpsewhich --format="other text files" --progname=context cont-en.tws` ;
+ $tws_path =~ s/cont-en\.tws.*// ;
+ chop $tws_path ;
+ @setup_files = glob ("$tws_path*.tws") ;
+ if (@setup_files)
+ { foreach (@setup_files) { s/\.tws// ; s/.*\/// }
+ $setup_file = $setup_files[0] ;
+ return 1 }
+ else
+ { return 0 } }
+
+#D A hide button
+
+sub show_hide_button
+ { my $hb = $bw -> Button ( -text => "hide" ,
+ -font => $buttonfont ,
+ -command => \&hide_widget ) ;
+ $hb -> pack ( -padx => '2p',
+ -pady => '2p',
+ -side => 'right' ) }
+
+sub hide_widget
+ { $mw -> withdraw() }
+
+#D The setup files can be shown and chosen.
+
+sub show_setups
+ { unpack_them_all ;
+ foreach (@setup_files)
+ { $lw{$_} = $bw -> Radiobutton ( -text => lc $_ ,
+ -value => $_ ,
+ -font => $buttonfont ,
+ -selectcolor => 'ivory1' ,
+ -indicatoron => 0 ,
+ -command => \&change_setup ,
+ -variable => \$setup_file ) ;
+ $lw{$_} -> pack ( -padx => '2p',
+ -pady => '2p',
+ -side => 'left' ) }
+ pack_them_all }
+
+$cw -> bind ('<B1-Motion>', \&update_setup ) ;
+$cw -> bind ('<1>' , \&update_setup ) ;
+$cw -> bind ('<Key>' , \&update_setup ) ;
+
+$sw -> tag ('configure', 'user' , -font => $userfont ) ;
+$sw -> tag ('configure', 'command' , -foreground => 'green3' ) ;
+$sw -> tag ('configure', 'variable' , -font => $userfont ) ;
+$sw -> tag ('configure', 'default' , -underline => 1 ) ;
+$sw -> tag ('configure', 'symbol' , -foreground => 'blue3' ) ;
+$sw -> tag ('configure', 'or' , -foreground => 'yellow3' ) ;
+$sw -> tag ('configure', 'argument' , -foreground => 'red3' ) ;
+$sw -> tag ('configure', 'par' , -lmargin1 => '4m' ,
+ -lmargin2 => '6m' ) ;
+
+my %setups ;
+my %commands ;
+my %loadedsetups ;
+my %positions ;
+my %crosslinks ;
+
+my $current_setup = '' ;
+
+#D Setups are organized in files called \type {*.tws} and
+#D alike. Several files can be loaded simultaneously. When
+#D loading, we grab whole paragraphs. The variables and values
+#D belonging to a command, are stored in the hash table \type
+#D {setups}, one per language. The command templates are
+#D stored in \type {commands}.
+#D
+#D A \type {tws} file is generated by \CONTEXT\ from the setup
+#D definition files. Only \CONTEXT\ knows the current meaning
+#D of commands and keywords. The files are generating by
+#D simply saying something like:
+#D
+#D \starttypen
+#D texexec --interface=en setupd
+#D texexec --interface=de setupd
+#D texexec --interface=nl setupd
+#D texexec --interface=cz setupd
+#D texexec --interface=it setupd
+#D \stoptypen
+#D
+#D This results in files formatted as:
+#D
+#D \starttypen
+#D startsetup
+#D com:setupcolors
+#D typ:vars/
+#D var:state:start,stop,global,local:
+#D var:conversion:yes,no,always:
+#D var:reduction:yes,no:
+#D var:rgb:yes,no:
+#D var:cmyk:yes,no:
+#D stopsetup
+#D \stoptypen
+#D
+#D This format can be stored rather efficient and parsed rather
+#D fast. What more do we need.
+
+sub load_setup
+ { my $filename = shift ;
+ unless (keys %{$commands{$filename}})
+ { local $/ = 'stopsetup' ; # in plaats van '' ivm unix ; (taco)
+ $current_setup = '' ;
+ if (open(SETUP, "$tws_path$filename.tws" ))
+ { my $position = 0 ;
+ while (<SETUP>)
+ { chomp ;
+ s/startsetup//mso ;
+ s/stopsetup//mso ; # redundant geworden
+ s/\r\n //gms ; # in plaats van s/ //gms ; (taco)
+ s/com\:(.*?)\:\s(.*)//mso ;
+ my $string = $1 ;
+ my $command = $1 ;
+ my $setup = $2 ;
+ ++$position ;
+ $string =~ s/(.*?)\<\<(.*?)\>\>(.*?)/$1$2$3/o ;
+ $setups {$filename}{$string} = $setup ;
+ $commands {$filename}{$string} = $command ;
+ $positions {$filename}{$string} = $position ;
+ $crosslinks{$filename}[$position] = $string }
+ close (SETUP) } }
+ my @list = sort {lc $a cmp lc $b} keys %{$commands{$filename}} ;
+ $cw -> delete ('0.0', 'end') ;
+ $cw -> insert ('end', @list) ;
+ $cw -> selectionSet ('0.0', '0.0') ;
+ $cw -> activate ('0.0') ;
+ $setup_file = $filename ;
+ update_setup }
+
+sub load_setups
+ { foreach my $setup (@setup_files) { load_setup ($setup) } ;
+ $mw -> deiconify() }
+
+#D The core of this module deals with transforming the
+#D definitions like shown earlier. Details on the format
+#D can be found in the file \type {setupd.tex}. We use the
+#D \type {Tk::Text} automatic hanging identation features.
+#D The next subs are examples of the kind you write once
+#D and never look at again.
+
+my @arguments = () ;
+my $nested_setup = 0 ;
+my $continue_setup = 0 ;
+my $argument = 0 ;
+my $stopsuffix = '' ;
+my $stopcommand = '' ;
+
+my %arg ;
+
+$arg {repeat} = '//n*/' ;
+$arg {arg} = 'argument/{/.../}' ;
+$arg {args} = 'argument/{/..,...,../}' ;
+$arg {dis} = 'argument/$$/.../$$' ;
+$arg {idx} = 'argument/{/.../}' ;
+$arg {idxs} = 'argument/{/..+...+../}' ;
+$arg {mat} = 'argument/$/...:$' ;
+$arg {nop} = '//.../' ;
+$arg {fil} = '//.../' ;
+$arg {pos} = 'symbol/(/.../)' ;
+$arg {poss} = 'symbol/(/...,.../)' ;
+$arg {sep} = 'command//\\\\/' ;
+$arg {ref} = 'symbol/[/ref/]' ;
+$arg {refs} = 'symbol/[/ref,../]' ;
+$arg {val} = 'symbol/[/.../]' ;
+$arg {vals} = 'symbol/[/..,...,../]' ;
+$arg {var} = 'symbol/[/..=../]' ;
+$arg {vars} = 'symbol/[/..,..=..,../]' ;
+$arg {cmd} = 'command//\cmd/' ;
+$arg {dest} = 'symbol/[/..ref/]' ;
+$arg {dests} = 'symbol/[/..,..refs,../]' ;
+$arg {trip} = 'symbol/[/x:y:z=/]' ;
+$arg {trips} = 'symbol/[/x:y:z=,../]' ;
+$arg {wrd} = 'argument/{/.../}' ;
+$arg {wrds} = 'argument/{/......./}' ;
+$arg {par} = 'command//\par/' ;
+$arg {stp} = '//stop/' ;
+$arg {par} = 'command///' ;
+
+sub show_command
+ { my $command = shift ;
+ local $_ = $commands{$setup_file}{$command} ;
+ if ($command eq $_)
+ { $sw -> insert ('end', "\\$command", 'command' ) }
+ elsif (/(.*?)\<\<(.*?)\>\>(.*?)/o)
+ { $sw -> insert ('end', "\\", 'command' ) ;
+ if ($1) { $sw -> insert ('end', $1, 'command' ) }
+ if ($2) { $sw -> insert ('end', $2, ['command','user'] ) }
+ if ($3) { $sw -> insert ('end', $3, 'command' ) }
+ $stopsuffix = $2 } }
+
+sub show_left_argument
+ { local $_ = shift ;
+ my @thearg = split (/\//, $arg{$arguments[$_]}) ;
+ $sw -> insert ('end', $thearg[1], ['par',$thearg[0]] ) }
+
+sub show_middle_argument
+ { local $_ = shift ;
+ my @thearg = split (/\//, $arg{$arguments[$_]}) ;
+ if ($thearg[1])
+ { $sw -> insert ('end', $thearg[2], 'par' ) }
+ else
+ { $sw -> insert ('end', $thearg[2], ['par',$thearg[0]] ) } }
+
+sub show_right_argument
+ { local $_ = shift ;
+ my @thearg = split (/\//, $arg{$arguments[$_]}) ;
+ $sw -> insert ('end', $thearg[3], ['par',$thearg[0]] ) ;
+ ++$argument }
+
+sub show_reference
+ { if (($nested_setup<=1)&&(defined($arguments[$argument])))
+ { if ($arguments[$argument]=~/ref/)
+ { $sw -> insert ('end', "\n" ) ;
+ show_left_argument ($argument) ;
+ show_middle_argument ($argument) ;
+ show_right_argument ($argument) } } }
+
+sub show_stop_command
+ { my $before_stop = shift ;
+ if ($stopcommand)
+ { if ($stopsuffix)
+ { $sw -> insert ('end', '\\stop', 'command' ) ;
+ $sw -> insert ('end', $stopsuffix, ['command','user'] ) }
+ else
+ { $sw -> insert ('end', $stopcommand, 'command' ) } } }
+
+sub show_whatever_left
+ { while ($argument<@arguments)
+ { $sw -> insert ('end', "\n" ) ;
+ show_left_argument ($argument) ;
+ show_middle_argument ($argument) ;
+ show_right_argument ($argument) ;
+ ++$argument }
+ if ($stopcommand)
+ { $sw -> insert ('end', "\n...\n...\n...\n", 'par') ;
+ show_stop_command } }
+
+sub do_update_setup # type: 0=all 1=vars 2=vals
+ { my ($command, $type) = @_ ;
+ my $setup = $setups{$setup_file}{$command} ;
+ my $default = '' ;
+ my $key = '' ;
+ my $meaning = '' ;
+ my @values = () ;
+ local $_ ;
+ ++$nested_setup ;
+ while ($setup=~/(typ|var|val|ivr|ivl)\:(.*?)\:\s/mgo)
+ { $key = $1 ;
+ $meaning = $2 ;
+ if (($key=~/var/o)&&($type!=2))
+ { $_ = $meaning ; s/(.*?)\:(.*?)\:(.*)//o ;
+ if (($nested_setup>1)&&(!$2)) { next }
+ $key = $1 ;
+ if ($3) { $default = $3 } else { $default = '' }
+ $_= $2 ; s/\s//go ; @values = split (/,/,$_) ;
+ if ($continue_setup)
+ { $sw -> insert ('end', ",\n ", 'par') }
+ else
+ { $continue_setup = 1 ;
+ $sw -> insert ('end', "\n", 'par') ;
+ show_left_argument($argument) }
+ $sw -> insert ('end', $key , 'par' ) ;
+ $sw -> insert ('end', '=', ['symbol','par'] ) ;
+ #while (1)
+ while (@values)
+ { my $value = shift @values ;
+ if ($value =~ /^\*/o)
+ { $value =~ s/^\*//o ;
+ $sw -> insert ('end', lc $value, ['variable','par'] ) }
+ elsif ($value eq $default)
+ { $sw -> insert ('end', $value, ['default','par'] ) }
+ else
+ { $sw -> insert ('end', $value, 'par' ) }
+ if (@values)
+ { $sw -> insert ('end', '|' , ['or','par'] ) }
+ else
+ { last } } }
+ elsif (($key=~/val/o)&&($type!=1))
+ { $_ = $meaning ; s/(.*)\:(.*)//o ;
+ if (($nested_setup>1)&&(!$2)) { next }
+ $_ = $1 ; s/\s//go ; @values = split (/,/,$_) ;
+ if ($2) { $default = $2 } else { $default = '' }
+ if ($continue_setup)
+ { $continue_setup = 0 ;
+ show_right_argument($argument) }
+ $sw -> insert ('end', "\n" , 'par') ;
+ show_left_argument($argument) ;
+ #while (1)
+ while (@values)
+ { unless (@values) { last }
+ my $value = shift (@values) ;
+ if ($value =~ /^\*/o)
+ { $value =~ s/^\*//o ;
+ $sw -> insert ('end', lc $value, ['variable','par'] ) }
+ elsif ($value eq $default)
+ { $sw -> insert ('end', $value, ['default','par'] ) }
+ else
+ { $sw -> insert ('end', $value, 'par' ) }
+ if (@values)
+ { $sw -> insert ('end', ', ', 'par' ) }
+ else
+ { last } }
+ show_right_argument($argument) }
+ elsif ($key=~/typ/o)
+ { if ($nested_setup==1)
+ { show_command ($command) ;
+ my $arguments = $meaning ;
+ if ($arguments=~/stp/)
+ { $_ = $command ;
+ s/start(.*)/$1/o ;
+ $stopcommand = "\\stop$_" ;
+ $arguments =~ s/stp//go }
+ @arguments = split (/\//,$arguments) ;
+ if (@arguments)
+ { for (my $i=0;$i<@arguments;$i++)
+ { show_left_argument ($i) ;
+ show_middle_argument ($i) ;
+ show_right_argument ($i) }
+ if ($stopcommand)
+ { $sw -> insert ('end', ' ... ') ;
+ show_stop_command }
+ $sw -> insert ('end', "\n\n") ;
+ show_command ($command) }
+ $argument = 0 ;
+ $continue_setup = 0 } }
+ elsif ($key=~/ivr/o)
+ { $meaning =~ s/(.*)\:(.*)//o ;
+ do_update_setup ($1,1) }
+ elsif ($key=~/ivl/o)
+ { $meaning =~ s/(.*)\:(.*)//o ;
+ do_update_setup ($1,2) }
+ show_reference }
+ --$nested_setup ;
+ if (($continue_setup)&&(!$nested_setup))
+ { show_right_argument ;
+ show_whatever_left } }
+
+#D Now the real work is done, we only have to define a few
+#D housekeeping routines. The next sub adapts the text area
+#D to the current selected command and normally is bound to
+#D the list browsing commands.
+
+sub update_setup
+ { $old_setup_file = $setup_file ;
+ if (keys %{$commands{$setup_file}})
+ { my $key ;
+ unless ($cw->curselection)
+ { $cw -> selectionSet('0.0','0.0') }
+ $key = $cw -> get($cw->curselection) ;
+ if ($current_setup ne $key)
+ { $current_setup = $key ;
+ $sw -> delete ('1.0', 'end' ) ;
+ $nested_setup = 0 ;
+ $argument = 0 ;
+ $stopcommand = '' ;
+ $stopsuffix = '' ;
+ do_update_setup ($key,0) ;
+ $mw -> raise ;
+ $mw -> focus } } }
+
+#D In editors we want to provide context sensitive help
+#D information. The next sub first tries to locate the
+#D commands asked for in the setup data currently selected,
+#D and when not found takes a look at all the loaded files.
+
+sub show_setup
+ { my $asked_for = shift ;
+ unless ($asked_for) { return }
+ my $found = 0 ;
+ $asked_for =~ s/^\\// ;
+ if ($setup_interface)
+ { $found = 0 ;
+ foreach my $name (@setup_files)
+ { if (($name=~/\-$setup_interface/)&&(exists($commands{$name}{$asked_for})))
+ { $found = 1 ;
+ $setup_file = $name ;
+ last } } }
+ if (!($found)&&(exists($commands{$setup_file}{$asked_for})))
+ { $found = 1 }
+ else
+ { $found = 0 ;
+ foreach my $name (@setup_files)
+ { if (exists($commands{$name}{$asked_for}))
+ { $found = 1 ;
+ $setup_file = $name ;
+ last } } }
+ if ($found)
+ { my @list = sort {lc $a cmp lc $b} keys %{$commands{$setup_file}} ;
+ $cw -> delete ('0.0', 'end') ;
+ $cw -> insert ('end', @list) ;
+ $found = 0 ;
+ foreach (@list) { if ($_ eq $asked_for) { last } ++$found }
+ my $index = "$found.0" ;
+ $cw -> selectionSet ($index, $index) ;
+ $cw -> activate ($index) ;
+ $cw -> see ($index) ;
+ update_setup ;
+ $mw -> raise ;
+ $mw -> focus } }
+
+#D Whenever a new set of commands is selected (by means of the
+#D buttons on top the screen) the list and text are to be
+#D updated.
+
+sub change_setup
+ { my $command = '' ;
+ if ($old_setup_file)
+ { unless ($cw->curselection)
+ { $cw -> selectionSet('0.0','0.0') }
+ $command = $cw -> get($cw->curselection) ;
+ my $position = $positions{$old_setup_file}{$command} ;
+ $command = $crosslinks{$setup_file}[$position] }
+ load_setup($setup_file) ;
+ my @list = sort {lc $a cmp lc $b} keys %{$commands{$setup_file}} ;
+ $cw -> delete ('0.0', 'end') ;
+ $cw -> insert ('end', @list) ;
+ if ($command)
+ { show_setup($command) }
+ else
+ { $cw -> selectionClear ('0.0','end') ;
+ $cw -> selectionSet ('0.0', '0.0') ;
+ $cw -> see ('0.0') ;
+ $cw -> activate ('0.0') }
+ update_setup ;
+ $mw -> raise ;
+ $mw -> focus }
+
+#D Sometimes we want to make sure the dat is loaded indeed:
+
+sub setup_found
+ { my $filename = shift ;
+ if (-e "$tws_path$filename.tws")
+ { $setup_file = $filename ;
+ return 1 }
+ else
+ { return 0 } }
+
+#D The next feature is dedicated to Tobias, who suggested
+#D it, and Taco, who saw it as yet another proof of the
+#D speed of \PERL. It's also dedicated to Ton, who needs it
+#D for translating the big manual.
+
+sub handle_request
+ { my $index = $cw -> index('end') ;
+ unless ($index) { return }
+ my $req = $request -> get ;
+ unless ($req) { return }
+ $req =~ s/\\//o ;
+ $req =~ s/\s//go ;
+ $request -> delete('0','end') ;
+ $request -> insert('0',$req) ;
+ unless ($req) { return }
+ my ($l,$c) = split (/\./,$index) ;
+ for (my $i=0;$i<=$l;$i++)
+ { $index = "$i.0" ;
+ my $str = $cw -> get ($index, $index) ;
+ if ($str =~ /^$req/)
+ { $cw -> selectionClear ('0.0','end') ;
+ $cw -> selectionSet ($index, $index) ;
+ $cw -> activate ($index) ;
+ $cw -> see ($index) ;
+ update_setup ;
+ $mw -> raise ;
+ $mw -> focus ;
+ return } } }
+
+$request -> bind ('<Return>', sub { handle_request } ) ;
+
+sub insert_request
+ { my ($self, $chr) = @_ ;
+ if ($self ne $request)
+ { $request -> insert ('end', $chr) }
+ handle_request }
+
+foreach my $chr ('a'..'z','A'..'Z')
+ { $mw -> bind ( "<KeyPress-$chr>", sub { insert_request(shift, $chr) } ) }
+
+$mw -> bind ( "<backslash>", sub { insert_request(shift, "\\") } ) ;
+
+sub delete_request
+ { my $self = shift ;
+ if ($self ne $request)
+ { my $to = $request -> index ('end') ;
+ my $from = $to - 1 ;
+ if ($from<0) { $from = 0 }
+ $request -> delete ($from,$to) }
+ handle_request }
+
+$mw -> bind ( "<BackSpace>", sub { delete_request } ) ;
+
+sub new_request
+ { $request -> delete (0,'end') ;
+ handle_request }
+
+$mw -> bind ( "<space>", sub { new_request } ) ;
+
+#D Just in case:
+
+sub raise_setup
+ { $mw -> raise }
+
+sub dont_exit
+ { $mw -> protocol( 'WM_DELETE_WINDOW' => sub { } ) }
+
+#D An example use is:
+#D
+#D \starttypen
+#D load_setup ("cont-$nl") ;
+#D show_setup ('omlijnd') ;
+#D MainLoop () ;
+#D \stoptypen
+#D
+#D Now everything is done, we return 1:
+
+1 ;
diff --git a/Master/texmf-dist/scripts/context/perl/fdf2tan.pl b/Master/texmf-dist/scripts/context/perl/fdf2tan.pl
new file mode 100644
index 00000000000..c612f9886e1
--- /dev/null
+++ b/Master/texmf-dist/scripts/context/perl/fdf2tan.pl
@@ -0,0 +1,121 @@
+eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}' && eval 'exec perl -S $0 $argv:q'
+ if 0;
+
+#D \module
+#D [ file=fdf2tan.pl,
+#D version=2000.02.06,
+#D title=converting \FDF\ annotations,
+#D subtitle=fdf2tan,
+#D author=Hans Hagen,
+#D date=\currentdate,
+#D copyright={PRAGMA / Hans Hagen \& Ton Otten}]
+#C
+#C This module is part of the \CONTEXT\ macro||package and is
+#C therefore copyrighted by \PRAGMA. See licen-en.pdf for
+#C details.
+
+#D This is a preliminary version, that will probably be changed
+#D and merged into a more general module.
+
+use Text::Wrap ;
+
+my $filename = $ARGV[0] ; exit if ($filename eq '') ;
+
+$filename =~ s/\..*$//o ;
+
+my $D = "[0-9\-\.]" ;
+my $nn = 0 ;
+
+my %stack ;
+
+sub saveobject
+ { $n = shift ; $str = shift ;
+ if ($n>$max) { $max = $n }
+ if ($str =~ s/\/Type\s+\/Annot\s+\/Subtype\s+\/Text//o)
+ { ++$nn ;
+ $str =~ s/\/Page\s+(\d+)//o ;
+ $page = $1 ; ++$page ;
+ $str =~ s/\/Rect\s+\[\s*(.*?)\s*\]//o ;
+ $rec = $1 ;
+ if ($rec =~ /($D+)\s*($D+)\s*($D+)\s*($D+)/o)
+ { $FDFllx = $1 ; $FDFlly = $2 ; $FDFurx = $3 ; $FDFury = $4 }
+ $X = $FDFllx - $PDFllx ;
+ $Y = $PDFury - $FDFury ;
+ $str =~ s/\/M\s.*$//o ;
+ $str =~ s/\/T\s.*$//o ;
+ $str =~ s/^.*\/Contents\s.*?\(//o ;
+ $str =~ s/\)\s+$//o ;
+ $str =~ s/\\\\r/@@@@@@/o ;
+ $str =~ s/\\r/\n/go;
+ $str =~ s/@@@@@@/\\r/o ;
+ $str =~ s/\\([\<\>\(\)\{\}\\])/$1/go ;
+ $stack{sprintf("test:%3d %3d %3d\n",$page,$Y,$X)} =
+ "\\startFDFcomment[$page]" .
+ sprintf("[%.3f,%.3f]",$X,$Y) .
+ "\n$str\n\\stopFDFcomment\n\n" } }
+
+exit unless (open (PDF,"<$filename.pdf")) ; binmode PDF ;
+exit unless (open (FDF,"<$filename.fdf")) ;
+exit unless (open (TAN,">$filename.tan")) ;
+
+print "processing $filename ... " ;
+
+$PDFllx = 0 ; $PDFlly = 0 ; $PDFurx = 597 ; $PDFury = 847 ;
+
+while (<PDF>)
+ { if (/\/MediaBox\s*\[\s*($D+)\s*($D+)\s*($D+)\s*($D+)/o)
+ { $PDFllx = $1 ; $PDFlly = $2 ; $PDFurx = $3 ; $PDFury = $4 ;
+ last } }
+
+$_ = "" ; while ($Line=<FDF>) { chomp $Line; $_ .= $Line }
+
+s/\\n/ /go ;
+s/\\\s//go ;
+
+s/\\225/\\\/L/go ; s/\\226/\\OE/go ; s/\\227/\\vS/go ;
+s/\\230/\\"Y/go ; s/\\231/\\vZ/go ; s/\\233/\\\/l/go ;
+s/\\234/\\oe/go ; s/\\235/\\vs/go ; s/\\236/\\vz/go ;
+s/\\253/\\<</go ; s/\\273/\\>>/go ; s/\\300/\\`A/go ;
+s/\\301/\\'A/go ; s/\\302/\\^A/go ; s/\\303/\\~A/go ;
+s/\\304/\\"A/go ; s/\\305/\\oA/go ; s/\\306/\\AE/go ;
+s/\\307/\\,C/go ; s/\\310/\\`E/go ; s/\\311/\\'E/go ;
+s/\\312/\\^E/go ; s/\\313/\\"E/go ; s/\\314/\\`I/go ;
+s/\\315/\\'I/go ; s/\\316/\\^I/go ; s/\\317/\\"I/go ;
+s/\\321/\\~N/go ; s/\\322/\\`O/go ; s/\\323/\\'O/go ;
+s/\\324/\\^O/go ; s/\\325/\\~O/go ; s/\\326/\\"O/go ;
+s/\\330/\\\/O/go ; s/\\331/\\`U/go ; s/\\332/\\'U/go ;
+s/\\333/\\^U/go ; s/\\334/\\"U/go ; s/\\335/\\'Y/go ;
+s/\\337/\\SS/go ; s/\\340/\\`a/go ; s/\\341/\\'a/go ;
+s/\\342/\\^a/go ; s/\\343/\\~a/go ; s/\\344/\\"a/go ;
+s/\\345/\\oa/go ; s/\\346/\\ae/go ; s/\\347/\\,c/go ;
+s/\\350/\\`e/go ; s/\\351/\\'e/go ; s/\\352/\\^e/go ;
+s/\\353/\\"e/go ; s/\\354/\\`i/go ; s/\\355/\\'i/go ;
+s/\\356/\\^i/go ; s/\\357/\\"i/go ; s/\\361/\\~n/go ;
+s/\\362/\\`o/go ; s/\\363/\\'o/go ; s/\\364/\\^o/go ;
+s/\\365/\\~o/go ; s/\\366/\\"o/go ; s/\\370/\\\/o/go ;
+s/\\371/\\`u/go ; s/\\372/\\'u/go ; s/\\373/\\^u/go ;
+s/\\374/\\"u/go ; s/\\375/\\'y/go ; s/\\377/\\"y/go ;
+
+s/\\(\d\d\d)/[$1]/go ;
+
+while (s/(\d+)(\s+\d+\s+obj)(.*?)endobj/saveobject($1,$3)/goe) { }
+
+$wrap::columns = 80 ;
+
+foreach $key (sort keys %stack)
+ { print TAN wrap("","",$stack{$key}) }
+
+close (PDF) ; close (FDF) ; close (TAN) ;
+
+if (open (TAN,">fdf-tan.tex"))
+ { print TAN "% interface=en output=pdftex\n\n" .
+ "\\setupcolors[state=start]\n\n" .
+ "\\setupinteraction[state=start]\n\n" .
+ "\\setupbodyfont[pos,10pt]\n\n" .
+ "\\starttext\n\n" .
+ "\\usemodule[fdfann]\n\n" .
+ "\\annotatepages[$filename]\n\n" .
+ "\\stoptext\n" ;
+ close (TAN) }
+
+print "$nn annotations found, run 'texexec fdf-tan'\n" ;
diff --git a/Master/texmf-dist/scripts/context/perl/fdf2tex.pl b/Master/texmf-dist/scripts/context/perl/fdf2tex.pl
new file mode 100644
index 00000000000..f9684cd9f21
--- /dev/null
+++ b/Master/texmf-dist/scripts/context/perl/fdf2tex.pl
@@ -0,0 +1,213 @@
+eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}' && eval 'exec perl -S $0 $argv:q'
+ if 0;
+
+# not yet public
+
+# We're dealing with:
+
+$InpFile = $ARGV[0] ; $OutFile = $ARGV[1] ; $Field = $ARGV[2] ;
+
+# beware: fields are funny sorted
+
+$Program = "fdf2tex 1.02 - ConTeXt / PRAGMA 1997-2000" ;
+
+if ($Field eq "")
+ { print "\n$Program\n\n" }
+
+# filter \type{filename.fdf} into \type{filename.fdt}
+
+unless ($OutFile)
+ { $OutFile = $InpFile ;
+ $OutFile =~ s/\..*// }
+
+unless ($InpFile=~/\./)
+ { if (-e "$InpFile.fdf")
+ { $InpFile .= ".fdf" }
+ elsif (-e "$InpFile.xml")
+ { $InpFile .= ".xml" } }
+
+unless ($OutFile=~/\./)
+ { $OutFile .= ".fdt" }
+
+if (open (FDF, "<$InpFile"))
+ { binmode FDF ;
+ open (FDT, ">$OutFile") ;
+ if ($Field eq "")
+ { print " input file : $InpFile\n" ;
+ print " output file : $OutFile\n" } }
+else
+ { if ($Field eq "")
+ { print " error : $InpFile not found\n" }
+ exit }
+
+# load the whole file in the buffer
+
+$_ = "" ; while ($Line=<FDF>) { chomp $Line; $_ .= $Line }
+
+# or faster: dan ///s gebruiken (ipv m)
+
+# $/ = "\0777" ; $_ = <FDF> ;
+
+# zoom in on the objects and remove the header and trialer
+
+if ($InpFile =~ /\.xml$/)
+
+{ # begin kind of xml alternative
+
+s/\>\s*\</\>\</goms ;
+$N = s/\<field\s+(.*?)\/\>/\\FDFfield\[$1\]\n/goms ;
+s/(name|value)\=\"(.*?)\"/$1=\{$2\}/goms ;
+s/\} (name|value)/\}\,$1/goms ;
+s/\<fdfobject\>(.*?)\<\/fdfobject\>/\\beginFDFobject\n$1\\endFDFobject\n/goms ;
+s/\<fdfdata\>(.*?)\<\/fdfdata\>/\\beginFDFdata\n$1\\endFDFdata\n/goms ;
+s/\<fdffields\>(.*?)\<\/fdffields\>/\\beginFDFfields\n$1\\endFDFfields\n/goms ;
+
+} # end kind of xml alternative
+
+else
+
+{ # begin fdf alternative
+
+s/.*?obj\s*?<<(.*?)>>\s*?endobj/\n\\beginFDFobject$1\n\\endFDFobject/go;
+s/trailer.*//;
+
+# zoom in on the FDF data
+
+s/\/FDF.*?<<(.*)>>/\n\\beginFDFdata$1\n\\endFDFdata/go;
+
+# zoom in on the Field collection and remove whatever else
+
+s/\/Fields.*?\[.*?<<.*?(.*).*?>>.*?\]/\n\\beginFDFfields<<$1>>\n\\endFDFfields/go;
+s/\\endFDFfields.*\n\\endFDFdata/\\endFDFfields\n\\endFDFdata/go;
+
+# tag each field
+
+$N = s/\<<(.*?)>>/\n\\FDFfield[$1]/go;
+
+# remove non relevant entries, but keep \type{/T} and \type{/V}
+
+s/\s*?\/[Kids|Opt]\s*?<<.*?>>//go;
+s/\s*?\/[Ff|setFf|ClrFf|F|SetF|ClrF]\s*?\d*?//go;
+s/\s*?\/[AP|A|AS]\s*?\[.*?\]//go;
+s/\s*?\/AS\s*?\/.*?\s//go;
+
+# format the field identifier
+
+s/(.*?)\/T.*?\((.*?)\)/$1 name=$2,/go;
+
+# format the value, which can be a name or string
+
+s/\/V\s?\((.*?)\)/value=\{$1\},/go;
+s/\/V\s?\/(.*?)[\s|\/]/value=\{$1\},/go;
+
+# sanitize some special \TeX\ tokens
+
+s/(\#|\$|\&|\^|\_|\|)/\\$1/go;
+
+# remove spaces and commas
+
+#s/\s?([name|value])/$1/go;
+s/\[\s*/\[/go;
+s/,\]/\]/go;
+
+# convert PDFDocEncoding
+
+s/\\225/\\\/L/ ;
+s/\\226/\\OE/ ;
+s/\\227/\\vS/ ;
+s/\\230/\\"Y/ ;
+s/\\231/\\vZ/ ;
+s/\\233/\\\/l/ ;
+s/\\234/\\oe/ ;
+s/\\235/\\vs/ ;
+s/\\236/\\vz/ ;
+s/\\253/\\<</ ;
+s/\\273/\\>>/ ;
+s/\\300/\\`A/ ;
+s/\\301/\\'A/ ;
+s/\\302/\\^A/ ;
+s/\\303/\\~A/ ;
+s/\\304/\\"A/ ;
+s/\\305/\\oA/ ;
+s/\\306/\\AE/ ;
+s/\\307/\\,C/ ;
+s/\\310/\\`E/ ;
+s/\\311/\\'E/ ;
+s/\\312/\\^E/ ;
+s/\\313/\\"E/ ;
+s/\\314/\\`I/ ;
+s/\\315/\\'I/ ;
+s/\\316/\\^I/ ;
+s/\\317/\\"I/ ;
+s/\\321/\\~N/ ;
+s/\\322/\\`O/ ;
+s/\\323/\\'O/ ;
+s/\\324/\\^O/ ;
+s/\\325/\\~O/ ;
+s/\\326/\\"O/ ;
+s/\\330/\\\/O/ ;
+s/\\331/\\`U/ ;
+s/\\332/\\'U/ ;
+s/\\333/\\^U/ ;
+s/\\334/\\"U/ ;
+s/\\335/\\'Y/ ;
+s/\\337/\\ss/ ;
+s/\\340/\\`a/ ;
+s/\\341/\\'a/ ;
+s/\\342/\\^a/ ;
+s/\\343/\\~a/ ;
+s/\\344/\\"a/ ;
+s/\\345/\\oa/ ;
+s/\\346/\\ae/ ;
+s/\\347/\\,c/ ;
+s/\\350/\\`e/ ;
+s/\\351/\\'e/ ;
+s/\\352/\\^e/ ;
+s/\\353/\\"e/ ;
+s/\\354/\\`i/ ;
+s/\\355/\\'i/ ;
+s/\\356/\\^i/ ;
+s/\\357/\\"i/ ;
+s/\\361/\\~n/ ;
+s/\\362/\\`o/ ;
+s/\\363/\\'o/ ;
+s/\\364/\\^o/ ;
+s/\\365/\\~o/ ;
+s/\\366/\\"o/ ;
+s/\\370/\\\/o/ ;
+s/\\371/\\`u/ ;
+s/\\372/\\'u/ ;
+s/\\373/\\^u/ ;
+s/\\374/\\"u/ ;
+s/\\375/\\'y/ ;
+s/\\377/\\"y/ ;
+
+s/\\\</\</ ;
+s/\\\>/\>/ ;
+s/\\\(/\(/ ;
+s/\\\)/\)/ ;
+s/\#/\\#/ ;
+
+# convert newline and return commands
+
+s/\\n/ /go;
+s/\\r/\\par /go;
+
+} # end fdf alternative
+
+# flush buffer
+
+print FDT $_ ;
+
+close FDT ;
+close FDF ;
+
+# report some characteristics
+
+if ($Field eq "")
+ { print " number of fields : $N\n" }
+else
+ { if (/\\FDFfield\[value\=\{(.*)\}\,\s*name=$Field/mos)
+ { print "$1" }
+ elsif (/\\FDFfield\[name=$Field\,\s*value\=\{(.*)\}/mos)
+ { print "$1" } }
diff --git a/Master/texmf-dist/scripts/context/perl/makempy.pl b/Master/texmf-dist/scripts/context/perl/makempy.pl
new file mode 100644
index 00000000000..49fd9bbd21a
--- /dev/null
+++ b/Master/texmf-dist/scripts/context/perl/makempy.pl
@@ -0,0 +1,365 @@
+eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}' && eval 'exec perl -S $0 $argv:q'
+ if 0;
+
+#D \module
+#D [ file=makempy.pl,
+#D version=2000.12.14,
+#D title=\METAFUN,
+#D subtitle=\METAPOST\ Text Graphics,
+#D author=Hans Hagen,
+#D date=\currentdate,
+#D copyright={PRAGMA / Hans Hagen \& Ton Otten}]
+#C
+#C This module is part of the \CONTEXT\ macro||package and is
+#C therefore copyrighted by \PRAGMA. See licen-en.pdf for
+#C details.
+
+# Tobias Burnus provided the code needed to proper testing
+# of binaries on UNIX as well as did some usefull suggestions
+# to improve the functionality.
+
+# This script uses GhostScript and PStoEdit as well as
+# pdfTeX, and if requested TeXEdit and ConTeXt.
+
+# todo: we can nowadays do without the intermediate step, because GS
+# can now handle PDF quite good
+
+use Getopt::Long ;
+use Config ;
+use strict ;
+
+$Getopt::Long::passthrough = 1 ; # no error message
+$Getopt::Long::autoabbrev = 1 ; # partial switch accepted
+
+my $help = 0 ;
+my $silent = 0 ;
+my $force = 0 ;
+my $noclean = 0 ;
+
+my $amethod = my $pmethod = my $gmethod = 0 ;
+
+my $format = "plain" ; # can be "context" for plain users too
+
+&GetOptions
+ ( "help" => \$help ,
+ "silent" => \$silent ,
+ "force" => \$force ,
+ "pdftops" => \$pmethod ,
+ "xpdf" => \$pmethod ,
+# "acrobat" => \$amethod , # nowadays the reader is not that clear about this being permitted
+ "reader" => \$amethod ,
+ "gs" => \$gmethod ,
+ "ghostscript" => \$gmethod ,
+ "noclean" => \$noclean ) ;
+
+my $mpochecksum = 0 ;
+
+my %tex ; my %start ; my %stop ;
+
+$tex{plain} = "pdftex" ;
+$tex{latex} = "pdflatex" ;
+$tex{context} = "texexec --batch --once --interface=en --pdf" ;
+
+$start{plain} = '' ;
+$stop{plain} = '\end' ;
+
+$start{latex} = '\begin{document}' ;
+$stop{latex} = '\end{document}' ;
+
+$start{context} = '\starttext' ;
+$stop{context} = '\stoptext' ;
+
+my $ghostscript = "" ;
+my $pstoedit = "" ;
+my $pdftops = "" ;
+my $acroread = "" ;
+
+my $wereondos = ($Config{'osname'} =~ /dos|mswin/io) ;
+
+# Unix only: assume that "gs" in the path. We could also
+# use $ghostscipt = system "which gs" but this would require
+# that which is installedd on the system.
+
+sub checkenv
+ { my ($var, $env) = @_ ;
+ if ($var)
+ { return $var }
+ elsif ($ENV{$env})
+ { return $ENV{$env} }
+ else
+ { return $var } }
+
+$ghostscript = checkenv ($ghostscript, "GS_PROG" ) ;
+$ghostscript = checkenv ($ghostscript, "GS" ) ;
+$pstoedit = checkenv ($pstoedit , "PSTOEDIT") ;
+$pdftops = checkenv ($pdftops , "PDFTOPS" ) ;
+$acroread = checkenv ($acroread , "ACROREAD") ;
+
+sub setenv
+ { my ($var, $unix, $win) = @_ ;
+ if ($var)
+ { return $var }
+ elsif ($wereondos)
+ { return $win }
+ else
+ { return $unix } }
+
+$ghostscript = setenv($ghostscript, "gs" , "gswin32c") ;
+$pstoedit = setenv($pstoedit , "pstoedit", "pstoedit") ;
+$pdftops = setenv($pdftops , "pdftops" , "pdftops" ) ;
+$acroread = setenv($acroread , "acroread", "" ) ;
+
+# Force a method if unknown.
+
+unless ($pmethod||$amethod||$gmethod)
+ { if ($wereondos) { $pmethod = 1 } else { $amethod = 1 } }
+
+# Set the error redirection used under Unix:
+# stderr -> stdout
+
+my $logredirection = '>>' ;
+
+# This unfortunally doesn't work with the ksh and simple sh
+#
+# if (!$wereondos)
+# { $logredirection = '2>&1 >>' ; # Bash
+# $logredirection = '>>&' ; # tcsh, Bash
+# default $logredirection. }
+
+# Some TeX Code Snippets.
+
+my $macros = '
+
+% auxiliary macros
+
+\input supp-mis.tex
+
+\def\startTEXpage[scale=#1]%
+ {\output{}
+ \batchmode
+ \pdfoutput=1
+ \pdfcompresslevel=9
+ \hoffset=-1in
+ \voffset=\hoffset
+ \scratchcounter=#1
+ \divide\scratchcounter1000
+ \edef\TEXscale{\the\scratchcounter\space}
+ \forgetall
+ \setbox0=\vbox\bgroup}
+
+\def\stopTEXpage
+ {\egroup
+ \dimen0=\ht0 \advance\dimen0 \dp0
+ \setbox2=\vbox to 10\dimen0
+ {\pdfliteral{\TEXscale 0 0 \TEXscale 0 0 cm}
+ \copy0
+ \pdfliteral{1 0 0 1 0 0 cm}
+ \vfill}
+ \wd2=10\wd0
+ \pdfpageheight=\ht2
+ \pdfpagewidth=\wd2
+ \ScaledPointsToBigPoints{\number\pdfpageheight}\pdfcropheight
+ \ScaledPointsToBigPoints{\number\pdfpagewidth }\pdfcropwidth
+ \expanded{\pdfpageattr{/CropBox [0 0 \pdfcropwidth \space \pdfcropheight]}}
+ \shipout\hbox{\box2}}
+
+% end of auxiliary macros' ;
+
+sub report
+ { return if $silent ;
+ my $str = shift ;
+ if ($str =~ /(.*?)\s+([\:\/])\s+(.*)/o)
+ { if ($1 eq "") { $str = " " } else { $str = $2 }
+ print sprintf("%22s $str %s\n",$1,$3) } }
+
+sub error
+ { report("processing aborted : " . shift) ;
+ exit }
+
+sub process
+ { report("generating : " . shift) }
+
+sub banner
+ { return if $silent ;
+ print "\n" ;
+ report ("MakeMPY 1.1 - MetaFun / PRAGMA ADE 2000-2004") ;
+ print "\n" }
+
+my $metfile = "" ; # main metapost file
+my $mpofile = "" ; # metapost text specifiation file (provided)
+my $mpyfile = "" ; # metapost text picture file (generated)
+my $texfile = "" ; # temporary tex file
+my $pdffile = "" ; # temporary pdf file
+my $tmpfile = "" ; # temporary metapost file
+my $posfile = "" ; # temporary postscript file
+my $logfile = "" ; # temporary log file
+my $errfile = "" ; # final log file (with suffix log)
+
+sub show_help_info
+ { banner ;
+ report ("--help : this message" ) ;
+ report ("--noclean : don't remove temporary files" ) ;
+ report ("--force : force processing (ignore checksum)" ) ;
+ report ("--silent : don't show messages" ) ;
+ print "\n" ;
+ report ("--acrobat : use acrobat (reader) for pdf->ps (on unix)") ;
+ report ("--pdftops : use pdftops (xpdf) pdf->ps") ;
+ report ("--ghostscript : use ghostscript (gs) for pdf->ps") ;
+ print "\n" ;
+ report ("input file : metapost file with graphics") ;
+ report ("programs needed : texexec and english context") ;
+ report (" : pdftops from the xpdf suite, or") ; # page size buggy
+ report (" : pdf2ps and ghostscript, or") ;
+ report (" : acrobat reader for unix, and") ;
+ report (" : pstoedit and ghostscript") ;
+ report ("output file : metapost file with pictures") ;
+ exit }
+
+sub check_input_file
+ { my $file = $ARGV[0] ;
+ if ((!defined($file))||($file eq ""))
+ { banner ; error("no filename given") }
+ else
+ { $file =~ s/\.mp.*$//o ;
+ $metfile = "$file.mp" ;
+ $mpofile = "$file.mpo" ;
+ $mpyfile = "$file.mpy" ;
+ $logfile = "$file.log" ;
+ $texfile = "mpy-$file.tex" ;
+ $pdffile = "mpy-$file.pdf" ;
+ $posfile = "mpy-$file.pos" ;
+ $tmpfile = "mpy-$file.tmp" ;
+ $errfile = "mpy-$file.log" ;
+ if (! -f $metfile)
+ { banner ; error("$metfile is empty") }
+ elsif (-s $mpofile < 32)
+ { unlink $mpofile ; # may exist with zero length
+ unlink $mpyfile ; # get rid of left overs
+ exit }
+ else
+ { banner ; report("processing file : $mpofile") } } }
+
+sub verify_check_sum # checksum calculation from perl documentation
+ { return unless (open (MPO,"$mpofile")) ;
+ $mpochecksum = do { local $/ ; unpack("%32C*",<MPO>) % 65535 } ;
+ close (MPO) ;
+ return unless open (MPY,"$mpyfile") ;
+ my $str = <MPY> ; chomp $str ;
+ close (MPY) ;
+ if ($str =~ /^\%\s*mpochecksum\s*\:\s*(\d+)/o)
+ { if ($mpochecksum eq $1)
+ { report("mpo checksum : $mpochecksum / unchanged") ;
+ exit unless $force }
+ else
+ { report("mpo checksum : $mpochecksum / changed") } } }
+
+sub cleanup_files
+ { my @files = <mpy-*.*> ;
+ foreach (@files) { unless (/\.log/o) { unlink $_ } } }
+
+sub construct_tex_file
+ { my $n = 0 ;
+ unless (open (MPO, "<$mpofile"))
+ { error("unable to open $mpofile") }
+ unless (open (TEX, ">$texfile"))
+ { error("unable to open $texfile") }
+ my $textext = "" ;
+ while (<MPO>)
+ { s/\s*$//mois ;
+ if (/\%\s*format=(\w+)/)
+ { $format = $1 }
+ else # if (!/^\%/)
+ { if (/startTEXpage/o)
+ { ++$n ;
+ $textext .= "$start{$format}\n" ;
+ $start{$format} = "" }
+ $textext .= "$_\n" } }
+ unless (defined($tex{$format})) { $format = "plain" }
+ if ($format eq "context") { $macros = "" }
+ # print TEX "$start{$format}\n$macros\n$textext\n$stop{$format}\n" ;
+ print TEX "$start{$format}\n\n" if $start{$format} ;
+ print TEX "$macros\n" if $macros ;
+ print TEX "$textext\n" if $textext ;
+ print TEX "$stop{$format}\n" if $stop{$format} ;
+ close (MPO) ;
+ close (TEX) ;
+ report("tex format : $format") ;
+ report("requested texts : $n") }
+
+sub construct_mpy_file
+ { unless (open (TMP, "<$tmpfile"))
+ { error("unable to open $tmpfile file") }
+ unless (open (MPY, ">$mpyfile"))
+ { error("unable to open $mpyfile file") }
+ print MPY "% mpochecksum : $mpochecksum\n" ;
+ my $copying = my $n = 0 ;
+ while (<TMP>)
+ { if (s/beginfig/begingraphictextfig/o)
+ { print MPY $_ ; $copying = 1 ; ++$n }
+ elsif (s/endfig/endgraphictextfig/o)
+ { print MPY $_ ; $copying = 0 }
+ elsif ($copying)
+ { print MPY $_ } }
+ close (TMP) ;
+ close (MPY) ;
+ report("processed texts : $n") ;
+ report("produced file : $mpyfile") }
+
+sub run
+ { my ($resultfile, $program,$arguments) = @_ ;
+ my $result = system("$program $arguments $logredirection $logfile") ;
+ unless (-f $resultfile) { error("invalid `$program' run") } }
+
+sub make_pdf_pages
+ { process ("pdf file") ;
+ run ($pdffile, "$tex{$format}", "$texfile") }
+
+sub make_mp_figures
+ { process ("postscript file") ;
+ if ($pmethod) { run($posfile, "$pdftops",
+ "-paper match $pdffile $posfile") }
+ if ($gmethod) { run($posfile, "$ghostscript",
+ "-q -sOutputFile=$posfile -dNOPAUSE -dBATCH -dSAFER -sDEVICE=pswrite $pdffile") }
+ if ($amethod) { run($posfile, "$acroread",
+ "-toPostScript -pairs $pdffile $posfile") } }
+
+sub make_mp_pictures_ps
+ { process ("metapost file") ;
+ run ($tmpfile, "$pstoedit", "-ssp -dt -f mpost $posfile $tmpfile") }
+
+sub make_mp_pictures_pdf
+ { process ("metapost file") ;
+ run ($tmpfile, "$pstoedit", "-ssp -dt -f mpost $pdffile $tmpfile") }
+
+if ($help) { show_help_info }
+
+check_input_file ;
+verify_check_sum ;
+cleanup_files ;
+construct_tex_file ;
+make_pdf_pages ;
+if (1)
+ { make_mp_pictures_pdf ; }
+else
+ { make_mp_figures ;
+ make_mp_pictures_ps ; }
+construct_mpy_file ; # less save : rename $tmpfile, $mpyfile ;
+unless ($noclean) { cleanup_files }
+
+# a simple test file (needs context)
+#
+# % output=pdftex
+#
+# \starttext
+#
+# \startMPpage
+# graphictext
+# "\bf MAKE"
+# scaled 8
+# zscaled (1,2)
+# withdrawcolor \MPcolor{blue}
+# withfillcolor \MPcolor{gray}
+# withpen pencircle scaled 5pt ;
+# \stopMPpage
+#
+# \stoptext
diff --git a/Master/texmf-dist/scripts/context/perl/mptopdf.pl b/Master/texmf-dist/scripts/context/perl/mptopdf.pl
new file mode 100644
index 00000000000..efbc5ba0122
--- /dev/null
+++ b/Master/texmf-dist/scripts/context/perl/mptopdf.pl
@@ -0,0 +1,123 @@
+eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}' && eval 'exec perl -S $0 $argv:q'
+ if 0;
+
+# MikTeX users can set environment variable TEXSYSTEM to "miktex".
+
+#D \module
+#D [ file=mptopdf.pl,
+#D version=2005.10.31,
+#D title=converting MP to PDF,
+#D subtitle=\MPTOPDF,
+#D author=Hans Hagen,
+#D date=\currentdate,
+#D url=www.pragma-ade.nl,
+#D copyright={PRAGMA ADE / Hans Hagen \& Ton Otten}]
+#C
+#C This module is part of the \CONTEXT\ macro||package and is
+#C therefore copyrighted by \PRAGMA. See licen-en.pdf for
+#C details.
+
+# use File::Copy ; # not in every perl
+
+use Config ;
+use Getopt::Long ;
+use strict ;
+
+$Getopt::Long::passthrough = 1 ; # no error message
+$Getopt::Long::autoabbrev = 1 ; # partial switch accepted
+
+my $Help = my $Latex = my $RawMP = my $MetaFun = 0 ;
+my $PassOn = '' ;
+
+&GetOptions
+ ( "help" => \$Help ,
+ "rawmp" => \$RawMP,
+ "metafun" => \$MetaFun,
+ "passon" => \$PassOn,
+ "latex" => \$Latex ) ;
+
+my $program = "MPtoPDF 1.3" ;
+my $pattern = $ARGV[0] ;
+my $done = 0 ;
+my $report = '' ;
+my $texlatexswitch = " --tex=latex --format=latex " ;
+my $mplatexswitch = " --tex=latex " ;
+
+my $dosish = ($Config{'osname'} =~ /^(ms)?dos|^os\/2|^(ms|cyg)win/i) ;
+my $miktex = ($ENV{"TEXSYSTEM"} =~ /miktex/io);
+my $escapeshell = ( ($ENV{'SHELL'}) && ($ENV{'SHELL'} =~ m/sh/i ));
+
+my @files ;
+my $command = my $mpbin = '' ;
+
+sub CopyFile # agressive copy, works for open files like in gs
+ { my ($From,$To) = @_ ;
+ return unless open(INP,"<$From") ; binmode INP ;
+ return unless open(OUT,">$To") ; binmode OUT ;
+ while (<INP>) { print OUT $_ }
+ close (INP) ;
+ close (OUT) }
+
+if (($pattern eq '')||($Help))
+ { print "\n$program : provide MP output file (or pattern)\n" ;
+ exit }
+elsif ($pattern =~ /\.mp$/io)
+ { shift @ARGV ; my $rest = join(" ", @ARGV) ;
+ if (open(INP,$pattern))
+ { while (<INP>)
+ { if (/(documentstyle|documentclass|begin\{document\})/io)
+ { $Latex = 1 ; last } }
+ close (INP) }
+ if ($RawMP)
+ { if ($Latex)
+ { $rest .= " $mplatexswitch" }
+ if ($MetaFun) {
+ $mpbin = 'mpost --mem=metafun --progname=mpost' ;
+ } else {
+ $mpbin = 'mpost --mem=mpost' ;
+ }
+ }
+ else
+ { if ($Latex)
+ { $rest .= " $texlatexswitch" }
+ $mpbin = 'texexec --mptex $PassOn' }
+ my $error = system ("$mpbin $rest $pattern") ;
+ if ($error)
+ { print "\n$program : error while processing mp file\n" ; exit }
+ else
+ { $pattern =~ s/\.mp$//io ;
+ @files = glob "$pattern.*" } }
+elsif (-e $pattern)
+ { @files = ($pattern) }
+elsif ($pattern =~ /.\../o)
+ { @files = glob "$pattern" }
+else
+ { $pattern .= '.*' ;
+ @files = glob "$pattern" }
+
+foreach my $file (@files)
+ { $_ = $file ;
+ if (s/\.(\d+|mps)$// && -e $file)
+ { if ($miktex)
+ { $command = "pdfetex -undump=mptopdf" }
+ else
+ { $command = "pdfetex --fmt=mptopdf --progname=context" }
+ if ($dosish)
+ { $command = "$command \\relax $file" }
+ else
+ { $command = "$command \\\\relax $file" }
+ #~ print $command ;
+ system($command) ;
+ rename ("$_.pdf", "$_-$1.pdf") ;
+ if (-e "$_.pdf") { CopyFile ("$_.pdf", "$_-$1.pdf") }
+ if ($done) { $report .= " +" }
+ $report .= " $_-$1.pdf" ;
+ ++$done } }
+
+if ($report eq '')
+ { $report = '*' }
+
+if ($done)
+ { print "\n$program : $pattern is converted to$report\n" }
+else
+ { print "\n$program : no filename matches $pattern\n" }
diff --git a/Master/texmf-dist/scripts/context/perl/path_tre.pm b/Master/texmf-dist/scripts/context/perl/path_tre.pm
new file mode 100644
index 00000000000..546afcd27b6
--- /dev/null
+++ b/Master/texmf-dist/scripts/context/perl/path_tre.pm
@@ -0,0 +1,36 @@
+#D \module
+#D [ file=path\_tre.pm,
+#D version=1999.05.05,
+#D title=Path modules,
+#D subtitle=selecting a path,
+#D author=Hans Hagen,
+#D date=\currentdate,
+#D copyright={PRAGMA / Hans Hagen \& Ton Otten}]
+#C
+#C This module is part of the \CONTEXT\ macro||package and is
+#C therefore copyrighted by \PRAGMA. See licen-en.pdf for
+#C details.
+
+#D Not yet documented, source will be cleaned up.
+
+package Tk::path_tre ;
+
+use Tk;
+require Tk::DirTree ;
+
+use base qw(Tk::DirTree);
+use strict;
+
+Construct Tk::Widget 'PathTree';
+
+sub ClassInit
+ { my ($class,$mw) = @_ ;
+ return $class -> SUPER::ClassInit ($mw) }
+
+sub dirnames
+ { my ( $w, $dir ) = @_ ;
+ unless ($dir=~/\//) { $dir .= '/' }
+ my @names = $w->Callback("-dircmd", $dir, $w->cget("-showhidden"));
+ return( @names ) }
+
+__END__
diff --git a/Master/texmf-dist/scripts/context/perl/texexec.pl b/Master/texmf-dist/scripts/context/perl/texexec.pl
new file mode 100644
index 00000000000..2f3b89e0461
--- /dev/null
+++ b/Master/texmf-dist/scripts/context/perl/texexec.pl
@@ -0,0 +1,3252 @@
+eval '(exit $?0)' && eval 'exec perl -w -S $0 ${1+"$@"}' && eval 'exec perl -w -S $0 $argv:q'
+ if 0 ;
+
+#D \module
+#D [ file=texexec.pl,
+#D version=2004.08.29,
+#D title=running \ConTeXt,
+#D subtitle=\TEXEXEC,
+#D author=Hans Hagen,
+#D date=\currentdate,
+#D copyright={PRAGMA / Hans Hagen \& Ton Otten}]
+#C
+#C This module is part of the \CONTEXT\ macro||package and is
+#C therefore copyrighted by \PRAGMA. See licen-en.pdf for
+#C details.
+
+# Thanks to Tobias Burnus for the german translations.
+# Thanks to Thomas Esser for hooking it into web2c
+# Thanks to Taco Hoekwater for suggesting improvements
+# Thanks to Wybo Dekker for the advanced help interface and making it strict
+# Thanks to Fabrice Popineau for windows path trickery and fixes
+
+# (I still have to completely understand the help code -)
+
+#D We started with a hack provided by Thomas Esser. This
+#D expression replaces the unix specific line \type
+#D {#!/usr/bin/perl}.
+
+#D History has learned that writing wrappers like this is quite painful
+#D because of differences between platforms, changes in the tex command
+#D line flags (fmt), default behaviour (e.g. 8 bit), and the assumption
+#D that everyone runs the same tex and that distributers take care of
+#D everything. Well, the result is a messy script like this ... Sorry.
+
+use strict ;
+
+my $OriginalArgs = join(' ',@ARGV) ;
+
+#~ use warnings ; # strange warnings, todo
+
+# todo: second run of checksum of mp file with --nomprun changes
+# todo: warning if no args
+# todo: <<<< in messages
+# todo: cleanup
+
+use Cwd;
+use Time::Local;
+use Config;
+use Getopt::Long;
+use Class::Struct; # needed for help subsystem
+use FindBin;
+use File::Compare;
+use File::Temp;
+use Digest::MD5;
+
+#~ use IO::Handle; autoflush STDOUT 1;
+
+my %ConTeXtInterfaces; # otherwise problems with strict
+my %ResponseInterface; # since i dunno how to allocate else
+
+my %Help;
+
+#D In this script we will launch some programs and other
+#D scripts. \TEXEXEC\ uses an ini||file to sort out where
+#D those programs are stored. Two boolean variables keep
+#D track of the way to call the programs. In \TEXEXEC,
+#D \type {$dosish} keeps track of the operating system.
+#D It will be no surprise that Thomas Esser provided me
+#D the neccessary code to accomplish this.
+
+$ENV{"MPXCOMMAND"} = "0"; # otherwise loop
+
+my $TotalTime = time;
+
+# start random seed hack
+#
+# This hack is needed since tex has 1 minute resolution, so
+# we need to be smaller about 1440 (== 24*60 == tex's max time)
+# in which case (david a's) random calculator will overflow.
+
+# my ( $sec, $min, $rest ) = gmtime;
+# my $RandomSeed = $min * 60 + $sec;
+#
+# # i have to look up the mod function -)
+#
+# if ( $RandomSeed > 2880 ) { $RandomSeed -= 2880 }
+# if ( $RandomSeed > 1440 ) { $RandomSeed -= 1440 }
+
+my ($sec, $min) = gmtime;
+my $RandomSeed = ($min * 60 + $sec) % 2880; # else still overflow
+
+# See usage of $Random and $RandomSeed later on.
+#
+# end random seed hack
+
+my $dosish = ( $Config{'osname'} =~ /^(ms)?dos|^os\/2|^mswin/i );
+my $escapeshell = ( ($ENV{'SHELL'}) && ($ENV{'SHELL'} =~ m/sh/i ));
+
+my $TeXUtil = 'texutil';
+my $TeXExec = 'texexec';
+my $MetaFun = 'metafun';
+my $MpToPdf = 'mptopdf';
+
+$Getopt::Long::passthrough = 1; # no error message
+$Getopt::Long::autoabbrev = 1; # partial switch accepted
+
+my $AddEmpty = '';
+my $Alone = 0;
+my $Optimize = 0;
+my $ForceTeXutil = 0;
+my $Arrange = 0;
+my $BackSpace = '0pt';
+my $Background = '';
+my $CenterPage = 0;
+my $ConTeXtInterface = 'unknown';
+my $Convert = '';
+my $DoMPTeX = 0;
+my $DoMPXTeX = 0;
+my $EnterBatchMode = 0;
+my $EnterNonStopMode = 0;
+my $Environments = '';
+my $Modules = '';
+my $FastMode = 0;
+my $FinalMode = 0;
+my $Format = '';
+my $MpDoFormat = '';
+my $HelpAsked = 0;
+my $Version = 0;
+my $MainBodyFont = 'standard';
+my $MainLanguage = 'standard';
+my $MainResponse = 'standard';
+my $MakeFormats = 0;
+my $Markings = 0;
+my $Mode = '';
+my $NoArrange = 0;
+my $NoDuplex = 0;
+my $NOfRuns = 8;
+my $NoMPMode = 0;
+my $NoMPRun = 0;
+my $NoBanner = 0;
+my $AutoMPRun = 0;
+my $OutputFormat = 'standard';
+my $Pages = '';
+my $PageScale = '1000'; # == 1.0
+my $PaperFormat = 'standard';
+my $PaperOffset = '0pt';
+my $PassOn = '';
+my $PdfArrange = 0;
+my $PdfSelect = 0;
+my $PdfCombine = 0;
+my $PdfOpen = 0;
+my $PdfClose = 0;
+my $AutoPdf = 0;
+my $PrintFormat = 'standard';
+my $ProducePdfT = 0;
+my $ProducePdfM = 0;
+my $ProducePdfX = 0;
+my $ProducePdfXTX = 0;
+my $ProducePs = 0;
+my $Input = "";
+my $Result = '';
+my $Suffix = '';
+my $RunOnce = 0;
+my $Selection = '';
+my $Combination = '2*4';
+my $SilentMode = 0;
+my $TeXProgram = '';
+my $TeXTranslation = '';
+my $TextWidth = '0pt';
+my $TopSpace = '0pt';
+my $TypesetFigures = 0;
+my $ForceFullScreen = 0;
+my $ScreenSaver = 0;
+my $TypesetListing = 0;
+my $TypesetModule = 0;
+my $UseColor = 0;
+my $Verbose = 0;
+my $PdfCopy = 0;
+my $PdfTrim = 0;
+my $LogFile = "";
+my $MpyForce = 0;
+my $InpPath = "";
+my $AutoPath = 0;
+my $RunPath = "";
+my $Arguments = "";
+my $Pretty = 0;
+my $SetFile = "";
+my $TeXTree = "";
+my $TeXRoot = "";
+my $Purge = 0;
+my $Separation = "";
+my $ModeFile = "";
+my $GlobalFile = 0;
+my $AllPatterns = 0;
+my $ForceXML = 0;
+my $Random = 0;
+my $Filters = '';
+my $NoMapFiles = 0 ;
+my $Foxet = 0 ;
+my $TheEnginePath = 0 ;
+my $Paranoid = 0 ;
+my $NotParanoid = 0 ;
+my $BoxType = '' ;
+my $Local = '' ;
+
+my $TempDir = '' ;
+
+my $StartLine = 0 ;
+my $StartColumn = 0 ;
+my $EndLine = 0 ;
+my $EndColumn = 0 ;
+
+my $MpEngineSupport = 0 ; # not now, we also need to patch executemp in context itself
+
+# makempy :
+
+my $MakeMpy = '';
+
+&GetOptions(
+ "arrange" => \$Arrange,
+ "batch" => \$EnterBatchMode,
+ "nonstop" => \$EnterNonStopMode,
+ "color" => \$UseColor,
+ "centerpage" => \$CenterPage,
+ "convert=s" => \$Convert,
+ "environments=s" => \$Environments,
+ "usemodules=s" => \$Modules,
+ "xml" => \$ForceXML,
+ "xmlfilters=s" => \$Filters,
+ "fast" => \$FastMode,
+ "final" => \$FinalMode,
+ "format=s" => \$Format,
+ "mpformat=s" => \$MpDoFormat,
+ "help" => \$HelpAsked,
+ "version" => \$Version,
+ "interface=s" => \$ConTeXtInterface,
+ "language=s" => \$MainLanguage,
+ "bodyfont=s" => \$MainBodyFont,
+ "results=s" => \$Result,
+ "response=s" => \$MainResponse,
+ "make" => \$MakeFormats,
+ "mode=s" => \$Mode,
+ "module" => \$TypesetModule,
+ "figures=s" => \$TypesetFigures,
+ "fullscreen" => \$ForceFullScreen,
+ "screensaver" => \$ScreenSaver,
+ "listing" => \$TypesetListing,
+ "mptex" => \$DoMPTeX,
+ "mpxtex" => \$DoMPXTeX,
+ "noarrange" => \$NoArrange,
+ "nomp" => \$NoMPMode,
+ "nomprun" => \$NoMPRun,
+ "nobanner" => \$NoBanner,
+ "automprun" => \$AutoMPRun,
+ "once" => \$RunOnce,
+ "output=s" => \$OutputFormat,
+ "pages=s" => \$Pages,
+ "paperformat=s" => \$PaperFormat,
+ "passon=s" => \$PassOn,
+ "path=s" => \$InpPath,
+ "autopath" => \$AutoPath,
+ "pdf" => \$ProducePdfT,
+ "pdm" => \$ProducePdfM,
+ "dpm" => \$ProducePdfM,
+ "pdx" => \$ProducePdfX,
+ "dpx" => \$ProducePdfX,
+ "xtx" => \$ProducePdfXTX,
+ "ps" => \$ProducePs,
+ "pdfarrange" => \$PdfArrange,
+ "pdfselect" => \$PdfSelect,
+ "pdfcombine" => \$PdfCombine,
+ "pdfcopy" => \$PdfCopy,
+ "pdftrim" => \$PdfTrim,
+ "scale=s" => \$PageScale,
+ "selection=s" => \$Selection,
+ "combination=s" => \$Combination,
+ "noduplex" => \$NoDuplex,
+ "paperoffset=s" => \$PaperOffset,
+ "backspace=s" => \$BackSpace,
+ "topspace=s" => \$TopSpace,
+ "markings" => \$Markings,
+ "textwidth=s" => \$TextWidth,
+ "addempty=s" => \$AddEmpty,
+ "background=s" => \$Background,
+ "logfile=s" => \$LogFile,
+ "print=s" => \$PrintFormat,
+ "suffix=s" => \$Suffix,
+ "runs=s" => \$NOfRuns,
+ "silent" => \$SilentMode,
+ "tex=s" => \$TeXProgram,
+ "verbose" => \$Verbose,
+ "alone" => \$Alone,
+ "optimize" => \$Optimize,
+ "texutil" => \$ForceTeXutil,
+ "mpyforce" => \$MpyForce,
+ "input=s" => \$Input,
+ "arguments=s" => \$Arguments,
+ "pretty" => \$Pretty,
+ "setfile=s" => \$SetFile, # obsolete
+ "purge" => \$Purge,
+ #### yet undocumented #################
+ "runpath=s" => \$RunPath,
+ "random" => \$Random,
+ "makempy=s" => \$MakeMpy,
+ "allpatterns" => \$AllPatterns,
+ "separation=s" => \$Separation,
+ "textree=s" => \$TeXTree,
+ "texroot=s" => \$TeXRoot,
+ "translate=s" => \$TeXTranslation,
+ "pdfclose" => \$PdfClose,
+ "pdfopen" => \$PdfOpen,
+ "autopdf" => \$AutoPdf,
+ "modefile=s" => \$ModeFile, # additional modes file
+ "globalfile" => \$GlobalFile,
+ "nomapfiles" => \$NoMapFiles,
+ "foxet" => \$Foxet,
+ "engine" => \$TheEnginePath,
+ "paranoid" => \$Paranoid,
+ "notparanoid" => \$NotParanoid,
+ "boxtype=s" => \$BoxType, # media art crop bleed trim
+ "local" => \$Local,
+ #### unix is unsafe (symlink viruses)
+ "tempdir=s" => \$TempDir,
+ #### experiment
+ "startline=s" => \$StartLine,
+ "startcolumn=s" => \$StartColumn,
+ "endline=s" => \$EndLine,
+ "endcolumn=s" => \$EndColumn
+); # don't check name
+
+if ($Foxet) {
+ $ProducePdfT = 1 ;
+ $ForceXML = 1 ;
+ $Modules = "foxet" ;
+ $Purge = 1 ;
+}
+
+# a set file (like blabla.bat) can set paths now
+
+if ( $SetFile ne "" ) { load_set_file( $SetFile, $Verbose ); $SetFile = "" }
+
+# later we will do a second attempt.
+
+$SIG{INT} = "IGNORE";
+
+if ( $ARGV[0] && $ARGV[0] =~ /\.mpx$/io ) { # catch -tex=.... bug in mpost
+ $TeXProgram = '';
+ $DoMPXTeX = 1;
+ $NoMPMode = 1;
+}
+
+####
+
+if ($Paranoid) {
+ $ENV{shell_escape} = 'f' ;
+ $ENV{openout_any} = 'p' ;
+ $ENV{openin_any} = 'p' ;
+} elsif ($NotParanoid) {
+ $ENV{shell_escape} = 't' ;
+ $ENV{openout_any} = 'p' ;
+ $ENV{openin_any} = 'a' ;
+}
+
+if (defined $ENV{openin_any} && $ENV{openin_any} eq 'p') {
+ $Paranoid = 1 ; # extra test in order to set readlevel
+}
+
+if ((defined $ENV{shell_escape} && $ENV{shell_escape} eq 'f') ||
+ (defined $ENV{SHELL_ESCAPE} && $ENV{SHELL_ESCAPE} eq 'f')) {
+ $AutoMPRun = 1 ;
+}
+
+if ($ScreenSaver) {
+ $ForceFullScreen = 1;
+ $TypesetFigures = 'c';
+ $ProducePdfT = 1;
+ $Purge = 1;
+}
+
+if ( $DoMPTeX || $DoMPXTeX ) {
+ $RunOnce = 1;
+ $ProducePdfT = 0;
+ $ProducePdfX = 0;
+ $ProducePdfM = 0;
+ $ProducePdfXTX = 0;
+ $ProducePs = 0;
+}
+
+if ( $PdfArrange || $PdfSelect || $PdfCopy || $PdfTrim || $PdfCombine ) {
+ $ProducePdfT = 1;
+ $RunOnce = 1;
+}
+
+if ($ProducePdfT) { $OutputFormat = "pdftex" }
+elsif ($ProducePdfM) { $OutputFormat = "dvipdfm" }
+elsif ($ProducePdfX) { $OutputFormat = "dvipdfmx" }
+elsif ($ProducePdfXTX) { $OutputFormat = "xetex" }
+elsif ($ProducePs) { $OutputFormat = "dvips" }
+
+if ( $ProducePdfXTX ) {
+ $TeXProgram = 'xetex' ; # ignore the default pdfetex engine
+ $PassOn .= ' -no-pdf ' ; # Adam Lindsay's preference
+}
+
+if ($AutoPdf) {
+ $PdfOpen = $PdfClose = 1 ;
+}
+
+# this is our hook into paranoid path extensions, assumes that
+# these three vars are part of path specs in texmf.cnf
+
+foreach my $i ('TXRESOURCES','MPRESOURCES','MFRESOURCES') {
+ foreach my $j ($RunPath,$InpPath) {
+ if ($j ne '') {
+ if ($ENV{$i} ne '') {
+ $ENV{$i} = $ENV{$i} . ',' . $j ;
+ } else {
+ $ENV{$i} = $j ;
+ }
+ }
+ }
+}
+
+if ( $RunOnce || $Pages || $TypesetFigures || $TypesetListing ) { $NOfRuns = 1 }
+
+if ( ( $LogFile ne '' ) && ( $LogFile =~ /\w+\.log$/io ) ) {
+ open( LOGFILE, ">$LogFile" );
+ *STDOUT = *LOGFILE;
+ *STDERR = *LOGFILE;
+}
+
+my $Program = " TeXExec 5.4.3 - ConTeXt / PRAGMA ADE 1997-2005";
+
+print "\n$Program\n\n";
+
+if ($Verbose) { print " current path : " . cwd . "\n" }
+
+my $pathslash = '/';
+if ( $FindBin::Bin =~ /\\/ ) { $pathslash = "\\" }
+my $cur_path = ".$pathslash";
+
+# we need to handle window's "Program Files" path (patch by Fabrice P)
+
+my $own_path = "$FindBin::Bin/";
+my $own_type = $FindBin::Script;
+my $own_quote = ( $own_path =~ m/^[^\"].* / ? "\"" : "" );
+my $own_stub = "";
+
+if ( $own_type =~ /(\.pl|perl)/oi ) { $own_stub = "perl " }
+
+if ( $own_type =~ /(\.(pl|bin|exe))$/io ) { $own_type = $1 }
+else { $own_type = '' }
+
+sub checked_path {
+ my $path = shift;
+ if ( ( defined($path) ) && ( $path ne '' ) ) {
+ $path =~ s/[\/\\]/$pathslash/go;
+ $path =~ s/[\/\\]*$//go;
+ $path .= $pathslash;
+ } else {
+ $path = '';
+ }
+ return $path;
+}
+
+sub checked_file {
+ my $path = shift;
+ if ( ( defined($path) ) && ( $path ne '' ) ) {
+ $path =~ s/[\/\\]/$pathslash/go;
+ } else {
+ $path = '';
+ }
+ return $path;
+}
+
+sub CheckPath {
+ my ( $Key, $Value ) = @_;
+ if ( ( $Value =~ /\// ) && ( $Value !~ /\;/ ) ) # no multipath test yet
+ {
+ $Value = checked_path($Value);
+ unless ( -d $Value ) {
+ print " error : $Key set to unknown path $Value\n";
+ }
+ }
+}
+
+# set <variable> to <value>
+# for <script> set <variable> to <value>
+# except for <script> set <variable> to <value>
+
+my $IniPath = '';
+
+#D The kpsewhich program is not available in all tex distributions, so
+#D we have to locate it before running it (as suggested by Thomas).
+
+my @paths;
+
+if ( $ENV{PATH} =~ /\;/ ) { @paths = split( /\;/, $ENV{PATH} ) }
+else { @paths = split( /\:/, $ENV{PATH} ) }
+
+my $kpsewhich = '';
+
+sub found_ini_file {
+ my $suffix = shift ;
+ #~ $IniPath = $0 ;
+ #~ $IniPath ~= s/\.pl$//io ;
+ #~ $IniPath = $InPath . ".'" + $suffix ;
+ #~ if (-e $IniPath) {
+ #~ }
+ # not really needed to check on texmfscripts, better on own path
+ print " locating ini file : kpsewhiching texexec.$suffix on scripts\n" if $Verbose ;
+ my $IniPath = `$kpsewhich --format="texmfscripts" -progname=context texexec.$suffix` ;
+ chomp($IniPath) ;
+ if ($IniPath eq '') {
+ print " locating ini file : kpsewhiching texexec.$suffix elsewhere\n" if $Verbose ;
+ $IniPath = `$kpsewhich --format="other text files" -progname=context texexec.$suffix` ;
+ chomp($IniPath) ;
+ }
+ return $IniPath ;
+}
+
+if ( $IniPath eq '' ) {
+ foreach (@paths) {
+ my $p = checked_path($_) . 'kpsewhich';
+ if ( ( -e $p ) || ( -e $p . '.exe' ) ) {
+ $kpsewhich = $p;
+ # FP: catch spurious error messages here if there $p has
+ # spaces and $own_quote is not set
+ $kpsewhich = ($kpsewhich =~ m/^[^\"].* / ? "\"$kpsewhich\"" : "$kpsewhich") ;
+ $IniPath = found_ini_file("ini");
+ unless ( -e $IniPath ) { $IniPath = found_ini_file("rme") }
+ last;
+ }
+ }
+ if ($Verbose) {
+ if ( $kpsewhich eq '' ) {
+ print " locating ini file : kpsewhich not found in path\n";
+ } elsif ( $IniPath eq '' ) {
+ print " locating ini file : not found by kpsewhich\n";
+ } else {
+ if ( $IniPath =~ /rme/oi ) {
+ print " locating ini file : not found by kpsewhich, using '.rme' file\n";
+ } else {
+ print " locating ini file : found by kpsewhich\n";
+ }
+ }
+ }
+}
+
+#D Now, when we didn't find the \type {kpsewhich}, we have
+#D to revert to some other method. We could have said:
+#D
+#D \starttypen
+#D unless ($IniPath)
+#D { $IniPath = `perl texpath.pl texexec.ini` }
+#D \stoptypen
+#D
+#D But loading perl (for the second time) take some time. Instead of
+#D providing a module, which can introduce problems with loading, I
+#D decided to copy the code of \type {texpath} into this file.
+
+use File::Find;
+# use File::Copy ; no standard in perl
+
+my ( $ReportPath, $ReportName, $ReportFile ) = ( 0, 0, 1 );
+my ( $FileToLocate, $PathToStartOn ) = ( '', '' );
+my ( $LocatedPath, $LocatedName, $LocatedFile ) = ( '', '', '' );
+
+sub DoLocateFile { # we have to keep on pruning
+ if ( lc $_ eq $FileToLocate ) {
+ $LocatedPath = $File::Find::dir;
+ $LocatedName = $_;
+ $LocatedFile = $File::Find::name;
+ }
+ if ($LocatedName) { $File::Find::prune = 1 }
+}
+
+sub LocatedFile {
+ $PathToStartOn = shift;
+ $FileToLocate = lc shift;
+ if ( $FileToLocate eq '' ) {
+ $FileToLocate = $PathToStartOn;
+ $PathToStartOn = $own_path;
+ }
+ ( $LocatedPath, $LocatedName, $LocatedFile ) = ( '', '', '' );
+ if ( $FileToLocate ne '' ) {
+ if ( -e $cur_path . $FileToLocate ) {
+ $LocatedPath = $cur_path;
+ $LocatedName = $FileToLocate;
+ $LocatedFile = $cur_path . $FileToLocate;
+ } else {
+ $_ = checked_path($PathToStartOn);
+ if ( -e $_ . $FileToLocate ) {
+ $LocatedPath = $_;
+ $LocatedName = $FileToLocate;
+ $LocatedFile = $_ . $FileToLocate;
+ } else {
+ $_ = checked_path($PathToStartOn);
+ if (/(.*?[\/\\]texmf[\/\\]).*/i) {
+ my $SavedRoot = $1;
+ File::Find::find( \&DoLocateFile,
+ checked_path( $1 . 'context/' ) );
+ unless ($LocatedFile) {
+ File::Find::find( \&DoLocateFile, $SavedRoot );
+ }
+ } else {
+ $_ = checked_path($_);
+ File::Find::find( \&DoLocateFile, $_ );
+ }
+ }
+ }
+ }
+ return ( $LocatedPath, $LocatedName, $LocatedFile );
+}
+
+#D So now we can say:
+
+unless ($IniPath) {
+ ( $LocatedPath, $LocatedName, $IniPath ) =
+ LocatedFile( $own_path, 'texexec.ini' );
+ if ($Verbose) {
+ if ( $IniPath eq '' ) {
+ print " locating ini file : not found by searching\n";
+ } else {
+ print " locating ini file : found by searching\n";
+ }
+ }
+}
+
+#D The last resorts:
+
+unless ($IniPath) {
+ if ( $ENV{TEXEXEC_INI_FILE} ) {
+ $IniPath = checked_path( $ENV{TEXEXEC_INI_FILE} ) . 'texexec.ini';
+ unless ( -e $IniPath ) { $IniPath = '' }
+ }
+ if ($Verbose) {
+ if ( $IniPath eq '' ) {
+ print " locating ini file : no environment variable set\n";
+ } else {
+ print " locating ini file : found by environment variable\n";
+ }
+ }
+}
+
+unless ($IniPath) {
+ $IniPath = $own_path . 'texexec.ini';
+ unless ( -e $IniPath ) { $IniPath = '' }
+ if ($Verbose) {
+ if ( $IniPath eq '' ) {
+ print " locating ini file : not found in own path\n";
+ } else {
+ print " locating ini file : found in own path\n";
+ }
+ }
+}
+
+#D Now we're ready for loading the initialization file! We
+#D also define some non strict variables. Using \type {$Done}
+#D permits assignments.
+
+my %Done;
+
+unless ($IniPath) { $IniPath = 'texexec.ini' }
+
+if ( open( INI, $IniPath ) ) {
+ if ($Verbose) { print " reading : $IniPath\n" }
+ while (<INI>) {
+ if ( !/^[a-zA-Z\s]/oi ) { }
+ elsif (/except for\s+(\S+)\s+set\s+(\S+)\s*to\s*(.*)\s*/goi) {
+ my $one = $1;
+ my $two = $2;
+ my $three = $3;
+ if ( $one ne $Done{"TeXShell"} ) {
+ $three =~ s/^[\'\"]//o;
+ $three =~ s/[\'\"]$//o;
+ $three =~ s/\s*$//o;
+ if ($Verbose) {
+ print " setting : '$two' to '$three' except for '$one'\n";
+ }
+ $Done{"$two"} = $three;
+ CheckPath( $two, $three );
+ }
+ } elsif (/for\s+(\S+)\s+set\s+(\S+)\s*to\s*(.*)\s*/goi) {
+ my $one = $1;
+ my $two = $2;
+ my $three = $3;
+ $three =~ s/\s*$//o;
+ if ( $one eq $Done{"TeXShell"} ) {
+ $three =~ s/^[\'\"]//o;
+ $three =~ s/[\'\"]$//o;
+ if ($Verbose) {
+ print
+" setting : '$two' to '$three' for '$one'\n";
+ }
+ $Done{"$two"} = $three;
+ CheckPath( $two, $three );
+ }
+ } elsif (/set\s+(\S+)\s*to\s*(.*)\s*/goi) {
+ my $one = $1;
+ my $two = $2;
+ unless ( defined( $Done{"$one"} ) ) {
+ $two =~ s/^[\'\"]//o;
+ $two =~ s/[\'\"]$//o;
+ $two =~ s/\s*$//o;
+ if ($Verbose) {
+ print
+ " setting : '$one' to '$two' for 'all'\n";
+ }
+ $Done{"$one"} = $two;
+ CheckPath( $one, $two );
+ }
+ }
+ }
+ close(INI);
+ if ($Verbose) { print "\n" }
+} elsif ($Verbose) {
+ print
+ " warning : $IniPath not found, did you read 'texexec.rme'?\n";
+ exit 1;
+} else {
+ print
+ " warning : $IniPath not found, try 'texexec --verbose'\n";
+ exit 1;
+}
+
+sub IniValue {
+ my ( $Key, $Default ) = @_;
+ if ( defined( $Done{$Key} ) ) { $Default = $Done{$Key} }
+ if ($Default =~ /^(true|yes|on)$/io) {
+ $Default = 1 ;
+ } elsif ($Default =~ /^(false|no|off)$/io) {
+ $Default = 0 ;
+ }
+ if ($Verbose) { print " used setting : $Key = $Default\n" }
+ return $Default;
+}
+
+my $TeXShell = IniValue( 'TeXShell', '' );
+my $SetupPath = IniValue( 'SetupPath', '' );
+my $UserInterface = IniValue( 'UserInterface', 'en' );
+my $UsedInterfaces = IniValue( 'UsedInterfaces', 'en' );
+my $TeXFontsPath = IniValue( 'TeXFontsPath', '.' );
+my $MpExecutable = IniValue( 'MpExecutable', 'mpost' );
+my $MpToTeXExecutable = IniValue( 'MpToTeXExecutable', 'mpto' );
+my $DviToMpExecutable = IniValue( 'DviToMpExecutable', 'dvitomp' );
+my $TeXProgramPath = IniValue( 'TeXProgramPath', '' );
+my $TeXFormatPath = IniValue( 'TeXFormatPath', '' );
+my $ConTeXtPath = IniValue( 'ConTeXtPath', '' );
+my $TeXScriptsPath = IniValue( 'TeXScriptsPath', '' );
+my $TeXHashExecutable = IniValue( 'TeXHashExecutable', '' );
+my $TeXExecutable = IniValue( 'TeXExecutable', 'tex' );
+my $TeXVirginFlag = IniValue( 'TeXVirginFlag', '-ini' );
+my $TeXBatchFlag = IniValue( 'TeXBatchFlag', '-interaction=batchmode' );
+my $TeXNonStopFlag = IniValue( 'TeXNonStopFlag', '-interaction=nonstopmode' );
+my $MpBatchFlag = IniValue( 'MpBatchFlag', '-interaction=batchmode' );
+my $MpNonStopFlag = IniValue( 'MpNonStopFlag', '-interaction=nonstopmode' );
+my $TeXPassString = IniValue( 'TeXPassString', '' );
+my $TeXFormatFlag = IniValue( 'TeXFormatFlag', '' );
+my $MpFormatFlag = IniValue( 'MpFormatFlag', '' );
+my $MpVirginFlag = IniValue( 'MpVirginFlag', '-ini' );
+my $MpPassString = IniValue( 'MpPassString', '' );
+my $MpFormat = IniValue( 'MpFormat', $MetaFun );
+my $MpFormatPath = IniValue( 'MpFormatPath', $TeXFormatPath );
+my $UseEnginePath = IniValue( 'UseEnginePath', '');
+
+if ($TheEnginePath) { $UseEnginePath = 1 }
+
+# ok, let's force the engine; let's also forget about
+# fmtutil, since it does not support $engine subpaths
+# we will replace texexec anyway
+
+$UseEnginePath = 1 ;
+$Alone = 1 ;
+
+my $FmtLanguage = IniValue( 'FmtLanguage', '' );
+my $FmtBodyFont = IniValue( 'FmtBodyFont', '' );
+my $FmtResponse = IniValue( 'FmtResponse', '' );
+my $TcXPath = IniValue( 'TcXPath', '' );
+
+
+$SetFile = IniValue( 'SetFile', $SetFile );
+
+if ( ($Verbose) && ( $kpsewhich ne '' ) ) {
+ print "\n";
+ my $CnfFile = `$kpsewhich -progname=context texmf.cnf`;
+ chomp($CnfFile);
+ print " applications will use : $CnfFile\n";
+}
+
+if ( ($FmtLanguage) && ( $MainLanguage eq 'standard' ) ) {
+ $MainLanguage = $FmtLanguage;
+}
+if ( ($FmtBodyFont) && ( $MainBodyFont eq 'standard' ) ) {
+ $MainBodyFont = $FmtBodyFont;
+}
+if ( ($FmtResponse) && ( $MainResponse eq 'standard' ) ) {
+ $MainResponse = $FmtResponse;
+}
+
+# new versions, > 2004 will have -fmt as switch
+
+if ( $TeXFormatFlag eq "" ) {
+ if ($TeXProgram =~ /(etex|pdfetex)/) {
+ $TeXFormatFlag = "-efmt=" ; # >=2004 -fmt=
+ } elsif ($TeXProgram =~ /(eomega)/) {
+ $TeXFormatFlag = "-eoft=" ; # >=2004 obsolete
+ } elsif ($TeXProgram =~ /(aleph)/) {
+ $TeXFormatFlag = "-fmt=" ;
+ } else {
+ $TeXFormatFlag = "-fmt=" ;
+ }
+}
+
+if ( $MpFormatFlag eq "" ) {
+ $MpFormatFlag = "-mem=" ;
+}
+
+if ($TeXProgram) { $TeXExecutable = $TeXProgram }
+
+my $fmtutil = '';
+
+# obsolete
+#
+# if ( $MakeFormats || $Verbose ) {
+# if ($Alone || $UseEnginePath) {
+# if ($Verbose) { print " generating format : not using fmtutil\n" }
+# } elsif ( $TeXShell =~ /tetex|fptex/i ) {
+# foreach (@paths) {
+# my $p = checked_path($_) . 'fmtutil';
+# if ( -e $p ) { $fmtutil = $p; last }
+# elsif ( -e $p . '.exe' ) { $fmtutil = $p . '.exe'; last }
+# }
+# $fmtutil = ($fmtutil =~ m/^[^\"].* / ? "\"$fmtutil\"" : "$fmtutil") ;
+# if ($Verbose) {
+# if ( $fmtutil eq '' ) {
+# print " locating fmtutil : not found in path\n";
+# } else {
+# print " locating fmtutil : $fmtutil\n";
+# }
+# }
+# }
+# }
+
+if ($Verbose) { print "\n" }
+
+unless ($TeXScriptsPath) { $TeXScriptsPath = $own_path }
+
+unless ($ConTeXtPath) { $ConTeXtPath = $TeXScriptsPath }
+
+if ( $ENV{"HOME"} ) {
+ if ($SetupPath) { $SetupPath .= "," }
+# my $home = $ENV{"HOME"};
+# $home = ($home =~ m/^[^\"].* / ? "\"$home\"" : "$home") ;
+# $SetupPath .= $home;
+ $SetupPath .= $ENV{"HOME"};
+}
+
+if ($TeXFormatPath) { $TeXFormatPath =~ s/[\/\\]$//; $TeXFormatPath .= '/' }
+if ($MpFormatPath) { $MpFormatPath =~ s/[\/\\]$//; $MpFormatPath .= '/' }
+if ($ConTeXtPath) { $ConTeXtPath =~ s/[\/\\]$//; $ConTeXtPath .= '/' }
+if ($SetupPath) { $SetupPath =~ s/[\/\\]$//; $SetupPath .= '/' }
+if ($TeXScriptsPath) { $TeXScriptsPath =~ s/[\/\\]$//; $TeXScriptsPath .= '/' }
+
+sub QuotePath {
+ my ($path) = @_;
+ my @l = split(",", $path);
+ map { my $e = $_; $e = ($e =~ m/^[^\"].* / ? "\"$e\"" : "$e"); $_ = $e ;} @l;
+ return join(",", @l);
+}
+
+$SetupPath = &QuotePath($SetupPath);
+
+$SetupPath =~ s/\\/\//go;
+
+my %OutputFormats;
+
+# the mother of all drivers
+
+$OutputFormats{dvips} = "dvips";
+
+# needs an update
+
+$OutputFormats{acrobat} = "acrobat";
+
+# the core drivers
+
+$OutputFormats{pdftex} = "pdftex"; $OutputFormats{pdf} = "pdftex";
+$OutputFormats{dvipdfm} = "dvipdfm"; $OutputFormats{dpm} = "dvipdfm";
+$OutputFormats{dvipdfmx} = "dvipdfmx"; $OutputFormats{dpx} = "dvipdfmx";
+$OutputFormats{xetex} = "xetex"; $OutputFormats{xtx} = "xetex";
+$OutputFormats{dvips} = "dvips"; $OutputFormats{ps} = "dvips";
+
+# kind of obsolete now that yandy is gone
+
+$OutputFormats{dvipsone} = "dvipsone";
+$OutputFormats{dviwindo} = "dviwindo";
+
+# it was never finished
+
+$OutputFormats{dviview} = "dviview";
+
+my @ConTeXtFormats = ( "nl", "en", "de", "cz", "uk", "it", "ro", "xx");
+
+sub SetInterfaces {
+ my ( $short, $long, $full ) = @_;
+ $ConTeXtInterfaces{$short} = $short;
+ $ConTeXtInterfaces{$long} = $short;
+ $ResponseInterface{$short} = $full;
+ $ResponseInterface{$long} = $full;
+}
+
+#SetInterfaces ( "en" , "unknown" , "english" ) ;
+
+SetInterfaces( "nl", "dutch", "dutch" );
+SetInterfaces( "en", "english", "english" );
+SetInterfaces( "de", "german", "german" );
+SetInterfaces( "cz", "czech", "czech" );
+SetInterfaces( "uk", "brittish", "english" );
+SetInterfaces( "it", "italian", "italian" );
+SetInterfaces( "no", "norwegian", "norwegian" );
+SetInterfaces( "ro", "romanian", "romanian" );
+
+# Sub-option
+
+struct Subopt => {
+ desc => '$', # description
+ vals => '%' # assignable values
+};
+
+# Main option
+
+struct Opt => {
+ desc => '$', # desciption
+ vals => '%', # assignable values
+ subs => '%' # suboptions
+};
+
+my $helpdone = 0;
+
+sub print_subopt {
+ my ( $k, $opt ) = @_;
+ $~ = 'H3';
+ write;
+ for $k ( sort keys %{ $opt->vals } ) {
+ print_val( $k, ${ $opt->vals }{$k} );
+ }
+ format H3 =
+@>>>>>>>>>>>>>>>>>>>>> @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+"--$k",$opt->desc
+.
+}
+
+sub print_val {
+ my ( $k, $opt ) = @_;
+ $~ = 'H2';
+ write;
+ format H2 =
+ @<<<<<<<< : @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+$k,$opt
+.
+}
+
+# read all options
+
+my $recurse = -1 ;
+my $shorthelp;
+my @help;
+my @opts = <DATA>;
+while (@opts) {
+ $_ = shift @opts;
+ last if /^--+/;
+ my ( $k, $v ) = split( /\s+/, $_, 2 ); # was \t
+ $Help{$k} = read_options($v);
+}
+
+# read a main option plus its
+# description,
+# assignable values and
+# sub-options and their
+# description and
+# assignable values
+
+sub read_options {
+ $recurse++;
+ my $v = shift;
+ chomp;
+ my $opt = $recurse ? Subopt->new() : Opt->new();
+ $opt->desc($v);
+
+ while (@opts) {
+ $_ = shift @opts;
+ if (/^--+/) { unshift @opts, $_ if $recurse; last }
+ if ( $recurse && !/^=/ ) { unshift @opts, $_; last }
+ chomp;
+ my ( $kk, $vv ) = split( /\s+/, $_, 2 ); # was \t
+ $vv ||= '';
+ if (/^=/) { $opt->vals( $kk, $vv ) }
+ elsif ( !$recurse ) { $opt->subs( $kk, read_options($vv) ) }
+ }
+ $recurse--;
+ $opt;
+}
+
+sub print_opt {
+ my ( $k, $opt ) = @_;
+ if ($helpdone) { $shorthelp or print "\n" }
+ $helpdone = 1; # hh
+ $~ = 'H1';
+ write;
+ return if $shorthelp < 0;
+ for $k ( sort keys %{ $opt->vals } ) {
+ print_val( $k, ${ $opt->vals }{$k} );
+ }
+ return if $shorthelp > 0;
+
+ for $k ( sort keys %{ $opt->subs } ) {
+ print_subopt( $k, ${ $opt->subs }{$k} );
+ }
+ format H1 =
+@>>>>>>>>>>>>>>>>>>>>> @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+"--$k",$opt->desc
+.
+}
+
+# help to help
+
+sub show_help_options {
+ print # "\n" .
+ " --help overview of all options and their values\n"
+ . " --help all all about all options\n"
+ . " --help short just the main options\n"
+ . " --help mode ... pdf all about a few options\n"
+ . " --help '*.pdf' all about options containing 'pdf'\n"
+ . "\n"
+ . " more info http://www.pragma-ade.com/general/manuals/mtexexec.pdf\n"
+ . " http://www.ntg.nl/mailman/listinfo/ntg-context\n";
+}
+
+# determine what user wants to see
+
+if ($HelpAsked) {
+ $shorthelp = 0;
+ @help = ( sort keys %Help );
+ if ( "@ARGV" eq "all" ) { # everything
+ } elsif ( "@ARGV" eq "short" ) { # nearly everything
+ $shorthelp--;
+ } elsif ( "@ARGV" eq "help" ) { # help on help
+ show_help_options;
+ exit;
+ } elsif (@ARGV) { # one or a few options, completely
+ my @h = @ARGV;
+ @help = ();
+ for (@h) { # print "testing $_\n";
+ # next if (/^[\*\?]/) ; # HH, else error
+ if (/^[\*\?]/) { $_ = ".$_" } # HH, else error
+ $Help{$_} and push( @help, $_ ) or do {
+ my $unknown = $_;
+ for ( keys %Help ) { /$unknown/ and push( @help, $_ ) }
+ }
+ }
+ } else { # all main option and their assignable values
+ $shorthelp++;
+ }
+}
+
+sub show_help_info {
+ map { print_opt( $_, $Help{$_} ) } @help;
+}
+
+# uncomment this to see the structure of a Help element:
+# print Dumper($Help{pdfselect});
+
+#### end of help system
+
+my $FinalRunNeeded = 0;
+
+sub MPJobName {
+ my $JobName = shift;
+ my $MPfile = shift;
+ my $MPJobName = '';
+ if ( -e "$JobName-$MPfile.mp" && -s "$JobName-$MPfile.mp" > 100 ) {
+ $MPJobName = "$JobName-$MPfile.mp"
+ } elsif ( -e "$MPfile.mp" && -s "$MPfile.mp" > 100 ) {
+ $MPJobName = "$MPfile.mp"
+ } else { $MPJobName = "" }
+ return $MPJobName;
+}
+
+sub System {
+ my $cmd = shift ;
+ unless ( $dosish && ! $escapeshell ) {
+ $cmd =~ s/([^\\])\&/$1\\\&/io ;
+ }
+ if ($Verbose) {
+ print "\n$cmd\n\n" ;
+ }
+ system($cmd)
+}
+
+sub Pipe {
+ my $cmd = shift ;
+ unless ( $dosish && ! $escapeshell ) {
+ $cmd =~ s/([^\\])\&/$1\\\&/io ;
+ }
+ if ($Verbose) {
+ print "\n$cmd\n\n" ;
+ }
+ return `$cmd`
+}
+
+
+sub RunPerlScript {
+ my ( $ScriptName, $Options ) = @_;
+ my $cmd = '';
+ $own_quote = ($own_path =~ m/^[^\"].* / ? "\"" : "") ;
+ if ($Verbose) {
+ $Options .= ' --verbose' ;
+ }
+ if ($dosish) {
+ if ( -e "own_path$ScriptName$own_type" ) {
+ $cmd =
+"$own_stub$own_quote$own_path$ScriptName$own_type$own_quote $Options";
+ } elsif ( -e "$TeXScriptsPath$ScriptName$own_type" ) {
+ $cmd =
+"$own_stub$own_quote$TeXScriptsPath$ScriptName$own_type$own_quote $Options";
+ } else {
+ $cmd = "";
+ }
+ } else {
+ $cmd = "$ScriptName $Options";
+ }
+ unless ( $cmd eq "" ) {
+ System($cmd) ;
+ }
+}
+
+my $FullFormat = '';
+
+sub CheckOutputFormat {
+ my $Ok = 1;
+ if ( $OutputFormat ne 'standard' ) {
+ my @OutputFormat = split( /,/, $OutputFormat );
+ foreach my $F (@OutputFormat) {
+ if ( defined( $OutputFormats{ lc $F } ) ) {
+ my $OF = $OutputFormats{ lc $F };
+ next if ( ",$FullFormat," =~ /\,$OF\,/ );
+ if ($FullFormat) { $FullFormat .= "," }
+ $FullFormat .= "$OutputFormats{lc $F}";
+ } else {
+ $Ok = 0;
+ }
+ }
+ if ( !$Ok ) {
+ print(" unknown output format : $OutputFormat\n");
+ }
+ }
+ unless ($FullFormat) { $FullFormat = $OutputFormat }
+} # 'standard' to terminal
+
+sub MakeOptionFile {
+ my ( $FinalRun, $FastDisabled, $JobName, $JobSuffix, $KindOfRun ) = @_;
+ open( OPT, ">$JobName.top" );
+ print OPT "\% $JobName.top\n";
+ print OPT "\\unprotect\n";
+ if ($EnterBatchMode) { print OPT "\\batchmode\n" }
+ if ($EnterNonStopMode) { print OPT "\\nonstopmode\n" }
+ if ($Paranoid) {
+ print " paranoid file mode : very true\n";
+ print OPT "\\def\\maxreadlevel{1}\n" ;
+ }
+ $ModeFile =~ s/\\/\//gio ; # do this at top of file
+ $Result =~ s/\\/\//gio ; # do this at top of file
+ if ( $ModeFile ne '' ) { print OPT "\\readlocfile{$ModeFile}{}{}" }
+ if ( $Result ne '' ) { print OPT "\\setupsystem[file=$Result]\n" }
+ elsif ($Suffix) { print OPT "\\setupsystem[file=$JobName$Suffix]\n" }
+ if ( $InpPath ne "" ) {
+ $InpPath =~ s/\\/\//go;
+ $InpPath =~ s/\/$//go;
+ print OPT "\\usepath[$InpPath]\n";
+ }
+ $MainLanguage = lc $MainLanguage;
+ unless ( $MainLanguage eq "standard" ) {
+ print OPT "\\setuplanguage[$MainLanguage]\n";
+ }
+ # can best become : \use...[mik] / [web]
+ if ( $TeXShell =~ /MikTeX/io ) {
+ print OPT "\\def\\MPOSTbatchswitch \{$MpBatchFlag\}";
+ print OPT "\\def\\MPOSTnonstopswitch \{$MpNonStopFlag\}";
+ print OPT "\\def\\MPOSTformatswitch \{$MpPassString $MpFormatFlag\}";
+ }
+ #
+ if ( $FullFormat ne 'standard' ) {
+ print OPT "\\setupoutput[$FullFormat]\n";
+ }
+ if ($UseColor) { print OPT "\\setupcolors[\\c!state=\\v!start]\n" }
+ if ( $NoMPMode || $NoMPRun || $AutoMPRun ) {
+ print OPT "\\runMPgraphicsfalse\n";
+ }
+ if ( ($FastMode) && ( !$FastDisabled ) ) { print OPT "\\fastmode\n" }
+ if ($SilentMode) { print OPT "\\silentmode\n" }
+ if ( $Separation ne "" ) {
+ print OPT "\\setupcolors[\\c!split=$Separation]\n";
+ }
+ if ($SetupPath) { print OPT "\\setupsystem[\\c!directory=\{$SetupPath\}]\n" }
+ print OPT "\\setupsystem[\\c!n=$KindOfRun]\n";
+ $_ = $PaperFormat;
+ #unless (($PdfArrange)||($PdfSelect)||($PdfCombine)||($PdfCopy))
+ unless ( ($PdfSelect) || ($PdfCombine) || ($PdfCopy) || ($PdfTrim) ) {
+ if (/.4.3/goi) {
+ print OPT "\\setuppapersize[A4][A3]\n" ;
+ } elsif (/.5.4/goi) {
+ print OPT "\\setuppapersize[A5][A4]\n" ;
+ } elsif ( !/standard/ ) {
+ s/x/\*/io;
+ if (/\w+\d+/) { $_ = uc $_ }
+ my ( $from, $to ) = split(/\*/);
+ if ( $to eq "" ) { $to = $from }
+ print OPT "\\setuppapersize[$from][$to]\n";
+ }
+ }
+ if ( ( $PdfSelect || $PdfCombine || $PdfCopy || $PdfTrim || $PdfArrange )
+ && ( $Background ne '' ) )
+ {
+ print " background graphic : $Background\n";
+ print OPT "\\defineoverlay[whatever][{\\externalfigure[$Background][\\c!factor=\\v!max]}]\n";
+ print OPT "\\setupbackgrounds[\\v!page][\\c!background=whatever]\n";
+ }
+ if ($CenterPage) {
+ print OPT
+ "\\setuplayout[\\c!location=\\v!middle,\\c!marking=\\v!on]\n";
+ }
+ if ($NoMapFiles) {
+ print OPT "\\disablemapfiles\n";
+ }
+ if ($NoArrange) { print OPT "\\setuparranging[\\v!disable]\n" }
+ elsif ( $Arrange || $PdfArrange ) {
+ $FinalRunNeeded = 1;
+ if ($FinalRun) {
+ my $DupStr;
+ if ($NoDuplex) { $DupStr = "" }
+ else { $DupStr = ",\\v!doublesided" }
+ if ( $PrintFormat eq '' ) {
+ print OPT "\\setuparranging[\\v!normal]\n";
+ } elsif ( $PrintFormat =~ /.*up/goi ) {
+ print OPT "\\setuparranging[2UP,\\v!rotated$DupStr]\n";
+ } elsif ( $PrintFormat =~ /.*down/goi ) {
+ print OPT "\\setuparranging[2DOWN,\\v!rotated$DupStr]\n";
+ } elsif ( $PrintFormat =~ /.*side/goi ) {
+ print OPT "\\setuparranging[2SIDE,\\v!rotated$DupStr]\n";
+ } else {
+ print OPT "\\setuparranging[$PrintFormat]\n";
+ }
+ } else {
+ print OPT "\\setuparranging[\\v!disable]\n";
+ }
+ }
+ if ($Arguments) { print OPT "\\setupenv[$Arguments]\n" }
+ if ($Input) { print OPT "\\setupsystem[inputfile=$Input]\n" }
+ else { print OPT "\\setupsystem[inputfile=$JobName.$JobSuffix]\n" }
+ if ($Random) { print OPT "\\setupsystem[\\c!random=$RandomSeed]\n" }
+ if ($Mode) { print OPT "\\enablemode[$Mode]\n" }
+ if ($Pages) {
+ if ( lc $Pages eq "odd" ) {
+ print OPT "\\chardef\\whichpagetoshipout=1\n";
+ } elsif ( lc $Pages eq "even" ) {
+ print OPT "\\chardef\\whichpagetoshipout=2\n";
+ } else {
+ my @Pages = split( /\,/, $Pages );
+ $Pages = '';
+ foreach my $page (@Pages) {
+ if ( $page =~ /\:/ ) {
+ my ( $from, $to ) = split( /\:/, $page );
+ foreach ( my $i = $from ; $i <= $to ; $i++ ) {
+ $Pages .= $i . ',';
+ }
+ } else {
+ $Pages .= $page . ',';
+ }
+ }
+ chop $Pages;
+ print OPT "\\def\\pagestoshipout\{$Pages\}\n";
+ }
+ }
+ print OPT "\\protect\n";
+ if ( $Filters ne "" ) {
+ foreach my $F ( split( /,/, $Filters ) ) {
+ print OPT "\\useXMLfilter[$F]\n";
+ }
+ }
+ if ( $Modules ne "" ) {
+ foreach my $M ( split( /,/, $Modules ) ) {
+ print OPT "\\usemodule[$M]\n";
+ }
+ }
+ if ( $Environments ne "" ) {
+ foreach my $E ( split( /,/, $Environments ) ) {
+ print OPT "\\environment $E\n";
+ }
+ }
+ close(OPT);
+}
+
+my $UserFileOk = 0;
+my @MainLanguages;
+my $AllLanguages = '';
+
+sub MakeUserFile {
+ $UserFileOk = 0;
+ if ($AllPatterns) {
+ open( USR, ">cont-fmt.tex" );
+ print USR "\\preloadallpatterns\n";
+ } else {
+ return
+ if ( ( $MainLanguage eq 'standard' )
+ && ( $MainBodyFont eq 'standard' ) );
+ print " preparing user file : cont-fmt.tex\n";
+ open( USR, ">cont-fmt.tex" );
+ print USR "\\unprotect\n";
+ $AllLanguages = $MainLanguage;
+ if ( $MainLanguage ne 'standard' ) {
+ @MainLanguages = split( /\,/, $MainLanguage );
+ foreach (@MainLanguages) {
+ print USR "\\installlanguage[\\s!$_][\\c!state=\\v!start]\n";
+ }
+ $MainLanguage = $MainLanguages[0];
+ print USR "\\setupcurrentlanguage[\\s!$MainLanguage]\n";
+ }
+ if ( $MainBodyFont ne 'standard' ) {
+ print USR "\\definetypescriptsynonym[cmr][$MainBodyFont]";
+ print USR "\\definefilesynonym[font-cmr][font-$MainBodyFont]\n";
+ }
+ print USR "\\protect\n";
+ }
+ print USR "\\endinput\n";
+ close(USR);
+ ReportUserFile();
+ print "\n";
+ $UserFileOk = 1;
+}
+
+sub RemoveResponseFile { unlink "mult-def.tex" }
+
+sub MakeResponseFile {
+ if ( $MainResponse eq 'standard' ) { RemoveResponseFile() }
+ elsif ( !defined( $ResponseInterface{$MainResponse} ) ) {
+ RemoveResponseFile();
+ } else {
+ my $MR = $ResponseInterface{$MainResponse};
+ print " preparing interface file : mult-def.tex\n";
+ print " response language : $MR\n";
+ open( DEF, ">mult-def.tex" );
+ print DEF "\\def\\currentresponses\{$MR\}\n\\endinput\n";
+ close(DEF);
+ }
+}
+
+sub RestoreUserFile {
+ unlink "cont-fmt.log";
+ rename "cont-fmt.tex", "cont-fmt.log";
+ ReportUserFile();
+}
+
+sub ReportUserFile {
+ return unless ($UserFileOk);
+ print "\n";
+ if ( $MainLanguage ne 'standard' ) {
+ print " additional patterns : $AllLanguages\n";
+ print " default language : $MainLanguage\n";
+ }
+ if ( $MainBodyFont ne 'standard' ) {
+ print " default bodyfont : $MainBodyFont\n";
+ }
+}
+
+sub CheckPositions { }
+
+my $ConTeXtVersion = "unknown";
+my $ConTeXtModes = '';
+
+sub ScanTeXPreamble {
+ my ($FileName) = @_;
+ open( TEX, $FileName );
+ while (<TEX>) {
+ chomp;
+ if (/^\%.*/) {
+ if (/tex=([a-z]*)/goi) { $TeXExecutable = $1 }
+ if (/translat.*?=([\:\/0-9\-a-z]*)/goi) { $TeXTranslation = $1 }
+ if (/program=([a-z]*)/goi) { $TeXExecutable = $1 }
+ if (/output=([a-z\,\-]*)/goi) { $OutputFormat = $1 }
+ if (/modes=([a-z\,\-]*)/goi) { $ConTeXtModes = $1 }
+ if (/textree=([a-z\-]*)/goi) { $TeXTree = $1 }
+ if (/texroot=([a-z\-]*)/goi) { $TeXRoot = $1 }
+ if ( $ConTeXtInterface eq "unknown" ) {
+
+ if (/format=([a-z]*)/goi) {
+ $ConTeXtInterface = $ConTeXtInterfaces{$1};
+ }
+ if (/interface=([a-z]*)/goi) {
+ $ConTeXtInterface = $ConTeXtInterfaces{"$1"};
+ }
+ }
+ if (/version=([a-z]*)/goi) { $ConTeXtVersion = $1 }
+ } else {
+ last;
+ }
+ }
+ close(TEX);
+
+ # handy later on
+
+ $ProducePdfT = ($OutputFormat eq "pdftex") ;
+ $ProducePdfM = ($OutputFormat eq "dvipdfm") ;
+ $ProducePdfX = ($OutputFormat eq "dvipdfmx") ;
+ $ProducePdfXTX = ($OutputFormat eq "xetex") ;
+ $ProducePs = ($OutputFormat eq "dvips") ;
+}
+
+sub ScanContent {
+ my ($ConTeXtInput) = @_;
+ open( TEX, $ConTeXtInput );
+ while (<TEX>) {
+ next if (/^\%/) ;
+ if (
+/\\(starttekst|stoptekst|startonderdeel|startdocument|startoverzicht)/
+ )
+ {
+ $ConTeXtInterface = "nl";
+ last;
+ } elsif (/\\(stelle|verwende|umgebung|benutze)/) {
+ $ConTeXtInterface = "de";
+ last;
+ } elsif (/\\(stel|gebruik|omgeving)/) {
+ $ConTeXtInterface = "nl";
+ last;
+ } elsif (/\\(use|setup|environment)/) {
+ $ConTeXtInterface = "en";
+ last;
+ } elsif (/\\(usa|imposta|ambiente)/) {
+ $ConTeXtInterface = "it";
+ last;
+ } elsif (/(height|width|style)=/) {
+ $ConTeXtInterface = "en";
+ last;
+ } elsif (/(hoehe|breite|schrift)=/) {
+ $ConTeXtInterface = "de";
+ last;
+ }
+ # brr, can be \c!
+ elsif (/(hoogte|breedte|letter)=/) { $ConTeXtInterface = "nl"; last }
+ elsif (/(altezza|ampiezza|stile)=/) { $ConTeXtInterface = "it"; last }
+ elsif (/externfiguur/) { $ConTeXtInterface = "nl"; last }
+ elsif (/externalfigure/) { $ConTeXtInterface = "en"; last }
+ elsif (/externeabbildung/) { $ConTeXtInterface = "de"; last }
+ elsif (/figuraesterna/) { $ConTeXtInterface = "it"; last }
+ }
+ close(TEX);
+}
+
+if ( $ConTeXtInterfaces{$ConTeXtInterface} ) {
+ $ConTeXtInterface = $ConTeXtInterfaces{$ConTeXtInterface};
+}
+
+my $Problems = my $Ok = 0;
+
+sub PrepRunTeX {
+ my ( $JobName, $JobSuffix, $PipeString ) = @_;
+ my $cmd;
+ my $TeXProgNameFlag = '';
+ if ( !$dosish ) # we assume tetex on linux
+ {
+ $TeXProgramPath = '';
+ $TeXFormatPath = '';
+ if ( !$TeXProgNameFlag
+ && ( $Format =~ /^cont/ )
+ && ( $TeXPassString !~ /progname/io ) )
+ {
+ $TeXProgNameFlag = "-progname=context";
+ }
+ }
+ $own_quote = ($TeXProgramPath =~ m/^[^\"].* / ? "\"" : "") ;
+ $cmd = join( ' ',
+ "$own_quote$TeXProgramPath$TeXExecutable$own_quote",
+ $TeXProgNameFlag, $TeXPassString, $PassOn, "" );
+ if ($EnterBatchMode) { $cmd .= "$TeXBatchFlag " }
+ if ($EnterNonStopMode) { $cmd .= "$TeXNonStopFlag " }
+ if ( $TeXTranslation ne '' ) { $cmd .= "-translate-file=$TeXTranslation " }
+ $cmd .= "$TeXFormatFlag$TeXFormatPath$Format $JobName.$JobSuffix $PipeString";
+ return $cmd;
+}
+
+my $emergencyend = "" ;
+#~ my $emergencyend = "\\emergencyend" ;
+
+sub RunTeX {
+ my ( $JobName, $JobSuffix ) = @_;
+ my $StartTime = time;
+ my $cmd = PrepRunTeX($JobName, $JobSuffix, '');
+ if ($EnterBatchMode) {
+ $Problems = System("$cmd $emergencyend");
+ } else {
+ $Problems = System("$cmd $emergencyend");
+ }
+ my $StopTime = time - $StartTime;
+ print "\n return code : $Problems";
+ print "\n run time : $StopTime seconds\n";
+ return $Problems;
+}
+
+sub PushResult {
+ my $File = shift;
+ $File =~ s/\..*$//o;
+ $Result =~ s/\..*$//o;
+ if ( ( $Result ne '' ) && ( $Result ne $File ) ) {
+ print " outputfile : $Result\n";
+ unlink "texexec.tuo";
+ rename "$File.tuo", "texexec.tuo";
+ unlink "texexec.log";
+ rename "$File.log", "texexec.log";
+ unlink "texexec.dvi";
+ rename "$File.dvi", "texexec.dvi";
+ unlink "texexec.pdf";
+ rename "$File.pdf", "texexec.pdf";
+
+ if ( -e "$Result.tuo" ) {
+ unlink "$File.tuo";
+ rename "$Result.tuo", "$File.tuo";
+ }
+ }
+ if ($Optimize) { unlink "$File.tuo" }
+}
+
+sub PopResult {
+ my $File = shift;
+ $File =~ s/\..*$//o;
+ $Result =~ s/\..*$//o;
+ if ( ( $Result ne '' ) && ( $Result ne $File ) ) {
+ print " renaming : $File to $Result\n";
+ unlink "$Result.tuo";
+ rename "$File.tuo", "$Result.tuo";
+ unlink "$Result.log";
+ rename "$File.log", "$Result.log";
+ unlink "$Result.dvi";
+ rename "$File.dvi", "$Result.dvi";
+ if ( -e "$File.dvi" ) { CopyFile( "$File.dvi", "$Result.dvi" ) }
+ unlink "$Result.pdf";
+ rename "$File.pdf", "$Result.pdf";
+ if ( -e "$File.pdf" ) { CopyFile( "$File.pdf", "$Result.pdf" ) }
+ return if ( $File ne "texexec" );
+ rename "texexec.tuo", "$File.tuo";
+ rename "texexec.log", "$File.log";
+ rename "texexec.dvi", "$File.dvi";
+ rename "texexec.pdf", "$File.pdf";
+ }
+}
+
+sub RunTeXutil {
+ my $StopRunning;
+ my $JobName = shift;
+ unlink "$JobName.tup";
+ rename "$JobName.tuo", "$JobName.tup";
+ print " sorting and checking : running texutil\n";
+ my $TcXSwitch = '';
+ if ( $TcXPath ne '' ) { $TcXSwitch = "--tcxpath=$TcXPath" }
+ RunPerlScript( $TeXUtil, "--ref --ij --high $TcXPath $JobName" );
+
+ if ( -e "$JobName.tuo" ) {
+ CheckPositions($JobName);
+ #~ print " utility file check : $JobName.tup <-> $JobName.tuo\n";
+ $StopRunning = !compare( "$JobName.tup", "$JobName.tuo" );
+ } else {
+ $StopRunning = 1;
+ } # otherwise potential loop
+ if ( !$StopRunning ) {
+ print "\n utility file analysis : another run needed\n";
+ }
+ return $StopRunning;
+}
+
+sub PurgeFiles {
+ my $JobName = shift;
+ print "\n purging files : $JobName\n";
+ RunPerlScript( $TeXUtil, "--purge $JobName" );
+ unlink( $Result . '.log' ) if ( -f $Result . '.log' );
+}
+
+sub RunTeXMP {
+ my $JobName = shift;
+ my $MPfile = shift;
+ my $MPrundone = 0;
+ my $MPJobName = MPJobName( $JobName, $MPfile );
+ my $MPFoundJobName = "";
+ if ( $MPJobName ne "" ) {
+ if ( open( MP, "$MPJobName" ) ) {
+ $_ = <MP>;
+ chomp; # we should handle the prefix as well
+ if (/^\%\s+translate.*?\=([\w\d\-]+)/io) { $TeXTranslation = $1 }
+ if (/collected graphics of job \"(.+)\"/i) { $MPFoundJobName = $1 }
+ close(MP);
+ if ( $MPFoundJobName ne "" ) {
+ if ( $JobName =~ /$MPFoundJobName$/i ) {
+ if ( $MpExecutable ne '' ) {
+ print
+ " generating graphics : metaposting $MPJobName\n";
+ my $ForceMpy = "";
+ if ($MpyForce) { $ForceMpy = "--mpyforce" }
+ my $ForceTCX = '';
+ if ( $TeXTranslation ne '' ) {
+ $ForceTCX = "--translate=$TeXTranslation ";
+ }
+ if ($EnterBatchMode) {
+ RunPerlScript( $TeXExec,
+"$ForceTCX $ForceMpy --mptex --nomp --batch $MPJobName"
+ );
+ } elsif ($EnterNonStopMode) {
+ RunPerlScript( $TeXExec,
+"$ForceTCX $ForceMpy --mptex --nomp --nonstop $MPJobName"
+ );
+ } else {
+ RunPerlScript( $TeXExec,
+ "$ForceTCX $ForceMpy --mptex --nomp $MPJobName"
+ );
+ }
+ } else {
+ print
+ " generating graphics : metapost cannot be run\n";
+ }
+ $MPrundone = 1;
+ }
+ }
+ }
+ }
+ return $MPrundone;
+}
+
+sub CopyFile { # agressive copy, works for open files like in gs
+ my ( $From, $To ) = @_;
+ return unless open( INP, "<$From" );
+ binmode INP;
+ return unless open( OUT, ">$To" );
+ binmode OUT;
+ while (<INP>) { print OUT $_ }
+ close(INP);
+ close(OUT);
+}
+
+#~ sub CheckMPChanges {
+ #~ my $JobName = shift;
+ #~ my $checksum = 0;
+ #~ my $MPJobName = MPJobName( $JobName, "mpgraph" );
+ #~ if ( open( MP, $MPJobName ) ) {
+ #~ while (<MP>) {
+ #~ unless (/random/oi) {
+ #~ $checksum += do { unpack( "%32C*", <MP> ) % 65535 }
+ #~ }
+ #~ }
+ #~ close(MP);
+ #~ }
+ #~ $MPJobName = MPJobName( $JobName, "mprun" );
+ #~ if ( open( MP, $MPJobName ) ) {
+ #~ while (<MP>) {
+ #~ unless (/random/oi) {
+ #~ $checksum += do { unpack( "%32C*", <MP> ) % 65535 }
+ #~ }
+ #~ }
+ #~ close(MP);
+ #~ }
+ #~ print " mpgraph/mprun : $checksum\n";
+ #~ return $checksum;
+#~ }
+
+sub CheckMPChanges {
+ my $JobName = shift; my $str = '' ;
+ my $MPJobName = MPJobName( $JobName, "mpgraph" );
+ if ( open( MP, $MPJobName ) ) {
+ $str .= do { local $/ ; <MP> ; } ;
+ close(MP) ;
+ }
+ $MPJobName = MPJobName( $JobName, "mprun" );
+ if ( open( MP, $MPJobName ) ) {
+ $str .= do { local $/ ; <MP> ; } ;
+ close(MP) ;
+ }
+ $str =~ s/^.*?random.*?$//oim ;
+ return Digest::MD5::md5_hex($str) ;
+}
+
+#~ sub CheckTubChanges {
+ #~ my $JobName = shift;
+ #~ my $checksum = 0;
+ #~ if ( open( TUB, "$JobName.tub" ) ) {
+ #~ while (<TUB>) {
+ #~ $checksum += do { unpack( "%32C*", <TUB> ) % 65535 }
+ #~ }
+ #~ close(TUB);
+ #~ }
+ #~ return $checksum;
+#~ }
+
+sub CheckTubChanges {
+ my $JobName = shift; my $str = '' ;
+ if ( open( TUB, "$JobName.tub" ) ) {
+ $str = do { local $/ ; <TUB> ; } ;
+ close(TUB);
+ }
+ return Digest::MD5::md5_hex($str);
+}
+
+
+my $DummyFile = 0;
+
+sub isXMLfile {
+ my $Name = shift;
+ if ( ($ForceXML) || ( $Name =~ /\.(xml|fo|fox)$/io ) ) { return 1 }
+ else {
+ open( XML, $Name );
+ my $str = <XML>;
+ close(XML);
+ return ( $str =~ /\<\?xml /io );
+ }
+}
+
+sub RunConTeXtFile {
+ my ( $JobName, $JobSuffix ) = @_;
+ if ($AutoPath) {
+ if ($JobName =~ /^(.*)[\/\\](.*?)$/o) {
+ $InpPath = $1 ;
+ $JobName = $2 ;
+ }
+ }
+ $JobName =~ s/\\/\//goi;
+ $InpPath =~ s/\\/\//goi;
+ my $OriSuffix = $JobSuffix;
+ if ($JobSuffix =~ /\_fo$/i) {
+ if (! -f $JobName) {
+ print "stripping funny suffix : _fo\n";
+ $JobName =~ s/\_fo$//io ;
+ $JobSuffix =~ s/\_fo$//io ;
+ $OriSuffix =~ s/\_fo$//io ;
+ }
+ }
+ if (($dosish) && ($PdfClose)) {
+ my $ok = System("pdfclose --file $JobName.pdf") if -e "$JobName.pdf" ;
+ if (($Result ne '') && (-e "$Result.pdf")) {
+ $ok = System("pdfclose --file $Result.pdf") ;
+ }
+ System("pdfclose --all") unless $ok ;
+ }
+ if ( -e "$JobName.$JobSuffix" ) {
+ $DummyFile = ( ($ForceXML) || ( $JobSuffix =~ /(xml|fo|fox)/io ) );
+ }
+ # to be considered :
+ # { $DummyFile = isXMLfile("$JobName.$JobSuffix") }
+ elsif ( $InpPath ne "" ) {
+ my @InpPaths = split( /,/, $InpPath );
+ foreach my $rp (@InpPaths) {
+ if ( -e "$rp/$JobName.$JobSuffix" ) { $DummyFile = 1; last }
+ }
+ }
+ if ($DummyFile) {
+ open( TMP, ">$JobName.run" );
+ if ( ( $JobSuffix =~ /(xml|fo|fox)/io ) || $ForceXML ) {
+ # scan xml preamble
+ open(XML,"<$JobName.$JobSuffix") ;
+ while (<XML>) {
+ if (/\<\?context\-directive\s+(\S+)\s+(\S+)\s+(\S+)\s*(.*?)\s*\?\>/o) {
+ my ($class, $key, $value, $rest) = ($1, $2, $3, $4) ;
+ if ($class eq 'job') {
+ if (($key eq 'mode') || ($key eq 'modes')) {
+ print TMP "\\enablemode[$value]\n" ;
+ } elsif (($key eq 'stylefile') || ($key eq 'environment')) {
+ print TMP "\\environment $value\n" ;
+ } elsif ($key eq 'module') {
+ print TMP "\\usemodule[$value]\n" ;
+ } elsif ($key eq 'interface') {
+ $ConTeXtInterface = $value ;
+ } elsif ($key eq 'control') {
+ if ($rest == 'purge') { $Purge = 1 }
+ }
+ }
+ } elsif (/\<[a-z]+/io) {
+ last ;
+ }
+ }
+ close(XML) ;
+ if ( $Filters ne "" ) {
+ print " using xml filters : $Filters\n";
+ }
+ print TMP "\\starttext\n";
+ print TMP "\\processXMLfilegrouped{$JobName.$JobSuffix}\n";
+ print TMP "\\stoptext\n";
+ } else {
+ print TMP "\\starttext\n";
+ print TMP "\\processfile{$JobName.$JobSuffix}\n";
+ print TMP "\\stoptext\n";
+ }
+ close(TMP);
+ $JobSuffix = "run";
+ }
+ if ( ( -e "$JobName.$JobSuffix" ) || ($GlobalFile) ) {
+ unless ($DummyFile) { # we don't need this for xml
+ ScanTeXPreamble("$JobName.$JobSuffix");
+ if ( $ConTeXtInterface eq "unknown" ) {
+ ScanContent("$JobName.$JobSuffix");
+ }
+ }
+ if ( $ConTeXtInterface eq "unknown" ) {
+ $ConTeXtInterface = $UserInterface;
+ }
+ if ( $ConTeXtInterface eq "unknown" ) { $ConTeXtInterface = "en" }
+ if ( $ConTeXtInterface eq "" ) { $ConTeXtInterface = "en" }
+ CheckOutputFormat;
+ my $StopRunning = 0;
+ my $MPrundone = 0;
+ if ( $Format eq '' ) { $Format = "cont-$ConTeXtInterface" }
+ print " executable : $TeXProgramPath$TeXExecutable\n";
+ print " format : $TeXFormatPath$Format\n";
+ if ($InpPath) { print " source path : $InpPath\n" }
+
+ if ($DummyFile) {
+ print " dummy file : $JobName.$JobSuffix\n";
+ }
+ print " inputfile : $JobName\n";
+ print " output : $FullFormat\n";
+ print " interface : $ConTeXtInterface\n";
+ if ( $TeXTranslation ne '' ) {
+ print " translation : $TeXTranslation\n";
+ }
+ my $Options = '';
+ if ($Random) { $Options .= " random" }
+ if ($FastMode) { $Options .= " fast" }
+ if ($FinalMode) { $Options .= " final" }
+ if ($Verbose) { $Options .= " verbose" }
+ if ($TypesetListing) { $Options .= " listing" }
+ if ($TypesetModule) { $Options .= " module" }
+ if ($TypesetFigures) { $Options .= " figures" }
+ if ($MakeFormats) { $Options .= " make" }
+ if ($RunOnce) { $Options .= " once" }
+ if ($UseColor) { $Options .= " color" }
+ if ($EnterBatchMode) { $Options .= " batch" }
+ if ($EnterNonStopMode) { $Options .= " nonstop" }
+ if ($NoMPMode) { $Options .= " nomp" }
+ if ($CenterPage) { $Options .= " center" }
+ if ($Arrange) { $Options .= " arrange" }
+ if ($NoArrange) { $Options .= " no-arrange" }
+ if ($Options) { print " options :$Options\n" }
+ if ($ConTeXtModes) { print " possible modes : $ConTeXtModes\n" }
+ if ($Mode) { print " current mode : $Mode\n" }
+ else { print " current mode : none\n" }
+ if ($Arguments) { print " arguments : $Arguments\n" }
+ if ($Modules) { print " modules : $Modules\n" }
+ if ($Environments) { print " environments : $Environments\n" }
+ if ($Suffix) { $Result = "$JobName$Suffix" }
+ PushResult($JobName);
+ $Problems = 0;
+ my $TeXRuns = 0;
+
+ if ( ($PdfArrange) || ($PdfSelect) || ($RunOnce) ) {
+ MakeOptionFile( 1, 1, $JobName, $OriSuffix, 3 );
+ print "\n";
+ $Problems = RunTeX( $JobName, $JobSuffix );
+ if ($ForceTeXutil) { $Ok = RunTeXutil($JobName) }
+ CopyFile( "$JobName.top", "$JobName.tmp" );
+ unlink "$JobName.top"; # runtime option file
+ PopResult($JobName);
+ } else {
+ while ( !$StopRunning && ( $TeXRuns < $NOfRuns ) && ( !$Problems ) )
+ {
+ ++$TeXRuns;
+ if ( $TeXRuns == 1 ) {
+ MakeOptionFile( 0, 0, $JobName, $OriSuffix, 1 );
+ } else {
+ MakeOptionFile( 0, 0, $JobName, $OriSuffix, 2 );
+ }
+ print " TeX run : $TeXRuns\n\n";
+ my ( $mpchecksumbefore, $mpchecksumafter ) = ( '', '' );
+ my ( $tubchecksumbefore, $tubchecksumafter ) = ( '', '' );
+ if ($AutoMPRun) { $mpchecksumbefore = CheckMPChanges($JobName) }
+ $tubchecksumbefore = CheckTubChanges($JobName) ;
+ $Problems = RunTeX( $JobName, $JobSuffix );
+ $tubchecksumafter = CheckTubChanges($JobName) ;
+ if ($AutoMPRun) { $mpchecksumafter = CheckMPChanges($JobName) }
+ if ( ( !$Problems ) && ( $NOfRuns > 1 ) ) {
+ unless ( $NoMPMode ) {
+ $MPrundone = RunTeXMP( $JobName, "mpgraph" );
+ $MPrundone = RunTeXMP( $JobName, "mprun" );
+ }
+ $StopRunning = RunTeXutil($JobName);
+ if ($AutoMPRun) {
+ $StopRunning =
+ ( $StopRunning
+ && ( $mpchecksumafter eq $mpchecksumbefore ) );
+ }
+ $StopRunning =
+ ( $StopRunning
+ && ( $tubchecksumafter eq $tubchecksumbefore ) );
+ }
+ }
+ if ( ( $NOfRuns == 1 ) && $ForceTeXutil ) {
+ $Ok = RunTeXutil($JobName);
+ }
+ if ( ( !$Problems )
+ && ( ( $FinalMode || $FinalRunNeeded ) )
+ && ( $NOfRuns > 1 ) )
+ {
+ MakeOptionFile( 1, $FinalMode, $JobName, $OriSuffix, 4 );
+ print " final TeX run : $TeXRuns\n\n";
+ $Problems = RunTeX( $JobName, $JobSuffix );
+ }
+ CopyFile( "$JobName.top", "$JobName.tmp" );
+ unlink "$JobName.tup"; # previous tuo file
+ unlink "$JobName.top"; # runtime option file
+ if ($ProducePdfX) {
+ $ENV{'backend'} = $ENV{'progname'} = 'dvipdfm' ;
+ $ENV{'TEXFONTMAPS'} = '.;$TEXMF/fonts/map/{dvipdfm,dvips,}//' ;
+ System("dvipdfmx -d 4 $JobName") ;
+ } elsif ($ProducePdfM) {
+ $ENV{'backend'} = $ENV{'progname'} = 'dvipdfm' ;
+ $ENV{'TEXFONTMAPS'} = '.;$TEXMF/fonts/map/{dvipdfm,dvips,}//' ;
+ System("dvipdfm $JobName") ;
+ } elsif ($ProducePdfXTX) {
+ $ENV{'backend'} = $ENV{'progname'} = 'xetex' ;
+ $ENV{'TEXFONTMAPS'} = '.;$TEXMF/fonts/map/{xetex,pdftex,dvips,}//' ;
+ System("xdv2pdf $JobName.xdv") ;
+ } elsif ($ProducePs) {
+ $ENV{'backend'} = $ENV{'progname'} = 'dvips' ;
+ $ENV{'TEXFONTMAPS'} = '.;$TEXMF/fonts/map/{dvips,pdftex,}//' ;
+ # temp hack, some day there will be map file loading in specials
+ my $mapfiles = '' ;
+ if (-f "$JobName.tui") {
+ open(TUI,"$JobName.tui") ;
+ while (<TUI>) {
+ if (/c \\usedmapfile\{.\}\{(.*?)\}/o) {
+ $mapfiles .= "-u +$1 " ;
+ }
+ }
+ close(TUI) ;
+ }
+ System("dvips $mapfiles $JobName.dvi") ;
+ }
+ PopResult($JobName);
+ }
+ if ($Purge) { PurgeFiles($JobName) }
+ if ($DummyFile) # $JobSuffix == run
+ {
+ unlink "$JobName.$JobSuffix";
+ }
+ if ((!$Problems) && ($PdfOpen)) {
+ if ($Result ne '') {
+ System("pdfopen --file $Result.pdf") if -f "$Result.pdf"
+ } else {
+ System("pdfopen --file $JobName.pdf") if -f "$JobName.pdf"
+ }
+ }
+ }
+}
+
+sub RunSomeTeXFile {
+ my ( $JobName, $JobSuffix ) = @_;
+ if ( -e "$JobName.$JobSuffix" ) {
+ PushResult($JobName);
+ print " executable : $TeXProgramPath$TeXExecutable\n";
+ print " format : $TeXFormatPath$Format\n";
+ print " inputfile : $JobName.$JobSuffix\n";
+ $Problems = RunTeX( $JobName, $JobSuffix );
+ PopResult($JobName);
+ }
+}
+
+my $ModuleFile = "texexec";
+my $ListingFile = "texexec";
+my $FiguresFile = "texexec";
+my $ArrangeFile = "texexec";
+my $SelectFile = "texexec";
+my $CopyFile = "texexec";
+my $CombineFile = "texexec";
+
+sub RunModule {
+ my @FileNames = sort @_;
+ if ($FileNames[0]) {
+ unless ( -e $FileNames[0] ) {
+ my $Name = $FileNames[0];
+ @FileNames = ( "$Name.tex", "$Name.mp", "$Name.pl", "$Name.pm" );
+ }
+ foreach my $FileName (@FileNames) {
+ next unless -e $FileName;
+ my ( $Name, $Suffix ) = split( /\./, $FileName );
+ next unless $Suffix =~ /(tex|mp|pl|pm)/io;
+ DoRunModule( $Name, $Suffix );
+ }
+ } else {
+ print " module : no modules found\n\n";
+ }
+}
+
+# the next one can be more efficient: directly process ted
+# file a la --use=abr-01,mod-01
+
+sub checktexformatpath {
+ # engine support is either broken of not implemented in some
+ # distributions, so we need to take care of it ourselves
+ my $texformats ;
+ if (defined($ENV{'TEXFORMATS'})) {
+ $texformats = $ENV{'TEXFORMATS'} ;
+ } else {
+ $texformats = '' ;
+ }
+ if ($texformats eq '') {
+ if ($UseEnginePath) {
+ if ($dosish) {
+ $texformats = `kpsewhich --engine=$TeXExecutable --expand-var=\$TEXFORMATS` ;
+ } else {
+ $texformats = `kpsewhich --engine=$TeXExecutable --expand-var=\\\$TEXFORMATS` ;
+ }
+ } else {
+ if ($dosish) {
+ $texformats = `kpsewhich --expand-var=\$TEXFORMATS` ;
+ } else {
+ $texformats = `kpsewhich --expand-var=\\\$TEXFORMATS` ;
+ }
+ }
+ chomp($texformats) ;
+ }
+ if (($texformats !~ /web2c\/.*$TeXExecutable/) && ($texformats !~ /web2c[\/\\].*\$engine/i)) {
+ $texformats =~ s/(web2c\/\{)(\,\})/$1\$engine$2/ ; # needed for empty engine flags
+ if ($texformats !~ /web2c[\/\\].*\$ENGINE/) {
+ $texformats =~ s/web2c/web2c\/{\$engine,}/ ; # needed for me
+ }
+ $ENV{'TEXFORMATS'} = $texformats ;
+ print " fixing texformat path : $ENV{'TEXFORMATS'}\n";
+ } else {
+ print " using texformat path : $ENV{'TEXFORMATS'}\n" if ($Verbose) ;
+ }
+ if (! defined($ENV{'ENGINE'})) {
+ if ($MpEngineSupport) {
+ $ENV{'ENGINE'} .= $MpExecutable ;
+ } ;
+ $ENV{'ENGINE'} = $TeXExecutable ;
+ print "fixing engine variable : $ENV{'ENGINE'}\n";
+ }
+}
+
+sub DoRunModule {
+ my ( $FileName, $FileSuffix ) = @_;
+ RunPerlScript( $TeXUtil, "--documents $FileName.$FileSuffix" );
+ print " module : $FileName\n\n";
+ open( MOD, ">$ModuleFile.tex" );
+ # we need to signal to texexec what interface to use
+ open( TED, "$FileName.ted" );
+ my $firstline = <TED>;
+ close(TED);
+ if ( $firstline =~ /interface=/ ) {
+ print MOD $firstline ;
+ } else {
+ print MOD "% interface=en\n" ;
+ }
+ # so far
+ print MOD "\\usemodule[abr-01,mod-01]\n";
+ print MOD "\\def\\ModuleNumber{1}\n";
+ print MOD "\\starttext\n";
+ print MOD "\\readlocfile{$FileName.ted}{}{}\n";
+ print MOD "\\stoptext\n";
+ close(MOD);
+ checktexformatpath ;
+ RunConTeXtFile( $ModuleFile, "tex" );
+ if ( $FileName ne $ModuleFile ) {
+ foreach my $FileSuffix ( "dvi", "pdf", "tui", "tuo", "log" ) {
+ unlink("$FileName.$FileSuffix");
+ rename( "$ModuleFile.$FileSuffix", "$FileName.$FileSuffix" );
+ }
+ }
+ unlink("$ModuleFile.tex");
+}
+
+sub RunFigures {
+ my @Files = @_ ;
+ $TypesetFigures = lc $TypesetFigures;
+ return unless ( $TypesetFigures =~ /[abcd]/o );
+ unlink "$FiguresFile.pdf";
+ if (@Files) { RunPerlScript( $TeXUtil, "--figures @Files" ) }
+ open( FIG, ">$FiguresFile.tex" );
+ print FIG "% format=english\n";
+ print FIG "\\setuplayout\n";
+ print FIG " [topspace=1.5cm,backspace=1.5cm,\n";
+ print FIG " header=1.5cm,footer=0pt,\n";
+ print FIG " width=middle,height=middle]\n";
+ if ($ForceFullScreen) {
+ print FIG "\\setupinteraction\n";
+ print FIG " [state=start]\n";
+ print FIG "\\setupinteractionscreen\n";
+ print FIG " [option=max]\n";
+ }
+ if ($BoxType ne '') {
+ if ($BoxType !~ /box$/io) {
+ $BoxType .= "box" ;
+ }
+ }
+ print FIG "\\starttext\n";
+ print FIG "\\showexternalfigures[alternative=$TypesetFigures,offset=$PaperOffset,size=$BoxType]\n";
+ print FIG "\\stoptext\n";
+ close(FIG);
+ $ConTeXtInterface = "en";
+ checktexformatpath ;
+ RunConTeXtFile( $FiguresFile, "tex" );
+ unlink('texutil.tuf') if ( -f 'texutil.tuf' );
+}
+
+sub CleanTeXFileName {
+ my $str = shift;
+ $str =~ s/([\$\_\#])/\\$1/go;
+ $str =~ s/([\~])/\\string$1/go;
+ return $str;
+}
+
+sub RunListing {
+ my $FileName = my $CleanFileName = shift;
+ my @FileNames = glob $FileName;
+ return unless -f $FileNames[0];
+ print " input file : $FileName\n";
+ if ( $BackSpace eq "0pt" ) { $BackSpace = "1.5cm" }
+ else { print " backspace : $BackSpace\n" }
+ if ( $TopSpace eq "0pt" ) { $TopSpace = "1.5cm" }
+ else { print " topspace : $TopSpace\n" }
+ open( LIS, ">$ListingFile.tex" );
+ print LIS "% format=english\n";
+ print LIS "\\setupbodyfont[11pt,tt]\n";
+ print LIS "\\setuplayout\n";
+ print LIS " [topspace=$TopSpace,backspace=$BackSpace,\n";
+ print LIS " header=0cm,footer=1.5cm,\n";
+ print LIS " width=middle,height=middle]\n";
+ print LIS "\\setuptyping[lines=yes]\n";
+ if ($Pretty) { print LIS "\\setuptyping[option=color]\n" }
+ print LIS "\\starttext\n";
+
+ foreach $FileName (@FileNames) {
+ $CleanFileName = lc CleanTeXFileName($FileName);
+ print LIS "\\page\n";
+ print LIS "\\setupfootertexts[\\tttf $CleanFileName][\\tttf \\pagenumber]\n";
+ print LIS "\\typefile\{$FileName\}\n";
+ }
+ print LIS "\\stoptext\n";
+ close(LIS);
+ $ConTeXtInterface = "en";
+ checktexformatpath ;
+ RunConTeXtFile( $ListingFile, "tex" );
+}
+
+sub RunArrange {
+ my @files = @_;
+ print " backspace : $BackSpace\n";
+ print " topspace : $TopSpace\n";
+ print " paperoffset : $PaperOffset\n";
+ if ( $AddEmpty eq '' ) { print " empty pages added : none\n" }
+ else { print " empty pages added : $AddEmpty\n" }
+ if ( $TextWidth eq '0pt' ) { print " textwidth : unknown\n" }
+ else { print " textwidth : $TextWidth\n" }
+ open( ARR, ">$ArrangeFile.tex" );
+ print ARR "% format=english\n";
+ print ARR "\\definepapersize\n";
+ print ARR " [offset=$PaperOffset]\n";
+ print ARR "\\setuplayout\n";
+ print ARR " [backspace=$BackSpace,\n";
+ print ARR " topspace=$TopSpace,\n";
+
+ if ($Markings) {
+ print ARR " marking=on,\n";
+ print " cutmarkings : on\n";
+ }
+ print ARR " width=middle,\n";
+ print ARR " height=middle,\n";
+ print ARR " location=middle,\n";
+ print ARR " header=0pt,\n";
+ print ARR " footer=0pt]\n";
+ if ($NoDuplex) { print " duplex : off\n" }
+ else {
+ print " duplex : on\n";
+ print ARR "\\setuppagenumbering\n";
+ print ARR " [alternative=doublesided]\n";
+ }
+ print ARR "\\starttext\n";
+ foreach my $FileName (@files) {
+ print " pdffile : $FileName\n";
+ print ARR "\\insertpages\n [$FileName]";
+ if ( $AddEmpty ne '' ) { print ARR "[$AddEmpty]" }
+ print ARR "[width=$TextWidth]\n";
+ }
+ print ARR "\\stoptext\n";
+ close(ARR);
+ $ConTeXtInterface = "en";
+ checktexformatpath ;
+ RunConTeXtFile( $ModuleFile, "tex" );
+}
+
+sub RunSelect {
+ my $FileName = shift;
+ print " pdffile : $FileName\n";
+ print " backspace : $BackSpace\n";
+ print " topspace : $TopSpace\n";
+ print " paperoffset : $PaperOffset\n";
+ if ( $TextWidth eq '0pt' ) { print " textwidth : unknown\n" }
+ else { print " textwidth : $TextWidth\n" }
+ open( SEL, ">$SelectFile.tex" );
+ print SEL "% format=english\n";
+ print SEL "\\definepapersize\n";
+ print SEL " [offset=$PaperOffset]\n";
+ if ($PaperFormat =~ /fit/) {
+ print SEL "\\getfiguredimensions[$FileName]\n" ;
+ print SEL "\\expanded{\\definepapersize[fit][width=\\figurewidth,height=\\figureheight]}\n" ;
+ print SEL "\\setuppapersize[fit][fit]\n";
+ $PaperFormat = '' ; # avoid overloading in option file
+ } elsif ( $PaperFormat ne 'standard' ) {
+ $_ = $PaperFormat; # NO UPPERCASE !
+ s/x/\*/io;
+ my ( $from, $to ) = split(/\*/);
+ if ( $to eq "" ) { $to = $from }
+ print " papersize : $PaperFormat\n";
+ print SEL "\\setuppapersize[$from][$to]\n";
+ $PaperFormat = '' ; # avoid overloading in option file
+ }
+ #
+ print SEL "\\setuplayout\n";
+ print SEL " [backspace=$BackSpace,\n";
+ print SEL " topspace=$TopSpace,\n";
+ if ($Markings) {
+ print SEL " marking=on,\n";
+ print " cutmarkings : on\n";
+ }
+ print SEL " width=middle,\n";
+ print SEL " height=middle,\n";
+ print SEL " location=middle,\n";
+ print SEL " header=0pt,\n";
+ print SEL " footer=0pt]\n";
+ print SEL "\\setupexternalfigures\n";
+ print SEL " [directory=]\n";
+ print SEL "\\starttext\n";
+
+ if ( $Selection ne '' ) {
+ print SEL "\\filterpages\n";
+ print SEL " [$FileName][$Selection][width=$TextWidth]\n";
+ }
+ print SEL "\\stoptext\n";
+ close(SEL);
+ $ConTeXtInterface = "en";
+ checktexformatpath ;
+ RunConTeXtFile( $SelectFile, "tex" );
+}
+
+sub RunCopy {
+ my $DoTrim = shift ;
+ my @Files = @_ ;
+ if ( $PageScale == 1000 ) {
+ print " offset : $PaperOffset\n";
+ } else {
+ print " scale : $PageScale\n";
+ if ( $PageScale < 10 ) { $PageScale = int( $PageScale * 1000 ) }
+ }
+ open( COP, ">$CopyFile.tex" );
+ print COP "% format=english\n";
+ print COP "\\starttext\n";
+ for my $FileName (@Files) {
+ print " pdffile : $FileName\n";
+ print COP "\\getfiguredimensions\n";
+ print COP " [$FileName]\n";
+ print COP " [page=1";
+ if ($DoTrim) {
+ print COP ",\n size=trimbox";
+ }
+ print COP "]\n";
+ print COP "\\definepapersize\n";
+ print COP " [copy]\n";
+ print COP " [width=\\naturalfigurewidth,\n";
+ print COP " height=\\naturalfigureheight]\n";
+ print COP "\\setuppapersize\n";
+ print COP " [copy][copy]\n";
+ print COP "\\setuplayout\n";
+ print COP " [page]\n";
+ print COP "\\setupexternalfigures\n";
+ print COP " [directory=]\n";
+ print COP "\\copypages\n";
+ print COP " [$FileName]\n";
+ print COP " [scale=$PageScale,\n";
+ if ($Markings) {
+ print COP " marking=on,\n";
+ print " cutmarkings : on\n";
+ }
+ if ($DoTrim) {
+ print COP " size=trimbox,\n";
+ print " cropping to : trimbox\n";
+ }
+ print COP " offset=$PaperOffset]\n";
+ }
+ print COP "\\stoptext\n";
+ close(COP);
+ $ConTeXtInterface = "en";
+ checktexformatpath ;
+ RunConTeXtFile( $CopyFile, "tex" );
+}
+
+sub RunCombine {
+ my @Files = @_;
+ $Combination =~ s/x/\*/io;
+ my ( $nx, $ny ) = split( /\*/, $Combination, 2 );
+ return unless ( $nx && $ny );
+ print " combination : $Combination\n";
+ open( COM, ">$CombineFile.tex" );
+ print COM "% format=english\n";
+ if ( $PaperFormat ne 'standard' ) {
+ $_ = $PaperFormat; # NO UPPERCASE !
+ s/x/\*/io;
+ my ( $from, $to ) = split(/\*/);
+ if ( $to eq "" ) { $to = $from }
+ print " papersize : $PaperFormat\n";
+ print COM "\\setuppapersize[$from][$to]\n";
+ }
+ #
+ if ( $PaperOffset eq '0pt' ) { $PaperOffset = '1cm' }
+ print " paper offset : $PaperOffset\n";
+ print COM "\\setuplayout\n";
+ print COM " [topspace=$PaperOffset,\n";
+ print COM " backspace=$PaperOffset,\n";
+ print COM " header=0pt,\n";
+ print COM " footer=1cm,\n";
+ print COM " width=middle,\n";
+ print COM " height=middle]\n";
+
+ if ($NoBanner) {
+ print COM "\\setuplayout\n";
+ print COM " [footer=0cm]\n";
+ }
+ print COM "\\setupexternalfigures\n";
+ print COM " [directory=]\n";
+ print COM "\\starttext\n";
+ for my $FileName (@Files) {
+ next if ( $FileName =~ /^texexec/io );
+ next if (($Result ne '') && ( $FileName =~ /^$Result/i ));
+ print " pdffile : $FileName\n";
+ my $CleanFileName = CleanTeXFileName($FileName);
+ print COM "\\setupfootertexts\n";
+ print COM " [\\tttf $CleanFileName\\quad\\quad\\currentdate\\quad\\quad\\pagenumber]\n";
+ print COM "\\combinepages[$FileName][nx=$nx,ny=$ny]\n";
+ print COM "\\page\n";
+ }
+ print COM "\\stoptext\n";
+ close(COM);
+ $ConTeXtInterface = "en";
+ checktexformatpath ;
+ RunConTeXtFile( $CombineFile, "tex" );
+}
+
+sub LocatedFormatPath { # watch out $engine is lowercase in kpse
+ my $FormatPath = shift;
+ my $EnginePath = shift;
+ my $EngineDone = shift;
+ if ($Local) {
+ $FormatPath = '.' ; # for patrick
+ } else {
+ if ( ( $FormatPath eq '' ) && ( $kpsewhich ne '' ) ) {
+ unless ($EngineDone) {
+ my $str = $ENV{"TEXFORMATS"} ;
+ $str =~ s/\$engine//io ;
+ $ENV{"TEXFORMATS"} = $str ;
+ }
+ # expanded paths
+ print " assuming engine : $EnginePath\n";
+ if (($UseEnginePath)&&($EngineDone)) {
+ $FormatPath = `$kpsewhich --engine=$EnginePath --show-path=fmt` ;
+ } else {
+ $FormatPath = `$kpsewhich --show-path=fmt` ;
+ }
+ chomp($FormatPath) ;
+ if ( ( $FormatPath ne '' ) && $Verbose ) {
+ print "located formatpath (1) : $FormatPath\n";
+ }
+ # fall back
+ if ($FormatPath eq '') {
+ if (($UseEnginePath)&&($EngineDone)) {
+ if ($dosish) {
+ $FormatPath = `$kpsewhich --engine=$EnginePath --expand-path=\$TEXFORMATS` ;
+ } else {
+ $FormatPath = `$kpsewhich --engine=$EnginePath --expand-path=\\\$TEXFORMATS` ;
+ }
+ }
+ chomp($FormatPath) ;
+ # either no enginepath or failed run
+ if ($FormatPath eq '') {
+ if ($dosish) {
+ $FormatPath = `$kpsewhich --expand-path=\$TEXFORMATS` ;
+ } else {
+ $FormatPath = `$kpsewhich --expand-path=\\\$TEXFORMATS` ;
+ }
+ }
+ chomp $FormatPath ;
+ }
+ chomp($FormatPath) ;
+ if ( ( $FormatPath ne '' ) && $Verbose ) {
+ print "located formatpath (2) : $FormatPath\n";
+ }
+ $FormatPath =~ s/\\/\//g ;
+ if ($FormatPath ne '') {
+ my @fpaths ;
+ if ($dosish) {
+ @fpaths = split(';', $FormatPath) ;
+ } else {
+ @fpaths = split(':', $FormatPath) ;
+ }
+ # take first writable unless current
+ foreach my $fp (@fpaths) {
+ # remove funny patterns
+ $fp =~ s/\/+$// ;
+ $fp =~ s/^!!// ;
+ $fp =~ s/unsetengine/$EnginePath/ ;
+ if (($fp ne '') && ($fp ne '.')) {
+ # correct if needed
+ # append engine unless engine is already there
+ $fp =~ "$fp/$EnginePath" if ($fp =~ /[\\\/]$EnginePath[\\\/]*$/) ;
+ # path may not yet be present
+ # check if usable format path
+ my $fpp = $fp ;
+ $fpp =~ s/\/*$EnginePath\/*// ;
+ if ((-d $fpp) && (-w $fpp)) {
+ $FormatPath = $fpp ;
+ last ;
+ }
+ }
+ }
+ }
+ $FormatPath = '.' if (($FormatPath eq '') || (! -w $FormatPath)) ;
+ if ( ( $FormatPath ne '' ) && $Verbose ) {
+ print "located formatpath (3) : $FormatPath\n";
+ }
+ $FormatPath .= '/';
+ }
+ if ($UseEnginePath && $EngineDone && ($FormatPath ne '') && ($FormatPath !~ /$EnginePath\/$/)) {
+ $FormatPath .= $EnginePath ;
+ unless (-d $FormatPath) {
+ mkdir $FormatPath ;
+ }
+ $FormatPath .= '/' ;
+ }
+ }
+ print " using formatpath : $FormatPath\n" if $Verbose ;
+ return $FormatPath;
+}
+
+sub RunOneFormat {
+ my ($FormatName) = @_;
+ my @TeXFormatPath;
+ my $TeXPrefix = "";
+ if ( ( $fmtutil ne "" ) && ( $FormatName !~ /metafun|mptopdf/io ) ) {
+ # could not happen, not supported any more
+ my $cmd = "$fmtutil --byfmt $FormatName";
+ MakeUserFile; # this works only when the path is kept
+ MakeResponseFile;
+ $Problems = System("$cmd");
+ RemoveResponseFile;
+ RestoreUserFile;
+ } else {
+ $Problems = 1;
+ }
+ if ($Problems) {
+ $Problems = 0;
+ if ( $TeXExecutable =~ /etex|eetex|pdfetex|pdfeetex|pdfxtex|xpdfetex|eomega|aleph|xetex/io ) {
+ $TeXPrefix = "*";
+ }
+ my $CurrentPath = cwd();
+ my $TheTeXFormatPath = LocatedFormatPath($TeXFormatPath, $TeXExecutable,1);
+ if ( $TheTeXFormatPath ne '' ) { chdir $TheTeXFormatPath }
+ MakeUserFile;
+ MakeResponseFile;
+ $own_quote = ($TeXProgramPath =~ m/^[^\"].* / ? "\"" : "") ;
+ my $cmd =
+ "$own_quote$TeXProgramPath$TeXExecutable$own_quote $TeXVirginFlag "
+ . "$TeXPassString $PassOn ${TeXPrefix}$FormatName";
+ $Problems = System($cmd) ;
+ RemoveResponseFile;
+ RestoreUserFile;
+
+ if ( ( $TheTeXFormatPath ne '' ) && ( $CurrentPath ne '' ) ) {
+ print "\n";
+ if ($UseEnginePath) {
+ print " used engineformatpath : $TheTeXFormatPath\n";
+ } else {
+ print " used formatpath : $TheTeXFormatPath\n";
+ }
+ print "\n";
+ chdir $CurrentPath;
+ }
+ }
+}
+
+sub RunFormats {
+ my $ConTeXtFormatsPrefix;
+ my $MetaFunDone = 0;
+ if (@ARGV) { @ConTeXtFormats = @ARGV }
+ elsif ( $UsedInterfaces ne '' ) {
+ @ConTeXtFormats = split /[\,\s]/, $UsedInterfaces;
+ }
+ if ($Format) { @ConTeXtFormats = $Format; $ConTeXtFormatsPrefix = ''; }
+ else { $ConTeXtFormatsPrefix = "cont-"; }
+ if ( $TeXHashExecutable ne '' ) {
+ unless ($FastMode) {
+ $own_quote = ($TeXProgramPath =~ m/^[^\"].* / ? "\"" : "") ;
+ my $cmd = "$own_quote$TeXProgramPath$TeXHashExecutable$own_quote";
+ print "\n";
+ print " TeX hash binary : $TeXProgramPath$TeXHashExecutable\n";
+ print " comment : hashing may take a while ...\n";
+ System($cmd);
+ }
+ }
+ foreach my $Interface (@ConTeXtFormats) {
+ if ( $Interface eq $MetaFun ) {
+ RunMpFormat($MetaFun);
+ $MetaFunDone = 1;
+ } elsif ( $Interface eq $MpToPdf ) {
+ if ( $TeXExecutable =~ /pdf/io ) { RunOneFormat("$MpToPdf") }
+ } else {
+ RunOneFormat("$ConTeXtFormatsPrefix$Interface");
+ }
+ }
+ print "\n";
+ print " TeX binary : $TeXProgramPath$TeXExecutable\n";
+ print " format(s) : @ConTeXtFormats\n\n";
+}
+
+sub RunMpFormat {
+ # engine is not supported by MP
+ my $MpFormat = shift;
+ return if ( $MpFormat eq '' );
+ my $CurrentPath = cwd();
+ my $TheMpFormatPath = LocatedFormatPath($MpFormatPath,$MpExecutable,$MpEngineSupport);
+ if ( $TheMpFormatPath ne '' ) { chdir $TheMpFormatPath }
+ $own_quote = ($MpExecutable =~ m/^[^\"].* / ? "\"" : "") ;
+ my $cmd =
+ "$own_quote$MpExecutable$own_quote $MpVirginFlag $MpPassString $MpFormat";
+ System($cmd ) ;
+ if ( ( $TheMpFormatPath ne '' ) && ( $CurrentPath ne '' ) ) {
+ print "\n";
+ print " used formatpath : $TheMpFormatPath\n";
+ print "\n";
+ chdir $CurrentPath;
+ }
+}
+
+
+my $dir = File::Temp::tempdir(CLEANUP=>1) ;
+my ($fh, $filename) = File::Temp::tempfile(DIR=>$dir, UNLINK=>1);
+
+sub RunFiles {
+ my $currentpath = cwd() ;
+ my $oldrunpath = $RunPath ;
+ # new
+ checktexformatpath ;
+ # test if current path is writable
+ if (! -w "$currentpath") {
+ print " current path readonly : $currentpath\n";
+ #
+ # we cannot use the following because then the result will
+ # also be removed and users will not know where to look
+ #
+ # $RunPath = File::Temp::tempdir(CLEANUP=>1) ;
+ # if ($RunPath) {
+ # print " using temp path : $RunPath\n";
+ # } else {
+ # print " problematic temp path : $currentpath\n";
+ # exit ;
+ # }
+ #
+ foreach my $d ($ENV{"TMPDIR"},$ENV{"TEMP"},$ENV{"TMP"},"/tmp") {
+ if ($d && -e $d) { $RunPath = $d ; last ; }
+ }
+ if ($TempDir eq '') {
+ print " provide temp path for : $RunPath\n";
+ exit ;
+ } elsif ($RunPath ne $oldrunpath) {
+ chdir ($RunPath) ;
+ unless (-e $TempDir) {
+ print " creating texexec path : $TempDir\n";
+ mkdir ("$TempDir", 077)
+ }
+ if (-e $TempDir) {
+ $RunPath += $TempDir ;
+ } else {
+ # we abort this run because on unix an invalid tmp
+ # path can be an indication of a infected system
+ print " problematic temp path : $RunPath\n";
+ exit ;
+ }
+ } else {
+ print " no writable temp path : $RunPath\n";
+ exit ;
+ }
+ }
+ # test if we need to change paths
+ if (($RunPath ne "") && (-w "$RunPath")) {
+ print " changing to path : $RunPath\n";
+ $InpPath = $currentpath ;
+ chdir ($RunPath) ;
+ }
+ # start working
+ if ($PdfArrange) {
+ my @arrangedfiles = ();
+ foreach my $JobName (@ARGV) {
+ unless ( $JobName =~ /.*\.pdf$/oi ) {
+ if ( -f "$JobName.pdf" ) { $JobName .= ".pdf" }
+ else { $JobName .= ".PDF" }
+ }
+ push @arrangedfiles, $JobName;
+ }
+ if (@arrangedfiles) { RunArrange(@arrangedfiles) }
+ } elsif ( ($PdfSelect) || ($PdfCopy) || ($PdfTrim) || ($PdfCombine) ) {
+ my $JobName = $ARGV[0];
+ if ( $JobName ne '' ) {
+ unless ( $JobName =~ /.*\.pdf$/oi ) {
+ if ( -f "$JobName.pdf" ) { $JobName .= ".pdf" }
+ else { $JobName .= ".PDF" }
+ }
+ if ($PdfSelect) {
+ RunSelect($JobName) ;
+ } elsif ($PdfCopy) {
+ # RunCopy($JobName) ;
+ RunCopy(0,@ARGV) ;
+ } elsif ($PdfTrim) {
+ # RunCopy($JobName) ;
+ RunCopy(1,@ARGV) ;
+ } else {
+ # RunCombine ($JobName) ;
+ RunCombine(@ARGV);
+ }
+ }
+ } elsif ($TypesetModule) {
+ RunModule(@ARGV);
+ } else {
+ my $JobSuffix = "tex";
+ foreach my $JobName (@ARGV) {
+ next if ($JobName =~ /^\-/io) ;
+ # start experiment - full name spec including suffix is prerequisite
+ if (($StartLine>0) && ($EndLine>=$StartLine) && (-e $JobName)) {
+ if (open(INP,$JobName) && open(OUT,'>texexec.tex')) {
+ print " writing partial file : $JobName\n";
+ my $Line = 1 ;
+ my $Preamble = 1 ;
+ while (my $str = <INP>) {
+ if ($Preamble) {
+ if ($str =~ /\\start(text|tekst|product|project|component)/io) {
+ $Preamble = 0 ;
+ } else {
+ print OUT $str;
+ }
+ } elsif ($Line==$StartLine) {
+ print OUT "\\starttext\n" ; # todo: multilingual
+ print OUT $str ;
+ } elsif ($Line==$EndLine) {
+ print OUT $str ;
+ print OUT "\\stoptext\n" ; # todo: multilingual
+ last ;
+ } elsif (($Line>$StartLine) && ($Line<$EndLine)) {
+ print OUT $str ;
+ }
+ $Line += 1 ;
+ }
+ close(INP) ;
+ close(OUT) ;
+ $JobName = 'texexec.tex' ;
+ print " using job name : $JobName\n";
+ }
+ }
+ # end experiment
+ if ( $JobName =~ s/\.(\w+)$//io ) { $JobSuffix = $1 }
+ if ( ( $Format eq '' ) || ( $Format =~ /^cont.*/io ) ) {
+ RunConTeXtFile( $JobName, $JobSuffix );
+ } else {
+ RunSomeTeXFile( $JobName, $JobSuffix );
+ }
+ unless ( -s "$JobName.log" ) { unlink("$JobName.log") }
+ unless ( -s "$JobName.tui" ) { unlink("$JobName.tui") }
+ }
+ }
+}
+
+my $MpTmp = "tmpgraph"; # todo: prefix met jobname
+my $MpKep = "$MpTmp.kep"; # sub => MpTmp("kep")
+my $MpLog = "$MpTmp.log";
+my $MpBck = "$MpTmp.bck";
+my $MpTex = "$MpTmp.tex";
+my $MpDvi = "$MpTmp.dvi";
+
+my %mpbetex;
+
+sub RunMP { ###########
+ if ( ($MpExecutable) && ($MpToTeXExecutable) && ($DviToMpExecutable) ) {
+ foreach my $RawMpName (@ARGV) {
+ my ( $MpName, $Rest ) = split( /\./, $RawMpName, 2 );
+ my $MpFile = "$MpName.mp";
+ if ( -e $MpFile
+ and ( -s $MpFile > 25 ) ) # texunlink makes empty file
+ {
+ unlink "$MpName.mpt";
+ doRunMP( $MpName, 0 );
+ # test for graphics, new per 14/12/2000
+ my $mpgraphics = checkMPgraphics($MpName);
+ # test for labels
+ my $mplabels = checkMPlabels($MpName);
+ if ( $mpgraphics || $mplabels ) {
+ doRunMP( $MpName, $mplabels );
+ }
+ }
+ }
+ }
+}
+
+my $mpochecksum = '';
+
+#~ sub checkMPgraphics { # also see makempy
+ #~ my $MpName = shift;
+ #~ if ( $MakeMpy ne '' ) { $MpName .= " --$MakeMpy " } # extra switches
+ #~ if ($MpyForce) { $MpName .= " --force " } # dirty
+ #~ else {
+ #~ return 0 unless -s "$MpName.mpo" > 32;
+ #~ return 0 unless ( open( MPO, "$MpName.mpo" ) );
+ #~ $mpochecksum = do { local $/; unpack( "%32C*", <MPO> ) % 65535 };
+ #~ close(MPO);
+ #~ if ( open( MPY, "$MpName.mpy" ) ) {
+ #~ my $str = <MPY>;
+ #~ chomp $str;
+ #~ close(MPY);
+ #~ if ( $str =~ /^\%\s*mpochecksum\s*\:\s*(\d+)/o ) {
+ #~ return 0 if ( ( $mpochecksum eq $1 ) && ( $mpochecksum ne 0 ) );
+ #~ }
+ #~ }
+ #~ }
+ #~ RunPerlScript( "makempy", "$MpName" );
+ #~ print " second MP run needed : text graphics found\n";
+ #~ return 1;
+#~ }
+
+sub checkMPgraphics { # also see makempy
+ my $MpName = shift;
+ if ( $MakeMpy ne '' ) { $MpName .= " --$MakeMpy " } # extra switches
+ if ($MpyForce) { $MpName .= " --force " } # dirty
+ else {
+ return 0 unless -s "$MpName.mpo" > 32;
+ return 0 unless ( open( MPO, "$MpName.mpo" ) );
+ $mpochecksum = do { local $/; Digest::MD5::md5_hex(<MPO>) ; };
+ close(MPO);
+ if ( open( MPY, "$MpName.mpy" ) ) {
+ my $str = <MPY>;
+ chomp $str;
+ close(MPY);
+ if ( $str =~ /^\%\s*mpochecksum\s*\:\s*([a-fA-F0-9]+)/o ) {
+ return 0 if ( ( $mpochecksum eq $1 ) && ( $mpochecksum ne '' ) );
+ }
+ }
+ }
+ RunPerlScript( "makempy", "$MpName" );
+ print " second MP run needed : text graphics found\n";
+ return 1;
+}
+
+sub checkMPlabels {
+ my $MpName = shift;
+ return 0 unless ((-f "$MpName.mpt") && ((-s "$MpName.mpt")>10) );
+ return 0 unless open( MP, "$MpName.mpt" );
+ my $n = 0;
+ my $t = "" ;
+ while (<MP>) {
+ if (/% setup : (.*)/o) {
+ $t = $1 ;
+ } else {
+ $t = "" ;
+ }
+ if (/% figure (\d+) : (.*)/o) {
+ if ($t ne "") {
+ $mpbetex{$1} .= "$t\n" ;
+ $t = "" ;
+ }
+ $mpbetex{$1} .= "$2\n";
+ ++$n ;
+ }
+ }
+ close(MP);
+ print " second MP run needed : $n tex labels found\n" if $n;
+ return $n;
+}
+
+sub doMergeMP {
+ # make sure that the verbatimtex ends up before btex etc
+ my ($n,$str) = @_ ;
+ if ($str =~ /(.*?)(verbatimtex.*?etex)\s*\;(.*)/mois) {
+ return "beginfig($n)\;\n$1$2\;\n$mpbetex{$n}\n$3\;endfig\;\n" ;
+ } else {
+ return "beginfig($n)\;\n$mpbetex{$n}\n$str\;endfig\;\n" ;
+ }
+}
+
+sub doRunMP { ###########
+ my ( $MpName, $MergeBE ) = @_;
+ my $TexFound = 0;
+ my $MpFile = "$MpName.mp";
+ if ( open( MP, $MpFile ) ) { # fails with %
+ my $MPdata = "";
+ while (<MP>) {
+ unless (/^\%/) { $MPdata .= $_ }
+ }
+ $_ = $MPdata;
+ close(MP);
+
+ # save old file
+ unlink($MpKep);
+ return if ( -e $MpKep );
+ rename( $MpFile, $MpKep );
+ # check for tex stuff
+
+ $TexFound = $MergeBE || /btex .*? etex/o;
+
+ # shorten lines into new file if okay
+ unless ( -e $MpFile ) {
+ open( MP, ">$MpFile" );
+ s/(btex.*?)\;(.*?etex)/$1\@\@\@$2/gmois;
+ s/(\".*?)\;(.*?\")/$1\@\@\@$2/gmois; # added
+ s/\;/\;\n/gmois;
+ s/\n\n/\n/gmois;
+ s/(btex.*?)\@\@\@(.*?etex)/$1\;$2/gmois;
+ s/(\".*?)\@\@\@(.*?\")/$1\;$2/gmois; # added
+ # merge labels
+ if ($MergeBE) {
+ # i hate this indirect (sub regexp) mess
+ s/beginfig\s*\((\d+)\)\s*\;(.*?)endfig\s*\;/doMergeMP($1,$2)/gems ;
+ }
+ unless (/beginfig\s*\(\s*0\s*\)/gmois) {
+ if (defined($mpbetex{0})) { # test added, warning
+ print MP $mpbetex{0} ;
+ }
+ }
+ print MP $_;
+ print MP "\n" . "end" . "\n";
+ close(MP);
+ }
+ if ($TexFound) {
+ print " metapost to tex : $MpName\n";
+ $own_quote = ($MpToTeXExecutable =~ m/^[^\"].* / ? "\"" : "") ;
+ $Problems =
+ System("$own_quote$MpToTeXExecutable$own_quote $MpFile > $MpTex");
+ if ( -e $MpTex && !$Problems ) {
+ open( TMP, ">>$MpTex" );
+ print TMP "\\end\{document\}\n"; # to be sure
+ close(TMP);
+ if ( ( $Format eq '' ) || ( $Format =~ /^cont.*/io ) ) {
+ $OutputFormat = "dvips";
+ RunConTeXtFile( $MpTmp, "tex" );
+ } else {
+ RunSomeTeXFile( $MpTmp, "tex" );
+ }
+ if ( -e $MpDvi && !$Problems ) {
+ print " dvi to metapost : $MpName\n";
+ $own_quote = ($DviToMpExecutable =~ m/^[^\"].* / ? "\"" : "") ;
+ $Problems = System("$own_quote$DviToMpExecutable$own_quote $MpDvi $MpName.mpx");
+ }
+ unlink $MpBck;
+ rename $MpTex, $MpBck;
+ unlink $MpDvi;
+ }
+ }
+ print " metapost : $MpName\n";
+ $own_quote = ($MpExecutable =~ m/^[^\"].* / ? "\"" : "") ;
+ my $cmd = "$own_quote$MpExecutable$own_quote";
+ if ($EnterBatchMode) { $cmd .= " $MpBatchFlag " }
+ if ($EnterNonStopMode) { $cmd .= " $MpNonStopFlag " }
+ if ( ( $MpFormat ne '' ) && ( $MpFormat !~ /(plain|mpost)/oi ) ) {
+ print " format : $MpFormat\n";
+ $cmd .= " $MpPassString $MpFormatFlag$MpFormat ";
+ }
+ # prevent nameclash, experimental
+ my $MpMpName = "$MpName";
+ $Problems = System("$cmd $MpMpName");
+ open( MPL, "$MpName.log" );
+ while (<MPL>) # can be one big line unix under win
+ {
+ while (/^l\.(\d+)\s/gmois) {
+ print " error in metapost run : $MpName.mp:$1\n";
+ }
+ }
+ close(MPL) ;
+ unlink "mptrace.tmp";
+ rename( $MpFile, "mptrace.tmp" );
+ if ( -e $MpKep ) {
+ unlink($MpFile);
+ rename( $MpKep, $MpFile );
+ }
+ }
+}
+
+sub RunMPX {
+ my $MpName = shift;
+ $MpName =~ s/\..*$//o;
+ my $MpFile = $MpName . ".mp";
+ if ( ($MpToTeXExecutable)
+ && ($DviToMpExecutable)
+ && ( -e $MpFile )
+ && ( -s $MpFile > 5 )
+ && open( MP, $MpFile ) )
+ {
+ local $/ = "\0777";
+ $_ = <MP>;
+ close(MP);
+ if (/(btex|etex|verbatimtex)/mos) {
+ print " generating mpx file : $MpName\n";
+ $own_quote = ($MpToTeXExecutable =~ m/^[^\"].* / ? "\"" : "") ;
+ $Problems =
+ System("$own_quote$MpToTeXExecutable$own_quote $MpFile > $MpTex");
+ if ( -e $MpTex && !$Problems ) {
+ open( TMP, ">>$MpTex" );
+ print TMP "\\end\n"; # to be sure
+ close(TMP);
+ checktexformatpath ;
+ if ( ( $Format eq '' ) || ( $Format =~ /^cont.*/io ) ) {
+ RunConTeXtFile( $MpTmp, "tex" );
+ } else {
+ RunSomeTeXFile( $MpTmp, "tex" );
+ }
+ if ( -e $MpDvi && !$Problems ) {
+ $own_quote = ($DviToMpExecutable =~ m/^[^\"].* / ? "\"" : "") ;
+ $Problems =
+ System("$own_quote$DviToMpExecutable$own_quote $MpDvi $MpName.mpx");
+ }
+ unlink $MpTex;
+ unlink $MpDvi;
+ }
+ }
+ }
+}
+
+sub load_set_file {
+ my %new;
+ my %old;
+ my ( $file, $trace ) = @_;
+ if ( open( BAT, $file ) ) {
+ while (<BAT>) {
+ chomp;
+ if (/\s*SET\s+(.+?)\=(.+)\s*/io) {
+ my ( $var, $val ) = ( $1, $2 );
+ $val =~ s/\%(.+?)\%/$ENV{$1}/goi;
+ unless ( defined( $old{$var} ) ) {
+ if ( defined( $ENV{$var} ) ) { $old{$var} = $ENV{$var} }
+ else { $old{$var} = "" }
+ }
+ $ENV{$var} = $new{$var} = $val;
+ }
+ }
+ close(BAT);
+ }
+ if ($trace) {
+ foreach my $key ( sort keys %new ) {
+ if ( $old{$key} ne $new{$key} ) {
+ print " changing env variable : '$key' from '$old{$key}' to '$new{$key}'\n";
+ } elsif ( $old{$key} eq "" ) {
+ print " setting env variable : '$key' to '$new{$key}'\n";
+ } else {
+ print " keeping env variable : '$key' at '$new{$key}'\n";
+ }
+ }
+ print "\n";
+ }
+}
+
+if ( $SetFile ne "" ) { load_set_file( $SetFile, $Verbose ) }
+
+sub check_texmf_root { }
+sub check_texmf_tree { }
+
+sub AnalyzeVersion
+ { my $str = join("\n", @_) ;
+ my ($texengine,$type) = ('unknown', 'unknown');
+ open (LOG, "<texvers.log") ;
+ while (<LOG>)
+ { /^\s*This is (.*(pdf)?(|e|x)TeX.*?)$/o and $texengine = $1 ;
+ /^\s*ConTeXt (.*int: ([a-z]+).*?)\s*$/o and $type = $1; }
+ $type =~ s/ int: ([a-z]+)//;
+ $texengine =~ s/ Version//;
+ $texengine =~ s/ \(format.*$//;
+ close (LOG);
+ return ($texengine,$type) }
+
+sub show_version_info {
+ my ($texengine,$type);
+ open (TEX,">texvers.tex") ;
+ print TEX "\\bye " ;
+ close (TEX) ;
+ my $texutil = `$TeXUtil --help`;
+ $texutil =~ s/.*(TeXUtil[^\n]+)\n.*?$/$1/s;
+ print " texexec :$Program\n" ;
+ print " texutil : $texutil" ;
+ my $contexttext = `$kpsewhich context.tex`;
+ my $contextversion = "<not found>";
+ if ($contexttext) {
+ chop $contexttext;
+ { local $/;
+ open (IN,"<$contexttext");
+ $contextversion = <IN>;
+ close IN;
+ }
+ $contextversion =~ s/.*contextversion\{([0-9.]+)\}.*/$1/s;
+ }
+ $EnterBatchMode = 1;
+ $Format = 'cont-en';
+ my $cmd = PrepRunTeX("texvers","tex",'') ;
+ ($texengine,$type) = AnalyzeVersion(Pipe($cmd)) ;
+ print " tex : $texengine\n" ;
+ print " context : ver: $contextversion\n" ;
+ print " cont-en : $type\n" ;
+ foreach my $a (qw(cz de it nl ro uk xx)) {
+ my $test = Pipe("$kpsewhich -format='fmt' cont-$a") ;
+ if (defined $test && $test) {
+ $Format = 'cont-' . $a;
+ $cmd = PrepRunTeX("texvers","tex",'');
+ ($texengine,$type) = AnalyzeVersion(Pipe($cmd)) ;
+ print " cont-$a : $type\n" ;
+ }
+ }
+ unlink <texvers.*>;
+}
+
+# the main thing
+
+if ($HelpAsked) {
+ show_help_info
+} elsif ($Version) {
+ show_version_info
+} elsif ($TypesetListing) {
+ check_texmf_root;
+ check_texmf_tree;
+ RunListing(@ARGV);
+} elsif ($TypesetFigures) {
+ check_texmf_root;
+ check_texmf_tree;
+ RunFigures(@ARGV);
+} elsif ($DoMPTeX) {
+ check_texmf_root;
+ check_texmf_tree;
+ RunMP;
+} elsif ($DoMPXTeX) {
+ check_texmf_root;
+ check_texmf_tree;
+ RunMPX( $ARGV[0] );
+} elsif ($MakeFormats) {
+ check_texmf_root;
+ check_texmf_tree;
+ if ( $MpDoFormat ne '' ) {
+ RunMpFormat($MpDoFormat) ;
+ }
+ else {
+ RunFormats ;
+ }
+} elsif (@ARGV) {
+ check_texmf_root;
+ check_texmf_tree;
+ @ARGV = <@ARGV>;
+ RunFiles;
+} elsif ( !$HelpAsked ) {
+ show_help_options;
+}
+
+$TotalTime = time - $TotalTime;
+
+unless ($HelpAsked) { print "\n total run time : $TotalTime seconds\n" }
+
+if ($Problems) { exit 1 }
+
+__DATA__
+arrange process and arrange
+-----------
+batch run in batch mode (don't pause)
+-----------
+nonstop run in non stop mode (don't pause)
+-----------
+centerpage center the page on the paper
+-----------
+color enable color (when not yet enabled)
+-----------
+usemodule load some modules first
+=name list of modules
+-----------
+xmlfilter apply XML filter
+=name list of filters
+-----------
+environment load some environments first
+=name list of environments
+-----------
+fast skip as much as possible
+-----------
+figures typeset figure directory
+=a room for corrections
+=b just graphics
+=c one (cropped) per page
+paperoffset room left at paper border
+fullscreen force full screen mode (pdf)
+-----------
+screensaver turn graphic file into a (pdf) full screen file
+-----------
+final add a final run without skipping
+-----------
+format fmt file
+=name format file (memory dump)
+-----------
+mpformat mem file
+=name format file (memory dump)
+-----------
+interface user interface
+=en English
+=nl Dutch
+=de German
+=cz Czech
+=uk Brittish
+=it Italian
+-----------
+language main hyphenation language
+=xx standard abbreviation
+-----------
+listing produce a verbatim listing
+backspace inner margin of the page
+topspace top/bottom margin of the page
+pretty enable pretty printing
+color use color for pretty printing
+-----------
+make build format files
+language patterns to include
+bodyfont bodyfont to preload
+response response interface language
+format TeX format
+mpformat MetaPost format
+program TeX program
+-----------
+mode running mode
+=list modes to set
+-----------
+module typeset tex/pl/mp module
+-----------
+mptex run an MetaPost plus btex-etex cycle
+-----------
+mpxtex generatet an MetaPostmpx file
+-----------
+noarrange process but ignore arrange
+-----------
+nomp don't run MetaPost at all
+-----------
+nomprun don't run MetaPost at runtime
+-----------
+automprun MetaPost at runtime when needed
+-----------
+once run TeX only once (no TeXUtil either)
+-----------
+output specials to use
+=pdftex Han The Than's pdf backend
+=dvips Thomas Rokicky's dvi to ps converter
+=dvipsone YandY's dvi to ps converter
+=dviwindo YandY's windows previewer
+=dvipdfm Mark Wicks' dvi to pdf converter
+=dvipdfmx Jin-Hwan Cho's extended dvipdfm
+-----------
+passon switches to pass to TeX (--src for MikTeX)
+-----------
+pages pages to output
+=odd odd pages
+=even even pages
+=x,y:z pages x and y to z
+-----------
+paper paper input and output format
+=a4a3 A4 printed on A3
+=a5a4 A5 printed on A4
+-----------
+path document source path
+=string path
+-----------
+pdf produce PDF directly using pdf(e)tex
+-----------
+pdfarrange arrange pdf pages
+paperoffset room left at paper border
+paper paper format
+noduplex single sided
+backspace inner margin of the page
+topspace top/bottom margin of the page
+markings add cutmarks
+background
+=string background graphic
+addempty add empty page after
+textwidth width of the original (one sided) text
+-----------
+pdfcombine combine pages to one page
+paperformat paper format
+combination n*m pages per page
+paperoffset room left at paper border
+nobanner no footerline
+-----------
+pdfcopy scale pages down/up
+scale new page scale
+paperoffset room left at paper border
+markings add cutmarks
+background
+=string background graphic
+-----------
+pdfselect select pdf pages
+selection pages to select
+=odd odd pages
+=even even pages
+=x,y:z pages x and y to z
+paperoffset room left at paper border
+paperformat paper format
+backspace inner margin of the page
+topspace top/bottom margin of the page
+markings add cutmarks
+background
+=string background graphic
+addempty add empty page after
+textwidth width of the original (one sided) text
+-----------
+print page imposition scheme
+=up 2 pages per sheet doublesided
+=down 2 rotated pages per sheet doublesided
+-----------
+result resulting file
+=name filename
+-----------
+input input file (if used)
+=name filename
+-----------
+suffix resulting file suffix
+=string suffix
+-----------
+runs maximum number of TeX runs
+=n number of runs
+-----------
+silent minimize (status) messages
+-----------
+tex TeX binary
+=name binary of executable
+-----------
+textree additional texmf tree to be used
+=path subpath of tex root
+-----------
+texroot root of tex trees
+=path tex root
+-----------
+verbose shows some additional info
+-----------
+help show this or more, e.g. '--help interface'
+-----------
+alone bypass utilities (e.g. fmtutil for non-standard fmt's)
+-----------
+texutil force TeXUtil run
+-----------
+version display various version information
+-----------
+setfile load environment (batch) file
diff --git a/Master/texmf-dist/scripts/context/perl/texexec.rme b/Master/texmf-dist/scripts/context/perl/texexec.rme
new file mode 100644
index 00000000000..f38b4be7fe0
--- /dev/null
+++ b/Master/texmf-dist/scripts/context/perl/texexec.rme
@@ -0,0 +1,169 @@
+% == introduction ==
+%
+% This is 'texexec.ini', the file used by texexec to determine where
+% to find files, what TeX to use, what flags to pass, etc. Although
+% TeXexec tries to locate things itself, a little help is sometimes
+% needed. One can influence texexec by setting some variables. These
+% are only needed when the automatic determined settings fail.
+%
+% == interfacing ==
+%
+% UsedInterfaces nl,en the formats generated with --make
+% UserInterface nl the default format used
+%
+% == binaries ==
+%
+% TeXExecutable pdfetex the TeX binary to use
+% MpExecutable mpost the MetaPost binary to use
+% MpToTeXExecutable mpto the MetaPost to TeX converter
+% DviToMpExecutable dvitomp the DVI to MetaPost converter
+%
+% == Scripts ==
+%
+% DviSpecialScript dvispec the DVI special filter script
+%
+% == flags ==
+%
+% TeXFormatFlag -fmt= the format introducer
+% TeXVirginFlag -ini the format generation switch
+%
+% == paths ==
+%
+% TeXFormatPath texmf/... fmt files
+% ConTeXtPath texmf/tex/context/base sources
+% SetupPath texmf/tex/base/user cont-sys/usr file
+% TeXScriptsPath texmf/context/perltk scripts
+% TeXFontsPath texmf font files
+%
+% MpFormatPath TeXFormatPath mem files
+%
+% == the main shell setting ==
+%
+% As shown below, one can define his/her own sections. We default to
+% the teTeX/fpTeX web2c based settings.
+
+set TeXShell to tetex
+%set TeXShell to fptex
+%set TeXShell to miktex
+%set TeXShell to private
+
+% == setting up the variables ==
+%
+% Here are some general defaults. They can be overruled later.
+
+set UseEnginePath to true
+
+set UsedInterfaces to en nl metafun mptopdf
+set UserInterface to en
+
+set TeXExecutable to tex
+
+set MpExecutable to mpost
+set MpToTeXExecutable to mpto
+set DviToMpExecutable to dvitomp
+set DviSpecialScript to dvispec
+
+set MpFormat to metafun
+
+set TeXFormatFlag to &
+set MpFormatFlag to &
+
+% For teTeX the next settings will do.
+
+% -default-translate-file=cp8bit -file-line-error-style
+
+for tetex set TeXHashExecutable to mktexlsr
+for tetex set TeXExecutable to pdfetex
+for tetex set TeXVirginFlag to -ini
+for tetex set TeXPassString to -progname=context
+for tetex set TeXBatchFlag to -int=batchmode
+for tetex set TeXNonStopFlag to -int=nonstopmode
+for tetex set MpToTeXExecutable to mpto
+for tetex set MpVirginFlag to -ini
+for tetex set MpPassString to -progname=mpost
+for tetex set MpBatchFlag to -int=batchmode
+for tetex set MpNonStopFlag to -int=nonstopmode
+
+% These also apply to fpTeX.
+
+% -default-translate-file=cp8bit -file-line-error-style
+
+for fptex set TeXHashExecutable to mktexlsr
+for fptex set TeXExecutable to pdfetex
+for fptex set TeXVirginFlag to -ini
+for fptex set TeXPassString to -progname=context
+for fptex set TeXBatchFlag to -int=batchmode
+for fptex set TeXNonStopFlag to -int=nonstopmode
+for fptex set MpToTeXExecutable to mpto
+for fptex set MpVirginFlag to -ini
+for fptex set MpPassString to -progname=mpost
+for fptex set MpBatchFlag to -int=batchmode
+for fptex set MpNonStopFlag to -int=nonstopmode
+
+% a downward compatibility test (<7.5.3), next year we will use -8bit
+
+for tetex set TeXVirginFlag to -ini -translate-file=natural.tcx
+for fptex set TeXVirginFlag to -ini -translate-file=natural.tcx
+for tetex set MpVirginFlag to -ini -translate-file=natural.tcx
+for fptex set MpVirginFlag to -ini -translate-file=natural.tcx
+
+for tetex set TeXPassString to -progname=context -translate-file=natural.tcx
+for fptex set TeXPassString to -progname=context -translate-file=natural.tcx
+for tetex set MpPassString to -progname=mpost -translate-file=natural.tcx
+for fptex set MpPassString to -progname=mpost -translate-file=natural.tcx
+
+% MikTeX users probably have to set up some paths too.
+
+for miktex set TeXHashExecutable to initexmf --update-fndb
+for miktex set TeXExecutable to pdfetex
+for miktex set TeXVirginFlag to --initialize
+for miktex set TeXPassString to --alias=context --translate-file=natural.tcx
+for miktex set TeXBatchFlag to --interaction=batchmode
+for miktex set TeXNonStopFlag to --interaction=nonstopmode
+for miktex set MpToTeXExecutable to mptotex
+for miktex set MpVirginFlag to --initialize
+for miktex set MpPassString to --alias=mpost --translate-file=natural.tcx
+for miktex set MpBatchFlag to --interaction=batchmode
+for miktex set MpNonStopFlag to --interaction=nonstopmode
+
+for miktex set TeXFormatFlag to --undump=
+for miktex set MpFormatFlag to --undump=
+
+% These are the settings used on some machines at PRAGMA ADE that
+% don't use the texmf tree. They can serve as an example for local
+% settings. Local settings should either be added to the previous
+% one, or go without the 'for' directives. Consider these
+% settings as an example.
+
+for private set UsedInterfaces to en nl
+for private set UserInterface to nl
+for private set ConTeXtPath to t:/sources/
+for private set SetupPath to t:/perl/
+for private set TeXScriptsPath to t:/perl/
+
+% == read this too ==
+%
+% If this file is called 'texexec.rme', copy it to 'texexec.ini',
+% check the settings above, change them according to your TeX
+% distribution, and say:
+%
+% texexec --verbose
+%
+% When set up properly, you should see your local settings fly by.
+% When these settings are ok, the next call should work:
+%
+% texexec --make
+%
+% and you should be able to process a file by saying
+%
+% texexec filename
+%
+% See 'mtexexec.pdf' for more information on the flags you can use with
+% 'texexec'. Also make sure you have the 'texutil' script installed in
+% the same path as 'texexec'.
+
+% Experimental
+%
+% set TcXPath to d:/tex/texmf/web2c
+% set FmtLanguage to pl
+% set FmtBodyFont to plr
diff --git a/Master/texmf-dist/scripts/context/perl/texfind.pl b/Master/texmf-dist/scripts/context/perl/texfind.pl
new file mode 100644
index 00000000000..53a560c7954
--- /dev/null
+++ b/Master/texmf-dist/scripts/context/perl/texfind.pl
@@ -0,0 +1,270 @@
+eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}' && eval 'exec perl -S $0 $argv:q'
+ if 0;
+
+#D \module
+#D [ file=texfind.pl,
+#D version=1998.05.10,
+#D title=\TEXFIND,
+#D subtitle=searching files,
+#D author=Hans Hagen,
+#D date=\currentdate,
+#D copyright={PRAGMA / Hans Hagen \& Ton Otten}]
+#C
+#C This module is part of the \CONTEXT\ macro||package and is
+#C therefore copyrighted by \PRAGMA. See licen-en.pdf for
+#C details.
+
+# test with "doif(un|)defined"
+
+use strict ;
+use Getopt::Long ;
+use File::Find ;
+use Cwd ;
+use Tk ;
+use Tk::widgets ;
+use Tk::ROText ;
+
+use FindBin ;
+use lib $FindBin::Bin ;
+use path_tre ;
+
+my $FileSuffix = 'tex' ;
+my $SearchString = '' ;
+my $Recurse = 0 ;
+my $NumberOfHits = 0 ;
+my $QuitSearch = 0 ;
+my $Location = '' ;
+my $currentpath = '.' ;
+
+my @FileList ;
+
+my ($dw, $mw, $log, $sea, $fil, $num, $but, $dir, $loc) ;
+
+$mw = MainWindow -> new () ;
+$dw = MainWindow -> new () ;
+
+$mw -> protocol( 'WM_DELETE_WINDOW' => sub { exit } ) ;
+$dw -> protocol( 'WM_DELETE_WINDOW' => sub { exit } ) ;
+
+$log = $mw -> Scrolled ( 'ROText' ,
+ -scrollbars => 'se' ,
+ -font => 'courier' ,
+ -wrap => 'none' ,
+ -width => 65 ,
+ -height => 22 )
+ -> pack ( -side => 'bottom' ,
+ -padx => 2 ,
+ -pady => 2 ,
+ -expand => 1 ,
+ -fill => 'both' ) ;
+
+$sea = $mw -> Entry ( -textvariable => \$SearchString ,
+ -font => 'courier' ,
+ -width => 20 )
+ -> pack ( -side => 'left' ,
+ -padx => 2 ,
+ -pady => 2 ) ;
+
+$fil = $mw -> Entry ( -textvariable => \$FileSuffix ,
+ -font => 'courier' ,
+ -width => 5 )
+ -> pack ( -side => 'left' ,
+ -padx => 2 ,
+ -pady => 2 ) ;
+
+$but = $mw -> Checkbutton ( -variable => \$Recurse ,
+ -text => 'recurse' )
+ -> pack ( -side => 'left' ) ;
+
+$num = $mw -> Entry ( -textvariable => \$NumberOfHits ,
+ -font => 'courier' ,
+ -justify => 'right' ,
+ -width => 5 )
+ -> pack ( -side => 'right' ,
+ -padx => 2 ,
+ -pady => 2 ) ;
+
+$loc = $mw -> Entry ( -textvariable => \$Location ,
+ -font => 'courier' ,
+ -width => 8 )
+ -> pack ( -side => 'right' ,
+ -padx => 2 ,
+ -pady => 2 ) ;
+
+sub BuildDir
+ { if (Exists($dir)) { $dir -> destroy } ;
+ $dir = $dw -> Scrolled ( 'PathTree' ,
+ -scrollbars => 'se' )
+ -> pack ( -expand => 1 ,
+ -fill => 'both' ,
+ -padx => 2 ,
+ -pady => 2 ) ;
+ $dir -> configure ( -font => 'courier' ,
+ -height => 24 ,
+ -width => 65 ,
+ -selectbackground => 'blue3' ,
+ -browsecmd => \&ChangePath ) ;
+ $dir -> bind ('<Return>' , \&ShowFile ) ;
+ $dir -> bind ('<Double-1>' , \&ShowFile ) }
+
+BuildDir ;
+
+sub ShowFile { $mw -> raise ; $sea -> focusForce }
+sub ShowPath { $dw -> raise ; $dir -> focusForce }
+
+$log -> tagConfigure ( 'found', -foreground => 'green3' ) ;
+$log -> tagConfigure ( 'title', -foreground => 'blue3' ) ;
+
+$sea -> bind ('<Return>' , \&LocateStrings ) ;
+$fil -> bind ('<Return>' , \&LocateStrings ) ;
+$loc -> bind ('<Return>' , \&ChangeLocation ) ;
+$log -> bind ('<Return>' , \&ShowPath ) ;
+
+$sea -> bind ('<KeyPress>' , \&QuitSearch ) ;
+$fil -> bind ('<KeyPress>' , \&QuitSearch ) ;
+$loc -> bind ('<KeyPress>' , \&QuitSearch ) ;
+
+$sea -> bind ('<Escape>' , \&QuitSearch ) ;
+$fil -> bind ('<Escape>' , \&QuitSearch ) ;
+$loc -> bind ('<Escape>' , \&QuitSearch ) ;
+$log -> bind ('<Escape>' , \&QuitSearch ) ;
+
+$sea -> bind ('<Double-1>' , \&LocateStrings ) ;
+$fil -> bind ('<Double-1>' , \&LocateStrings ) ;
+$loc -> bind ('<Double-1>' , \&ChangeLocation ) ;
+$log -> bind ('<Double-1>' , \&ShowPath ) ;
+
+sub ChangePath
+ { my $currentpath = shift ;
+chdir($currentpath) ;
+ $QuitSearch = 1 ;
+ $log -> delete ('1.0', 'end') ;
+ $log -> insert ('end', "$currentpath\n\n", 'title') }
+
+sub ChangeLocation
+ { $QuitSearch = 1 ;
+ $log -> delete ('1.0', 'end') ;
+ $Location =~ s/^\s*//o ;
+ $Location =~ s/\s*$//o ;
+ $Location =~ s/(\\|\/\/)/\//go ;
+ unless (-d $Location)
+ { unless ($Location =~ /\//) { $Location .= '/' } }
+ if (-d $Location)
+ { $log -> insert ('end', "changed to location '$Location'\n\n", 'title') ;
+ $currentpath = $Location ;
+ chdir ($currentpath) ;
+ $dir -> destroy ;
+ BuildDir ;
+ $dw -> raise ;
+ $dw -> focusForce }
+ else
+ { $log -> insert ('end', "unknown location '$Location'\n\n", 'title') ;
+ $Location = '' } }
+
+sub QuitSearch
+ { $QuitSearch = 1 }
+
+sub SearchFile
+ { my ($FileName, $SearchString) = @_ ;
+ my $Ok = 0 ; my $len ;
+ open (TEX, $FileName) ;
+ my $LineNumber = 0 ;
+ while (<TEX>)
+ { ++$LineNumber ;
+ if ($QuitSearch)
+ { if ($Ok) { $log -> see ('end') }
+ last }
+ if (/$SearchString/i)
+ { ++$NumberOfHits ; $num -> update ;
+ unless ($Ok)
+ { $Ok = 1 ;
+ $log -> insert ('end', "$FileName\n\n",'title') }
+ $log -> insert ('end', sprintf("%5i : ",$LineNumber), 'title') ;
+ s/^\s*//o ;
+#
+ $len = 0 ;
+ while (/(.*?)($SearchString)/gi)
+ { $len += length($1) + length($2) ;
+ $log -> insert ('end', "$1") ;
+ $log -> insert ('end', "$2", 'found' ) }
+ $_ = substr($_,$len) ;
+ $log -> insert ('end', "$_") ;
+#
+ $log -> update ;
+ $log -> see ('end') } }
+ if ($Ok) { $log -> insert ('end', "\n") }
+ close (TEX) }
+
+sub DoLocateFiles
+ { @FileList = () ;
+ $NumberOfHits = 0 ;
+ if ($FileSuffix ne "")
+ { $log -> delete ('1.0', 'end') ;
+ if ($Recurse)
+ { $log -> insert ('end', "recursively identifying files\n", 'title') ;
+ $log -> see ('end') ;
+ find (\&wanted, $currentpath) ;
+ sub wanted
+ { if ($QuitSearch) { last ; return }
+ if (/.*\.$FileSuffix/i)
+ { ++$NumberOfHits ; $num -> update ;
+ push @FileList, $File::Find::name } } }
+ else
+ { $log -> insert ('end', "identifying files\n", 'title') ;
+ $log -> see ('end') ;
+ opendir(DIR, $currentpath) ; my @TEMPLIST = readdir(DIR) ; closedir(DIR) ;
+ foreach my $FileName (@TEMPLIST)
+ { if ($FileName =~ /.*\.$FileSuffix/i)
+ { ++$NumberOfHits ; $num -> update ;
+ if ($QuitSearch)
+ { last }
+ push @FileList, $FileName } } }
+ @FileList = sort @FileList } }
+
+sub DoLocateStrings
+ { $log -> delete ('1.0', 'end') ;
+ $log -> update ;
+ $log -> see ('end') ;
+ $NumberOfHits = 0 ;
+ if ($SearchString ne "")
+ { foreach my $FileName (@FileList)
+ { if ($QuitSearch)
+ { $log -> insert ('end', "search aborted\n", 'title') ;
+ $log -> see ('end') ;
+ last }
+ SearchFile($FileName,$SearchString) } }
+ unless ($QuitSearch)
+ { $log -> insert ('end', "done\n", 'title') ;
+ $log -> see ('end') } }
+
+sub LocateStrings
+ { $QuitSearch = 0 ;
+ DoLocateFiles() ;
+ DoLocateStrings() }
+
+$log -> insert ('end',
+
+ "data fields\n\n" , '' ,
+
+
+ "string :", 'title', " regular expression to search for\n" , '' ,
+ "suffix :", 'title', " type of file to search in\n" , '' ,
+ "recurse :", 'title', " enable searching subpaths\n" , '' ,
+ "location :", 'title', " drive of root path\n" , '' ,
+ "counter :", 'title', " file/hit counter\n\n" , '' ,
+
+ "key bindings\n\n" , '' ,
+
+ "double 1 :", 'title', " directory window <-> search window\n" , '' ,
+ "enter :", 'title', " start searching\n" , '' ,
+ "escape :", 'title', " quit searching\n\n" , '' ,
+
+ "current path\n\n" , '' ,
+
+ cwd(), 'title', "\n\n" , 'title' ) ;
+
+$log -> update ;
+
+ShowPath ;
+
+MainLoop() ;
diff --git a/Master/texmf-dist/scripts/context/perl/texfont.pl b/Master/texmf-dist/scripts/context/perl/texfont.pl
new file mode 100644
index 00000000000..425417374de
--- /dev/null
+++ b/Master/texmf-dist/scripts/context/perl/texfont.pl
@@ -0,0 +1,1154 @@
+eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}' && eval 'exec perl -S $0 $argv:q'
+ if 0;
+
+# This is an example of a crappy unstructured file but once
+# I know what should happen exactly, I will clean it up.
+
+# once it works all right, afmpl will be default
+
+# todo : ttf (partially doen already)
+
+# added: $pattern in order to avoid fuzzy shelle expansion of
+# filenames (not consistent over perl and shells); i hate that
+# kind of out of control features.
+
+#D \module
+#D [ file=texfont.pl,
+#D version=2004.02.06, % 2000.12.14
+#D title=Font Handling,
+#D subtitle=installing and generating,
+#D author=Hans Hagen ++,
+#D date=\currentdate,
+#D copyright={PRAGMA / Hans Hagen \& Ton Otten}]
+#C
+#C This module is part of the \CONTEXT\ macro||package and is
+#C therefore copyrighted by \PRAGMA. See licen-en.pdf for
+#C details.
+
+#D For usage information, see \type {mfonts.pdf}.
+
+#D Todo : copy afm/pfb from main to local files to ensure metrics
+#D Todo : Wybo's help system
+#D Todo : list of encodings [texnansi, ec, textext]
+
+#D Thanks to George N. White III for solving a couple of bugs.
+#D Thanks to Adam T. Lindsay for adding Open Type support (and more).
+
+use strict ;
+
+my $savedoptions = join (" ",@ARGV) ;
+
+use Config ;
+use FindBin ;
+use File::Copy ;
+use Getopt::Long ;
+
+$Getopt::Long::passthrough = 1 ; # no error message
+$Getopt::Long::autoabbrev = 1 ; # partial switch accepted
+
+# Unless a user has specified an installation path, we take
+# the dedicated font path or the local path.
+
+## $dosish = ($Config{'osname'} =~ /dos|mswin/i) ;
+my $dosish = ($Config{'osname'} =~ /^(ms)?dos|^os\/2|^(ms|cyg)win/i) ;
+
+my $IsWin32 = ($^O =~ /MSWin32/i);
+my $SpacyPath = 0 ;
+
+# great, the win32api is not present in all perls
+
+BEGIN {
+ $IsWin32 = ($^O =~ /MSWin32/i) ;
+ $SpacyPath = 0 ;
+ if ($IsWin32) {
+ my $str = `kpsewhich -expand-path=\$TEXMF` ;
+ $SpacyPath = ($str =~ / /) ;
+ if ($SpacyPath) {
+ require Win32::API; import Win32::API;
+ }
+ }
+}
+
+# great, glob changed to bsd glob in an incompatible way ... sigh, we now
+# have to catch a failed glob returning the pattern
+#
+# to stupid either:
+#
+# sub validglob {
+# my @globbed = glob(shift) ;
+# if ((@globbed) && (! -e $globbed[0])) {
+# return () ;
+# } else {
+# return @globbed ;
+# }
+# }
+#
+# so now we have:
+
+sub validglob {
+ my @globbed = glob(shift) ;
+ my @globout = () ;
+ foreach my $file (@globbed) {
+ push (@globout,$file) if (-e $file) ;
+ }
+ return @globout ;
+}
+
+sub GetShortPathName {
+ my ($filename) = @_ ;
+ return $filename unless (($IsWin32)&&($SpacyPath)) ;
+ my $GetShortPathName = new Win32::API('kernel32', 'GetShortPathName', 'PPN', 'N') ;
+ if(not defined $GetShortPathName) {
+ die "Can't import API GetShortPathName: $!\n" ;
+ }
+ my $buffer = " " x 260;
+ my $len = $GetShortPathName->Call($filename, $buffer, 260) ;
+ return substr($buffer, 0, $len) ;
+}
+
+my $installpath = "" ;
+
+if (defined($ENV{TEXMFLOCAL})) {
+ $installpath = "TEXMFLOCAL" ;
+}
+
+if (defined($ENV{TEXMFFONTS})) {
+ $installpath = "TEXMFFONTS" ;
+}
+
+if ($installpath eq "") {
+ $installpath = "TEXMFLOCAL" ; # redundant
+}
+
+my $encoding = "texnansi" ;
+my $vendor = "" ;
+my $collection = "" ;
+my $fontroot = "" ; #/usr/people/gwhite/texmf-fonts" ;
+my $help = 0 ;
+my $makepath = 0 ;
+my $show = 0 ;
+my $install = 0 ;
+my $sourcepath = "." ;
+my $passon = "" ;
+my $extend = "" ;
+my $narrow = "" ;
+my $slant = "" ;
+my $spaced = "" ;
+my $caps = "" ;
+my $noligs = 0 ;
+my $test = 0 ;
+my $virtual = 0 ;
+my $novirtual = 0 ;
+my $listing = 0 ;
+my $remove = 0 ;
+my $expert = 0 ;
+my $trace = 0 ;
+my $afmpl = 0 ;
+my $trees = 'TEXMFFONTS,TEXMFLOCAL,TEXMFEXTRA,TEXMFMAIN,TEXMFDIST' ;
+my $pattern = '' ;
+
+my $fontsuffix = "" ;
+my $namesuffix = "" ;
+
+my $batch = "" ;
+
+my $weight = "" ;
+my $width = "" ;
+
+my $preproc = 0 ; # atl: formerly OpenType switch
+my $variant = "" ; # atl: encoding variant
+my $extension = "pfb" ; # atl: default font extension
+my $lcdf = "" ; # atl: trigger for lcdf otftotfm
+
+my @cleanup = () ; # atl: build list of generated files to delete
+
+# todo: parse name for style, take face from command line
+#
+# @Faces = ("Serif","Sans","Mono") ;
+# @Styles = ("Slanted","Spaced", "Italic","Bold","BoldSlanted","BoldItalic") ;
+#
+# for $fac (@Faces) { for $sty (@Styles) { $FacSty{"$fac$sty"} = "" } }
+
+&GetOptions
+ ( "help" => \$help,
+ "makepath" => \$makepath,
+ "noligs" => \$noligs,
+ "show" => \$show,
+ "install" => \$install,
+ "encoding=s" => \$encoding,
+ "variant=s" => \$variant, # atl: used as a suffix to $encfile only
+ "vendor=s" => \$vendor,
+ "collection=s" => \$collection,
+ "fontroot=s" => \$fontroot,
+ "sourcepath=s" => \$sourcepath,
+ "passon=s" => \$passon,
+ "slant=s" => \$slant,
+ "spaced=s" => \$spaced,
+ "extend=s" => \$extend,
+ "narrow=s" => \$narrow,
+ "listing" => \$listing,
+ "remove" => \$remove,
+ "test" => \$test,
+ "virtual" => \$virtual,
+ "novirtual" => \$novirtual,
+ "caps=s" => \$caps,
+ "batch" => \$batch,
+ "weight=s" => \$weight,
+ "width=s" => \$width,
+ "expert" => \$expert,
+ "afmpl" => \$afmpl,
+ "afm2pl" => \$afmpl,
+ "rootlist=s" => \$trees,
+ "pattern=s" => \$pattern,
+ "trace" => \$trace, # --verbose conflicts with --ve
+ "preproc" => \$preproc, # atl: trigger conversion to pfb
+ "lcdf" => \$lcdf ) ; # atl: trigger use of lcdf fonttoools
+
+# for/from Fabrice:
+
+my $own_path = "$FindBin::Bin/" ;
+
+$FindBin::RealScript =~ m/([^\.]*)(\.pl|\.bat|\.exe|)/io ;
+
+my $own_name = $1 ;
+my $own_type = $2 ;
+my $own_stub = "" ;
+
+if ($own_type =~ /pl/oi) {
+ $own_stub = "perl "
+}
+
+if ($caps) { $afmpl = 0 } # for the moment
+
+# so we can use both combined
+
+if ($lcdf) {
+ $novirtual = 1 ;
+}
+
+if (!$novirtual) {
+ $virtual = 1 ;
+}
+
+# A couple of routines.
+
+sub report {
+ my $str = shift ;
+ $str =~ s/ / /goi ;
+ if ($str =~ /(.*?)\s+([\:\/])\s+(.*)/o) {
+ if ($1 eq "") {
+ $str = " " ;
+ } else {
+ $str = $2 ;
+ }
+ print sprintf("%22s $str %s\n",$1,$3) ;
+ }
+}
+
+sub error {
+ report("processing aborted : " . shift) ;
+ print "\n" ;
+ report "--help : show some more info" ;
+ exit ;
+}
+
+# The banner.
+
+print "\n" ;
+report ("TeXFont 2.2.1 - ConTeXt / PRAGMA ADE 2000-2004") ;
+print "\n" ;
+
+# Handy for scripts: one can provide a preferred path, if it
+# does not exist, the current path is taken.
+
+if (!(-d $sourcepath)&&($sourcepath ne 'auto')) { $sourcepath = "." }
+
+# Let's make multiple masters if requested.
+
+sub create_mm_font
+ { my ($name,$weight,$width) = @_ ; my $flag = my $args = my $tags = "" ;
+ my $ok ;
+ if ($name ne "")
+ { report ("mm source file : $name") }
+ else
+ { error ("missing mm source file") }
+ if ($weight ne "")
+ { report ("weight : $weight") ;
+ $flag .= " --weight=$weight " ;
+ $tags .= "-weight-$weight" }
+ if ($width ne "")
+ { report ("width : $width") ;
+ $flag .= " --width=$width " ;
+ $tags .= "-width-$width" }
+ error ("no specification given") if ($tags eq "") ;
+ error ("no amfm file found") unless (-f "$sourcepath/$name.amfm") ;
+ error ("no pfb file found") unless (-f "$sourcepath/$name.pfb") ;
+ $args = "$flag --precision=5 --kern-precision=0 --output=$sourcepath/$name$tags.afm" ;
+ my $command = "mmafm $args $sourcepath/$name.amfm" ;
+ print "$command\n" if $trace ;
+ $ok = `$command` ; chomp $ok ;
+ if ($ok ne "") { report ("warning $ok") }
+ $args = "$flag --precision=5 --output=$sourcepath/$name$tags.pfb" ;
+ $command = "mmpfb $args $sourcepath/$name.pfb" ;
+ print "$command\n" if $trace ;
+ $ok = `$command` ; chomp $ok ;
+ if ($ok ne "") { report ("warning $ok") }
+ report ("mm result file : $name$tags") }
+
+if (($weight ne "")||($width ne ""))
+ { create_mm_font($ARGV[0],$weight,$width) ;
+ exit }
+
+# go on
+
+if (($listing||$remove)&&($sourcepath eq "."))
+ { $sourcepath = "auto" }
+
+if ($fontroot eq "")
+ { if ($dosish)
+ { $fontroot = `kpsewhich -expand-path=\$$installpath` }
+ else
+ { $fontroot = `kpsewhich -expand-path=\\\$$installpath` }
+ chomp $fontroot }
+
+
+if ($fontroot =~ /\s+/) # needed for windows, spaces in name
+ { $fontroot = &GetShortPathName($fontroot) } # but ugly when not needed
+
+if ($test)
+ { $vendor = $collection = "test" ;
+ $install = 1 }
+
+if (($spaced ne "") && ($spaced !~ /\d/)) { $spaced = "50" }
+if (($slant ne "") && ($slant !~ /\d/)) { $slant = "0.167" }
+if (($extend ne "") && ($extend !~ /\d/)) { $extend = "1.200" }
+if (($narrow ne "") && ($narrow !~ /\d/)) { $narrow = "0.800" }
+if (($caps ne "") && ($caps !~ /\d/)) { $caps = "0.800" }
+
+$encoding = lc $encoding ;
+$vendor = lc $vendor ;
+$collection = lc $collection ;
+
+if ($encoding =~ /default/oi) { $encoding = "texnansi" }
+
+my $lcfontroot = lc $fontroot ;
+
+# Auto search paths
+
+my @trees = split(/\,/,$trees) ;
+
+# Test for help asked.
+
+if ($help)
+ { report "--fontroot=path : texmf destination font root (default: $lcfontroot)" ;
+ report "--rootlist=paths : texmf source roots (default: $trees)" ;
+ report "--sourcepath=path : when installing, copy from this path (default: $sourcepath)" ;
+ report "--sourcepath=auto : locate and use vendor/collection" ;
+ print "\n" ;
+ report "--vendor=name : vendor name/directory" ;
+ report "--collection=name : font collection" ;
+ report "--encoding=name : encoding vector (default: $encoding)" ;
+ report "--variant=name : encoding variant (.enc file or otftotfm features)" ;
+ print "\n" ;
+ report "--spaced=s : space glyphs in font by promille of em (0 - 1000)" ;
+ report "--slant=s : slant glyphs in font by factor (0.0 - 1.5)" ;
+ report "--extend=s : extend glyphs in font by factor (0.0 - 1.5)" ;
+ report "--caps=s : capitalize lowercase chars by factor (0.5 - 1.0)" ;
+ report "--noligs : remove ligatures" ;
+ print "\n" ;
+ report "--install : copy files from source to font tree" ;
+ report "--listing : list files on auto sourcepath" ;
+ report "--remove : remove files on auto sourcepath" ;
+ report "--makepath : when needed, create the paths" ;
+ print "\n" ;
+ report "--test : use test paths for vendor/collection" ;
+ report "--show : run tex on texfont.tex" ;
+ print "\n" ;
+ report "--batch : process given batch file" ;
+ print "\n" ;
+ report "--weight : multiple master weight" ;
+ report "--width : multiple master width" ;
+ print "\n" ;
+ report "--expert : also handle expert fonts" ;
+ print "\n" ;
+ report "--afmpl : use afm2pl instead of afm2tfm" ;
+ report "--preproc : pre-process ttf/otf, converting them to pfb" ;
+ report "--lcdf : use lcdf fonttools to create virtual encoding" ;
+ exit }
+
+if (($batch)||(($ARGV[0]) && ($ARGV[0] =~ /.+\.dat$/io)))
+ { my $batchfile = $ARGV[0] ;
+ unless (-f $batchfile)
+ { if ($batchfile !~ /\.dat$/io) { $batchfile .= ".dat" } }
+ unless (-f $batchfile)
+ { report ("trying to locate : $batchfile") ;
+ $batchfile = `kpsewhich -format="other text files" -progname=context $batchfile` ;
+ chomp $batchfile }
+ error ("unknown batch file $batchfile") unless -e $batchfile ;
+ report ("processing batch file : $batchfile") ;
+ my $select = (($vendor ne "")||($collection ne "")) ;
+ my $selecting = 0 ;
+ if (open(BAT, $batchfile))
+ { while (<BAT>)
+ { chomp ;
+ s/(.+)\#.*/$1/o ;
+ next if (/^\s*$/io) ;
+ if ($select)
+ { if ($selecting)
+ { if (/^\s*[\#\%]/io) { if (!/\-\-/o) { last } else { next } } }
+ elsif ((/^\s*[\#\%]/io)&&(/$vendor/i)&&(/$collection/i))
+ { $selecting = 1 ; next }
+ else
+ { next } }
+ else
+ { next if (/^\s*[\#\%]/io) ;
+ next unless (/\-\-/oi) }
+ s/\s+/ /gio ;
+ s/(--en.*\=)\?/$1$encoding/io ;
+ report ("batch line : $_") ;
+ # system ("perl $0 --fontroot=$fontroot $_") }
+ my $own_quote = ( $own_path =~ m/^[^\"].* / ? "\"" : "" );
+ my $switches = '' ;
+ $switches .= "--afmpl " if $afmpl ;
+ system ("$own_stub$own_quote$own_path$own_name$own_type$own_quote $switches --fontroot=$fontroot $_") }
+ close (BAT) }
+ exit }
+
+error ("unknown vendor $vendor") unless $vendor ;
+error ("unknown collection $collection") unless $collection ;
+error ("unknown tex root $lcfontroot") unless -d $fontroot ;
+
+my $varlabel = $variant ;
+
+if ($lcdf)
+ { $varlabel =~ s/,/-/goi ;
+ $varlabel =~ tr/a-z/A-Z/ }
+
+if ($varlabel ne "")
+ { $varlabel = "-$varlabel" }
+
+my $identifier = "$encoding$varlabel-$vendor-$collection" ;
+
+my $outlinepath = $sourcepath ; my $path = "" ;
+
+my $shape = "" ;
+
+if ($noligs)
+ { report ("ligatures : removed") ;
+ $fontsuffix .= "-unligatured" ;
+ $namesuffix .= "-NoLigs" }
+
+if ($caps ne "")
+ { if ($caps <0.5) { $caps = 0.5 }
+ elsif ($caps >1.0) { $caps = 1.0 }
+ $shape .= " -c $caps " ;
+ report ("caps factor : $caps") ;
+ $fontsuffix .= "-capitalized-" . int(1000*$caps) ;
+ $namesuffix .= "-Caps" }
+
+if ($extend ne "")
+ { if ($extend<0.0) { $extend = 0.0 }
+ elsif ($extend>1.5) { $extend = 1.5 }
+ report ("extend factor : $extend") ;
+ if ($lcdf)
+ { $shape .= " -E $extend " }
+ else
+ { $shape .= " -e $extend " }
+ $fontsuffix .= "-extended-" . int(1000*$extend) ;
+ $namesuffix .= "-Extended" }
+
+if ($narrow ne "") # goodie
+ { $extend = $narrow ;
+ if ($extend<0.0) { $extend = 0.0 }
+ elsif ($extend>1.5) { $extend = 1.5 }
+ report ("narrow factor : $extend") ;
+ if ($lcdf)
+ { $shape .= " -E $extend " }
+ else
+ { $shape .= " -e $extend " }
+ $fontsuffix .= "-narrowed-" . int(1000*$extend) ;
+ $namesuffix .= "-Narrowed" }
+
+if ($slant ne "")
+ { if ($slant <0.0) { $slant = 0.0 }
+ elsif ($slant >1.5) { $slant = 1.5 }
+ report ("slant factor : $slant") ;
+ if ($lcdf)
+ { $shape .= " -S $slant " }
+ else
+ { $shape .= " -s $slant " }
+ $fontsuffix .= "-slanted-" . int(1000*$slant) ;
+ $namesuffix .= "-Slanted" }
+
+if ($spaced ne "")
+ { if ($spaced < 0) { $spaced = 0 }
+ elsif ($spaced >1000) { $spaced = 1000 }
+ report ("space factor : $spaced") ;
+ if ($lcdf)
+ { $shape .= " -L $spaced " }
+ else
+ { $shape .= " -m $spaced " }
+ $fontsuffix .= "-spaced-" . $spaced ;
+ $namesuffix .= "-Spaced" }
+
+if ($sourcepath eq "auto") # todo uppercase root
+ { foreach my $root (@trees)
+ { if ($dosish)
+ { $path = `kpsewhich -expand-path=\$$root` }
+ else
+ { $path = `kpsewhich -expand-path=\\\$$root` }
+ chomp $path ;
+ $path = $ENV{$root} if (($path eq '') && defined($ENV{$root})) ;
+ report ("checking root : $root") ;
+ if ($preproc)
+ { $sourcepath = "$path/fonts/truetype/$vendor/$collection" }
+ else
+ { $sourcepath = "$path/fonts/afm/$vendor/$collection" }
+ unless (-d $sourcepath)
+ { my $ven = $vendor ; $ven =~ s/(........).*/$1/ ;
+ my $col = $collection ; $col =~ s/(........).*/$1/ ;
+ $sourcepath = "$path/fonts/afm/$ven/$col" ;
+ if (-d $sourcepath)
+ { $vendor = $ven ; $collection = $col } }
+ $outlinepath = "$path/fonts/type1/$vendor/$collection" ;
+ if (-d $sourcepath)
+ { # $install = 0 ; # no copy needed
+ $makepath = 1 ; # make on local if needed
+ my @files = validglob("$sourcepath/*.afm") ;
+ if ($preproc)
+ { @files = validglob("$sourcepath/*.otf") ;
+ report("locating : otf files") }
+ unless (@files)
+ { @files = validglob("$sourcepath/*.ttf") ;
+ report("locating : ttf files") }
+ if (@files)
+ { if ($listing)
+ { report ("fontpath : $sourcepath" ) ;
+ print "\n" ;
+ foreach my $file (@files)
+ { if (open(AFM,$file))
+ { my $name = "unknown name" ;
+ while (<AFM>)
+ { chomp ;
+ if (/^fontname\s+(.*?)$/oi)
+ { $name = $1 ; last } }
+ close (AFM) ;
+ if ($preproc)
+ { $file =~ s/.*\/(.*)\..tf/$1/io }
+ else
+ { $file =~ s/.*\/(.*)\.afm/$1/io }
+ report ("$file : $name") } }
+ exit }
+ elsif ($remove)
+ { error ("no removal from : $root") if ($root eq 'TEXMFMAIN') ;
+ foreach my $file (@files)
+ { if ($preproc)
+ { $file =~ s/.*\/(.*)\..tf/$1/io }
+ else
+ { $file =~ s/.*\/(.*)\.afm/$1/io }
+ foreach my $sub ("tfm","vf")
+ { foreach my $typ ("","-raw")
+ { my $nam = "$path/fonts/$sub/$vendor/$collection/$encoding$varlabel$typ-$file.$sub" ;
+ # { my $nam = "$path/fonts/$sub/$vendor/$collection/$encoding$varlabel$typ-$file$fontsuffix.$sub" ;
+ if (-s $nam)
+ { report ("removing : $encoding$varlabel$typ-$file.$sub") ;
+ unlink $nam } } } }
+ my $nam = "$encoding$varlabel-$vendor-$collection.tex" ;
+ if (-e $nam)
+ { report ("removing : $nam") ;
+ unlink "$nam" }
+ my $mapfile = "$encoding$varlabel-$vendor-$collection" ;
+ my $maproot = "$fontroot/fonts/map/pdftex/context";
+ if (-e "$maproot$mapfile.map")
+ { report ("renaming : $mapfile.map -> $mapfile.bak") ;
+ unlink "$maproot$mapfile.bak" ;
+ rename "$maproot$mapfile.map", "$maproot$mapfile.bak" }
+ exit }
+ else
+ { last } } } }
+ error ("unknown subpath ../fonts/afm/$vendor/$collection") unless -d $sourcepath }
+
+error ("unknown source path $sourcepath") unless -d $sourcepath ;
+error ("unknown option $ARGV[0]") if (($ARGV[0]||'') =~ /\-\-/) ;
+
+my $afmpath = "$fontroot/fonts/afm/$vendor/$collection" ;
+my $tfmpath = "$fontroot/fonts/tfm/$vendor/$collection" ;
+my $vfpath = "$fontroot/fonts/vf/$vendor/$collection" ;
+my $pfbpath = "$fontroot/fonts/type1/$vendor/$collection" ;
+my $ttfpath = "$fontroot/fonts/truetype/$vendor/$collection" ;
+my $mappath = "$fontroot/fonts/map/pdftex/context" ;
+my $encpath = "$fontroot/fonts/enc/dvips/context" ;
+
+# are not on local path ! ! ! !
+
+foreach my $path ($afmpath, $pfbpath)
+ { my @gzipped = <$path/*.gz> ;
+ foreach my $file (@gzipped)
+ { print "file = $file\n";
+ system ("gzip -d $file") } }
+
+# For gerben, we only generate a new database when an lsr file is present but for
+# myself we force this when texmf-fonts is used (else I get compatibility problems).
+
+if (($fontroot =~ /texmf\-fonts/o) || (-e "$fontroot/ls-R") || (-e "$fontroot/ls-r") || (-e "$fontroot/LS-R")) {
+ system ("mktexlsr $fontroot") ;
+}
+
+sub do_make_path
+ { my $str = shift ;
+ if ($str =~ /^(.*)\/.*?$/)
+ { do_make_path($1) }
+ mkdir $str, 0755 unless -d $str }
+
+sub make_path
+ { my $str = shift ;
+ do_make_path("$fontroot/fonts") ;
+ do_make_path("$fontroot/fonts/$str") ;
+ do_make_path("$fontroot/fonts/$str/$vendor") ;
+ do_make_path("$fontroot/fonts/$str/$vendor/$collection") }
+
+if ($makepath&&$install)
+ { make_path ("afm") ; make_path ("type1") }
+
+do_make_path($mappath) ;
+do_make_path($encpath) ;
+
+# now fonts/map and fonts/enc
+
+make_path ("vf") ;
+make_path ("tfm") ;
+
+if ($install)
+ { error ("unknown afm path $afmpath") unless -d $afmpath ;
+ error ("unknown pfb path $pfbpath") unless -d $pfbpath }
+
+error ("unknown tfm path $tfmpath") unless -d $tfmpath ;
+error ("unknown vf path $vfpath" ) unless -d $vfpath ;
+error ("unknown map path $mappath") unless -d $mappath ;
+
+my $mapfile = "$identifier.map" ;
+my $bakfile = "$identifier.bak" ;
+my $texfile = "$identifier.tex" ;
+
+ report "encoding vector : $encoding" ;
+if ($variant) { report "encoding variant : $variant" }
+ report "vendor name : $vendor" ;
+ report " source path : $sourcepath" ;
+ report "font collection : $collection" ;
+ report "texmf font root : $lcfontroot" ;
+ report "pdftex map file : $mapfile" ;
+
+if ($install) { report "source path : $sourcepath" }
+
+my $fntlist = "" ;
+
+my $runpath = $sourcepath ;
+
+my @files ;
+
+sub UnLink
+ { foreach my $f (@_)
+ { if (unlink $f)
+ { report "deleted : $f" if $trace } } }
+
+sub globafmfiles
+ { my ($runpath, $pattern) = @_ ;
+ my @files = validglob("$runpath/$pattern.afm") ;
+ report("locating afm files : using pattern $runpath/$pattern.afm");
+ if ($preproc && !$lcdf)
+ { @files = validglob("$runpath/$pattern.*tf") ;
+ report("locating otf files : using pattern $runpath/$pattern.*tf");
+ unless (@files)
+ { @files = validglob("$sourcepath/$pattern.ttf") ;
+ report("locating ttf files : using pattern $sourcepath/$pattern.ttf") }
+ }
+ if (@files) # also elsewhere
+ { report("locating afm files : using pattern $pattern") }
+ else
+ { @files = validglob("$runpath/$pattern.ttf") ;
+ if (@files)
+ { report("locating afm files : using ttf files") ;
+ $extension = "ttf" ;
+ foreach my $file (@files)
+ { $file =~ s/\.ttf$//io ;
+ report ("generating afm file : $file.afm") ;
+ my $command = "ttf2afm \"$file.ttf\" -o \"$file.afm\"" ;
+ system($command) ;
+ print "$command\n" if $trace ;
+ push(@cleanup, "$file.afm") }
+ @files = validglob("$runpath/$pattern.afm") }
+ else # try doing the pre-processing earlier
+ { report("locating afm files : using otf files") ;
+ $extension = "otf" ;
+ @files = validglob("$runpath/$pattern.otf") ;
+ foreach my $file (@files)
+ { $file =~ s/\.otf$//io ;
+ if (!$lcdf)
+ { report ("generating afm file : $file.afm") ;
+ preprocess_font("$file.otf", "$file.bdf") ;
+ push(@cleanup,"$file.afm") }
+ if ($preproc)
+ { my $command = "cfftot1 --output=$file.pfb $file.otf" ;
+ print "$command\n" if $trace ;
+ report("converting : $file.otf to $file.pfb") ;
+ system($command) ;
+ push(@cleanup, "$file.pfb") ;
+ }
+ }
+ if ($lcdf)
+ { @files = validglob("$runpath/$pattern.otf") }
+ else
+ { @files = validglob("$runpath/$pattern.afm") }
+ }
+ }
+ return @files }
+
+if ($pattern eq '') { if ($ARGV[0]) { $pattern = $ARGV[0] } }
+
+if ($pattern ne '')
+ { report ("processing files : all in pattern $pattern") ;
+ @files = globafmfiles($runpath,$pattern) }
+elsif ("$extend$narrow$slant$spaced$caps" ne "")
+ { error ("transformation needs file spec") }
+else
+ { $pattern = "*" ;
+ report ("processing files : all on afm path") ;
+ @files = globafmfiles($runpath,$pattern) }
+
+sub copy_files
+ { my ($suffix,$sourcepath,$topath) = @_ ;
+ my @files = validglob("$sourcepath/$pattern.$suffix") ;
+ return if ($topath eq $sourcepath) ;
+ report ("copying files : $suffix") ;
+ foreach my $file (@files)
+ { my $ok = $file =~ /(.*)\/(.+?)\.(.*)/ ;
+ my ($path,$name,$suffix) = ($1,$2,$3) ;
+ UnLink "$topath/$name.$suffix" ;
+ report ("copying : $name.$suffix") ;
+ copy ($file,"$topath/$name.$suffix") } }
+
+if ($install)
+ { copy_files("afm",$sourcepath,$afmpath) ;
+# copy_files("tfm",$sourcepath,$tfmpath) ; # raw supplied names
+ copy_files("pfb",$outlinepath,$pfbpath) ;
+ if ($extension eq "ttf")
+ { make_path("truetype") ;
+ copy_files("ttf",$sourcepath,$ttfpath) }
+ if ($extension eq "otf")
+ { make_path("truetype") ;
+ copy_files("otf",$sourcepath,$ttfpath) } }
+
+error ("no afm files found") unless @files ;
+
+my $map = my $tex = 0 ; my $mapdata = my $texdata = "" ;
+
+copy ("$mappath/$mapfile","$mappath/$bakfile") ;
+
+if (open (MAP,"<$mappath/$mapfile"))
+ { report ("extending map file : $mappath/$mapfile") ;
+ while (<MAP>) { unless (/^\%/o) { $mapdata .= $_ } }
+ close (MAP) }
+else
+ { report ("no map file at : $mappath/$mapfile") }
+
+if (open (TEX,"<$texfile"))
+ { while (<TEX>) { unless (/stoptext/o) { $texdata .= $_ } }
+ close (TEX) }
+
+$map = open (MAP,">$mapfile") ;
+$tex = open (TEX,">$texfile") ;
+
+unless ($map) { report "warning : can't open $mapfile" }
+unless ($tex) { report "warning : can't open $texfile" }
+
+if ($map)
+ { print MAP "% This file is generated by the TeXFont Perl script.\n" ;
+ print MAP "%\n" ;
+ print MAP "% You need to add the following line to your file:\n" ;
+ print MAP "%\n" ;
+ print MAP "% \\pdfmapfile{+$mapfile}\n" ;
+ print MAP "%\n" ;
+ print MAP "% In ConTeXt you can best use:\n" ;
+ print MAP "%\n" ;
+ print MAP "% \\loadmapfile\[$mapfile\]\n\n" }
+
+if ($tex)
+ { if ($texdata eq "")
+ { print TEX "% output=pdftex interface=en\n" ;
+ print TEX "\n" ;
+ print TEX "\\usemodule[fnt-01]\n" ;
+ print TEX "\n" ;
+ print TEX "\\loadmapfile[$mapfile]\n" ;
+ print TEX "\n" ;
+ print TEX "\\starttext\n\n" }
+ else
+ { print TEX "$texdata" ;
+ print TEX "\n\%appended section\n\n\\page\n\n" } }
+
+sub removeligatures
+ { my $filename = shift ; my $skip = 0 ;
+ copy ("$filename.vpl","$filename.tmp") ;
+ if ((open(TMP,"<$filename.tmp"))&&(open(VPL,">$filename.vpl")))
+ { report "removing ligatures : $filename" ;
+ while (<TMP>)
+ { chomp ;
+ if ($skip)
+ { if (/^\s*\)\s*$/o) { $skip = 0 ; print VPL "$_\n" } }
+ elsif (/\(LIGTABLE/o)
+ { $skip = 1 ; print VPL "$_\n" }
+ else
+ { print VPL "$_\n" } }
+ close(TMP) ; close(VPL) }
+ UnLink ("$filename.tmp") }
+
+my $raw = my $use = my $maplist = my $texlist = my $report = "" ;
+
+$use = "$encoding$varlabel-" ; $raw = $use . "raw-" ;
+
+my $encfil = "" ;
+
+if ($encoding ne "") # evt -progname=context
+ { $encfil = `kpsewhich -progname=pdftex $encoding$varlabel.enc` ;
+ chomp $encfil ; if ($encfil eq "") { $encfil = "$encoding$varlabel.enc" } }
+
+sub preprocess_font
+ { my ($infont,$pfbfont) = @_ ;
+ if ($infont ne "")
+ { report ("otf/ttf source file : $infont") ;
+ report ("destination file : $pfbfont") ; }
+ else
+ { error ("missing otf/ttf source file") }
+ open (CONVERT, "| pfaedit -script -") || error ("couldn't open pipe to pfaedit") ;
+ report ("pre-processing with : pfaedit") ;
+ print CONVERT "Open('$infont');\n Generate('$pfbfont', '', 1) ;\n" ;
+ close (CONVERT) }
+
+foreach my $file (@files)
+ { my $option = my $slant = my $spaced = my $extend = my $vfstr = my $encstr = "" ;
+ my $strange = "" ; my ($rawfont,$cleanfont,$restfont) ;
+ $file = $file ;
+ my $ok = $file =~ /(.*)\/(.+?)\.(.*)/ ;
+ my ($path,$name,$suffix) = ($1,$2,$3) ;
+ # remove trailing _'s
+ my $fontname = $name ;
+ my $cleanname = $fontname ;
+ $cleanname =~ s/\_//gio ;
+ # atl: pre-process an opentype or truetype file by converting to pfb
+ if ($preproc && !$lcdf)
+ { unless (-f "$afmpath/$cleanname.afm" && -f "$pfbpath/$cleanname.pfb")
+ { preprocess_font("$path/$name.$suffix", "$pfbpath/$cleanname.pfb") ;
+ rename("$pfbpath/$cleanname.afm", "$afmpath/$cleanname.afm")
+ || error("couldn't move afm product of pre-process.") }
+ $path = $afmpath ;
+ $file = "$afmpath/$cleanname.afm" }
+ # cleanup
+ foreach my $suf ("tfm", "vf", "vpl")
+ { UnLink "$raw$cleanname$fontsuffix.$suf" ;
+ UnLink "$use$cleanname$fontsuffix.$suf" }
+ UnLink "texfont.log" ;
+ # set switches
+ if ($encoding ne "")
+ { $encstr = " -T $encfil" }
+ if ($caps ne "")
+ { $vfstr = " -V $raw$cleanname$fontsuffix" }
+ else # if ($virtual)
+ { $vfstr = " -v $raw$cleanname$fontsuffix" }
+ my $font = "";
+ # let's see what we have here (we force texnansi.enc to avoid error messages)
+ if ($lcdf)
+ { my $command = "otfinfo -p $file" ;
+ print "$command\n" if $trace ;
+ $font = `$command` ;
+ chomp $font ;
+ $cleanname = $cleanfont = $font }
+ else
+ { my $command = "afm2tfm \"$file\" -p texnansi.enc texfont.tfm" ;
+ print "$command\n" if $trace ;
+ $font = `$command` ;
+ UnLink "texfont.tfm" ;
+ ($rawfont,$cleanfont,$restfont) = split(/\s/,$font) }
+ if ($font =~ /(math|expert)/io) { $strange = lc $1 }
+ $cleanfont =~ s/\_/\-/goi ;
+ $cleanfont =~ s/\-+$//goi ;
+ print "\n" ;
+ if (($strange eq "expert")&&($expert))
+ { report ("font identifier : $cleanfont$namesuffix -> $strange -> tfm") }
+ elsif ($strange ne "")
+ { report ("font identifier : $cleanfont$namesuffix -> $strange -> skipping") }
+ elsif ($afmpl)
+ { report ("font identifier : $cleanfont$namesuffix -> text -> tfm") }
+ elsif ($virtual)
+ { report ("font identifier : $cleanfont$namesuffix -> text -> tfm + vf") }
+ else
+ { report ("font identifier : $cleanfont$namesuffix -> text -> tfm") }
+ # don't handle strange fonts
+ if ($strange eq "")
+ { # atl: support for lcdf otftotfm
+ if ($lcdf && $extension eq "otf")
+ { # no vf, bypass afm, use otftotfm to get encoding and tfm
+ my $varstr = my $encout = my $tfmout = "" ;
+ report "processing files : otf -> tfm + enc" ;
+ if ($encoding ne "")
+ { $encfil = `kpsewhich -progname=pdftex $encoding.enc` ;
+ chomp $encfil ; if ($encfil eq "") { $encfil = "$encoding.enc" }
+ $encstr = " -e $encfil " }
+ if ($variant ne "")
+ { ( $varstr = $variant ) =~ s/,/ -f /goi ;
+ $varstr = " -f $varstr" }
+ $encout = "$encpath/$use$cleanfont.enc" ;
+ if (-e $encout)
+ { report ("renaming : $encout -> $use$cleanfont.bak") ;
+ UnLink "$encpath/$use$cleanfont.bak" ;
+ rename $encout, "$encpath/$use$cleanfont.bak" }
+ UnLink "texfont.map" ;
+ $tfmout = "$use$cleanfont$fontsuffix" ;
+ my $otfcommand = "otftotfm -a $varstr $encstr $passon $shape --name=\"$tfmout\" --encoding-dir=\"$encpath/\" --tfm-dir=\"$tfmpath/\" --vf-dir=\"$vfpath/\" --no-type1 --map-file=./texfont.map \"$file\"" ;
+ print "$otfcommand\n" if $trace ;
+ system("$otfcommand") ;
+ $encfil = $encout }
+ else
+ { # generate tfm and vpl, $file is on afm path
+ my $font = '' ;
+ if ($afmpl)
+ { report " generating pl : $cleanname$fontsuffix (from $cleanname)" ;
+ $encstr = " -p $encfil" ;
+ my $command = "afm2pl -f afm2tfm $shape $passon $encstr $file $cleanname$fontsuffix.vpl" ;
+ print "$command\n" if $trace ;
+ my $ok = `$command` ;
+ if (open (TMP,"$cleanname$fontsuffix.map"))
+ { $font = <TMP> ;
+ close(TMP) ;
+ UnLink "$cleanname$fontsuffix.map" } }
+ else
+ { report "generating raw tfm/vpl : $raw$cleanname$fontsuffix (from $cleanname)" ;
+ my $command = "afm2tfm $file $shape $passon $encstr $vfstr $raw$cleanname$fontsuffix" ;
+ print "$command\n" if $trace ;
+ $font = `$command` }
+ # generate vf file if needed
+ chomp $font ;
+ if ($font =~ /.*?([\d\.]+)\s*ExtendFont/io) { $extend = $1 }
+ if ($font =~ /.*?([\d\.]+)\s*SlantFont/io) { $slant = $1 }
+ if ($extend ne "") { $option .= " $1 ExtendFont " }
+ if ($slant ne "") { $option .= " $1 SlantFont " }
+ if ($noligs) { removeligatures("$raw$cleanname$fontsuffix") }
+ if ($afmpl)
+ { report "generating new tfm : $use$cleanname$fontsuffix" ;
+ my $command = "pltotf $cleanname$fontsuffix.vpl $use$cleanname$fontsuffix.tfm" ;
+ print "$command\n" if $trace ;
+ my $ok = `$command` }
+ elsif ($virtual)
+ { report "generating new vf : $use$cleanname$fontsuffix (from $raw$cleanname)" ;
+ my $command = "vptovf $raw$cleanname$fontsuffix.vpl $use$cleanname$fontsuffix.vf $use$cleanname$fontsuffix.tfm" ;
+ print "$command\n" if $trace ;
+ my $ok = `$command` }
+ else
+ { report "generating new tfm : $use$cleanname$fontsuffix (from $raw$cleanname)" ;
+ my $command = "pltotf $raw$cleanname$fontsuffix.vpl $use$cleanname$fontsuffix.tfm" ;
+ print "$command\n" if $trace ;
+ my $ok = `$command` } } }
+ elsif (-e "$sourcepath/$cleanname.tfm" )
+ { report "using existing tfm : $cleanname.tfm" }
+ elsif (($strange eq "expert")&&($expert))
+ { report "creating tfm file : $cleanname.tfm" ;
+ my $command = "afm2tfm $file $cleanname.tfm" ;
+ print "$command\n" if $trace ;
+ my $font = `$command` }
+ else
+ { report "use supplied tfm : $cleanname" }
+ # report results
+ if (!$lcdf)
+ { ($rawfont,$cleanfont,$restfont) = split(/\s/,$font) }
+ $cleanfont =~ s/\_/\-/goi ;
+ $cleanfont =~ s/\-+$//goi ;
+ # copy files
+ my $usename = "$use$cleanname$fontsuffix" ;
+ my $rawname = "$raw$cleanname$fontsuffix" ;
+
+ if ($lcdf eq "")
+ { if ($strange ne "")
+ { UnLink ("$vfpath/$cleanname.vf", "$tfmpath/$cleanname.tfm") ;
+ copy ("$cleanname.tfm","$tfmpath/$cleanname.tfm") ;
+ copy ("$usename.tfm","$tfmpath/$usename.tfm") ;
+ # or when available, use vendor one :
+ copy ("$sourcepath/$cleanname.tfm","$tfmpath/$cleanname.tfm") }
+ elsif ($virtual)
+ { UnLink ("$vfpath/$rawname.vf", "$vfpath/$usename.vf") ;
+ UnLink ("$tfmpath/$rawname.tfm", "$tfmpath/$usename.tfm") ;
+ copy ("$usename.vf" ,"$vfpath/$usename.vf") ;
+ copy ("$rawname.tfm","$tfmpath/$rawname.tfm") ;
+ copy ("$usename.tfm","$tfmpath/$usename.tfm") }
+ elsif ($afmpl)
+ { UnLink ("$vfpath/$rawname.vf", "$vfpath/$usename.vf", "$vfpath/$cleanname.vf") ;
+ UnLink ("$tfmpath/$rawname.tfm", "$tfmpath/$usename.tfm", "$tfmpath/$cleanname.tfm") ;
+ copy ("$usename.tfm","$tfmpath/$usename.tfm") }
+ else
+ { UnLink ("$vfpath/$usename.vf", "$tfmpath/$usename.tfm") ;
+ # slow but prevents conflicting vf's
+ my $rubish = `kpsewhich $usename.vf` ; chomp $rubish ;
+ if ($rubish ne "") { UnLink $rubish }
+ #
+ copy ("$usename.tfm","$tfmpath/$usename.tfm") } }
+ # cleanup
+ foreach my $suf ("tfm", "vf", "vpl")
+ { UnLink ("$rawname.$suf", "$usename.$suf") ;
+ UnLink ("$cleanname.$suf", "$fontname.$suf") ;
+ UnLink ("$cleanname$fontsuffix.$suf", "$fontname$fontsuffix.$suf") }
+ # add line to maps file
+ $option =~ s/^\s+(.*)/$1/o ;
+ $option =~ s/(.*)\s+$/$1/o ;
+ $option =~ s/ / /o ;
+ if ($option ne "")
+ { $option = "\"$option\" 4" }
+ else
+ { $option = "4" }
+ # adding cleanfont is kind of dangerous
+ my $thename = my $str = my $theencoding = "" ;
+ if ($strange ne "")
+ { $thename = $cleanname ; $theencoding = "" ; }
+ elsif ($lcdf)
+ { $thename = $usename ; $theencoding = " $encoding$varlabel-$cleanname.enc" }
+ elsif ($afmpl)
+ { $thename = $usename ; $theencoding = " $encoding$varlabel.enc" }
+ elsif ($virtual)
+ { $thename = $rawname ; $theencoding = " $encoding$varlabel.enc" }
+ else
+ { $thename = $usename ; $theencoding = " $encoding$varlabel.enc" }
+ # quit rest if no type 1 file
+ my $pfb_sourcepath = $sourcepath ;
+ $pfb_sourcepath =~ s@/afm/@/type1/@ ;
+ unless ((-e "$pfbpath/$fontname.$extension")||
+ (-e "$pfb_sourcepath/$fontname.$extension")||
+ (-e "$sourcepath/$fontname.$extension")||
+ (-e "$ttfpath/$fontname.$extension"))
+ { if ($tex) { $report .= "missing file: \\type \{$fontname.pfb\}\n" }
+ report ("missing pfb file : $fontname.pfb") }
+ # now add entry to map
+ if ($strange eq "") {
+ if ($extension eq "otf") {
+ if ($lcdf) {
+ my $mapline = "" ;
+ if (open(ALTMAP,"texfont.map")) {
+ while (<ALTMAP>) {
+ chomp ;
+ # atl: we assume this b/c we always force otftotfm --no-type1
+ if (/<<(.*)\.otf$/oi) {
+ $mapline = $_ ; last ;
+ }
+ }
+ close(ALTMAP) ;
+ } else {
+ report("no mapfile from otftotfm : texfont.map") ;
+ }
+ if ($preproc) {
+ $mapline =~ s/<\[/</;
+ $mapline =~ s/<<(\S+)\.otf$/<$1\.pfb/ ;
+ } else {
+ $mapline =~ s/<<(\S+)\.otf$/<< $ttfpath\/$fontname.$extension/ ;
+ }
+ $str = "$mapline\n" ;
+ } else {
+ if ($preproc) {
+ $str = "$thename $cleanfont $option < $fontname.pfb$theencoding\n" ;
+ } else {
+ # PdfTeX can't subset OTF files, so we have to include the whole thing
+ # It looks like we also need to be explicit on where to find the file
+ $str = "$thename $cleanfont $option << $ttfpath/$fontname.$extension <[$theencoding\n" ;
+ }
+ }
+ } else {
+ $str = "$thename $cleanfont $option < $fontname.$extension$theencoding\n" ;
+ }
+ } else {
+ $str = "$thename $cleanfont < $fontname.$extension\n" ;
+ }
+ # check for redundant entries
+ if ($map) {
+ $mapdata =~ s/^$thename\s.*?$//gmis ;
+ if ($afmpl) {
+ if ($mapdata =~ s/^$rawname\s.*?$//gmis) {
+ report ("removing raw file : $rawname") ;
+ }
+ }
+ $maplist .= $str ;
+ $mapdata .= $str ;
+ }
+ # write lines to tex file
+ if (($strange eq "expert")&&($expert)) {
+ $fntlist .= "\\definefontsynonym[$cleanfont$namesuffix][$cleanname] \% expert\n" ;
+ } elsif ($strange ne "") {
+ $fntlist .= "\%definefontsynonym[$cleanfont$namesuffix][$cleanname]\n" ;
+ } else {
+ $fntlist .= "\\definefontsynonym[$cleanfont$namesuffix][$usename][encoding=$encoding]\n" ;
+ }
+ next unless $tex ;
+ if (($strange eq "expert")&&($expert)) {
+ $texlist .= "\\ShowFont[$cleanfont$namesuffix][$cleanname]\n" ;
+ } elsif ($strange ne "") {
+ $texlist .= "\%ShowFont[$cleanfont$namesuffix][$cleanname]\n" ;
+ } else {
+ $texlist .= "\\ShowFont[$cleanfont$namesuffix][$usename][$encoding]\n"
+ }
+}
+
+if ($map)
+ { report ("updating map file : $mapfile") ;
+ while ($mapdata =~ s/\n\n+/\n/mois) {} ;
+ $mapdata =~ s/^\s*//gmois ;
+ print MAP $mapdata }
+
+if ($tex)
+ { $mappath =~ s/\\/\//go ;
+ $savedoptions =~ s/^\s+//gmois ; $savedoptions =~ s/\s+$//gmois ;
+ $fntlist =~ s/^\s+//gmois ; $fntlist =~ s/\s+$//gmois ;
+ $maplist =~ s/^\s+//gmois ; $maplist =~ s/\s+$//gmois ;
+ print TEX "$texlist" ;
+ print TEX "\n" ;
+ print TEX "\\setupheadertexts[\\tttf example definitions]\n" ;
+ print TEX "\n" ;
+ print TEX "\\starttyping\n" ;
+ print TEX "texfont $savedoptions\n" ;
+ print TEX "\\stoptyping\n" ;
+ print TEX "\n" ;
+ print TEX "\\starttyping\n" ;
+ print TEX "$mappath/$mapfile\n" ;
+ print TEX "\\stoptyping\n" ;
+ print TEX "\n" ;
+ print TEX "\\starttyping\n" ;
+ print TEX "$fntlist\n" ;
+ print TEX "\\stoptyping\n" ;
+ print TEX "\n" ;
+ print TEX "\\page\n" ;
+ print TEX "\n" ;
+ print TEX "\\setupheadertexts[\\tttf $mapfile]\n" ;
+ print TEX "\n" ;
+ print TEX "\\starttyping\n" ;
+ print TEX "$maplist\n" ;
+ print TEX "\\stoptyping\n" ;
+ print TEX "\n" ;
+ print TEX "\\stoptext\n" }
+
+if ($map) { close (MAP) }
+if ($tex) { close (TEX) }
+
+copy ($mapfile,"$mappath/$mapfile") ;
+
+# atl: global cleanup with generated files (afm & ttf don't mix)
+
+UnLink(@cleanup) ;
+
+print "\n" ; report ("generating : ls-r databases") ;
+
+# Refresh database.
+
+print "\n" ; system ("mktexlsr $fontroot") ; print "\n" ;
+
+# Process the test file.
+
+if ($show) { system ("texexec --once --silent $texfile") }
+
+@files = validglob("$identifier.*") ;
+
+foreach my $file (@files)
+ { unless ($file =~ /(tex|pdf|log|mp|tmp)$/io) { unlink $file } }
+
+exit ;
diff --git a/Master/texmf-dist/scripts/context/perl/texshow.pl b/Master/texmf-dist/scripts/context/perl/texshow.pl
new file mode 100644
index 00000000000..79222c9f03c
--- /dev/null
+++ b/Master/texmf-dist/scripts/context/perl/texshow.pl
@@ -0,0 +1,936 @@
+eval '(exit $?0)' && eval 'exec perl -w -S $0 ${1+"$@"}' && eval 'exec perl -w -S $0 $argv:q'
+ if 0;
+
+#D \module
+#D [ file=texshow.pl,
+#D version=2005.01.06,
+#D title=TeXShow,
+#D subtitle=showing \CONTEXT\ commands,
+#D author=Taco Hoekwater,
+#D date=\currentdate,
+#D copyright={Taco Hoekwater}]
+
+#D Early 1999 \TEXSHOW\ showed up in the \CONTEXT\ distribution. At that time
+#D the user interface was described in files named \type {setup*.tex}. The
+#D program used a stripped down version of these definition files, generated
+#D by \CONTEXT\ itself. \TEXSHOW\ shows you the commands, their (optional)
+#D arguments, as well as the parameters and their values. For some five years
+#D there was no need to change \TEXSHOW. However, when a few years ago we
+#D started providing an \XML\ variant of the user interface definitions, Taco
+#D came up with \TEXSHOW||\XML. Because Patricks \CONTEXT\ garden and tools
+#D like \CTXTOOLS\ also use the \XML\ definitions, it's time to drop the old
+#D \TEX\ based definitions and move forward. From now on Taco's version is the
+#D one to be used.
+#D
+#D Hans Hagen - Januari 2005
+
+use strict;
+use Getopt::Long ;
+use XML::Parser;
+use Data::Dumper;
+use Tk;
+use Tk::ROText ;
+use Config;
+use Time::HiRes;
+
+$Getopt::Long::passthrough = 1 ; # no error message
+$Getopt::Long::autoabbrev = 1 ; # partial switch accepted
+
+my $ShowHelp = 0;
+my $Debug = 0;
+my $Editmode = 0;
+my $Interface = 'cont-en';
+my $current_command;
+my $current_interface;
+my $current_part;
+my @setup_files;
+
+my %setups;
+my %commes;
+my %descrs;
+my %examps;
+my %trees;
+my %positions;
+my %locations;
+my %crosslinks;
+
+
+&GetOptions
+ ( "help" => \$ShowHelp ,
+ "interface=s" => \$Interface ,
+ "debug" => \$Debug,
+ "edit" => \$Editmode) ;
+
+print "\n";
+
+show('TeXShow-XML 0.2 beta','Taco Hoekwater 2004',"/");
+
+print "\n";
+
+if ($ShowHelp) {
+ show('--help','print this help');
+ show('--interface=lg','primary interface');
+ show('--debug','print debugging info');
+ show('string','show info about command \'string\'');
+ show('string lg','show info about \'string\' in language \'lg\'');
+ print "\n";
+ exit 0;
+}
+
+my $command = $ARGV[0] || '';
+my $interface = $ARGV[1] || '';
+if ($interface =~ /^[a-z][a-z]$/i) {
+ $Interface = 'cont-' . lc($interface);
+} elsif ($interface && $command =~ /^[a-z][a-z]$/i) {
+ show('debug',"switching '$interface' and '$command'");
+ $Interface = 'cont-' . lc($command);
+ $command = $interface;
+}
+
+if ($command =~ s/^\\//) {
+ show('debug','removed initial command backslash');
+}
+
+show('interface', $Interface);
+if ($command){
+ show ('command', "\\$command") ;
+}
+
+print "\n";
+
+show('status','searching for setup files');
+
+my $setup_path;
+my ($mainwindow,$interfaceframe,$partframe,$leftframe,$rightframe,$buttonframe);
+my ($request,$listbox,$textwindow,%interfacebuttons,%partbuttons);
+
+my ($textfont,$userfont,$buttonfont);
+
+my $Part;
+
+if (setups_found($Interface)) {
+ $current_interface = '';
+ $current_command = '';
+ $current_part = 'Command';
+ show('status','loading setups') ;
+ load_setups($Interface) ;
+ show ('status','initializing display') ;
+ initialize_display();
+ change_setup();
+ show_command ($command);
+ $mainwindow->deiconify();
+ show ('status','entering main loop') ;
+ MainLoop () ;
+ show ('status','closing down') ;
+} else {
+ show ('error','no setup files found') ;
+}
+print "\n";
+
+sub initialize_display {
+ my $dosish = ($Config{'osname'} =~ /dos|win/i) ;
+ my $default_size = $dosish ? 9 : 12 ;
+ my $s_vertical = 30 ;
+ my $s_horizontal = 72 ;
+ my $c_horizontal = 24 ;
+ if (!$dosish) {
+ $textfont = "-adobe-courier-bold-r-normal--$default_size-120-75-75-m-70-iso8859-1" ;
+ $userfont = "-adobe-courier-bold-o-normal--$default_size-120-75-75-m-70-iso8859-1" ;
+ $buttonfont = "-adobe-helvetica-bold-r-normal--$default_size-120-75-75-p-69-iso8859-1";
+ } else {
+ $textfont = "Courier $default_size " ;
+ $userfont = "Courier $default_size italic" ;
+ $buttonfont = "Helvetica $default_size bold " ;
+ }
+ $mainwindow = MainWindow -> new ( -title => 'ConTeXt commands' ) ;
+ $buttonframe = $mainwindow -> Frame () ; # buttons
+ $leftframe = $mainwindow -> Frame () ; # leftside
+ $rightframe = $mainwindow -> Frame();
+ $request = $rightframe -> Entry (-font => $textfont,
+ -background => 'ivory1',
+ -width => $c_horizontal);
+ $listbox = $rightframe -> Scrolled ('Listbox',
+ -scrollbars => 'e',
+ -font => $textfont,
+ -width => $c_horizontal,
+ -selectbackground => 'gray',
+ -background => 'ivory1',
+ -selectmode => 'browse') ;
+ $textwindow = $leftframe -> Scrolled ('ROText',
+ -scrollbars => 'se',
+ -height => $s_vertical,
+ -width => $s_horizontal,
+ -wrap => 'none',
+ -background => 'ivory1',
+ -font => $textfont);
+ $interfaceframe = $leftframe -> Frame();
+ $mainwindow -> withdraw() ;
+ $mainwindow -> resizable ('y', 'y') ;
+ foreach (@setup_files) {
+ $interfacebuttons{$_} = $buttonframe -> Radiobutton (-text => $_,
+ -value => $_,
+ -font => $buttonfont,
+ -selectcolor => 'ivory1',
+ -indicatoron => 0,
+ -command => \&change_setup,
+ -variable => \$Interface );
+
+ $interfacebuttons{$_} -> pack (-padx => '2p',-pady => '2p','-side' => 'left' );
+ }
+ foreach (qw(Command Description Comments Examples)) {
+ $partbuttons{$_} = $interfaceframe -> Radiobutton (-text => $_,
+ -value => $_,
+ -font => $buttonfont,
+ -selectcolor => 'ivory1',
+ -indicatoron => 0,
+ -command => \&change_part,
+ -variable => \$Part );
+ $partbuttons{$_} -> pack (-padx => '2p',-pady => '2p','-side' => 'left' );
+ }
+ # global top
+ $buttonframe -> pack ( -side => 'top' , -fill => 'x' , -expand => 0 ) ;
+ # top in left
+ $interfaceframe -> pack ( -side => 'top' , -fill => 'x' , -expand => 0 ) ;
+ $textwindow -> pack ( -side => 'top' , -fill => 'both' , -expand => 1 ) ;
+ $leftframe -> pack ( -side => 'left' , -fill => 'both' , -expand => 1 ) ;
+ # right
+ $request -> pack ( -side => 'top' , -fill => 'x' ) ;
+ $listbox -> pack ( -side => 'bottom' , -fill => 'both' , -expand => 1 ) ;
+ $rightframe -> pack ( -side => 'right' , -fill => 'both' , -expand => 1 ) ;
+ $listbox -> bind ('<B1-Motion>', \&show_command ) ;
+ $listbox -> bind ('<1>' , \&show_command ) ;
+ $listbox -> bind ('<Key>' , \&show_command ) ;
+ $textwindow -> tag ('configure', 'user' , -font => $userfont ) ;
+ $textwindow -> tag ('configure', 'optional' , -font => $userfont ) ;
+ $textwindow -> tag ('configure', 'command' , -foreground => 'green3' ) ;
+ $textwindow -> tag ('configure', 'variable' , -font => $userfont ) ;
+ $textwindow -> tag ('configure', 'default' , -underline => 1 ) ;
+ $textwindow -> tag ('configure', 'symbol' , -foreground => 'blue3' ) ;
+ $textwindow -> tag ('configure', 'or' , -foreground => 'yellow3' ) ;
+ $textwindow -> tag ('configure', 'argument' , -foreground => 'red3' ) ;
+ $textwindow -> tag ('configure', 'par' , -lmargin1 => '4m' ,
+ -wrap => 'word' ,
+ -lmargin2 => '6m' ) ;
+ foreach my $chr ('a'..'z','A'..'Z') {
+ $mainwindow -> bind ( "<KeyPress-$chr>", sub { insert_request(shift, $chr) } );
+ }
+ $request -> bind ('<Return>', sub { handle_request() } ) ;
+ $mainwindow -> bind ( "<backslash>", sub { insert_request(shift, "\\") } ) ;
+ $mainwindow -> bind ( "<space>", sub { new_request() } ) ;
+ $mainwindow -> bind ( "<BackSpace>", sub { delete_request() } ) ;
+ $mainwindow -> bind ( "<Prior>", sub { prev_command() } ) ;
+ $mainwindow -> bind ( "<Next>", sub { next_command() } ) ;
+}
+
+sub show {
+ my ($pre,$post,$sep) = @_;
+ unless ($pre eq 'debug' && !$Debug) {
+ $sep = ':' unless defined $sep;
+ print sprintf("%22s $sep %+s\n",$pre,$post);
+ }
+}
+
+sub change_setup {
+ # switches to another setup file
+ if ($current_interface ne $Interface ) {
+ my $loc = 0;
+ if ($current_command) {
+ $loc = $positions{$Interface}{$current_command} || 0;
+ }
+ my @list = sort {lc $a cmp lc $b} keys %{$setups{$Interface}} ;
+ my $num = 0;
+ map { $locations{$Interface}{$_} = $num++; } @list;
+ $listbox -> delete ('0.0', 'end') ;
+ $listbox -> insert ('end', @list) ;
+ # try to switch to other command as well, here.
+ if ($current_command ne '') {
+ show_command($crosslinks{$Interface}[$loc] || '');
+ } else {
+ $listbox -> selectionSet ('0.0', '0.0') ;
+ $listbox -> activate ('0.0') ;
+ }
+ }
+ $current_interface = $Interface;
+ $mainwindow -> focus ;
+}
+
+sub change_part {
+ if ($Part ne $current_part) {
+ if($Part eq 'Command') {
+ show_command();
+ } elsif ($Part eq 'Description') {
+ show_description();
+ } elsif ($Part eq 'Comments') {
+ show_comments();
+ } elsif ($Part eq 'Examples') {
+ show_examples();
+ }
+ }
+ $current_part = $Part;
+}
+
+
+sub setups_found {
+ # find the setup files
+ my ($primary) = @_;
+ $setup_path = `kpsewhich --progname=context cont-en.xml` ;
+ chomp $setup_path;
+ show ('debug', "path = '$setup_path'");
+ if ($setup_path) {
+ $setup_path =~ s/cont-en\.xml.*// ;
+ @setup_files = glob ("${setup_path}cont\-??.xml") ; # HH: pattern patched, too greedy
+ show ('debug', "globbed path into '@setup_files'");
+ if (@setup_files) {
+ my $found = 0;
+ foreach (@setup_files) {
+ s/\.xml.*$//;
+ s/^.*?cont-/cont-/;
+ if ($_ eq $primary) {
+ $found = 1;
+ show ('debug', "found primary setup '$primary'");
+ } else {
+ show ('debug', "found non-primary setup '$_'");
+ }
+ }
+ if ($found) {
+ return 1;
+ } else {
+ show('error',"setup file for '$primary' not found, using 'cont-en'");
+ $Interface = 'cont-en';
+ return 1;
+ }
+ } else {
+ show('error',"setup file glob failed");
+ }
+ } elsif ($!) {
+ show('error','kpsewhich not found');
+ } else {
+ show('error','setup files not found');
+ }
+ return 0;
+}
+
+sub load_setup {
+ my ($path,$filename) = @_;
+ unless (keys %{$setups{$filename}}) {
+ if (open(IN,"<${path}$filename.xml")) {
+ my $position = 0 ;
+ local $/ = '</cd:command>';
+ while (my $data= <IN>) {
+ if ($data =~ /\<\/cd:interface/) {
+ next;
+ }
+ if ($data =~ /\<cd:interface/) {
+ $data =~ s/^(.*?)\<cd:command/\<cd:command/sm;
+ my $meta = $1;
+ }
+ #
+ $data =~ s/\s*\n\s*//g;
+ $data =~ /\<cd:command(.*?)\>/;
+ my $info = $1;
+ my ($name,$environment) = ('','');
+ while ($info =~ s/^\s*(.*?)\s*=\s*(["'])(.*?)\2\s*//) {
+ my $a = $1; my $b = $3;
+ if ($a eq 'name') {
+ $name = $b;
+ } elsif ($a eq 'type') {
+ $environment = $b;
+ }
+ }
+ my $cmd = $name;
+ if ($environment) {
+ $cmd = "start" . $name;
+ }
+ $setups {$filename}{$cmd} = $data ;
+ $trees {$filename}{$cmd} = undef;
+ $positions {$filename}{$cmd} = ++$position ;
+ $crosslinks{$filename}[$position] = $cmd ;
+ }
+ close IN;
+ # now get explanations as well ...
+ my $explname = $filename;
+ $explname =~ s/cont-/expl-/;
+ my $extras = 0 ;
+ if (open(IN,"<${path}$explname.xml")) {
+ local $/ = '</cd:explanation>';
+ while (my $data= <IN>) {
+ if ($data =~ /\<\/cd:explanations/) {
+ next;
+ }
+ if ($data =~ /\<cd:explanations/) {
+ $data =~ s/^(.*?)\<cd:explanation /\<cd:explanation /sm;
+ my $meta = $1;
+ }
+ #
+ $extras++;
+ $data =~ /\<cd:explanation(.*?)\>/;
+ my $info = $1;
+ my ($name,$environment) = ('','');
+ while ($info =~ s/^\s*(.*?)\s*=\s*(["'])(.*?)\2\s*//) {
+ my $a = $1; my $b = $3;
+ if ($a eq 'name') {
+ $name = $b;
+ } elsif ($a eq 'type') {
+ $environment = $b;
+ }
+ }
+ my $cmd = $name;
+ if ($environment) {
+ $cmd = "start" . $name;
+ }
+ my $comment = '';
+ my $description = '';
+ my @examples = ();
+ $data =~ /\<cd:description\>(.*)\<\/cd:description\>/s and $description = $1;
+ $data =~ /\<cd:comment\>(.*)\<\/cd:comment\>/s and $comment = $1;
+ while ($data =~ s/\<cd:example\>(.*?)\<\/cd:example\>//s) {
+ push @examples, $1;
+ }
+ if (length($comment) && $comment =~ /\S/) {
+ $commes {$filename}{$cmd} = $comment;
+ }
+ if (length($description) && $description =~ /\S/) {
+ $descrs {$filename}{$cmd} = $description;
+ }
+ my $testex = "@examples";
+ if (length($testex) && $testex =~ /\S/) {
+ $examps {$filename}{$cmd} = [@examples];
+ }
+ }
+ }
+ if ($extras) {
+ show('debug',"interface '$filename', $position\&$extras commands");
+ } else {
+ show('debug',"interface '$filename', $position commands");
+ }
+ } else {
+ show ('debug',"open() of ${path}$filename.xml failed");
+ }
+ }
+ $Interface = $filename ;
+}
+
+sub load_setups {
+ my ($primary) = @_;
+ # load all setup files, but default to $primary
+ my $t0 = [Time::HiRes::gettimeofday()];
+ foreach my $setup (@setup_files) {
+ if ($setup ne $primary) {
+ load_setup ($setup_path,$setup);
+ show('status',"loading '$setup' took " .Time::HiRes::tv_interval($t0) . " seconds");
+ $t0 = [Time::HiRes::gettimeofday()];
+ };
+ };
+ load_setup ($setup_path,$primary);
+ show('status',"loading '$primary' took " .Time::HiRes::tv_interval($t0) . " seconds");
+}
+
+my @history = ();
+my $current_history = 0;
+
+sub show_command {
+ my ($command,$nofix) = @_;
+ if (keys %{$setups{$Interface}}) {
+ my $key = '';
+ if (defined $command && $command &&
+ (defined $setups{$Interface}{$command} ||
+ defined $setups{$Interface}{"start" . $command})) {
+ $key = $command;
+ my $whence =$locations{$Interface}{$command};
+ $listbox -> selectionClear ('0.0','end') ;
+ $listbox -> selectionSet($whence,$whence);
+ $listbox -> activate($whence);
+ $listbox -> see($whence);
+ } else {
+ $listbox -> selectionSet('0.0','0.0') unless $listbox->curselection();
+ $key = $listbox -> get($listbox->curselection()) ;
+ }
+ show('debug',"current command: $current_command");
+ show('debug'," new command: $key");
+ $current_command = $key ;
+ $textwindow -> delete ('1.0', 'end' ) ;
+ $partbuttons{"Command"}->select();
+ $partbuttons{"Command"}->configure('-state' => 'normal');
+ $partbuttons{"Description"}->configure('-state' => 'disabled');
+ $partbuttons{"Comments"}->configure('-state' => 'disabled');
+ $partbuttons{"Examples"}->configure('-state' => 'disabled');
+ if (defined $commes{$Interface}{$key}) {
+ $partbuttons{"Comments"}->configure('-state' => 'normal');
+ }
+ if (defined $descrs{$Interface}{$key}) {
+ $partbuttons{"Description"}->configure('-state' => 'normal');
+ }
+ if (defined $examps{$Interface}{$key}) {
+ $partbuttons{"Examples"}->configure('-state' => 'normal');
+ }
+ unless (defined $nofix && $nofix) {
+ push @history, $key;
+ $current_history = $#history;
+ }
+ do_update_command ($key) ;
+ $mainwindow -> update();
+ $mainwindow -> focus() ;
+ }
+}
+
+sub prev_command {
+ if ($current_history > 0) {
+ $current_history--;
+ show_command($history[$current_history],1);
+ }
+}
+
+sub next_command {
+ unless ($current_history == $#history) {
+ $current_history++;
+ show_command($history[$current_history],1);
+ }
+}
+
+sub show_description {
+ $textwindow -> delete ('1.0', 'end' ) ;
+ if (defined $descrs{$current_interface}{$current_command}) {
+ $textwindow-> insert ('end',$descrs{$current_interface}{$current_command});
+ }
+ $mainwindow -> update();
+ $mainwindow -> focus() ;
+}
+
+sub show_comments {
+ $textwindow -> delete ('1.0', 'end' ) ;
+ if (defined $commes{$current_interface}{$current_command}) {
+ $textwindow-> insert ('end',$commes{$current_interface}{$current_command});
+ }
+ $mainwindow -> update();
+ $mainwindow -> focus() ;
+}
+
+
+sub show_examples {
+ $textwindow -> delete ('1.0', 'end' ) ;
+ if (defined $examps{$current_interface}{$current_command}) {
+ $textwindow-> insert ('end',join("\n\n",@{$examps{$current_interface}{$current_command}}));
+ }
+ $mainwindow -> update();
+ $mainwindow -> focus() ;
+}
+
+
+
+
+sub has_attr {
+ my ($elem,$att,$val) = @_;
+ return 1 if (attribute($elem,$att) eq $val);
+ return 0;
+}
+
+
+sub view_post {
+ my ($stuff,$extra) = @_;
+ $extra = '' unless defined $extra;
+ $stuff =~ /^(.)(.*?)(.)$/;
+ my ($l,$c,$r) = ($1,$2,$3);
+ if ($l eq '[' || $l eq '(') {
+ return ($l,['symbol','par',$extra],$c,['par',$extra],$r,['symbol','par',$extra],"\n",'par');
+ } else {
+ return ($l,['argument','par',$extra],$c,['par',$extra],$r,['argument','par',$extra],"\n",'par');
+ }
+}
+
+sub view_pre {
+ my ($stuff) = @_;
+ $stuff =~ /^(.)(.*?)(.)$/;
+ my ($l,$c,$r) = ($1,$2,$3);
+ if ($l eq '[' || $l eq '(') {
+ return ($l,['symbol'],$c,'',$r,['symbol']);
+ } else {
+ return ($l,['argument'],$c,'',$r,['argument']);
+ }
+}
+
+sub create_setup_arguments {
+ my $argx = shift;
+ my @predisp = ();
+ my @postdisp = ();
+ foreach my $arg (children($argx)) {
+ if (name($arg) eq 'cd:keywords') {
+ # children are Constant* & Inherit? & Variable*
+ my @children = children($arg);
+ my $optional = (attribute($arg,'optional') eq 'yes' ? 'optional' : '');
+ if (@children){
+ push @predisp,'[', ['symbol',$optional];
+ if (has_attr($arg,'list', 'yes')) {
+ if (has_attr($arg,'interactive', 'exclusive')) {
+ push @predisp, '...', '';
+ } else {
+ push @predisp, '..,...,..', '';
+ }
+ } else {
+ push @predisp,'...', '';
+ }
+ push @predisp,']', ['symbol',$optional];
+ }
+ push @postdisp,'[', ['symbol','par',$optional];
+ my $firsttrue = 1;
+ foreach my $kwd (@children) {
+ if ($firsttrue) {
+ $firsttrue = 0;
+ } else {
+ push @postdisp,', ', ['symbol','par'];
+ }
+ if (name($kwd) eq 'cd:constant' ||
+ name($kwd) eq 'cd:variable') {
+ my $v = attribute($kwd,'type');
+ my $def = '';
+ my $var = '';
+ $var = 'variable' if (name($kwd) eq 'cd:variable') ;
+ $def = 'default' if (has_attr($kwd,'default', 'yes'));
+ if ($v =~ /^cd:/) {
+ $v =~ s/^cd://;
+ $v .= "s" if (has_attr($arg,'list', 'yes'));
+ push @postdisp, $v, ['user',$def,'par',$var];
+ } else {
+ push @postdisp, $v, [$def,'par',$var];
+ }
+ } elsif (name($kwd) eq 'cd:inherit') {
+ my $v = attribute($kwd,'name');
+ $textwindow -> tag ('configure', $v , -foreground => 'blue3',-underline => 1 ) ;
+ $textwindow -> tagBind($v,'<ButtonPress>',sub {show_command($v)} );
+ push @postdisp,"see ","par", "$v", [$v,'par'];
+ }
+ }
+ push @postdisp,']', ['symbol','par',$optional];
+ push @postdisp,"\n", 'par';
+ } elsif (name($arg) eq 'cd:assignments') {
+ # children are Parameter* & Inherit?
+ my @children = children($arg);
+ my $optional = (attribute($arg,'optional') eq 'yes' ? 'optional' : '');
+ if (@children) {
+ push @predisp,'[', ['symbol',$optional];
+ if (has_attr($arg,'list', 'yes')) {
+ push @predisp, '..,..=..,..', '';
+ } else {
+ push @predisp,'..=..', '';
+ }
+ push @predisp,']', ['symbol',$optional];
+ push @postdisp,'[', ['symbol','par',$optional];
+ my $isfirst = 1;
+ foreach my $assn (@children) {
+ if ($isfirst) {
+ $isfirst = 0;
+ } else {
+ push @postdisp,",\n ", ['symbol','par'];
+ }
+ if (name($assn) eq 'cd:parameter') {
+ push @postdisp,attribute($assn,'name'), 'par';
+ push @postdisp,'=', ['symbol','par'];
+ my $firstxtrue = 1;
+ foreach my $par (children($assn)) {
+ if ($firstxtrue) {
+ $firstxtrue = 0;
+ } else {
+ push @postdisp,'|', ['or','par'];
+ }
+ if (name($par) eq 'cd:constant' || name($par) eq 'cd:variable') {
+ my $var = '';
+ $var = 'variable' if name($par) eq 'cd:variable';
+ my $v = attribute($par,'type');
+ if ($v =~ /^cd:/) {
+ $v =~ s/^cd://;
+ push @postdisp,$v, ['user','par',$var];
+ } else {
+ push @postdisp,$v, ['par',$var];
+ }
+ }
+ }
+ } elsif (name($assn) eq 'cd:inherit') {
+ my $v = attribute($assn,'name');
+ $textwindow -> tag ('configure', $v , -foreground => 'blue3',-underline => 1 ) ;
+ $textwindow -> tagBind($v,'<ButtonPress>',sub {show_command($v)} );
+ push @postdisp,"see ","par", "$v", [$v,'par'];
+ }
+ }
+ push @postdisp,"]", ['symbol','par',$optional], "\n", '';
+ }
+ } elsif (name($arg) eq 'cd:content') {
+ push @predisp, view_pre('{...}');
+ push @postdisp, view_post('{...}');
+ } elsif (name($arg) eq 'cd:triplet') {
+ if (has_attr($arg,'list','yes')) {
+ push @predisp, view_pre('[x:y:z=,..]');
+ push @postdisp,view_post('[x:y:z=,..]');
+ } else {
+ push @predisp, view_pre('[x:y:z=]');
+ push @postdisp,view_post('[x:y:z=]');
+ }
+ } elsif (name($arg) eq 'cd:reference') {
+ my $optional = (attribute($arg,'optional') eq 'yes' ? 'optional' : '');
+ if (has_attr($arg,'list','yes')) {
+ push @postdisp, view_post('[ref,..]',$optional);
+ push @predisp, view_pre('[ref,..]');
+ } else {
+ push @postdisp, view_post('[ref]',$optional);
+ push @predisp, view_pre('[ref]');;
+ }
+ } elsif (name($arg) eq 'cd:word') {
+ if (has_attr($arg,'list','yes')) {
+ push @predisp, view_pre ('{...,...}');
+ push @postdisp,view_post('{...,...}');
+ } else {
+ push @predisp, view_pre('{...}');
+ push @postdisp, view_post('{...}');
+ }
+ } elsif (name($arg) eq 'cd:nothing') {
+ my $sep = attribute($arg,'separator');
+ if ($sep) {
+ if($sep eq 'backslash') {
+# push @postdisp,'\\\\','par';
+ push @predisp,'\\\\','';
+ } else {
+# push @postdisp,$sep,'par';
+ push @predisp,$sep,'';
+ }
+ }
+ push @predisp,'...','';
+ push @postdisp,'text',['variable','par'],"\n",'par';
+ } elsif (name($arg) eq 'cd:file') {
+ push @predisp,'...',['default'];
+ push @postdisp,'...',['default','par'],"\n",'par';
+ } elsif (name($arg) eq 'cd:csname') {
+ push @predisp,'\command',['command'];
+ push @postdisp,'\command',['command','par'],"\n",'par';
+ } elsif (name($arg) eq 'cd:index') {
+ if (has_attr($arg,'list','yes')) {
+ push @predisp,view_pre('{..+...+..}');
+ push @postdisp,view_post('{..+...+..}');
+ } else {
+ push @predisp, view_pre('{...}');
+ push @postdisp,view_post('{...}');
+ }
+ } elsif (name($arg) eq 'cd:position') {
+ if (has_attr($arg,'list','yes')) {
+ push @predisp,view_pre('(...,...)');
+ push @postdisp,view_post('(...,...)');
+ } else {
+ push @predisp,view_pre('(...)');
+ push @postdisp,view_post('(...)');
+ }
+ } elsif (name($arg) eq 'cd:displaymath') {
+ push @predisp, ('$$',['argument'],'...','','$$',['argument']);
+ push @postdisp, ('$$',['argument','par'],'...',['par'],'$$',['argument','par']);
+ } elsif (name($arg) eq 'cd:tex') {
+ my $sep = attribute($arg,'separator');
+ if ($sep) {
+ if($sep eq 'backslash') {
+# push @postdisp,'\\\\','par';
+ push @predisp,'\\\\','';
+ } else {
+# push @postdisp,$sep,'par';
+ push @predisp,$sep,'';
+ }
+ }
+ my $cmd = "\\" . attribute($arg,'command');
+ push @predisp,$cmd,'';
+# push @postdisp,$cmd,['command','par'],"\n",'par';
+ }
+ }
+ return (\@predisp,\@postdisp);
+}
+
+
+# <foo><head id="a">Hello <em>there</em></head><bar>Howdy<ref/></bar>do</foo>
+#
+# would be:
+#
+# Tag Content
+# ==================================================================
+# [foo, [{}, head, [{id => "a"}, 0, "Hello ", em, [{}, 0, "there"]],
+# bar, [ {}, 0, "Howdy", ref, [{}]],
+# 0, "do"
+# ]
+# ]
+
+sub attribute {
+ my ($elem,$att) = @_;
+ if (defined $elem->[1] && defined $elem->[1]->[0] && defined $elem->[1]->[0]->{$att}) {
+ my $ret = $elem->[1]->[0]->{$att};
+ show ('debug',"returning attribute $att=$ret");
+ return $elem->[1]->[0]->{$att};
+ } else {
+ return '';
+ }
+}
+
+sub name {
+ my ($elem) = @_;
+ if (defined $elem->[0] ) {
+ return $elem->[0];
+ } else {
+ return '';
+ }
+}
+
+# return all children at a certain level
+sub children {
+ my ($elem) = @_;
+ if (defined $elem->[1] && defined $elem->[1]->[1]) {
+ my @items = @{$elem->[1]};
+ shift @items ; # deletes the attribute.
+ my @ret = ();
+ while (@items) {
+ push @ret, [shift @items, shift @items];
+ }
+ return @ret;
+ } else {
+ return ();
+ }
+}
+
+# return the first child with the right name
+sub find {
+ my ($elem,$name) = @_;
+ if ($elem->[0] eq $name) {
+ return $elem;
+ }
+ if (ref($elem->[1]) eq 'ARRAY') {
+ my @contents = @{$elem->[1]};
+ shift @contents;
+ while (my $ename = shift @contents) {
+ my $con = shift @contents;
+ if ($ename eq $name) {
+ return [$ename,$con];
+ }
+ }
+ }
+ return [];
+}
+
+sub do_update_command # type: 0=display, 1=compute only
+ { my ($command, $type) = @_ ;
+ $type = 0 unless defined $type;
+ my $setup;
+ if (!defined $trees{$Interface}{$command}) {
+ my $parser = XML::Parser->new('Style' => 'Tree');
+ $trees{$Interface}{$command} = $parser->parse($setups{$Interface}{$command});
+ }
+ $setup = $trees{$Interface}{$command} ;
+ my $predisp = undef;
+ my $postdisp = undef;
+ my @cmddisp = ();
+ my @cmddispafter = ();
+ my $pradisp = undef;
+ my $altdisp = undef;
+ if (attribute($setup,'file')) {
+ my $filename = attribute($setup,'file');
+ my $fileline = attribute($setup,'line') || 0;
+ $textwindow->insert ('end',"$filename:${fileline}::\n\n", '' );
+ }
+ # start with backslash
+ push @cmddisp, "\\", 'command' ;
+ my $env = 0;
+ if (has_attr($setup,'type','environment')) {
+ $env = 1;
+ }
+ if ($env) { push @cmddisp, "start", 'command' ; }
+ if ($env) { push @cmddispafter, " ... ", '', "\\stop", 'command' ; }
+ my $seq = find($setup,'cd:sequence');
+ # display rest of command name
+ foreach my $seqpart (children($seq)) {
+ my $text = attribute($seqpart,'value');
+ if (name($seqpart) eq 'cd:variable') {
+ push @cmddisp, $text, ['command','user'];
+ if ($env) { push @cmddispafter, $text, ['command','user']; }
+ } elsif (name($seqpart) eq 'cd:string') {
+ push @cmddisp, $text, 'command';
+ if ($env) { push @cmddispafter, $text, 'command'; }
+ }
+ }
+ #
+ my $args = find($setup,'cd:arguments');
+ # display commands
+ if ($args) {
+ my $curarg = 0;
+ foreach my $arg (children($args)) {
+ if (name($arg) eq 'cd:choice') {
+ my ($a,$b) = children($arg);
+ ($predisp,$postdisp) = create_setup_arguments(['cd:arguments',[{}, @$a]]);
+ ($pradisp,$altdisp) = create_setup_arguments(['cd:arguments',[{}, @$b]]);
+ } else {
+ ($predisp,$postdisp) = create_setup_arguments($args);
+ }
+ $curarg++;
+ }
+ }
+ return if $type;
+ if(defined $postdisp) {
+ if(defined $altdisp) {
+ $textwindow->insert('end',@cmddisp,@$predisp,@cmddispafter, "\n",'',
+ @cmddisp,@$pradisp,@cmddispafter, "\n\n",'',
+ @cmddisp, "\n",'',
+ @$postdisp, "\n",'',
+ @cmddisp, "\n",'',
+ @$altdisp);
+ } else {
+ $textwindow->insert('end',@cmddisp,@$predisp, @cmddispafter ,"\n\n",'',
+ @cmddisp,"\n",'',
+ @$postdisp);
+ }
+ } else {
+ $textwindow->insert('end',@cmddisp);
+ }
+}
+
+
+#D The next feature is dedicated to Tobias, who suggested
+#D it, and Taco, who saw it as yet another proof of the
+#D speed of \PERL. It's also dedicated to Ton, who needs it
+#D for translating the big manual.
+
+sub handle_request {
+ my $index = $listbox -> index('end') ;
+ return unless $index;
+ my $req = $request -> get ;
+ return unless $req;
+ $req =~ s/\\//o ;
+ $req =~ s/\s//go ;
+ $request -> delete('0','end') ;
+ $request -> insert('0',$req) ;
+ return unless $req;
+ my ($l,$c) = split (/\./,$index) ;
+ for (my $i=0;$i<=$l;$i++) {
+ $index = "$i.0" ;
+ my $str = $listbox -> get ($index, $index) ;
+ if (defined $str && ref($str) eq 'ARRAY') {
+ $str = "@{$str}";
+ }
+ if (defined $str && $str =~ /^$req/) {
+ show_command($str) ;
+ return ;
+ }
+ }
+}
+
+sub insert_request {
+ my ($self, $chr) = @_ ;
+ # don't echo duplicate if $chr was keyed in in the (focussed) entrybox
+ $request -> insert ('end', $chr) unless $self eq $request;
+ handle_request();
+}
+
+sub delete_request {
+ my $self = shift ;
+ # delete last character, carefully
+ if ($self ne $request) {
+ my $to = $request -> index ('end') ;
+ my $from = $to - 1 ;
+ if ($from<0) { $from = 0 }
+ $request -> delete ($from,$to);
+ }
+ handle_request();
+}
+
+sub new_request {
+ $request -> delete (0,'end') ;
+ handle_request();
+}
+
diff --git a/Master/texmf-dist/scripts/context/perl/texutil.pl b/Master/texmf-dist/scripts/context/perl/texutil.pl
new file mode 100644
index 00000000000..0a0d2975354
--- /dev/null
+++ b/Master/texmf-dist/scripts/context/perl/texutil.pl
@@ -0,0 +1,2902 @@
+eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}' && eval 'exec perl -S $0 $argv:q'
+ if 0;
+
+#D \module
+#D [ file=texutil.pl,
+#D version=2003.09.16,
+#D title=pre- and postprocessing utilities,
+#D subtitle=\TEXUTIL,
+#D author=Hans Hagen,
+#D date=\currentdate,
+#D copyright={PRAGMA / Hans Hagen \& Ton Otten}]
+#C
+#C This module is part of the \CONTEXT\ macro||package and is
+#C therefore copyrighted by \PRAGMA. See licen-en.pdf for
+#C details.
+
+# much functionality will move to ctxtools, xmltools and pdftools; that way texutil
+# becomes limited to tui processing only, which is cleaner (also for taco's binary
+# version)
+
+# Thanks to Tobias Burnus for the german translations.
+# Thanks to Thomas Esser for hooking it into web2c
+# Thanks to Taco Hoekwater for making the file -w proof and some fixes
+# Thanks to Alex Knowles and friends for the right JPG specs
+# Thanks to Sebastian Rahtz for the eps to PDF method
+# Thanks to Fabrice Popineau for windows bin code
+
+#D We started with a hack provided by Thomas Esser. This
+#D expression replaces the unix specific line \type
+#D {#!/usr/bin/perl}.
+
+# undocumented:
+#
+# --analyze file.pdf : reports some statistics
+# --purge [jobname] : removes temporary files
+# --purgeall [jobname] : removes all temporary files
+
+#D This is \TEXUTIL, a utility program (script) to be used
+#D alongside the \CONTEXT\ macro package. This \PERL\ script is
+#D derived from the \MODULA\ version and uses slightly better
+#D algoritms for sanitizing \TEX\ specific (sub|)|strings.
+#D
+#D This implementation has some features not found in the
+#D binary version, like scanning illustrations other than \EPS.
+#D I would suggest to keep an eye on the version number:
+
+$Program = "TeXUtil 9.0.0 - ConTeXt / PRAGMA ADE 1992-2004" ;
+
+#D By the way, this is my first \PERL\ script, which means
+#D that it will be improved as soon as I find new and/or more
+#D suitable solutions in the \PERL\ manuals. As can be seen in
+#D the definition of \type{$Program}, this program is part of
+#D the \CONTEXT\ suite, and therefore can communicate with the
+#D users in english as well as some other languages. One can
+#D set his favourite language by saying something like:
+
+#D \starttypen
+#D perl texutil.pl --int=de --fig *.eps *.tif *.pdf *.png *.jpg
+#D \stoptypen
+#D
+#D or simpler:
+#D
+#D \starttypen
+#D perl texutil.pl --fig *.*
+#D \stoptypen
+
+#D Of course one can also say \type{--interface=nl}, which
+#D happens to be my native language.
+
+#D I won't go into too much detail on the algoritms used.
+#D The next few pages show the functionality as reported by the
+#D helpinformation and controled by command line arguments
+#D and can serve as additional documentation.
+
+#D \TEXUTIL\ can handle different tasks; which one is active
+#D depends on the command line arguments. These are handled by
+#D a \PERL\ system module. This means that, at least for the
+#D moment, there is no external control as provided by the
+#D \PRAGMA\ environment system.
+
+use Getopt::Long ;
+use FindBin ;
+
+#D We don't want error messages and accept partial switches,
+#D which saves users some typing.
+
+$Getopt::Long::passthrough = 1 ; # no error message
+$Getopt::Long::autoabbrev = 1 ; # partial switch accepted
+
+#D We also predefine the interface language and set a boolean
+#D that keeps track of unknown options. \voetnoot {This feature
+#D is still to be implemented.}
+
+$UserInterface = "en" ;
+$UnknownOptions = 0 ;
+$TcXPath = '' ;
+
+#D We need this for calling GS.
+
+use Config ;
+
+my $dosish = ($Config{'osname'} =~ /^(ms)?dos|^os\/2|^(ms|cyg)win/i) ;
+
+#D Here come the options:
+
+&GetOptions
+ ("references" => \$ProcessReferences,
+ "ij" => \$ProcessIJ,
+ "high" => \$ProcessHigh,
+ "quotes" => \$ProcessQuotes,
+ "tcxpath=s" => \$TcXPath,
+ "documents" => \$ProcessDocuments,
+ "type=s" => \$ProcessType,
+ "outputfile=s" => \$ProcessOutputFile,
+ "sources" => \$ProcessSources,
+ "setups" => \$ProcessSetups,
+ "templates" => \$ProcessTemplates,
+ "infos" => \$ProcessInfos,
+ "figures" => \$ProcessFigures,
+ "epspage" =>\$ProcessEpsPage,
+ "epstopdf" =>\$ProcessEpsToPdf,
+ "logfile" => \$ProcessLogFile,
+ "box" =>\$ProcessBox,
+ "hbox" =>\$ProcessHBox,
+ "vbox" =>\$ProcessVBox,
+ "criterium=f" =>\$ProcessCriterium,
+ "unknown" =>\$ProcessUnknown,
+ "purge" => \$PurgeFiles,
+ "purgeall" => \$PurgeAllFiles,
+ "analyze" => \$AnalyzeFile,
+ "filter" => \$FilterPages,
+ "help" => \$ProcessHelp,
+ "silent" => \$ProcessSilent,
+ "verbose" => \$ProcessVerbose,
+ "interface=s" => \$UserInterface) ;
+
+# A bit old, this code, could be an array. Anyhow, we will
+# replace texutil soon.
+
+$InputFile = "@ARGV" ; # niet waterdicht
+
+#D We need some hacks to suppress terminal output. This
+#D piece of code is based on page~193 of "Programming Perl".
+
+$ProgramLog = "texutil.log" ;
+
+# Well, it seems that unix' symlinks are sensitive for being
+# hijacked. The assumption is that a known file can be a problem.
+# Of course when one knows that certains files are processed,
+# the names are always known and hijacking can always take
+# place. But let's use a slightly less predictable name here:
+#
+# if ((@ARGV[0]) && (@ARGV[0] ne "")) {
+# $ProgramLog = "@ARGV[0]-$ProgramLog" ;
+# } else {
+# # no need to be silent
+# $ProcessSilent = 0 ;
+# }
+#
+# or better, let's drop this feature, since i'm not in the mood
+# now to test hacks like this (i'll just wait till the age of
+# computer anarchy has ended).
+
+$ProgramLog = "/dev/null" ;
+
+# Maybe we should just write to the nul device. (In the rewritten
+# version I can treat unix more strick.)
+
+sub RedirectTerminal
+ { open SAVEDSTDOUT, ">&STDOUT" ;
+ open STDOUT, ">$ProgramLog" ;
+ select STDOUT; $| = 1 }
+
+#D And, indeed:
+
+if ($ProcessSilent)
+ { RedirectTerminal }
+else
+ { $ProcessVerbose = 0 }
+
+#D We can temporary open the terminal channel.
+
+sub OpenTerminal
+ { close STDOUT ;
+ open STDOUT, ">&SAVEDSTDOUT" }
+
+sub CloseTerminal
+ { open SAVEDSTDOUT, ">&STDOUT" ;
+ open STDOUT, ">>$ProgramLog" ;
+ select STDOUT; $| = 1 }
+
+#D By default wildcards are expanded into a list. The
+#D subroutine below is therefore only needed when no file or
+#D pattern is given.
+
+sub CompFileName
+ { my ($a,$b) = @_ ;
+ my ($fa,$sa) = split(/\./,$a) ;
+ my ($fb,$sb) = split(/\./,$b) ;
+ if (($sa =~ /^\d+$/o)&&($sb =~ /^\d+$/o))
+ { $a = $fa . "." . sprintf("%10d",$sa) ; $a =~ s/\s/0/o ;
+ $b = $fb . "." . sprintf("%10d",$sb) ; $b =~ s/\s/0/o }
+ return (lc ($a) cmp lc ($b)) }
+
+sub CheckInputFiles
+ { @UserSuppliedFiles = glob $_[0] ;
+ @UserSuppliedFiles = sort { CompFileName($a,$b) } @UserSuppliedFiles }
+
+#D The next subroutine takes care of the optional output
+#D filename (e.g. for figure dimensions).
+
+$ProcessOutputFile = "" ;
+
+my $Rubish ;
+
+sub SetOutputFile
+ { ($OutFilNam, $OutFilSuf) = split (/\./, $_[0], 2) ;
+ unless ($ProcessOutputFile eq "")
+ { $ProcessOutputFile .= "." . $OutFilSuf ;
+ ($OutFilNam, $OutFilSuf, $Rubish) = split (/\./, $ProcessOutputFile , 3)}
+ $OutputFile = $OutFilNam . "." . $OutFilSuf }
+
+#D Sometimes we need to split filenames.
+
+my ($FileName, $FileSuffix) = ("","") ;
+
+sub SplitFileName
+ { my $Rubish = "" ;
+ if ($_[0] =~ /^\.\//)
+ { ($Rubish, $FileName) = split ( /^\.\//, $_[0], 2) }
+ else
+ { $FileName = $_[0] }
+ return split (/\./, $FileName, 2) }
+
+#D In order to support multiple interfaces, we save the
+#D messages in a hash table. As a bonus we can get a quick
+#D overview of the messages we deal with.
+
+my %MS ;
+
+sub Report
+ { foreach $_ (@_)
+ { if (! defined $MS{$_})
+ { print $_ }
+ else
+ { print $MS{$_} }
+ print " " }
+ print "\n" }
+
+#D The messages are saved in a hash table and are called
+#D by name. This contents of this table depends on the
+#D interface language in use.
+
+#D \startcompressdefinitions
+
+if ($UserInterface eq "nl")
+
+ { # begin of dutch section
+
+ $MS{"ProcessingReferences"} = "commando's, lijsten en indexen verwerken" ;
+ $MS{"MergingReferences"} = "indexen samenvoegen" ;
+ $MS{"GeneratingDocumentation"} = "ConTeXt documentatie file voorbereiden" ;
+ $MS{"GeneratingSources"} = "ConTeXt broncode file genereren" ;
+ $MS{"FilteringDefinitions"} = "ConTeXt definities filteren" ;
+ $MS{"CopyingTemplates"} = "TeXEdit toets templates copieren" ;
+ $MS{"CopyingInformation"} = "TeXEdit help informatie copieren" ;
+ $MS{"GeneratingFigures"} = "figuur file genereren" ;
+ $MS{"FilteringLogFile"} = "log file filteren (poor mans version)" ;
+
+ $MS{"SortingIJ"} = "IJ sorteren onder Y" ;
+ $MS{"ConvertingHigh"} = "hoge ASCII waarden converteren" ;
+ $MS{"ProcessingQuotes"} = "characters met accenten afhandelen" ;
+ $MS{"ForcingFileType"} = "filetype instellen" ;
+ $MS{"UsingEps"} = "EPS files afhandelen" ;
+ $MS{"UsingTif"} = "TIF files afhandelen" ;
+ $MS{"UsingPdf"} = "PDF files afhandelen" ;
+ $MS{"UsingPng"} = "PNG files afhandelen" ;
+ $MS{"UsingJpg"} = "JPG files afhandelen" ;
+ $MS{"EpsToPdf"} = "EPS converteren naar PDF";
+ $MS{"EpsPage"} = "EPS pagina instellen";
+ $MS{"FilteringBoxes"} = "overfull boxes filteren" ;
+ $MS{"ApplyingCriterium"} = "criterium toepassen" ;
+ $MS{"FilteringUnknown"} = "onbekende ... filteren" ;
+
+ $MS{"NoInputFile"} = "geen invoer file opgegeven" ;
+ $MS{"NoOutputFile"} = "geen uitvoer file gegenereerd" ;
+ $MS{"EmptyInputFile"} = "lege invoer file" ;
+ $MS{"NotYetImplemented"} = "nog niet beschikbaar" ;
+
+ $MS{"Action"} = " actie :" ;
+ $MS{"Option"} = " optie :" ;
+ $MS{"Error"} = " fout :" ;
+ $MS{"Remark"} = " opmerking :" ;
+ $MS{"SystemCall"} = " systeemaanroep :" ;
+ $MS{"BadSystemCall"} = " foute systeemaanroep :" ;
+ $MS{"MissingSubroutine"} = " onbekende subroutine :" ;
+
+ $MS{"EmbeddedFiles"} = " gebruikte files :" ;
+ $MS{"BeginEndError"} = " b/e fout in :" ;
+ $MS{"SynonymEntries"} = " aantal synoniemen :" ;
+ $MS{"SynonymErrors"} = " fouten :" ;
+ $MS{"RegisterEntries"} = " aantal ingangen :" ;
+ $MS{"RegisterErrors"} = " fouten :" ;
+ $MS{"PassedCommands"} = " aantal commando's :" ;
+
+ $MS{"MultiPagePdfFile"} = " te veel pagina's :" ;
+ $MS{"MissingMediaBox"} = " geen mediabox :" ;
+ $MS{"MissingBoundingBox"} = " geen boundingbox :" ;
+
+ $MS{"NOfDocuments"} = " documentatie blokken :" ;
+ $MS{"NOfDefinitions"} = " definitie blokken :" ;
+ $MS{"NOfSkips"} = " overgeslagen blokken :" ;
+ $MS{"NOfSetups"} = " gecopieerde setups :" ;
+ $MS{"NOfTemplates"} = " gecopieerde templates :" ;
+ $MS{"NOfInfos"} = " gecopieerde helpinfos :" ;
+ $MS{"NOfFigures"} = " verwerkte figuren :" ;
+ $MS{"NOfBoxes"} = " te volle boxen :" ;
+ $MS{"NOfUnknown"} = " onbekende ... :" ;
+
+ $MS{"InputFile"} = " invoer file :" ;
+ $MS{"OutputFile"} = " outvoer file :" ;
+ $MS{"FileType"} = " type file :" ;
+ $MS{"EpsFile"} = " eps file :" ;
+ $MS{"PdfFile"} = " pdf file :" ;
+ $MS{"TifFile"} = " tif file :" ;
+ $MS{"PngFile"} = " png file :" ;
+ $MS{"JpgFile"} = " jpg file :" ;
+ $MS{"MPFile"} = " metapost file :" ;
+
+ $MS{"LoadedFilter"} = " geladen filter :" ;
+ $MS{"RemappedKeys"} = " onderschepte keys :" ;
+ $MS{"WrongFilterPath"} = " fout filter pad :" ;
+
+ $MS{"Overfull"} = "te vol" ;
+ $MS{"Entries"} = "ingangen" ;
+ $MS{"References"} = "verwijzingen" ;
+
+ $MS{"PlugInInit"} = " plugin initialized :" ;
+ $MS{"PlugInReport"} = " plugin report :" ;
+
+ } # end of dutch section
+
+elsif ($UserInterface eq "de")
+
+ { # begin of german section
+
+ $MS{"ProcessingReferences"} = "Verarbeiten der Befehle, Listen und Register" ;
+ $MS{"MergingReferences"} = "Register verschmelzen" ;
+ $MS{"GeneratingDocumentation"} = "Vorbereiten der ConTeXt-Dokumentationsdatei" ;
+ $MS{"GeneratingSources"} = "Erstellen einer nur Quelltext ConTeXt-Datei" ;
+ $MS{"FilteringDefinitions"} = "Filtern der ConTeXt-Definitionen" ;
+ $MS{"CopyingTemplates"} = "Kopieren der TeXEdit-Test-key-templates" ;
+ $MS{"CopyingInformation"} = "Kopieren der TeXEdit-Hilfsinformation" ;
+ $MS{"GeneratingFigures"} = "Erstellen einer Abb-Uebersichtsdatei" ;
+ $MS{"FilteringLogFile"} = "Filtern der log-Datei" ;
+
+ $MS{"SortingIJ"} = "Sortiere IJ nach Y" ;
+ $MS{"ConvertingHigh"} = "Konvertiere hohe ASCII-Werte" ;
+ $MS{"ProcessingQuotes"} = "Verarbeiten der Akzentzeichen" ;
+ $MS{"ForcingFileType"} = "Dateityp einstellen" ;
+ $MS{"UsingEps"} = "EPS-Dateien verarbeite" ;
+ $MS{"UsingTif"} = "TIF-Dateien verarbeite" ;
+ $MS{"UsingPdf"} = "PDF-Dateien verarbeite" ;
+ $MS{"UsingPng"} = "PNG-Dateien verarbeite" ;
+ $MS{"UsingJpg"} = "JPG-Dateien verarbeite" ;
+ $MS{"EpsToPdf"} = "convert EPS to PDF";
+ $MS{"EpsPage"} = "setup EPS page";
+
+ $MS{"FilteringBoxes"} = "Filtern der ueberfuellten Boxen" ;
+ $MS{"ApplyingCriterium"} = "Anwenden des uebervoll-Kriteriums" ;
+ $MS{"FilteringUnknown"} = "Filter unbekannt ..." ;
+
+ $MS{"NoInputFile"} = "Keine Eingabedatei angegeben" ;
+ $MS{"NoOutputFile"} = "Keine Ausgabedatei generiert" ;
+ $MS{"EmptyInputFile"} = "Leere Eingabedatei" ;
+ $MS{"NotYetImplemented"} = "Noch nicht verfuegbar" ;
+
+ $MS{"Action"} = " Aktion :" ;
+ $MS{"Option"} = " Option :" ;
+ $MS{"Error"} = " Fehler :" ;
+ $MS{"Remark"} = " Anmerkung :" ;
+ $MS{"SystemCall"} = " system call :" ;
+ $MS{"BadSystemCall"} = " bad system call :" ;
+ $MS{"MissingSubroutine"} = " missing subroutine :" ;
+ $MS{"SystemCall"} = " Systemaufruf :" ;
+ $MS{"BadSystemCall"} = " Fehlerhafter Aufruf :" ;
+ $MS{"MissingSubroutine"} = " Fehlende Unterroutine :" ;
+
+ $MS{"EmbeddedFiles"} = " Eingebettete Dateien :" ;
+ $MS{"BeginEndError"} = " Beg./Ende-Fehler in :" ;
+ $MS{"SynonymEntries"} = " Synonymeintraege :" ;
+ $MS{"SynonymErrors"} = " Fehlerhafte Eintraege :" ;
+ $MS{"RegisterEntries"} = " Registereintraege :" ;
+ $MS{"RegisterErrors"} = " Fehlerhafte Eintraege :" ;
+ $MS{"PassedCommands"} = " Verarbeite Befehle :" ;
+
+ $MS{"MultiPagePdfFile"} = " zu viele Seiten :" ;
+ $MS{"MissingMediaBox"} = " fehlende mediabox :" ;
+ $MS{"MissingBoundingBox"} = " fehlende boundingbox :" ;
+
+ $MS{"NOfDocuments"} = " Dokumentbloecke :" ;
+ $MS{"NOfDefinitions"} = " Definitionsbloecke :" ;
+ $MS{"NOfSkips"} = "Uebersprungene Bloecke :" ;
+ $MS{"NOfSetups"} = " Kopierte setups :" ;
+ $MS{"NOfTemplates"} = " Kopierte templates :" ;
+ $MS{"NOfInfos"} = " Kopierte helpinfos :" ;
+ $MS{"NOfFigures"} = " Verarbeitete Abb. :" ;
+ $MS{"NOfBoxes"} = " Zu volle Boxen :" ;
+ $MS{"NOfUnknown"} = " Unbekannt ... :" ;
+
+ $MS{"InputFile"} = " Eingabedatei :" ;
+ $MS{"OutputFile"} = " Ausgabedatei :" ;
+ $MS{"FileType"} = " Dateityp :" ;
+ $MS{"EpsFile"} = " eps-Datei :" ;
+ $MS{"PdfFile"} = " pdf-Datei :" ;
+ $MS{"TifFile"} = " tif-Datei :" ;
+ $MS{"PngFile"} = " png-Datei :" ;
+ $MS{"JpgFile"} = " jpg-Datei :" ;
+ $MS{"MPFile"} = " metapost-Datei :" ;
+
+ $MS{"LoadedFilter"} = " loaded filter :" ; # tobias
+ $MS{"RemappedKeys"} = " remapped keys :" ; # tobias
+ $MS{"WrongFilterPath"} = " wrong filter path :" ; # tobias
+
+ $MS{"Overfull"} = "zu voll" ;
+ $MS{"Entries"} = "Eintraege" ;
+ $MS{"References"} = "Referenzen" ;
+
+ $MS{"ExtraProgram"} = " extra program :" ;
+ $MS{"PlugInInit"} = " plugin initialized :" ;
+ $MS{"PlugInReport"} = " plugin report :" ;
+
+ } # end of german section
+
+elsif ($UserInterface eq "it")
+
+ { # begin of italian section
+
+ $MS{"ProcessingReferences"} = "elaborazione di comandi, liste e registri" ;
+ $MS{"MergingReferences"} = "fusione dei registri" ;
+ $MS{"GeneratingDocumentation"} = "preparazione del file di documentazione ConTeXt" ;
+ $MS{"GeneratingSources"} = "generazione del solo sorgente ConTeXt" ;
+ $MS{"FilteringDefinitions"} = "filtraggio delle definizioni formali ConTeXt" ;
+ $MS{"CopyingTemplates"} = "copia dei modelli rapidi di voci di TeXEdit" ;
+ $MS{"CopyingInformation"} = "copia delle informazioni di aiuto di TeXEdit" ;
+ $MS{"GeneratingFigures"} = "generazione del file di elengo delle figure" ;
+ $MS{"FilteringLogFile"} = "filtraggio del file di log" ;
+
+ $MS{"SortingIJ"} = "IJ elencato sotto Y" ;
+ $MS{"ConvertingHigh"} = "conversione dei valori ASCII alti" ;
+ $MS{"ProcessingQuotes"} = "elaborazione dei caratteri accentati" ;
+ $MS{"ForcingFileType"} = "impostazine del tipo di file" ;
+ $MS{"UsingEps"} = "elaborazione del file EPS" ;
+ $MS{"UsingTif"} = "elaborazione del file TIF" ;
+ $MS{"UsingPdf"} = "elaborazione del file PDF" ;
+ $MS{"UsingPng"} = "elaborazione del file PNG" ;
+ $MS{"UsingJpg"} = "elaborazione del file JPG" ;
+ $MS{"EpsToPdf"} = "conversione da EPS a PDF";
+ $MS{"EpsPage"} = "impostazione pagina EPS";
+
+ $MS{"FilteringBoxes"} = "filtraggio delle overfull boxes" ;
+ $MS{"ApplyingCriterium"} = "applicazione del criterio overfull" ;
+ $MS{"FilteringUnknown"} = "filtraggio dei messaggi non conosciuti ..." ;
+
+ $MS{"NoInputFile"} = "nessun file di input specificato" ;
+ $MS{"NoOutputFile"} = "nessun file di output generato" ;
+ $MS{"EmptyInputFile"} = "file di input vuoto" ;
+ $MS{"NotYetImplemented"} = "non ancora disponibile" ;
+
+ $MS{"Action"} = " azione :" ;
+ $MS{"Option"} = " opzione :" ;
+ $MS{"Error"} = " errore :" ;
+ $MS{"Remark"} = " commento :" ;
+ $MS{"SystemCall"} = " chiamata di sistema :" ;
+ $MS{"BadSystemCall"} = "chiamata di sistema er :" ; # GB: Hans, I need more space!
+ $MS{"MissingSubroutine"} = " subroutine mancante :" ;
+
+ $MS{"EmbeddedFiles"} = " file inclusi :" ;
+ $MS{"BeginEndError"} = " errore di i/f in :" ;
+ $MS{"SynonymEntries"} = " voci di sinonimi :" ;
+ $MS{"SynonymErrors"} = " voci errate :" ;
+ $MS{"RegisterEntries"} = " voci di registro :" ;
+ $MS{"RegisterErrors"} = " voci errate :" ;
+ $MS{"PassedCommands"} = " comandi passati :" ;
+
+ $MS{"MultiPagePdfFile"} = " troppe pagine :" ;
+ $MS{"MissingMediaBox"} = " mediabox mancante :" ;
+ $MS{"MissingBoundingBox"} = " boundingbox mancante :" ;
+
+ $MS{"NOfDocuments"} = " blocchi di documento :" ;
+ $MS{"NOfDefinitions"} = "blocchi di definizioni :" ;
+ $MS{"NOfSkips"} = " blocchi saltati :" ;
+ $MS{"NOfSetups"} = " impostazioni copiate :" ;
+ $MS{"NOfTemplates"} = " modelli copiati :" ;
+ $MS{"NOfInfos"} = " helpinfo copiati :" ;
+ $MS{"NOfFigures"} = " figure elaborate :" ;
+ $MS{"NOfBoxes"} = " overfull boxes :" ;
+ $MS{"NOfUnknown"} = " sconosciuti ... :" ;
+
+ $MS{"InputFile"} = " file di input :" ;
+ $MS{"OutputFile"} = " file di output :" ;
+ $MS{"FileType"} = " tipo di file :" ;
+ $MS{"EpsFile"} = " file eps :" ;
+ $MS{"PdfFile"} = " file pdf :" ;
+ $MS{"TifFile"} = " file tif :" ;
+ $MS{"PngFile"} = " file png :" ;
+ $MS{"JpgFile"} = " file jpg :" ;
+ $MS{"MPFile"} = " file metapost :" ;
+
+ $MS{"LoadedFilter"} = " filtro caricato :" ;
+ $MS{"RemappedKeys"} = " voci rimappate :" ;
+ $MS{"WrongFilterPath"} = "percorso filtro errato :" ;
+
+ $MS{"Overfull"} = "overfull" ;
+ $MS{"Entries"} = "voci" ;
+ $MS{"References"} = "riferimenti" ;
+
+ $MS{"ExtraProgram"} = " extra program :" ;
+ $MS{"PlugInInit"} = " plugin initialized :" ;
+ $MS{"PlugInReport"} = " plugin report :" ;
+
+ } # end of italian section
+
+else
+
+ { # begin of english section
+
+ $MS{"ProcessingReferences"} = "processing commands, lists and registers" ;
+ $MS{"MergingReferences"} = "merging registers" ;
+ $MS{"GeneratingDocumentation"} = "preparing ConTeXt documentation file" ;
+ $MS{"GeneratingSources"} = "generating ConTeXt source only file" ;
+ $MS{"FilteringDefinitions"} = "filtering formal ConTeXt definitions" ;
+ $MS{"CopyingTemplates"} = "copying TeXEdit quick key templates" ;
+ $MS{"CopyingInformation"} = "copying TeXEdit help information" ;
+ $MS{"GeneratingFigures"} = "generating figure directory file" ;
+ $MS{"FilteringLogFile"} = "filtering log file" ;
+
+ $MS{"SortingIJ"} = "sorting IJ under Y" ;
+ $MS{"ConvertingHigh"} = "converting high ASCII values" ;
+ $MS{"ProcessingQuotes"} = "handling accented characters" ;
+ $MS{"ForcingFileType"} = "setting up filetype" ;
+ $MS{"UsingEps"} = "processing EPS-file" ;
+ $MS{"UsingTif"} = "processing TIF-file" ;
+ $MS{"UsingPdf"} = "processing PDF-file" ;
+ $MS{"UsingPng"} = "processing PNG-file" ;
+ $MS{"UsingJpg"} = "processing JPG-file" ;
+ $MS{"EpsToPdf"} = "convert EPS to PDF";
+ $MS{"EpsPage"} = "setup EPS page";
+
+ $MS{"FilteringBoxes"} = "filtering overfull boxes" ;
+ $MS{"ApplyingCriterium"} = "applying overfull criterium" ;
+ $MS{"FilteringUnknown"} = "filtering unknown ..." ;
+
+ $MS{"NoInputFile"} = "no input file given" ;
+ $MS{"NoOutputFile"} = "no output file generated" ;
+ $MS{"EmptyInputFile"} = "empty input file" ;
+ $MS{"NotYetImplemented"} = "not yet available" ;
+
+ $MS{"Action"} = " action :" ;
+ $MS{"Option"} = " option :" ;
+ $MS{"Error"} = " error :" ;
+ $MS{"Remark"} = " remark :" ;
+ $MS{"SystemCall"} = " system call :" ;
+ $MS{"BadSystemCall"} = " bad system call :" ;
+ $MS{"MissingSubroutine"} = " missing subroutine :" ;
+
+ $MS{"EmbeddedFiles"} = " embedded files :" ;
+ $MS{"BeginEndError"} = " b/e error in :" ;
+ $MS{"SynonymEntries"} = " synonym entries :" ;
+ $MS{"SynonymErrors"} = " bad entries :" ;
+ $MS{"RegisterEntries"} = " register entries :" ;
+ $MS{"RegisterErrors"} = " bad entries :" ;
+ $MS{"PassedCommands"} = " passed commands :" ;
+
+ $MS{"MultiPagePdfFile"} = " too many pages :" ;
+ $MS{"MissingMediaBox"} = " missing mediabox :" ;
+ $MS{"MissingBoundingBox"} = " missing boundingbox :" ;
+
+ $MS{"NOfDocuments"} = " document blocks :" ;
+ $MS{"NOfDefinitions"} = " definition blocks :" ;
+ $MS{"NOfSkips"} = " skipped blocks :" ;
+ $MS{"NOfSetups"} = " copied setups :" ;
+ $MS{"NOfTemplates"} = " copied templates :" ;
+ $MS{"NOfInfos"} = " copied helpinfos :" ;
+ $MS{"NOfFigures"} = " processed figures :" ;
+ $MS{"NOfBoxes"} = " overfull boxes :" ;
+ $MS{"NOfUnknown"} = " unknown ... :" ;
+
+ $MS{"InputFile"} = " input file :" ;
+ $MS{"OutputFile"} = " output file :" ;
+ $MS{"FileType"} = " file type :" ;
+ $MS{"EpsFile"} = " eps file :" ;
+ $MS{"PdfFile"} = " pdf file :" ;
+ $MS{"TifFile"} = " tif file :" ;
+ $MS{"PngFile"} = " png file :" ;
+ $MS{"JpgFile"} = " jpg file :" ;
+ $MS{"MPFile"} = " metapost file :" ;
+
+ $MS{"LoadedFilter"} = " loaded filter :" ;
+ $MS{"RemappedKeys"} = " remapped keys :" ;
+ $MS{"WrongFilterPath"} = " wrong filter path :" ;
+
+ $MS{"Overfull"} = "overfull" ;
+ $MS{"Entries"} = "entries" ;
+ $MS{"References"} = "references" ;
+
+ $MS{"ExtraProgram"} = " extra program :" ;
+ $MS{"PlugInInit"} = " plugin initialized :" ;
+ $MS{"PlugInReport"} = " plugin report :" ;
+
+ } # end of english section
+
+#D \stopcompressdefinitions
+
+#D Showing the banner (name and version of the program) and
+#D offering helpinfo is rather straightforward.
+
+sub ShowBanner
+ { Report("\n $Program\n") }
+
+sub ShowHelpInfo
+ { Report("HelpInfo") }
+
+#D The helpinfo is also saved in the hash table. This looks
+#D like a waste of energy and space, but the program gains
+#D readability.
+
+#D \startcompressdefinitions
+
+if ($UserInterface eq "nl")
+
+ { # begin of dutch section
+
+ $MS{"HelpInfo"} =
+
+" --references hulp file verwerken / tui->tuo \n" .
+" --ij : IJ als Y sorteren \n" .
+" --high : hoge ASCII waarden converteren \n" .
+" --quotes : quotes converteren \n" .
+" --tcxpath : tcx filter pad \n" .
+" \n" .
+" --purge(all) tijdelijke (klad) files verwijderen \n" .
+" \n" .
+" --documents documentatie file genereren / tex->ted \n" .
+" --sources broncode file genereren / tex->tes \n" .
+" --setups ConTeXt definities filteren / tex->texutil.tus \n" .
+" --templates TeXEdit templates filteren / tex->tud \n" .
+" --infos TeXEdit helpinfo filteren / tex->tud \n" .
+" \n" .
+" --figures eps figuren lijst genereren / *->texutil.tuf \n" .
+" --epspage : voorbereiden voor pdf \n" .
+" --epstopdf : omzetten naar pdf \n" .
+" \n" .
+" --logfile logfile filteren / log->$ProgramLog \n" .
+" --box : overfull boxes controleren \n" .
+" --criterium : overfull criterium in pt \n" .
+" --unknown :onbekende ... controleren \n" ;
+
+ } # end of dutch section
+
+elsif ($UserInterface eq "de")
+
+ { # begin of german section
+
+ $MS{"HelpInfo"} =
+
+" --references Verarbeiten der Hilfsdatei / tui->tuo \n" .
+" --ij : Sortiere IJ als Y \n" .
+" --high : Konvertiere hohe ASCII-Werte \n" .
+" --quotes : Konvertiere akzentuierte Buchstaben \n" .
+" --tcxpath : tcx Filter Path \n" .
+" \n" .
+" --purge(all) entferne temporaere ConTeXt-Dateien \n" .
+" \n" .
+" --documents Erstelle Dokumentationsdatei / tex->ted \n" .
+" --sources Erstelle reine Quelltextdateien / tex->tes \n" .
+" --setups Filtere ConTeXt-Definitionen / tex->texutil.tus\n" .
+" --templates Filtere TeXEdit-templates / tex->tud \n" .
+" --infos Filtere TeXEdit-helpinfo / tex->tud \n" .
+" \n" .
+" --figures Erstelle eps-Abbildungsliste / *->texutil.tuf \n" .
+" --epspage : Bereite fuer pdf vor \n" .
+" --epstopdf : Konvertiere zu pdf \n" .
+" \n" .
+" --logfile Filtere log-Datei / log->$ProgramLog \n" .
+" --box : Ueberpruefe uebervolle Boxen \n" .
+" --criterium : Uebervoll-Kriterium in pt \n" .
+" --unknown : Ueberpruefe auf unbekannte ... \n" ;
+
+ } # end of german section
+
+elsif ($UserInterface eq "it")
+
+ { # begin of italian section GB: Hans, I need more space!
+
+ $MS{"HelpInfo"} =
+
+" --references elabora file ausiliari / tui->tuo \n" .
+" --ij : elenca IJ come Y \n" .
+" --high : converti i valori ASCII alti \n" .
+" --quotes : converti caratteri accentati \n" .
+" --tcxpath : percorso del filtro tcx \n" .
+" \n" .
+" --purge(all) rimuovi i file temporanei ConTeXt \n" .
+" \n" .
+" --documents genera file di documentazione / tex->ted \n" .
+" --sources genera solo sorgente / tex->tes \n" .
+" --setups filtra definizioni ConTeXt / tex->texutil.tus \n" .
+" --templates filtra modelli TeXEdit / tex->tud \n" .
+" --infos filtra helpinfo TeXEdit / tex->tud \n" .
+" \n" .
+" --figures genera lista figure eps / *->texutil.tuf \n" .
+" --epspage : prepara per pdf \n" .
+" --epstopdf : converti in pdf \n" .
+" \n" .
+" --logfile filtra logfile / log->$ProgramLog \n" .
+" --box : controlla overful boxes \n" .
+" --criterium : criterio overfull in pt \n" .
+" --unknown : controlla sconosciuti ... \n" ;
+
+ } # end of italian section
+
+else
+
+ { # begin of english section
+
+ $MS{"HelpInfo"} =
+
+" --references process auxiliary file / tui->tuo \n" .
+" --ij : sort IJ as Y \n" .
+" --high : convert high ASCII values \n" .
+" --quotes : convert quotes characters \n" .
+" --tcxpath : tcx filter path \n" .
+" \n" .
+" --purge(all) clean up temporary context files \n" .
+" \n" .
+" --documents generate documentation file / tex->ted \n" .
+" --sources generate source only file / tex->tes \n" .
+" --setups filter ConTeXt definitions / tex->texutil.tus \n" .
+" --templates filter TeXEdit templates / tex->tud \n" .
+" --infos filter TeXEdit helpinfo / tex->tud \n" .
+" \n" .
+" --figures generate eps figure list / *->texutil.tuf \n" .
+" --epspage : prepare for pdf \n" .
+" --epstopdf : convert to pdf \n" .
+" \n" .
+" --logfile filter logfile / log->$ProgramLog \n" .
+" --box : check overful boxes \n" .
+" --criterium : overfull criterium in pt \n" .
+" --unknown : check unknown ... \n" ;
+
+ } # end of english section
+
+#D \stopcompressdefinitions
+
+#D In order to sort strings correctly, we have to sanitize
+#D them. This is especially needed when we include \TEX\
+#D commands, quotes characters and compound word placeholders.
+#D
+#D \startopsomming[opelkaar]
+#D \som \type{\name}: csnames are stripped
+#D \som \type{{}}: are removed
+#D \som \type{\"e}: and alike are translated into \type{"e} etc.
+#D \som \type{"e}: is translated into an \type{e} and \type{b} etc.
+#D \som \type{||}: becomes \type{-}
+#D \som \type{\-}: also becomes \type{-}
+#D \som \type{<*..>}: becomes \type{..} (internal XML entity)
+#D \stopopsomming
+#D
+#D Of course other accented characters are handled too. The
+#D appended string is responsible for decent sorting.
+#D
+#D \startPL
+#D $TargetString = SanitizedString ( $SourceString ) ;
+#D \stopPL
+#D
+#D The sort order depends on the ordering in array
+#D \type{$ASCII}:
+
+$ASCII{"^"} = "a" ; $ASCII{'"'} = "b" ; $ASCII{"`"} = "c" ;
+$ASCII{"'"} = "d" ; $ASCII{"~"} = "e" ; $ASCII{","} = "f" ;
+
+#sub SanitizedString
+# { my ($string) = $_[0] ;
+# if ($ProcessQuotes)
+# { $string =~ s/\\([\^\"\`\'\~\,])/$1/gio ;
+# $copied = $string ;
+# $copied =~ s/([\^\"\`\'\~\,])([a-zA-Z])/$ASCII{$1}/gio ;
+# $string =~ s/([\^\"\`\'\~\,])([a-zA-Z])/$2/gio ;
+# $string=$string.$copied }
+# $string =~ s/\\-|\|\|/\-/gio ;
+# $string =~ s/\\[a-zA-Z]*| |\{|\}//gio ;
+# return $string }
+
+#D YET UNDOCUMENTED
+
+my $SortN = 0 ; my @Filter ;
+
+# copied from texexec
+
+my @paths ;
+my $kpsewhich = '' ;
+my $pathslash = '/' ; if ($0 =~ /\\/) { $pathslash = "\\" }
+
+sub checked_path
+ { my $path = shift ;
+ if ((defined($path))&&($path ne ''))
+ { $path =~ s/[\/\\]/$pathslash/go ;
+ $path =~ s/[\/\\]*$//go ;
+ $path .= $pathslash }
+ else
+ { $path = '' }
+ return $path }
+
+if ($ENV{PATH} =~ /\;/)
+ { @paths = split(/\;/,$ENV{PATH}) }
+else
+ { @paths = split(/\:/,$ENV{PATH}) }
+
+# until here.
+
+sub InitializeKeys
+ { my $filename = $ARGV[0] ;
+ return unless (open(TEX,"$filename.tex")) ;
+ for ($i=0;$i<=255;$i++)
+ { @Filter[$i] = $i }
+ if ($TcXPath eq '')
+ { foreach (@paths)
+ { my $p = checked_path($_) . 'kpsewhich' ;
+ if ((-e $p)||(-e $p . '.exe'))
+ { $kpsewhich = $p ; last } } }
+ $kpsewhich = "\"$kpsewhich\"" if ($kpsewhich =~ m/^[^\"].* /) ;
+ while (<TEX>)
+ { chomp ;
+ my $Filter ;
+ if (/^\%/)
+ { if (s/.*translat.*?=([\:\/0-9\-a-z]*)/$1/oi)
+ { my $Translation = $_ ;
+ if ($TcXPath ne '')
+ { $TcXPath = checked_path($TcXPath) ;
+ $Filter = "$TcXPath$pathslash$Translation.tcx" }
+ elsif ($kpsewhich ne '')
+ { $Filter = `$kpsewhich --format="web2c files" $Translation.tcx` ;
+ chomp $Filter }
+ else
+ { last }
+ if (open(ASC,$Filter))
+ { Report ("LoadedFilter", $Translation) ;
+ while (<ASC>)
+ { if (/^(\d+)\s*(\d+)/)
+ { @Filter[$2] = $1 } }
+ close (ASC) }
+ elsif ($TcXPath ne '')
+ { Report ("WrongFilterPath", $TcXPath) }
+ last } }
+ else
+ { last } }
+ close (TEX) }
+
+sub HandleKey
+ { ++$SortN ;
+ $RestOfLine =~ s/\{(.*)\}/$1/o ;
+ my ($lan, $enc, $str, $chr, $map, $alf) = split(/\}\s*\{/, $RestOfLine) ;
+ if ($str =~ /^(\d+)/) { $str = ''.chr(@Filter[$1]) }
+ $map = chr(ord($MAP[$i])+128) ;
+ $STR[$SortN] = $str ;
+ $CHR[$SortN] = $chr ;
+ $MAP[$SortN] = $map ;
+#print "$chr$map = $alf\n" ;
+# $ALF{"$chr$map"} = $alf }
+ $ALF{"$map"} = $alf }
+
+sub FlushKeys
+ { Report ("RemappedKeys", $SortN) }
+
+sub SanitizedString
+ { my $string = my $original = shift ;
+ if ($SortN)
+ { my $copied = $string ;
+ for ($i=1;$i<=$SortN;$i++)
+ { my $s = $STR[$i] ;
+ my $c = $CHR[$i] ;
+ my $m = $MAP[$i] ;
+ # print "[$i $s $c $m]\n" ;
+ $string =~ s/($s)/$c/ge ;
+ $copied =~ s/($s)/$m/ge }
+ $string .= "\x00";
+ $string .= $copied }
+ elsif ($ProcessQuotes)
+ { $string =~ s/\\([\^\"\`\'\~\,])/$1/gio ;
+ $copied = $string ;
+ $copied =~ s/([\^\"\`\'\~\,])([a-zA-Z])/$ASCII{$1}/gi ;
+ $string =~ s/([\^\"\`\'\~\,])([a-zA-Z])/$2/gio ;
+ $string .= "\x00";
+ $string .= $copied }
+# new and very experimental, will change
+$string =~ s/\<\*(.*?)\>/\\$1 /go ; # reduce entities / will be table too
+$string =~ s/\\getXMLentity\s*\{(.*?)\}/$1/gio ; # {tex} => tex
+$string =~ s/\<[a-zA-Z\/].*?\>//go ; # remove elements
+# so far
+ $string =~ s/\\-|\|\|/\-/gio ;
+ $string =~ s/\\[a-zA-Z]*| |\{|\}//gio ; # ?
+#print "$original $string $copied\n" ;
+ return $string }
+
+#D This subroutine looks a bit complicated, which is due to the
+#D fact that we want to sort for instance an accented \type{e}
+#D after the plain \type{e}, so the imaginary words
+#D
+#D \starttypen
+#D eerste
+#D \"eerste
+#D \"e\"erste
+#D eerst\"e
+#D \stoptypen
+#D
+#D come out in an acceptable order.
+
+#D We also have to deal with the typical \TEX\ sequences with
+#D the double \type{^}'s, like \type{^^45}. These hexadecimal
+#D coded characters are just converted.
+#D
+#D \startPL
+#D $TargetString = HighConverted ( $SourceString ) ;
+#D \stopPL
+
+sub HighConverted
+ { my ($string) = $_[0] ;
+ $string =~ s/\^\^([a-f0-9][a-f0-9])/chr hex($1)/geo ;
+ return $string }
+
+#D \extras
+#D {references}
+#D
+#D \CONTEXT\ can handle many lists, registers (indexes),
+#D tables of whatever and references. This data is collected
+#D in one pass and processed in a second one. In between,
+#D relevant data is saved in the file \type{\jobname.tui}.
+#D This file also holds some additional information concerning
+#D second pass optimizations.
+#D
+#D The main task of \TEXUTIL\ is to sort lists and registers
+#D (indexes). The results are stored in again one file called
+#D \type{\jobname.tuo}.
+#D
+#D Just for debugging purposes the nesting of files loaded
+#D during the \CONTEXT\ run is stored. Of course this only
+#D applies to files that are handled by the \CONTEXT\ file
+#D structuring commands (projects, products, components and
+#D environments).
+#D
+#D We have to handle the entries:
+#D
+#D \starttypen
+#D f b {test}
+#D f e {test}
+#D \stoptypen
+#D
+#D and only report some status info at the end of the run.
+
+sub InitializeFiles
+ { $NOfFiles = 0 ;
+ $NOfBadFiles = 0 }
+
+sub HandleFile
+ { $RestOfLine =~ s/.*\{(.*)\}/$1/gio ;
+ ++$Files{$RestOfLine} }
+
+sub FlushFiles # hash needs to be sorted, else problem on macosx
+ { print TUO "%\n" . "% $Program / Files\n" . "%\n" ;
+ foreach $File (sort keys %Files)
+ { print TUO "% $File ($Files{$File})\n" }
+ print TUO "%\n" ;
+ $NOfFiles = keys %Files ;
+ Report("EmbeddedFiles", $NOfFiles) ;
+ foreach $File (sort keys %Files)
+ { unless (($Files{$File} % 2) eq 0)
+ { ++$NOfBadFiles ;
+ Report("BeginEndError", $File) } } }
+
+#D Commands don't need a special treatment. They are just
+#D copied. Such commands are tagged by a \type{c}, like:
+#D
+#D \starttypen
+#D c \thisisutilityversion{year.month.day}
+#D c \twopassentry{class}{key}{value}
+#D c \mainreference{prefix}{entry}{pagenumber}{realpage}{tag}
+#D c \listentry{category}{tag}{number}{title}{pagenumber}{realpage}
+#D c \initializevariable\realnumberofpages{number}
+#D \stoptypen
+#D
+#D For historic reasons we check for the presense of the
+#D backslash.
+
+my $NOfPositionsFound = 0 ;
+my $TotalNOfPositions = 0 ;
+my $TotalNOfMPgraphics = 0 ;
+
+my $SectionSeparator = ":" ;
+
+sub InitializeCommands
+ { print TUO "%\n" . "% $Program / Commands\n" . "%\n" ;
+ $NOfCommands = 0 }
+
+sub HandleCommand
+ { ++$NOfCommands ;
+ $RestOfLine =~ s/^\\//go ;
+ if ($RestOfLine =~ /^pospxy/o)
+ { ++$NOfPositionsFound }
+ elsif ($RestOfLine =~ /^initializevariable\\totalnofpositions\{(.*)\}/o)
+ { $TotalNOfPositions = $1 }
+ elsif ($RestOfLine =~ /^initializevariable\\totalnofMPgraphics\{(.*)\}/o)
+ { $TotalNOfMPgraphics = $1 }
+# todo: reg how to
+# elsif ($RestOfLine =~ /^thisissectionseparator\{(.*)\}/o)
+# { $SectionSeparator = $1 }
+ elsif ($RestOfLine =~ /^thisisbytesequence\{(.*)\}/o)
+ { $RestOfLine =~ s/\^//go }
+ print TUO "\\$RestOfLine\n" }
+
+sub FlushCommands
+ { Report ("PassedCommands", $NOfCommands) }
+
+#D Experimental: Extra
+#D
+#D s p : extra programs
+
+my @ExtraPrograms = () ;
+
+sub InitializeExtra
+ { }
+
+sub HandleExtra
+ { if ($RestOfLine =~ /(.)\s+(.*)\s*$/o)
+ { if ($1 eq "p")
+ { my $str = $2 ; $str =~ s/^\{(.*)\}$/$1/o ;
+ push @ExtraPrograms,$str } } }
+
+sub FlushExtra
+ { print TUO "%\n" . "% $Program / System\n" . "%\n" ;
+ foreach $EP (@ExtraPrograms)
+ { print TUO "% extra program : $EP\n" } }
+
+sub RunExtraPrograms
+ { foreach $EP (@ExtraPrograms)
+ { Report ("ExtraProgram", $EP) ;
+ system($EP) } }
+
+#D Plugins
+#D
+#D test.pm:
+#D
+#D \starttypen
+#D see plugtest.pm
+#D \stoptypen
+#D
+#D utility format:
+#D
+#D \starttypen
+#D p u {name} {data} {data} ...
+#D \stoptypen
+
+my $pm_path ;
+
+BEGIN
+ { ## $pm_path = `kpsewhich --format="other text files" --progname=context texutil.pl` ;
+ ## chomp($pm_path) ;
+ # $pm_path =~ s/texutil\.pl.*// }
+ # $pm_path = $0 ;
+ # $pm_path =~ s/\\/\//o ;
+ # $pm_path =~ s/texutil\.pl.*//io ;
+ ## $pm_path =~ s/(.*)texutil.*?$/$1/i ;
+ $pm_path = "$FindBin::Bin/" ;
+ if ($pm_path eq "") { $pm_path = "./" } }
+
+use lib $pm_path ;
+
+my %UserPlugIns ;
+
+sub HandlePlugIn
+ { if ($RestOfLine =~ /\s*u\s*\{(.*?)\}\s*(.*)\s*/io)
+ { my $tag = $1 ;
+ my $arg = $2 ;
+ if (! defined($UserPlugIns{$tag}))
+ { $UserPlugIns{$tag} = 1 ;
+ eval("use $tag") ;
+ my $result = $tag->identify ;
+ if ($result ne "")
+ { Report ("PlugInInit", "$tag -> $result") }
+ else
+ { Report ("PlugInInit", $tag ) }
+ $tag->initialize() }
+ if (defined($UserPlugIns{$tag}))
+ { $arg =~ s/\{(.*)\}/$1/o ;
+ my @args = split(/\}\s*\{/o, $arg) ;
+ $tag->handle(@args) } } }
+
+sub FlushPlugIns
+ { foreach my $tag (keys %UserPlugIns)
+ { my @report = $tag->report ;
+ foreach $rep (@report)
+ { my ($key,$val) = split (/\s*\:\s*/,$rep) ;
+ if ($val ne "")
+ { Report ("PlugInReport", "$tag -> $key -> $val") }
+ else
+ { Report ("PlugInReport", "$tag -> $key") } }
+ $tag->process ;
+ print TUO "%\n" . "% $Program / " . $tag->identify . "\n" . "%\n" ;
+ foreach my $str ($tag->results)
+ { print TUO "\\plugincommand\{$str\}\n" } } }
+
+#D Synonyms are a sort of key||value pairs and are used for
+#D ordered lists like abbreviations and units.
+#D
+#D \starttypen
+#D s e {class}{sanitized key}{key}{associated data}
+#D \stoptypen
+#D
+#D The sorted lists are saved as (surprise):
+#D
+#D \starttypen
+#D \synonymentry{class}{sanitized key}{key}{associated data}
+#D \stoptypen
+
+sub InitializeSynonyms
+ { $NOfSynonyms = 0 ;
+ $NOfBadSynonyms = 0 }
+
+#M \definieersynoniem [testname] [testnames] [\testmeaning]
+#M
+#M \stelsynoniemenin [testname] [criterium=alles]
+
+#D Let's first make clear what we can expect. Synonym
+#D entries look like:
+#D
+#D \startbuffer
+#D \testname [alpha] {\sl alpha} {a greek letter a}
+#D \testname {alpha} {another a}
+#D \testname [Beta] {\kap{beta}} {a greek letter b}
+#D \testname {beta} {indeed another b}
+#D \testname {gamma} {something alike g}
+#D \testname {delta} {just a greek d}
+#D \stopbuffer
+#D
+#D \typebuffer
+#D
+#D This not that spectacular list is to be sorted according
+#D to the keys (names). \haalbuffer
+
+sub HandleSynonym
+ { ++$NOfSynonyms ;
+ ($SecondTag, $RestOfLine) = split(/ /, $RestOfLine, 2) ;
+ ($Class, $Key, $Entry, $Meaning) = split(/} \{/, $RestOfLine) ;
+ chop $Meaning ;
+ $Class = substr $Class, 1 ;
+ if ($Entry eq "")
+ { ++$NOfBadSynonyms }
+ else
+ { $SynonymEntry[$NOfSynonyms] =
+ join ($JOIN,$Class,$Key,$Entry,$Meaning) } }
+
+#D Depending on the settings\voetnoot{One can call for
+#D all defined entries, call only the used ones, change
+#D layout, attach (funny) commands etc.} a list of
+#D {\em testnames} looks like:
+#D
+#D \plaatslijstmettestnames
+#D
+#D Watch the order in which these entries are sorted.
+
+sub FlushSynonyms
+ { print TUO "%\n" . "% $Program / Synonyms\n" . "%\n" ;
+ @SynonymEntry = sort { lc($a) cmp lc($b) } @SynonymEntry ;
+ $NOfSaneSynonyms = 0 ;
+ for ($n=1; $n<=$NOfSynonyms; $n++)
+ { # check normally not needed
+ if (($n==1)||($SynonymEntry[$n] ne $SynonymEntry[$n-1]))
+ { ($Class, $Key, $Entry, $Meaning) =
+ split(/$JOIN/, $SynonymEntry[$n]) ;
+ ++$NOfSaneSynonyms ;
+ print TUO "\\synonymentry{$Class}{$Key}{$Entry}{$Meaning}\n" } }
+ Report("SynonymEntries", $NOfSynonyms, "->", $NOfSaneSynonyms, "Entries") ;
+ if ($NOfBadSynonyms>0)
+ { Report("SynonymErrors", $NOfBadSynonyms) } }
+
+#D Register entries need a bit more care, especially when they
+#D are nested. In the near future we will also handle page
+#D ranges.
+#D
+#D \starttypen
+#D r e {class}{tag}{sanitized key}{key}{pagenumber}{realpage}
+#D r s {class}{tag}{sanitized key}{key}{string}{pagenumber}
+#D r r {class}{tag}{sanitized key}{key}{string}{pagenumber}
+#D \stoptypen
+#D
+#D The last one indicates the start of a range.
+
+#D The first one is the normal entry, the second one concerns
+#D {\em see this or that} entries. Keys are sanitized, unless
+#D the user supplies a sanitized key. To save a lot of
+#D programming, all data concerning an entry is stored in one
+#D string. Subentries are specified as:
+#D
+#D \starttypen
+#D first&second&third
+#D first+second+third
+#D \stoptypen
+#D
+#D When these characters are needed for typesetting purposes, we
+#D can also use the first character to specify the separator:
+#D
+#D \starttypen
+#D &$x^2+y^2=r^2$
+#D +this \& that
+#D \stoptypen
+#D
+#D Subentries are first unpacked and next stored in a
+#D consistent way, which means that we can use both separators
+#D alongside each other. We leave it to the reader to sort
+#D out the dirty tricks.
+
+$SPLIT ="%%" ;
+$JOIN ="__" ;
+
+sub InitializeRegisters
+ { $NOfEntries = 0 ;
+ $NOfBadEntries = 0 }
+
+$ProcessType = "" ;
+
+$RegStat{"f"} = 1 ;
+$RegStat{"e"} = 2 ; # end up between from and to
+$RegStat{"t"} = 3 ;
+$RegStat{"s"} = 4 ;
+
+my $RegSep = "$SectionSeparator$SectionSeparator" ;
+
+sub HandleRegister # the } { makes sure that local {} is ok
+ { ($SecondTag, $RestOfLine) = split(/ /, $RestOfLine, 2) ;
+ ++$NOfEntries ;
+ #~ if ($SecondTag eq "s")
+ #~ { ($Class, $Location, $Key, $Entry, $SeeToo, $Page ) =
+ #~ split(/} \{/, $RestOfLine) ;
+ #~ chop $Page ;
+ #~ $Class = substr $Class, 1 ;
+ #~ $RealPage = 0 }
+ #~ else
+ #~ { ($Class, $Location, $Key, $Entry, $Page, $RealPage ) =
+ #~ split(/} \{/, $RestOfLine) ;
+ #~ chop $RealPage ;
+ #~ $Class = substr $Class, 1 ;
+ #~ $SeeToo = "" }
+ if ($SecondTag eq "s")
+ { if ($RestOfLine =~ /^\s*(.*?)\}\s\{(.*?)\}\s\{(.*?)\}\s\{(.*)\}\s\{(.*?)\}\s\{(.*?)\s*$/o)
+ { ($Class, $Location, $Key, $Entry, $SeeToo, $Page ) = ($1,$2,$3,$4,$5,$6) ;
+ chop $Page ;
+ $Class = substr $Class, 1 ;
+ $RealPage = 0 }
+ else
+ { return } }
+ else
+ { if ($RestOfLine =~ /^\s*(.*?)\}\s\{(.*?)\}\s\{(.*?)\}\s\{(.*)\}\s\{(.*?)\}\s\{(.*?)\s*$/o)
+ { ($Class, $Location, $Key, $Entry, $Page, $RealPage ) = ($1,$2,$3,$4,$5,$6) ;
+ chop $RealPage ;
+ $Class = substr $Class, 1 ;
+ $SeeToo = "" }
+ else
+ { return } }
+ $_ = $Key ;
+ if (/$RegSep/)
+ { ($PageHow,$Key) = split (/$RegSep/) }
+ else
+ { $PageHow = "" }
+ $_ = $Entry ;
+ if (/$RegSep/)
+ { ($TextHow,$Entry) = split (/$RegSep/) }
+ else
+ { $TextHow = "" }
+ #
+ if ($Key eq "")
+ { $Key = SanitizedString($Entry) }
+ if ($SortMethod ne '')
+ { $ProcessHigh = 0 }
+ if ($ProcessHigh)
+ { $Key = HighConverted($Key) }
+ $KeyTag = substr $Key, 0, 1 ;
+ if ($KeyTag eq "&")
+ { $Key =~ s/^\&//go ;
+ $Key =~ s/([^\\])\&/$1$SPLIT/go }
+ elsif ($KeyTag eq "+")
+ { $Key =~ s/^\+//go ;
+ $Key =~ s/([^\\])\+/$1$SPLIT/go }
+ else
+ { $Key =~ s/([^\\])\&/$1$SPLIT/go ;
+ $Key =~ s/([^\\])\+/$1$SPLIT/go }
+ $Key .= " " ; # so, "Word" comes for "Word Another Word"
+ $EntryTag = substr $Entry, 0, 1 ;
+ if ($EntryTag eq "&")
+ { $Entry =~ s/^\&//go ;
+ $Entry =~ s/([^\\])\&/$1$SPLIT/go }
+ elsif ($EntryTag eq "+")
+ { $Entry =~ s/^\+//go ;
+ $Entry =~ s/([^\\])\+/$1$SPLIT/go }
+ elsif ($KeyTag eq "&")
+ { $Entry =~ s/([^\\])\&/$1$SPLIT/go }
+ elsif ($KeyTag eq "+")
+ { $Entry =~ s/([^\\])\+/$1$SPLIT/go }
+ else
+ { $Entry =~ s/([^\\])\&/$1$SPLIT/go ;
+ $Entry =~ s/([^\\])\+/$1$SPLIT/go }
+ $Key =~ s/^([^a-zA-Z])/ $1/go ;
+ $Key =~ s/^\s*\{(.*)\}$SPLIT/$1$SPLIT/go ; ####### new
+ $Entry =~ s/^\{(.*)\}$SPLIT/$1$SPLIT/go ; ###### new
+ if ($ProcessIJ) { $Key =~ s/ij/yy/go }
+ $LCKey = lc $Key ;
+ $RegStatus = $RegStat{$SecondTag} ;
+ $RealPageNumber= sprintf("%6i",$RealPage) ;
+ $RegisterEntry[$NOfEntries] =
+ join($JOIN,$Class,$LCKey,$Key,$Entry,$TextHow,$RegStatus,
+ $RealPageNumber,$Location,$Page,$PageHow,$SeeToo) }
+
+#M \definieerregister [testentry] [testentries]
+
+#D The previous routine deals with entries like:
+#D
+#D \startbuffer
+#D \testentry {alpha}
+#D \testentry {beta}
+#D \testentry {gamma}
+#D \testentry {gamma}
+#D \testentry {delta}
+#D \testentry {epsilon}
+#D \testentry {alpha+first}
+#D \testentry {alpha+second}
+#D \testentry {alpha+second}
+#D \testentry {alpha+third}
+#D \testentry {alpha+second+one}
+#D \testentry {alpha+second+one}
+#D \testentry {alpha+second+two}
+#D \testentry {alpha+second+three}
+#D \testentry {gamma+first+one}
+#D \testentry {gamma+second}
+#D \testentry {gamma+second+one}
+#D
+#D \testentry {alpha+fourth}
+#D \testentry {&alpha&fourth}
+#D \testentry {+alpha+fourth}
+#D
+#D \testentry [alpha+fourth] {alpha+fourth}
+#D \testentry [&alpha&fourth&one] {&alpha&fourth&one}
+#D \testentry [+alpha+fourth+two] {&alpha&fourth&two}
+#D
+#D \testentry {\kap{alpha}+fifth}
+#D \testentry {\kap{alpha}+f\'ifth}
+#D \testentry {\kap{alpha}+f"ifth}
+#D
+#D \testentry [&betaformula] {&$a^2+b^2=c^2$}
+#D
+#D \testentry {zeta \& more}
+#D
+#D \testentry [pagehowto::key]{texthowto::entry}
+#D
+#D % a very special case, when key has , and is constructed
+#D
+#D \testentry [pagehowto::{key}]{texthowto::{entry}}
+#D
+#D \stopbuffer
+#D
+#D \typebuffer
+#D
+#D \haalbuffer After being sorted, these entries are
+#D turned into something \TEX\ using:
+
+$CollapseEntries = 0 ;
+
+$RegisterEntry[0] = ("") ;
+
+sub How
+ { return "$TextHow$RegSep" . "$_[0]" }
+
+sub FlushSavedLine
+ { if (($CollapseEntries)&&($SavedFrom ne ""))
+ { if ($SavedTo ne "")
+ { print TUO "\\registerfrom$SavedFrom" ;
+ print TUO "\\registerto$SavedTo" }
+ else
+ { print TUO "\\registerpage$SavedFrom" } }
+ $SavedHow = "" ;
+ $SavedFrom = "" ;
+ $SavedTo = "" ;
+ $SavedEntry = "" }
+
+sub FlushRegisters
+ { print TUO "%\n" . "% $Program / Registers\n" . "%\n" ;
+ @RegisterEntry = sort { lc($a) cmp lc($b) } @RegisterEntry ;
+ $NOfSaneEntries = 0 ;
+ $NOfSanePages = 0 ;
+ $LastPage = "" ;
+ $LastRealPage = "" ;
+ $AlfaClass = "" ;
+ $Alfa = "" ;
+ $PreviousA = "" ;
+ $PreviousB = "" ;
+ $PreviousC = "" ;
+ $ActualA = "" ;
+ $ActualB = "" ;
+ $ActualC = "" ;
+
+ $SavedFrom = "" ;
+ $SavedTo = "" ;
+ $SavedEntry = "" ;
+ $SavedHow = "" ;
+
+ for ($n=1 ; $n<=$NOfEntries ; ++$n)
+ { ($Class, $LCKey, $Key, $Entry, $TextHow, $RegisterState,
+ $RealPage, $Location, $Page, $PageHow, $SeeToo) =
+ split(/$JOIN/, $RegisterEntry[$n]) ;
+ $RealPage =~ s/^\s*//o ;
+ $TestAlfa = lc substr $Key, 0, 1 ;
+ #
+ if ($SortN)
+ { $AlfKey = $Key ;
+ $AlfKey =~ s/(.).*\x00(.).*/$2/o ;
+ if (defined($ALF{$AlfKey}))
+ { $TestAlfa = $ALF{$AlfKey} } }
+ #
+ if ((lc $TestAlfa ne lc $Alfa) or ($AlfaClass ne $Class))
+ { # $Alfa= lc substr $Key, 0, 1 ;
+ $Alfa = $TestAlfa ;
+ $AlfaClass = $Class ;
+ if ($Alfa ne " ")
+ { FlushSavedLine ;
+ print TUO "\\registerentry{$Class}{$Alfa}\n" } }
+ ($ActualA, $ActualB, $ActualC ) =
+ split(/$SPLIT/, $Entry, 3) ;
+ unless ($ActualA) { $ActualA = "" }
+ unless ($ActualB) { $ActualB = "" }
+ unless ($ActualC) { $ActualC = "" }
+ if (How($ActualA) eq $PreviousA)
+ { $ActualA = "" }
+ else
+ { $PreviousA = How($ActualA) ;
+ $PreviousB = "" ;
+ $PreviousC = "" }
+ if (How($ActualB) eq $PreviousB)
+ { $ActualB = "" }
+ else
+ { $PreviousB = How($ActualB) ;
+ $PreviousC = "" }
+ if (How($ActualC) eq $PreviousC)
+ { $ActualC = "" }
+ else
+ { $PreviousC = How($ActualC) }
+ $Copied = 0 ;
+ if ($ActualA ne "")
+ { FlushSavedLine ;
+ print TUO "\\registerentrya{$Class}{$ActualA}\n" ;
+ $Copied = 1 }
+ if ($ActualB ne "")
+ { FlushSavedLine ;
+ print TUO "\\registerentryb{$Class}{$ActualB}\n" ;
+ $Copied = 1 }
+ if ($ActualC ne "")
+ { FlushSavedLine ;
+ print TUO "\\registerentryc{$Class}{$ActualC}\n" ;
+ $Copied = 1 }
+ if ($Copied)
+ { $NOfSaneEntries++ }
+ if ($RealPage eq 0)
+ { FlushSavedLine ;
+ print TUO "\\registersee{$Class}{$PageHow,$TextHow}{$SeeToo}{$Page}\n" ;
+ $LastPage = $Page ;
+ $LastRealPage = $RealPage }
+ else {
+if (($SavedHow ne $PageHow) && ($PageHow ne "")) {
+ # last valid page attribute counts
+ $SavedHow = $PageHow ;
+}
+ if (($Copied) || ! (($LastPage eq $Page) && ($LastRealPage eq $RealPage)))
+ { # print "$LastPage / $Page // $LastRealPage / $RealPage\n" ;
+ $NextEntry = "{$Class}{$PreviousA}{$PreviousB}{$PreviousC}{$PageHow,$TextHow}" ;
+ #~ $SavedLine = "{$Class}{$PageHow,$TextHow}{$Location}{$Page}{$RealPage}\n" ;
+ $SavedLine = "{$Class}{$SavedHow,$TextHow}{$Location}{$Page}{$RealPage}\n" ;
+ if ($RegisterState eq $RegStat{"f"})
+ { FlushSavedLine ;
+ print TUO "\\registerfrom$SavedLine" }
+ elsif ($RegisterState eq $RegStat{"t"})
+ { FlushSavedLine ;
+ print TUO "\\registerto$SavedLine" ; $SavedHow = '' ; }
+ else
+ { if ($CollapseEntries)
+ { if ($SavedEntry ne $NextEntry)
+ { $SavedFrom = $SavedLine }
+ else
+ { $SavedTo = $SavedLine }
+ $SavedEntry = $NextEntry }
+ else
+ { print TUO "\\registerpage$SavedLine" ; $SavedHow = '' ; }
+ }
+ ++$NOfSanePages ;
+ $LastPage = $Page ;
+ $LastRealPage = $RealPage } } }
+
+FlushSavedLine ;
+
+ Report("RegisterEntries", $NOfEntries, "->", $NOfSaneEntries, "Entries",
+ $NOfSanePages, "References") ;
+ if ($NOfBadEntries>0)
+ { Report("RegisterErrors", $NOfBadEntries) } }
+
+#D As promised, we show the results:
+#D
+#D \plaatstestentry
+
+#D For debugging purposes we flush some status information. The
+#D faster machines become, the more important this section will
+#D be. The totals, when changed, force texexec to do a second pass.
+
+sub FlushData
+ { print TUO "%\n" . "% $Program / Status\n" . "%\n" ;
+ print TUO "" .
+ "% embedded files : $NOfFiles ($NOfBadFiles errors)\n" .
+ "% synonym entries : $NOfSynonyms ($NOfBadSynonyms errors)\n" .
+ "% register entries : $NOfEntries ($NOfBadEntries errors)\n" .
+ "% metapost graphics : $TotalNOfMPgraphics\n" .
+ "% position commands : $TotalNOfPositions " ;
+ if ($TotalNOfPositions)
+ { if ($NOfPositionsFound)
+ { print TUO "(resolved)\n" }
+ else
+ { print TUO "(unresolved)\n" } }
+ else
+ { print TUO "(not used)\n" } }
+
+#D The functionallity described on the previous few pages is
+#D called upon in the main routine:
+
+sub NormalHandleReferences
+ { if ($InputFile eq "")
+ { Report("Error", "NoInputFile") }
+ else
+ { unless (open (TUI, "$InputFile.tui"))
+ { Report("Error", "EmptyInputFile", $InputFile) }
+ else
+ { Report("InputFile", "$InputFile.tui" ) ;
+ unlink "$InputFile.tmp" ;
+ rename "$InputFile.tuo", "$InputFile.tmp" ;
+ Report("OutputFile", "$InputFile.tuo" ) ;
+ open (TUO, ">$InputFile.tuo") ;
+ print TUO "%\n" . "% $Program / Commands\n" . "%\n" ;
+ while (<TUI>)
+ { $SomeLine = $_ ;
+ chomp $SomeLine ;
+ ($FirstTag, $RestOfLine) = split ' ', $SomeLine, 2 ;
+ if ($FirstTag eq "c")
+ { HandleCommand }
+ elsif ($FirstTag eq "s")
+ { HandleSynonym }
+ elsif ($FirstTag eq "r")
+ { HandleRegister }
+ elsif ($FirstTag eq "f")
+ { HandleFile }
+ elsif ($FirstTag eq "k")
+ { HandleKey }
+ elsif ($FirstTag eq "e")
+ { HandleExtra }
+ elsif ($FirstTag eq "p")
+ { HandlePlugIn }
+ elsif ($FirstTag eq "q")
+ { $ValidOutput = 0 ;
+ last } }
+ if ($ValidOutput)
+ { FlushCommands ; # already done during pass
+ FlushKeys ;
+ FlushRegisters ;
+ FlushSynonyms ;
+ FlushPlugIns ;
+ FlushFiles ;
+ FlushData ;
+ FlushExtra ;
+ close (TUO) ;
+ RunExtraPrograms }
+ else
+ { close (TUO) ;
+ unlink "$InputFile.tuo" ;
+ rename "$InputFile.tmp", "$InputFile.tuo" ;
+ Report ("Remark", "NoOutputFile") } } } }
+
+my $Suffix ;
+
+sub MergerHandleReferences
+ { unlink "texutil.tuo" ;
+ Report("OutputFile", "texutil.tuo" ) ;
+ open (TUO, ">texutil.tuo") ;
+ foreach $InputFile (@ARGV)
+ { ($InputFile, $Suffix) = split (/\./, $InputFile, 2) ;
+ unless (open (TUI, "$InputFile.tui"))
+ { Report("Error", "EmptyInputFile", $InputFile) }
+ else
+ { Report("InputFile", "$InputFile.tui" ) ;
+ while (<TUI>)
+ { $SomeLine = $_ ;
+ chomp $SomeLine ;
+ ($FirstTag, $RestOfLine) = split ' ', $SomeLine, 2 ;
+ if ($FirstTag eq "r")
+ { HandleRegister } } } }
+ if ($ValidOutput)
+ { FlushRegisters ;
+ close (TUO) }
+ else
+ { close (TUO) ;
+ unlink "texutil.tuo" ;
+ Report ("Remark", "NoOutputFile") } }
+
+# sub HandleReferences
+# { Report("Action", "ProcessingReferences") ;
+# if ($ProcessIJ )
+# { Report("Option", "SortingIJ") }
+# if ($ProcessHigh)
+# { Report("Option", "ConvertingHigh") }
+# if ($ProcessQuotes)
+# { Report("Option", "ProcessingQuotes") }
+# if ($InputFile eq "")
+# { Report("Error", "NoInputFile") }
+# else
+# { unless (open (TUI, "$InputFile.tui"))
+# { Report("Error", "EmptyInputFile", $InputFile) }
+# else
+# { Report("InputFile", "$InputFile.tui" ) ;
+# InitializeCommands ;
+# InitializeRegisters ;
+# InitializeSynonyms ;
+# InitializeFiles ;
+# $ValidOutput = 1 ;
+# unlink "$InputFile.tmp" ;
+# rename "$InputFile.tuo", "$InputFile.tmp" ;
+# Report("OutputFile", "$InputFile.tuo" ) ;
+# open (TUO, ">$InputFile.tuo") ;
+# while (<TUI>)
+# { $SomeLine = $_ ;
+# chomp $SomeLine ;
+# ($FirstTag, $RestOfLine) = split ' ', $SomeLine, 2 ;
+# if ($FirstTag eq "c")
+# { HandleCommand }
+# elsif ($FirstTag eq "s")
+# { HandleSynonym }
+# elsif ($FirstTag eq "r")
+# { HandleRegister }
+# elsif ($FirstTag eq "f")
+# { HandleFile }
+# elsif ($FirstTag eq "q")
+# { $ValidOutput = 0 ;
+# last } }
+# if ($ValidOutput)
+# { FlushCommands ; # already done during pass
+# FlushRegisters ;
+# FlushSynonyms ;
+# FlushFiles ;
+# FlushData ;
+# close (TUO) }
+# else
+# { close (TUO) ;
+# unlink "$InputFile.tuo" ;
+# rename "$InputFile.tmp", "$InputFile.tuo" ;
+# Report ("Remark", "NoOutputFile") } } } }
+
+sub HandleReferences
+ { $Merging = @ARGV ;
+ $Merging = ($Merging>1) ;
+ if ($Merging)
+ { Report("Action", "MergingReferences") }
+ else
+ { Report("Action", "ProcessingReferences") }
+ if ($ProcessIJ )
+ { Report("Option", "SortingIJ") }
+ if ($ProcessHigh)
+ { Report("Option", "ConvertingHigh") }
+ if ($ProcessQuotes)
+ { Report("Option", "ProcessingQuotes") }
+ InitializeKeys ;
+ InitializeCommands ;
+ InitializeExtra ;
+ InitializeRegisters ;
+ InitializeSynonyms ;
+ InitializeFiles ;
+ $ValidOutput = 1 ;
+ if ($Merging)
+ { MergerHandleReferences }
+ else
+ { NormalHandleReferences } }
+
+# moved to ctxtools
+#
+# sub HandleDocuments
+# { my $files = @ARGV.join(' ') ; system("ctxtools $files") }
+
+#D \extras
+#D {documents}
+#D
+#D Documentation can be woven into a source file. The next
+#D routine generates a new, \TEX\ ready file with the
+#D documentation and source fragments properly tagged. The
+#D documentation is included as comment:
+#D
+#D \starttypen
+#D %D ...... some kind of documentation
+#D %M ...... macros needed for documenation
+#D %S B begin skipping
+#D %S E end skipping
+#D \stoptypen
+#D
+#D The most important tag is \type{%D}. Both \TEX\ and
+#D \METAPOST\ files use \type{%} as a comment chacacter, while
+#D \PERL\ uses \type{#}. Therefore \type{#D} is also handled.
+#D
+#D The generated file gets the suffix \type{ted} and is
+#D structured as:
+#D
+#D \starttypen
+#D \startmodule[type=suffix]
+#D \startdocumentation
+#D \stopdocumentation
+#D \startdefinition
+#D \stopdefinition
+#D \stopmodule
+#D \stoptypen
+#D
+#D Macro definitions specific to the documentation are not
+#D surrounded by start||stop commands. The suffix specifaction
+#D can be overruled at runtime, but defaults to the file
+#D extension. This specification can be used for language
+#D depended verbatim typesetting.
+
+my $skippingbang = 0 ;
+
+sub HandleDocuments
+ { Report("Action", "GeneratingDocumentation") ;
+ if ($ProcessType ne "")
+ { Report("Option", "ForcingFileType", $ProcessType) }
+ if ($InputFile eq "")
+ { Report("Error", "NoInputFile") }
+ else
+ { CheckInputFiles ($InputFile) ;
+ foreach $FullName (@UserSuppliedFiles)
+ { ($FileName, $FileSuffix) = SplitFileName ($FullName) ;
+ unless ($FileSuffix)
+ { $FileSuffix = "tex" }
+ unless (-f "$FileName.$FileSuffix")
+ { next }
+ unless (open (TEX, "$FileName.$FileSuffix"))
+ { Report("Error", "EmptyInputFile", "$FileName.$FileSuffix" ) }
+ else
+ { Report("InputFile", "$FileName.$FileSuffix") ;
+ Report("OutputFile", "$FileName.ted") ;
+ open (TED, ">$FileName.ted") ;
+ $NOfDocuments = 0 ;
+ $NOfDefinitions = 0 ;
+ $NOfSkips = 0 ;
+ $SkipLevel = 0 ;
+ $InDocument = 0 ;
+ $InDefinition = 0 ;
+ $skippingbang = 0 ;
+ if ($ProcessType eq "")
+ { $FileType=lc $FileSuffix }
+ else
+ { $FileType=lc $ProcessType }
+ Report("FileType", $FileType) ;
+ # we need to signal to texexec what interfaec to use
+ my $firstline = <TEX> ;
+ if ($firstline =~ /^\%.*interface\=/)
+ { print TED $firstline }
+ else
+ { seek TEX, 0, 0 }
+ # so far
+ print TED "\\startmodule[type=$FileType]\n" ;
+ while (<TEX>)
+ { chomp ;
+ s/\s*$//o ;
+ if ($skippingbang)
+ { $skippingbang = 0 }
+ elsif (/^[%\#]D/)
+ { if ($SkipLevel == 0)
+ { if (length $_ < 3)
+ {$SomeLine = "" }
+ else # HH: added after that
+ {$SomeLine = substr $_, 3 }
+ if ($InDocument)
+ { print TED "$SomeLine\n" }
+ else
+ { if ($InDefinition)
+ { print TED "\\stopdefinition\n" ;
+ $InDefinition = 0 }
+ unless ($InDocument)
+ { print TED "\n\\startdocumentation\n" }
+ print TED "$SomeLine\n" ;
+ $InDocument = 1 ;
+ ++$NOfDocuments } } }
+ elsif (/^[%\#]M/)
+ { if ($SkipLevel == 0)
+ { $SomeLine = substr $_, 3 ;
+ print TED "$SomeLine\n" } }
+ elsif (/^[%\%]S B]/)
+ { ++$SkipLevel ;
+ ++$NOfSkips }
+ elsif (/^[%\%]S E]/)
+ { --$SkipLevel }
+ elsif (/^[%\#]/)
+ { }
+ elsif (/^eval \'\(exit \$\?0\)\' \&\& eval \'exec perl/o)
+ { $skippingbang = 1 }
+ elsif ($SkipLevel == 0)
+ { $InLocalDocument = $InDocument ;
+ $SomeLine = $_ ;
+ if ($InDocument)
+ { print TED "\\stopdocumentation\n" ;
+ $InDocument = 0 }
+ if (($SomeLine eq "") && ($InDefinition))
+ { print TED "\\stopdefinition\n" ;
+ $InDefinition = 0 }
+ else
+ { if ($InDefinition)
+ { print TED "$SomeLine\n" }
+ elsif ($SomeLine ne "")
+ { print TED "\n" . "\\startdefinition\n" ;
+ $InDefinition = 1 ;
+ unless ($InLocalDocument)
+ { ++$NOfDefinitions }
+ print TED "$SomeLine\n" } } } }
+ if ($InDocument)
+ { print TED "\\stopdocumentation\n" }
+ if ($InDefinition)
+ { print TED "\\stopdefinition\n" }
+ print TED "\\stopmodule\n" ;
+ close (TED) ;
+ unless (($NOfDocuments) || ($NOfDefinitions))
+ { unlink "$FileName.ted" }
+ Report ("NOfDocuments", $NOfDocuments) ;
+ Report ("NOfDefinitions", $NOfDefinitions) ;
+ Report ("NOfSkips", $NOfSkips) } } } }
+
+#D \extras
+#D {sources}
+#D
+#D Documented sources can be stripped of documentation and
+#D comments, although at the current processing speeds the
+#D overhead of skipping the documentation at run time is
+#D neglectable. Only lines beginning with a \type{%} are
+#D stripped. The stripped files gets the suffix \type{tes}.
+
+sub HandleSources
+ { Report("Action", "GeneratingSources") ;
+ if ($InputFile eq "")
+ { Report("Error", "NoInputFile") }
+ else
+ { CheckInputFiles ($InputFile) ;
+ foreach $FullName (@UserSuppliedFiles)
+ { ($FileName, $FileSuffix) = SplitFileName ($FullName) ;
+ unless ($FileSuffix)
+ { $FileSuffix = "tex" }
+ unless (-f "$FileName.$FileSuffix")
+ { next }
+ unless (open (TEX, "$FileName.$FileSuffix"))
+ { Report("Error", "EmptyInputFile", "$FileName.$FileSuffix" ) }
+ else
+ { Report("InputFile", "$FileName.$FileSuffix") ;
+ Report("OutputFile", "$FileName.tes") ;
+ open (TES, ">$FileName.tes") ;
+ $EmptyLineDone = 1 ;
+ $FirstCommentDone = 0 ;
+ while (<TEX>)
+ { $SomeLine = $_ ;
+ chomp $SomeLine ;
+ if ($SomeLine eq "")
+ { unless ($FirstCommentDone)
+ { $FirstCommentDone = 1 ;
+ print TES
+ "\n% further documentation is removed\n\n" ;
+ $EmptyLineDone = 1 }
+ unless ($EmptyLineDone)
+ { print TES "\n" ;
+ $EmptyLineDone = 1 } }
+ elsif ($SomeLine =~ /^%/)
+ { unless ($FirstCommentDone)
+ { print TES "$SomeLine\n" ;
+ $EmptyLineDone = 0 } }
+ else
+ { print TES "$SomeLine\n" ;
+ $EmptyLineDone = 0 } }
+ close (TES) ;
+ unless ($FirstCommentDone)
+ { unlink "$FileName.tes" } } } } }
+
+#D \extras
+#D {setups}
+#D
+#D All \CONTEXT\ commands are specified in a compact format
+#D that can be used to generate quick reference tables and
+#D cards. Such setups are preceded by \type{%S}. The setups
+#D are collected in the file \type{texutil.tus}.
+
+sub HandleSetups
+ { Report("Action", "FilteringDefinitions" ) ;
+ if ($InputFile eq "")
+ { Report("Error", "NoInputFile") }
+ else
+ { SetOutputFile ("texutil.tus" ) ;
+ Report("OutputFile", $OutputFile) ;
+ open (TUS, ">$OutputFile") ; # always reset!
+ $NOfSetups = 0 ;
+ CheckInputFiles ($InputFile) ;
+ foreach $FullName (@UserSuppliedFiles)
+ { ($FileName, $FileSuffix) = SplitFileName ($FullName) ;
+ unless ($FileSuffix)
+ { $FileSuffix = "tex" }
+ unless (-f "$FileName.$FileSuffix")
+ { next }
+ unless (open (TEX, "$FileName.$FileSuffix"))
+ { Report("Error", "EmptyInputFile", "$FileName.$FileSuffix" ) }
+ else
+ { Report("InputFile", "$FileName.$FileSuffix") ;
+ print TUS "%\n" . "% File : $FileName.$FileSuffix\n" . "%\n" ;
+ while (<TEX>)
+ { $SomeLine = $_ ;
+ chomp $SomeLine ;
+ ($Tag, $RestOfLine) = split(/ /, $SomeLine, 2) ;
+ if ($Tag eq "%S")
+ { ++$NOfSetups ;
+ while ($Tag eq "%S")
+ { print TUS "$RestOfLine\n" ;
+ $SomeLine = <TEX> ;
+ chomp $SomeLine ;
+ ($Tag, $RestOfLine) = split(/ /, $SomeLine, 2) }
+ print TUS "\n" } } } }
+ close (TUS) ;
+ unless ($NOfSetups)
+ { unlink $OutputFile }
+ Report("NOfSetups", $NOfSetups) } }
+
+#D \extras
+#D {templates, infos}
+#D
+#D From the beginning, the \CONTEXT\ source files contained
+#D helpinfo and key||templates for \TEXEDIT. In fact, for a
+#D long time, this was the only documentation present. More
+#D and more typeset (interactive) documentation is replacing
+#D this helpinfo, but we still support the traditional method.
+#D This information is formatted like:
+#D
+#D \starttypen
+#D %I n=Struts
+#D %I c=\strut,\setnostrut,\setstrut,\toonstruts
+#D %I
+#D %I text
+#D %I ....
+#D %P
+#D %I text
+#D %I ....
+#D \stoptypen
+#D
+#D Templates look like:
+#D
+#D \starttypen
+#D %T n=kap
+#D %T m=kap
+#D %T a=k
+#D %T
+#D %T \kap{?}
+#D \stoptypen
+#D
+#D The key||value pairs stand for {\em name}, {\em mnemonic},
+#D {\em key}. This information is copied to files with the
+#D extension \type{tud}.
+
+sub HandleEditorCues
+ { if ($ProcessTemplates)
+ { Report("Action", "CopyingTemplates" ) }
+ if ($ProcessInfos)
+ {Report("Action", "CopyingInformation" ) }
+ if ($InputFile eq "")
+ { Report("Error", "NoInputFile") }
+ else
+ { CheckInputFiles ($InputFile) ;
+ foreach $FullName (@UserSuppliedFiles)
+ { ($FileName, $FileSuffix) = SplitFileName ($FullName) ;
+ if ($FileSuffix eq "")
+ { $FileSuffix = "tex" }
+ unless (-f "$FileName.$FileSuffix")
+ { next }
+ unless (open (TEX, "$FileName.$FileSuffix"))
+ { Report("Error", "EmptyInputFile", "$FileName.$FileSuffix" ) }
+ else
+ { Report("InputFile", "$FileName.$FileSuffix") ;
+ Report("OutputFile", "$FileName.tud") ;
+ open (TUD, ">$FileName.tud") ;
+ $NOfTemplates = 0 ;
+ $NOfInfos = 0 ;
+ while (<TEX>)
+ { $SomeLine = $_ ;
+ chomp $SomeLine ;
+ ($Tag, $RestOfLine) = split(/ /, $SomeLine, 2) ;
+ if (($Tag eq "%T") && ($ProcessTemplates))
+ { ++$NOfTemplates ;
+ while ($Tag eq "%T")
+ { print TUD "$SomeLine\n" ;
+ $SomeLine = <TEX> ;
+ chomp $SomeLine ;
+ ($Tag, $RestOfLine) = split(/ /, $SomeLine, 2) }
+ print TUD "\n" }
+ elsif (($Tag eq "%I") && ($ProcessInfos))
+ { ++$NOfInfos ;
+ while (($Tag eq "%I") || ($Tag eq "%P"))
+ { print TUD "$SomeLine\n" ;
+ $SomeLine = <TEX> ;
+ chomp $SomeLine ;
+ ($Tag, $RestOfLine) = split(/ /, $SomeLine, 2) }
+ print TUD "\n" } }
+ close (TUD) ;
+ unless (($NOfTemplates) || ($NOfInfos))
+ { unlink "$FileName.tud" }
+ if ($ProcessTemplates)
+ { Report("NOfTemplates", $NOfTemplates) }
+ if ($ProcessInfos)
+ { Report("NOfInfos", $NOfInfos) } } } } }
+
+#D \extras
+#D {figures}
+#D
+#D Directories can be scanned for illustrations in \EPS, \PDF,
+#D \TIFF, \PNG\ or \JPG\ format. The resulting file \type{texutil.tuf}
+#D contains entries like:
+#D
+#D \starttypen
+#D \thisisfigureversion{year.month.day}
+#D \presetfigure[file][...specifications...]
+#D \stoptypen
+#D
+#D where the specifications are:
+#D
+#D \starttypen
+#D [e=suffix,x=xoffset,y=yoffset,w=width,h=height,t=title,c=creator,s=size]
+#D \stoptypen
+#D
+#D This data can be used when determining dimensions and
+#D generate directories of illustrations.
+
+$DPtoCM = 2.54/72.0 ;
+$INtoCM = 2.54 ;
+
+sub SaveFigurePresets
+ { my ($FNam, $FTyp, $FUni, $FXof, $FYof, $FWid, $FHei, $FTit, $FCre, $FSiz) = @_ ;
+ if ($ProcessVerbose)
+ { OpenTerminal ;
+ if ($FUni)
+ { print "n=$FNam t=$FTyp " .
+ (sprintf "x=%1.3fcm y=%1.3fcm ", $FXof, $FYof) .
+ (sprintf "w=%5.3fcm h=%5.3fcm\n", $FWid, $FHei) }
+ else
+ { print "n=$FNam t=$FTyp " .
+ "x=${FXof}bp y=${FYof}bp " .
+ "w=${FWid}bp h=${FHei}bp\n" }
+ CloseTerminal }
+ else
+ { ++$NOfFigures ;
+ $Figures[$NOfFigures] = "\\presetfigure[$FNam][e=$FTyp" ;
+ if ($FUni)
+ { $Figures[$NOfFigures] .= (sprintf ",w=%5.3fcm,h=%5.3fcm", $FWid, $FHei) }
+ else
+ { $Figures[$NOfFigures] .= ",w=${FWid}bp,h=${FHei}bp" }
+ if (($FXof!=0)||($FYof!=0))
+ { if ($FUni)
+ { $Figures[$NOfFigures] .= (sprintf ",x=%1.3fcm,y=%1.3fcm", $FXof, $FYof) }
+ else
+ { $Figures[$NOfFigures] .= ",x=${FXof}bp,y=${FYof}bp" } }
+ if ($FTit)
+ { $Figures[$NOfFigures] .= ",t=\{$FTit\}" }
+ if ($FCre)
+ { $Figures[$NOfFigures] .= ",c=\{$FCre\}" }
+ $Figures[$NOfFigures] .= ",s=$FSiz]\n" } }
+
+#D The \EPS\ to \PDF\ conversion pipe to \GHOSTSCRIPT\ is
+#D inspired by a script posted by Sebastian Ratz at the
+#D \PDFTEX\ mailing list. Watch the bounding box check, we
+#D use the values found in an earlier pass.
+
+sub ConvertEpsToEps
+ { my ( $SuppliedFileName , $LLX, $LLY, $URX, $URY ) = @_ ;
+ ($FileName, $FileSuffix) = SplitFileName ($SuppliedFileName) ;
+ if ($ProcessEpsToPdf)
+ { if ($dosish) { $gs = "gswin32c" } else { $gs = "gs" }
+ unlink "$FileName.pdf" ;
+ $GSCommandLine = "-q " .
+ "-sDEVICE=pdfwrite " .
+ "-dNOCACHE " .
+ "-dUseFlateCompression=true " .
+ "-dMaxSubsetPct=100 " .
+ "-sOutputFile=$FileName.pdf " .
+ "- -c " .
+ "quit " ;
+ open ( EPS, "| $gs $GSCommandLine") }
+ elsif ($PDFReady)
+ { return }
+ else
+ { open ( EPS, ">texutil.tmp" ) ;
+ binmode EPS }
+ open ( TMP , "$SuppliedFileName" ) ;
+ binmode TMP ;
+ $EpsBBOX = 0 ;
+ $EpsWidth = $URX - $LLX ;
+ $EpsHeight = $URY - $LLY ;
+ $EpsXOffset = 0 - $LLX ;
+ $EpsYOffset = 0 - $LLY ;
+ while (<TMP>)
+ { if (/%!PS/)
+ { s/(.*)%!PS/%!PS/o ;
+ print EPS $_ ;
+ last } }
+ while (<TMP>)
+ { if ((!$PDFReady)&&(/^%%(HiResB|ExactB|B)oundingBox:/o))
+ { unless ($EpsBBOX)
+ { print EPS "%%PDFready: $Program\n" ;
+ print EPS "%%BoundingBox: 0 0 $EpsWidth $EpsHeight\n" ;
+ print EPS "<< /PageSize [$EpsWidth $EpsHeight] >> setpagedevice\n" ;
+ print EPS "gsave $EpsXOffset $EpsYOffset translate\n" ;
+ $EpsBBOX = 1 } }
+ elsif (/^%%EOF/o) # when final: (/^%%(EOF|Trailer)/o)
+ { last }
+ elsif (/^%%Trailer/o)
+ { last }
+ else
+ { print EPS $_ } }
+ close ( TMP ) ;
+ if (($EpsBBOX)&&(!$PDFReady))
+ { print EPS "grestore\n%%EOF\n%%RestOfFileIgnored: $Program\n" ;
+ close ( EPS ) ;
+ Report ( "PdfFile", "$SuppliedFileName" ) ;
+ unless ($ProcessEpsToPdf)
+ { unlink "$SuppliedFileName" ;
+ rename "texutil.tmp", "$SuppliedFileName" } }
+ else
+ { close (EPS) }
+ unlink "texutil.tmp" }
+
+sub HandleEpsFigure
+ { my ($SuppliedFileName) = @_ ;
+ my ($Temp) = "" ;
+ if (-f $SuppliedFileName)
+ { ($FileName, $FileSuffix) = SplitFileName ($SuppliedFileName) ;
+ if ($FileSuffix ne "")
+ {#$Temp = $FileSuffix ;
+ #$Temp =~ s/[0-9]//go ;
+ #if ($Temp eq "")
+ if ($FileSuffix =~ /^[0-9]+$/o)
+ { $EpsFileName = $SuppliedFileName;
+ Report ( "MPFile", "$SuppliedFileName" ) }
+ elsif ((lc $FileSuffix ne "eps")&&(lc $FileSuffix ne "mps"))
+ { return }
+ else
+ { $EpsFileName = $SuppliedFileName; # $FileName
+ Report ( "EpsFile", "$SuppliedFileName" ) }
+ $EpsTitle = "" ;
+ $EpsCreator = "" ;
+ open ( EPS , $SuppliedFileName ) ;
+ binmode EPS ;
+ $EpsSize = -s EPS ;
+ $PDFReady = 0 ;
+ $MPSFound = 0 ;
+ $BBoxFound = 0 ;
+ while (<EPS>)
+ { $SomeLine = $_;
+ chomp $SomeLine ;
+ if (($BBoxFound) && ((substr $SomeLine,0,1) ne "%"))
+ { last }
+ if ($BBoxFound<2)
+ { if ($SomeLine =~ /^%%BoundingBox:(?!\s+\(atend\))/io) # atend (th)
+ { $EpsBBox = $SomeLine ; $BBoxFound = 1 ; next }
+ elsif ($SomeLine =~ /^%%HiResBoundingBox:/io)
+ { $EpsBBox = $SomeLine ; $BBoxFound = 2 ; next }
+ elsif ($SomeLine =~ /^%%ExactBoundingBox:/io)
+ { $EpsBBox = $SomeLine ; $BBoxFound = 3 ; next } }
+ if ($SomeLine =~ /^%%PDFready:/io)
+ { $PDFReady = 1 }
+ elsif ($SomeLine =~ /^%%Creator:/io)
+ { ($Tag, $EpsCreator) = split (/ /, $SomeLine, 2) ;
+ if ($EpsCreator =~ /MetaPost/io)
+ { $MPSFound = 1 } }
+ elsif ($SomeLine =~ /^%%Title:/io)
+ { ($Tag, $EpsTitle) = split (/ /, $SomeLine, 2) } }
+ close ( EPS ) ;
+ if ($BBoxFound)
+ { ($Tag, $LLX, $LLY, $URX, $URY, $RestOfLine) = split (/ /, $EpsBBox, 6 ) ;
+ $EpsHeight = ($URY-$LLY)*$DPtoCM ;
+ $EpsWidth = ($URX-$LLX)*$DPtoCM ;
+ $EpsXOffset = $LLX*$DPtoCM ;
+ $EpsYOffset = $LLY*$DPtoCM ;
+ if ($MPSFound)
+ { $EpsType = "mps" }
+ else
+ { $EpsType = "eps" }
+ SaveFigurePresets
+ ( $EpsFileName, $EpsType, 1,
+ $EpsXOffset, $EpsYOffset, $EpsWidth, $EpsHeight,
+ $EpsTitle, $EpsCreator, $EpsSize ) ;
+ if (($ProcessEpsPage) || ($ProcessEpsToPdf))
+ { ConvertEpsToEps ( $SuppliedFileName, $LLX, $LLY, $URX, $URY ) } }
+ else
+ { Report ( "MissingBoundingBox", "$SuppliedFileName" ) } } } }
+
+#D The \PDF\ scanning does a similar job. This time we
+#D search for a mediabox. I could have shared some lines
+#D with the previous routines, but prefer readability.
+
+sub HandlePdfFigure
+ { my ( $SuppliedFileName ) = @_ ;
+ ($FileName, $FileSuffix) = SplitFileName ($SuppliedFileName) ;
+ if (lc $FileSuffix ne "pdf")
+ { return }
+ else
+ { $PdfFileName = $SuppliedFileName ;
+ Report ( "PdfFile", "$SuppliedFileName" ) }
+ open ( PDF , $SuppliedFileName ) ;
+ binmode PDF ;
+ $PdfSize = -s PDF ;
+ $MediaBoxFound = 0 ;
+ $MediaBox = 0 ;
+ $PageFound = 0 ;
+ $PagesFound = 0 ;
+ while (<PDF>)
+ { $SomeLine = $_ ;
+ chomp ($SomeLine) ;
+ if ($SomeLine =~ /\/Type\s*\/Pages/io)
+ { $PagesFound = 1 }
+ elsif ($SomeLine =~ /\/Type\s*\/Page/io)
+ { ++$PageFound ;
+ if ($PageFound>1) { last } }
+ if (($PageFound)||($PagesFound))
+ { if (($MediaBoxFound < 2) && ($SomeLine =~ /\/ArtBox\s*\[/io))
+ { $MediaBoxFound = 3 ;
+ $MediaBox = $SomeLine }
+ elsif (($MediaBoxFound < 2) && ($SomeLine =~ /\/CropBox\s*\[/io))
+ { $MediaBoxFound = 2 ;
+ $MediaBox = $SomeLine }
+ elsif (($MediaBoxFound == 0) && ($SomeLine =~ /\/MediaBox\s*\[/io))
+ { $MediaBoxFound = 1 ;
+ $MediaBox = $SomeLine } } }
+ close ( PDF ) ;
+ if ($PageFound>1)
+ { Report ( "MultiPagePdfFile", "$SuppliedFileName" ) }
+ if (($MediaBoxFound) && ($MediaBox))
+ { my $D = "[0-9\-\.]" ;
+ $MediaBox =~ /\/(Media|Crop|Art)Box\s*\[\s*($D+)\s*($D+)\s*($D+)\s*($D+)/o ;
+ $LLX = $2 ; $LLY = $3 ; $URX = $4 ; $URY = $5 ;
+ $PdfHeight = ($URY-$LLY)*$DPtoCM ;
+ $PdfWidth = ($URX-$LLX)*$DPtoCM ;
+ $PdfXOffset = $LLX*$DPtoCM ;
+ $PdfYOffset = $LLY*$DPtoCM ;
+ SaveFigurePresets
+ ( $PdfFileName, "pdf", 1,
+ $PdfXOffset, $PdfYOffset, $PdfWidth, $PdfHeight,
+ "", "", $PdfSize ) }
+ else
+ { Report ( "MissingMediaBox", "$SuppliedFileName" ) } }
+
+#D A previous version of \TEXUTIL\ used \type{tifftags} or
+#D \type{tiffinfo} for collecting the dimensions. However,
+#D the current implementation does this job itself.
+
+sub TifGetByte
+ { my $B = 0 ;
+ read TIF, $B, 1 ;
+ return ord($B) }
+
+sub TifGetShort
+ { my $S = 0 ;
+ read TIF, $S, 2 ;
+ if ($TifLittleEndian)
+ { return (unpack ("v", $S)) }
+ else
+ { return (unpack ("n", $S)) } }
+
+sub TifGetLong
+ { my $L = 0 ;
+ read TIF, $L, 4 ;
+ if ($TifLittleEndian)
+ { return (unpack ("V", $L)) }
+ else
+ { return (unpack ("N", $L)) } }
+
+sub TifGetRational
+ { my ($N, $M) = (0,0) ;
+ $N = TifGetLong ;
+ $M = TifGetLong ;
+ return $N/$M }
+
+sub TifGetAscii
+ { my $S = "" ;
+ --$TifValues;
+ unless ($TifValues)
+ { return "" }
+ else
+ { read TIF, $S, $TifValues ;
+ return $S } }
+
+sub TifGetWhatever
+ { if ($_[0]==1)
+ { return TifGetByte }
+ elsif ($_[0]==2)
+ { return TifGetAscii }
+ elsif ($_[0]==3)
+ { return TifGetShort }
+ elsif ($_[0]==4)
+ { return TifGetLong }
+ elsif ($_[0]==5)
+ { return TifGetRational }
+ else
+ { return 0 } }
+
+sub TifGetChunk
+ { seek TIF, $TifNextChunk, 0 ;
+ $Length = TifGetShort ;
+ $TifNextChunk += 2 ;
+ for ($i=1; $i<=$Length; $i++)
+ { seek TIF, $TifNextChunk, 0 ;
+ $TifTag = TifGetShort ;
+ $TifType = TifGetShort ;
+ $TifValues = TifGetLong ;
+ if ($TifTag==256)
+ { $TifWidth = TifGetWhatever($TifType) }
+ elsif ($TifTag==257)
+ { $TifHeight = TifGetWhatever($TifType) }
+ elsif ($TifTag==296)
+ { $TifUnit = TifGetWhatever($TifType) }
+ elsif ($TifTag==282)
+ { seek TIF, TifGetLong, 0 ;
+ $TifHRes = TifGetWhatever($TifType) }
+ elsif ($TifTag==283)
+ { seek TIF, TifGetLong, 0 ;
+ $TifVRes = TifGetWhatever($TifType) }
+ elsif ($TifTag==350)
+ { seek TIF, TifGetLong, 0 ;
+ $TifCreator = TifGetWhatever($TifType) }
+ elsif ($TifTag==315)
+ { seek TIF, TifGetLong, 0 ;
+ $TifAuthor = TifGetWhatever($TifType) }
+ elsif ($TifTag==269)
+ { seek TIF, TifGetLong, 0 ;
+ $TifTitle = TifGetWhatever($TifType) }
+ $TifNextChunk += 12 }
+ seek TIF, $TifNextChunk, 0 ;
+ $TifNextChunk = TifGetLong ;
+ return ($TifNextChunk>0) }
+
+sub HandleTifFigure
+ { my ( $SuppliedFileName ) = @_ ;
+ ($FileName, $FileSuffix) = SplitFileName ($SuppliedFileName) ;
+ if (lc $FileSuffix ne "tif")
+ { return }
+ else
+ { $TifFile = $SuppliedFileName ;
+ if (open ( TIF, $TifFile )) { # { must be here, perl 5.003 bug
+ Report ( "TifFile", "$SuppliedFileName" ) ;
+ binmode TIF;
+ $TifWidth = 0 ;
+ $TifHeight = 0 ;
+ $TifTitle = "" ;
+ $TifAuthor = "" ;
+ $TifCreator = "" ;
+ $TifUnit = 0 ;
+ $TifHRes = 1 ;
+ $TifVRes = 1 ;
+ $TifSize = -s TIF ;
+ $TifByteOrder = "" ;
+ seek TIF, 0, 0 ;
+ read TIF, $TifByteOrder, 2 ;
+ $TifLittleEndian = ($TifByteOrder eq "II") ;
+ $TifTag = TifGetShort;
+ unless ($TifTag == 42)
+ { close ( TIF ) ;
+ return }
+ $TifNextChunk = TifGetLong ;
+ while (TifGetChunk) { }
+ if ($TifUnit==2)
+ { $TifMult = $INtoCM }
+ elsif ($TifUnit==3)
+ { $TifMult = 1 }
+ else
+ { $TifMult = 72 }
+ $TifWidth = ($TifWidth /$TifHRes)*$TifMult ;
+ $TifHeight = ($TifHeight/$TifVRes)*$TifMult ;
+ close ( TIF ) ;
+ SaveFigurePresets
+ ( $TifFile, "tif", $TifUnit,
+ 0, 0, $TifWidth, $TifHeight,
+ $TifTitle, $TifCreator, $TifSize ) } } }
+
+#D I first intended to use the public utility \type{pngmeta}
+#D (many thanks to Taco for compiling it), but using this
+#D utility to analyze lots of \PNG\ files, I tried to do a
+#D similar job in \PERL. Here are the results:
+
+my ($PngSize, $PngWidth, $PngHeight) = (0,0,0) ;
+my ($PngMult, $PngHRes, $PngVRes, $PngUnit) = (0,1,1,0) ;
+my ($PngFile, $PngTitle, $PngAuthor, $PngCreator) = ("","","") ;
+my ($PngNextChunk, $PngLength, $PngType) = (0,0,0) ;
+my ($PngKeyword, $PngDummy) = ("","") ;
+
+my $PngSignature = chr(137) . chr(80) . chr(78) . chr(71) .
+ chr (13) . chr(10) . chr(26) . chr(10) ;
+sub PngGetByte
+ { my ($B) = 0 ;
+ read PNG, $B, 1 ;
+ return (ord($B)) }
+
+sub PngGetLong
+ { my ($L) = 0 ;
+ read PNG, $L, 4 ;
+ return (unpack("N", $L)) }
+
+sub PngGetChunk
+ { if ($PngNextChunk<$PngSize)
+ { seek PNG, $PngNextChunk, 0 ;
+ $PngLength = PngGetLong ;
+ $PngNextChunk = $PngNextChunk + $PngLength + 12 ;
+ read PNG, $PngType, 4 ;
+ if ($PngType eq "")
+ { return 0 }
+ elsif ($PngType eq "IEND")
+ { return 0 }
+ elsif ($PngType eq "IHDR")
+ { $PngWidth = PngGetLong ;
+ $PngHeight = PngGetLong }
+ elsif ($PngType eq "pHYs")
+ { $PngHRes = PngGetLong ;
+ $PngVRes = PngGetLong ;
+ read PNG, $PngUnit, 1 }
+ elsif ($PngType eq "tEXt")
+ { read PNG, $PngKeyword, $PngLength ;
+ ($PngKeyword,$PngDummy) = split(/\x00/,$PngKeyword) ;
+ if ( $PngKeyword eq "Title")
+ { $PngTitle = $PngDummy }
+ elsif ( $PngKeyword eq "Author")
+ { $PngAuthor = $PngDummy }
+ elsif ( $PngKeyword eq "Software")
+ { $PngCreator = $PngDummy } }
+ return 1 }
+ else
+ { return 0 } }
+
+sub HandlePngFigure
+ { my ( $SuppliedFileName ) = @_ ;
+ ($FileName, $FileSuffix) = SplitFileName ($SuppliedFileName) ;
+ if (lc $FileSuffix ne "png")
+ { return }
+ else
+ { $PngFile = $SuppliedFileName ;
+ if (open ( PNG, $PngFile ))
+ { Report ( "PngFile", "$SuppliedFileName" ) }
+ $PngSize = 0 ;
+ $PngWidth = 0 ;
+ $PngHeight = 0 ;
+ $PngTitle = "" ;
+ $PngAuthor = "" ;
+ $PngCreator = "" ;
+ $PngUnit = 0 ;
+ $PngVRes = 1 ;
+ $PngHRes = 1 ;
+ $PngSig = "" ;
+ $PngSize = -s PNG ;
+ binmode PNG ;
+ seek PNG, 0, 0 ;
+ read PNG, $PngSig, 8;
+ unless ($PngSig eq $PngSignature)
+ { close ( PNG ) ;
+ return }
+ $PngNextChunk = 8 ;
+ while (PngGetChunk) { }
+ $PngWidth = ($PngWidth /$PngVRes) ;
+ $PngHeight = ($PngHeight/$PngHRes) ;
+ close ( PNG ) ;
+ SaveFigurePresets
+ ( $PngFile, "png", $PngUnit,
+ 0, 0, $PngWidth, $PngHeight,
+ $PngTitle, $PngCreator, $PngSize ) } }
+
+#D Well, we also offer \JPG\ scanning (actually \JFIF)
+#D scanning. (I can recomend David Salomon's book on Data
+#D Compression to those interested in the internals of
+#D \JPG.)
+#D
+#D It took me some time to discover that the (sort of)
+#D reference document I used had a faulty byte position table.
+#D Nevertheless, when I was finaly able to grab the header,
+#D Piet van Oostrum pointer me to the \PERL\ script of Alex
+#D Knowles (and numerous other contributers), from which I
+#D could deduce what segment contained the dimensions.
+
+my ($JpgSize, $JpgWidth, $JpgHeight) = (0,0,0) ;
+my ($JpgMult, $JpgUnit, $JpgHRes, $JpgVRes) = (1,0,1,1) ;
+my ($JpgFile, $JpgVersion, $JpgDummy) = ("",0,"") ;
+my ($JpgSig, $JpgPos, $JpgLen, $JpgSoi, $JpgApp) = ("",0,0,0,0) ;
+
+my $JpgSignature = "JFIF" . chr(0) ;
+
+sub JpgGetByte
+ { my ($B) = 0 ;
+ read JPG, $B, 1 ;
+ return ( ord($B) ) }
+
+sub JpgGetInteger
+ { my ($I) = 0 ;
+ read JPG, $I, 2 ;
+ return (unpack("n", $I)) }
+
+sub HandleJpgFigure
+ { my ($SuppliedFileName) = @_ ;
+ ($FileName, $FileSuffix) = SplitFileName ($SuppliedFileName) ;
+ if (lc $FileSuffix ne "jpg")
+ { return }
+ else
+ { $JpgFile = $SuppliedFileName ;
+ Report ( "JpgFile", "$SuppliedFileName" ) }
+ open ( JPG, $JpgFile ) ;
+ binmode JPG ;
+ $JpgSignature = "JFIF" . chr(0) ;
+ $JpgSize = -s JPG ;
+ $JpgWidth = 0 ;
+ $JpgHeight = 0 ;
+ $JpgUnit = 0 ;
+ $JpgVRes = 1 ;
+ $JpgHRes = 1 ;
+ seek JPG, 0, 0 ;
+ read JPG, $JpgSig, 4 ;
+ unless ($JpgSig eq chr(255).chr(216).chr(255).chr(224))
+ { close ( JPG ) ;
+ return }
+ $JpgLen = JpgGetInteger;
+ read JPG, $JpgSig, 5 ;
+ unless ($JpgSig eq $JpgSignature)
+ { close ( JPG ) ;
+ return }
+ $JpgUnit = JpgGetByte ;
+ $JpgVersion = JpgGetInteger ;
+ $JpgHRes = JpgGetInteger ;
+ $JpgVRes = JpgGetInteger ;
+ $JpgPos = $JpgLen + 4 ;
+ $JpgSoi = 255 ;
+ while ()
+ { seek JPG, $JpgPos, 0 ;
+ $JpgSoi = JpgGetByte ;
+ $JpgApp = JpgGetByte ;
+ $JpgLen = JpgGetInteger ;
+ if ($JpgSoi!=255)
+ { last }
+ if (($JpgApp>=192) && ($JpgApp<=195)) # Found in the perl script.
+ { $JpgDummy = JpgGetByte ; # Found in the perl script.
+ $JpgHeight = JpgGetInteger ; # Found in the perl script.
+ $JpgWidth = JpgGetInteger } # Found in the perl script.
+ $JpgPos = $JpgPos + $JpgLen + 2 }
+ close ( JPG ) ;
+ if ($JpgUnit==1)
+ { $JpgMult = $INtoCM }
+ else
+ { $JpgMult = 1 }
+ $JpgHRes = 72 unless $JpgHRes>1 ;
+ $JpgVRes = 72 unless $JpgVRes>1 ;
+ $JpgWidth = ($JpgWidth/$JpgHRes)*$JpgMult ;
+ $JpgHeight = ($JpgHeight/$JpgVRes)*$JpgMult ;
+ close ( JPG ) ;
+ SaveFigurePresets
+ ( $JpgFile, "jpg", $JpgUnit,
+ 0, 0, $JpgWidth, $JpgHeight,
+ "", "", $JpgSize ) }
+
+#D Now we can handle figures!
+
+sub InitializeFigures
+ { $NOfFigures = 0 }
+
+sub FlushFigures
+ { SetOutputFile ("texutil.tuf") ;
+ open ( TUF, ">$OutputFile" ) ;
+ print TUF "%\n" . "% $Program / Figures\n" . "%\n" ;
+ print TUF "\\thisisfigureversion\{1996.06.01\}\n" . "%\n" ;
+ for ($n=1 ; $n<=$NOfFigures ; ++$n)
+ { print TUF $Figures[$n] }
+ close (TUF) ;
+ if ($NOfFigures)
+ { Report("OutputFile", $OutputFile ) }
+ else
+ { unlink $OutputFile }
+ Report ( "NOfFigures", $NOfFigures ) }
+
+sub DoHandleFigures
+ { my ($FigureSuffix, $FigureMethod) = @_ ;
+ if ($InputFile eq "")
+ { $InputFile = $FigureSuffix }
+ CheckInputFiles ($InputFile) ;
+ foreach $FileName (@UserSuppliedFiles)
+ { &{$FigureMethod} ( $FileName ) } }
+
+sub HandleFigures
+ { Report("Action", "GeneratingFigures" ) ;
+ foreach $FileType (@ARGV)
+ { if ($FileType=~/\.eps/io)
+ { Report("Option", "UsingEps") ;
+ if ($ProcessEpsToPdf) { Report("Option", "EpsToPdf") }
+ if ($ProcessEpsPage) { Report("Option", "EpsPage") }
+ last } }
+ foreach $FileType (@ARGV)
+ { if ($FileType=~/\.pdf/io)
+ { Report("Option", "UsingPdf") ;
+ last } }
+ foreach $FileType (@ARGV)
+ { if ($FileType=~/\.tif/io)
+ { Report("Option", "UsingTif") ;
+ #RunTifPrograms ;
+ last } }
+ foreach $FileType (@ARGV)
+ { if ($FileType=~/\.png/io)
+ { Report("Option", "UsingPng") ;
+ last } }
+ foreach $FileType (@ARGV)
+ { if ($FileType=~/\.jpg/io)
+ { Report("Option", "UsingJpg") ;
+ last } }
+ InitializeFigures ;
+ DoHandleFigures ("eps", "HandleEpsFigure") ;
+ DoHandleFigures ("pdf", "HandlePdfFigure") ;
+ DoHandleFigures ("tif", "HandleTifFigure") ;
+ DoHandleFigures ("png", "HandlePngFigure") ;
+ DoHandleFigures ("jpg", "HandleJpgFigure") ;
+ FlushFigures }
+
+#D \extras
+#D {logfiles}
+#D
+#D This (poor man's) log file scanning routine filters
+#D overfull box messages from a log file (\type{\hbox},
+#D \type{\vbox} or both). The collected problems are saved
+#D in \type{$ProgramLog}. One can specify a selection
+#D criterium.
+#D
+#D \CONTEXT\ reports unknown entities. These can also be
+#D filtered. When using fast computers, or when processing
+#D files in batch, one has to rely on the log files and/or
+#D this filter.
+
+$Unknown = "onbekende verwijzing|" .
+ "unbekannte Referenz|" .
+ "unknown reference|" .
+ "dubbele verwijzing|" .
+ "duplicate reference|" .
+ "doppelte Referenz" ;
+
+sub FlushLogTopic
+ { unless ($TopicFound)
+ { $TopicFound = 1 ;
+ print ALL "\n% File: $FileName.log\n\n" } }
+
+sub HandleLogFile
+ { if ($ProcessBox)
+ { Report("Option", "FilteringBoxes", "(\\vbox & \\hbox)") ;
+ $Key = "[h|v]box" }
+ elsif ($ProcessHBox)
+ { Report("Option", "FilteringBoxes", "(\\hbox)") ;
+ $Key = "hbox" ;
+ $ProcessBox = 1 }
+ elsif ($ProcessVBox)
+ { Report("Option", "FilteringBoxes", "(\\vbox)") ;
+ $Key = "vbox" ;
+ $ProcessBox = 1 }
+ if (($ProcessBox) && ($ProcessCriterium))
+ { Report("Option", "ApplyingCriterium") }
+ if ($ProcessUnknown)
+ { Report("Option", "FilteringUnknown") }
+ unless (($ProcessBox) || ($ProcessUnknown))
+ { ShowHelpInfo ;
+ return }
+ Report("Action", "FilteringLogFile" ) ;
+ if ($InputFile eq "")
+ { Report("Error", "NoInputFile") }
+ else
+ { $NOfBoxes = 0 ;
+ $NOfMatching = 0 ;
+ $NOfUnknown = 0 ;
+ SetOutputFile ($ProgramLog) ;
+ Report("OutputFile", $OutputFile) ;
+ CheckInputFiles ($InputFile) ;
+ open ( ALL, ">$OutputFile" ) ;
+ foreach $FullName (@UserSuppliedFiles)
+ { ($FileName, $FileSuffix) = SplitFileName ($FullName) ;
+ if (! open (LOG, "$FileName.log"))
+ { Report("Error", "EmptyInputFile", "$FileName.$FileSuffix" ) }
+ elsif (-e "$FileName.tex")
+ { $TopicFound = 0 ;
+ Report("InputFile", "$FileName.log") ;
+ while (<LOG>)
+ { $SomeLine = $_ ;
+ chomp $SomeLine ;
+ if (($ProcessBox) && ($SomeLine =~ /Overfull \\$Key/))
+ { ++$NOfBoxes ;
+ $SomePoints = $SomeLine ;
+ $SomePoints =~ s/.*\((.*)pt.*/$1/ ;
+ if ($SomePoints>=$ProcessCriterium)
+ { ++$NOfMatching ;
+ FlushLogTopic ;
+ print ALL "$SomeLine\n" ;
+ $SomeLine=<LOG> ;
+ print ALL $SomeLine } }
+ if (($ProcessUnknown) && ($SomeLine =~ /$Unknown/io))
+ { ++$NOfUnknown ;
+ FlushLogTopic ;
+ print ALL "$SomeLine\n" } } } }
+ close (ALL) ;
+ unless (($NOfBoxes) ||($NOfUnknown))
+ { unlink $OutputFile }
+ if ($ProcessBox)
+ { Report ( "NOfBoxes" , "$NOfBoxes", "->", $NOfMatching, "Overfull") }
+ if ($ProcessUnknown)
+ { Report ( "NOfUnknown", "$NOfUnknown") } } }
+
+#D Undocumented feature.
+#
+# obsolete, i.e now in ctxtools, so this will become:
+#
+# sub PurgeFiles {
+# if ($PurgeAllFiles) {
+# system("ctxtools --purge $ARGV[0]") ;
+# } else {
+# system("ctxtools --purge --all $ARGV[0]") ;
+# }
+
+my $removedfiles = 0 ;
+my $keptfiles = 0 ;
+my $persistentfiles = 0 ;
+my $reclaimedbytes = 0 ;
+
+sub RemoveContextFile
+ { my $filename = shift ;
+ my $filesize = -s $filename ;
+ unlink $filename ;
+ if (-e $filename)
+ { ++$persistentfiles ;
+ print " persistent : $filename\n" }
+ else
+ { ++$removedfiles ; $reclaimedbytes += $filesize ;
+ print " removed : $filename\n" } }
+
+sub KeepContextFile
+ { my $filename = shift ;
+ ++$keptfiles ;
+ print " kept : $filename\n" }
+
+my @dontaskprefixes = sort glob "mpx-*" ; push @dontaskprefixes ,
+ ("tex-form.tex","tex-edit.tex","tex-temp.tex",
+ "texexec.tex","texexec.tui","texexec.tuo",
+ "texexec.ps","texexec.pdf","texexec.dvi",
+ "cont-opt.tex","cont-opt.bak") ;
+my @dontasksuffixes =
+ ("mpgraph.mp","mpgraph.mpd","mpgraph.mpo","mpgraph.mpy",
+ "mprun.mp", "mprun.mpd", "mprun.mpo", "mprun.mpy",
+ "xlscript.xsl") ;
+my @forsuresuffixes =
+ ("tui","tup","ted","tes","top",
+ "log","tmp","run","bck","rlg",
+ "mpt","mpx","mpd","mpo") ;
+my @texonlysuffixes =
+ ("dvi","ps","pdf") ;
+my @texnonesuffixes =
+ ("tuo","tub","top") ;
+
+if ($PurgeAllFiles)
+ { push @forsuresuffixes, @texnonesuffixes ; @texnonesuffixes = [] }
+
+sub PurgeFiles # no my in foreach
+ { my $pattern = $ARGV[0] ; my $strippedname, $basename ;
+ my @files = () ;
+ if ($pattern eq '')
+ { $pattern = "*.*" ;
+ @files = glob $pattern }
+ else
+ { $pattern = $ARGV[0] . "-*.*" ;
+ @files = glob $pattern ;
+ $pattern = $ARGV[0] . ".*" ;
+ push(@files,glob $pattern) }
+ @files = sort @files ;
+ print " purging files : $pattern\n\n" ;
+ foreach $file (@dontaskprefixes)
+ { if (-e $file)
+ { RemoveContextFile($file) } }
+ foreach $file (@dontasksuffixes)
+ { if (-e $file)
+ { RemoveContextFile($file) } }
+ foreach $suffix (@dontasksuffixes)
+ { foreach (@files)
+ { if (/$suffix$/i)
+ { RemoveContextFile($_) } } }
+ foreach $suffix (@forsuresuffixes)
+ { foreach (@files)
+ { if (/\.$suffix$/i)
+ { RemoveContextFile($_) } } }
+ foreach $file (@files)
+ { if ($file =~ /(.*?)\.\d+$/)
+ { $basename = $1 ;
+ if (($file =~ /mp(graph|run)/) || (-e "$basename.mp"))
+ { RemoveContextFile($file) } } }
+ foreach $suffix (@texnonesuffixes)
+ { foreach (@files)
+ { if (/(.*)\.$suffix$/i)
+ { if ((-e "$1.tex")||(-e "$1.xml")||(-e "$1.fo"))
+ { KeepContextFile($_) }
+ else
+ { $strippedname = $1 ;
+ $strippedname =~ s/\-[a-z]$//io ;
+ if ((-e "$strippedname.tex")||(-e "$strippedname.xml"))
+ { KeepContextFile($_." (potential result file)") }
+ else
+ { RemoveContextFile($_) } } } } }
+ if ($removedfiles||$keptfiles||$persistentfiles)
+ { print "\n" }
+ print " removed files : $removedfiles\n" ;
+ print " kept files : $keptfiles\n" ;
+ print " persistent files : $persistentfiles\n" ;
+ print " reclaimed bytes : $reclaimedbytes\n" }
+
+#D Another undocumented feature.
+#
+# obsolete, i.e now in pdftools, so this will become:
+#
+# sub AnalyzeFile
+# { system("pdftools --analyze $ARGV[0]") }
+
+sub AnalyzeFile
+ { my $filename = $ARGV[0] ;
+ return unless (($filename =~ /\.pdf/)&&(-e $filename)) ;
+ my $filesize = -s $filename ;
+ print " analyzing file : $filename\n" ;
+ print " file size : $filesize\n" ;
+ open (PDF, $filename) ;
+ binmode PDF ;
+ my $Object = 0 ;
+ my $Annot = 0 ;
+ my $Link = 0 ;
+ my $Widget = 0 ;
+ my $Named = 0 ;
+ my $Script = 0 ;
+ my $Cross = 0 ;
+ while (<PDF>)
+ { while (/\d+\s+\d+\s+obj/go) { ++$Object } ;
+ while (/\/Type\s*\/Annot/go) { ++$Annot } ;
+ while (/\/GoToR\s*\/F/go) { ++$Cross } ;
+ while (/\/Subtype\s*\/Link/go) { ++$Link } ;
+ while (/\/Subtype\s*\/Widget/go) { ++$Widget } ;
+ while (/\/S\s*\/Named/go) { ++$Named } ;
+ while (/\/S\s*\/JavaScript/go) { ++$Script } }
+ close (PDF) ;
+ print " objects : $Object\n" ;
+ print " annotations : $Annot\n" ;
+ print " links : $Link ($Named named / $Script scripts / $Cross files)\n" ;
+ print " widgets : $Widget\n" }
+
+# moved to ctxtools
+#
+# sub FilterPages
+# { system("ctxtools $ARGV{0]") }
+
+sub FilterPages # temp feature / no reporting
+ { my $filename = $ARGV[0] ;
+ return unless -f "$filename.pdf" ;
+ my $old = '' ;
+ my $n = 0 ;
+ if (open(PDF,"<$filename.pdf") && open(TUO,">>$filename.tuo"))
+ { binmode PDF ;
+ while (<PDF>)
+ { chomp ;
+ if (($_ eq '/Type /Page') && ($old =~ /^(\d+)\s+0\s+obj/o))
+ { ++$n ; $p = $1 ;
+ print TUO "\\objectreference{PDFP}{$n}{$p}{$n}\n" }
+ else
+ { $old = $_ } }
+ close(PDF) ;
+ close(TUO) } }
+
+ ShowBanner ;
+
+if ($UnknownOptions ) { ShowHelpInfo } # not yet done
+elsif ($ProcessReferences) { HandleReferences }
+elsif ($ProcessDocuments ) { HandleDocuments }
+elsif ($ProcessSources ) { HandleSources }
+elsif ($ProcessSetups ) { HandleSetups }
+elsif ($ProcessTemplates ) { HandleEditorCues }
+elsif ($ProcessInfos ) { HandleEditorCues }
+elsif ($ProcessFigures ) { HandleFigures }
+elsif ($ProcessLogFile ) { HandleLogFile }
+elsif ($PurgeFiles ) { PurgeFiles }
+elsif ($PurgeAllFiles ) { PurgeFiles }
+elsif ($AnalyzeFile ) { AnalyzeFile }
+elsif ($FilterPages ) { FilterPages }
+elsif ($SciteApi ) { GenerateSciteApi }
+elsif ($ProcessHelp ) { ShowHelpInfo } # redundant
+else { ShowHelpInfo }
+
+#D So far.
diff --git a/Master/texmf-dist/scripts/context/perl/utiplug.pm b/Master/texmf-dist/scripts/context/perl/utiplug.pm
new file mode 100644
index 00000000000..2bc162e1e38
--- /dev/null
+++ b/Master/texmf-dist/scripts/context/perl/utiplug.pm
@@ -0,0 +1,30 @@
+package utiplug ;
+
+my @data ;
+my @result ;
+
+sub utiplug::initialize
+ { @data = () }
+
+sub utiplug::process
+ { @data = sort @data ;
+ for (my $i=0; $i<@data; $i++)
+ { @result[$i] = "\\plugintest\{$i\}\{$data[$i]\}" } }
+
+sub utiplug::handle
+ { my ($self,$text,$rest) = @_ ; push @data, $text }
+
+sub utiplug::identify
+ { return "utiplug test plugin" }
+
+sub utiplug::report
+ { my $keys = @data ;
+ if ($keys)
+ { return ("done", "keys:$keys") }
+ else
+ { return ("nothing done") } }
+
+sub utiplug::results
+ { return @result }
+
+1 ;
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-27 18:44:52 +0000