From ab3f887feadf929129087cd2cbc3783064507565 Mon Sep 17 00:00:00 2001 From: Hans Hagen Date: Fri, 9 Apr 2004 00:00:00 +0200 Subject: stable 2004.04.09 --- scripts/context/perl/cont_mis.pm | 69 + scripts/context/perl/cont_set.pm | 670 +++++++++ scripts/context/perl/fdf2tan.pl | 121 ++ scripts/context/perl/fdf2tex.pl | 213 +++ scripts/context/perl/makempy.pl | 355 +++++ scripts/context/perl/mptopdf.pl | 117 ++ scripts/context/perl/path_tre.pm | 36 + scripts/context/perl/texexec.pl | 2665 +++++++++++++++++++++++++++++++++++ scripts/context/perl/texexec.rme | 159 +++ scripts/context/perl/texfind.pl | 270 ++++ scripts/context/perl/texfont.pl | 1153 +++++++++++++++ scripts/context/perl/texshow.pl | 97 ++ scripts/context/perl/texutil.pl | 2878 ++++++++++++++++++++++++++++++++++++++ scripts/context/perl/utiplug.pm | 30 + 14 files changed, 8833 insertions(+) create mode 100644 scripts/context/perl/cont_mis.pm create mode 100644 scripts/context/perl/cont_set.pm create mode 100644 scripts/context/perl/fdf2tan.pl create mode 100644 scripts/context/perl/fdf2tex.pl create mode 100644 scripts/context/perl/makempy.pl create mode 100644 scripts/context/perl/mptopdf.pl create mode 100644 scripts/context/perl/path_tre.pm create mode 100644 scripts/context/perl/texexec.pl create mode 100644 scripts/context/perl/texexec.rme create mode 100644 scripts/context/perl/texfind.pl create mode 100644 scripts/context/perl/texfont.pl create mode 100644 scripts/context/perl/texshow.pl create mode 100644 scripts/context/perl/texutil.pl create mode 100644 scripts/context/perl/utiplug.pm (limited to 'scripts') diff --git a/scripts/context/perl/cont_mis.pm b/scripts/context/perl/cont_mis.pm new file mode 100644 index 000000000..6bd449bf0 --- /dev/null +++ b/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/scripts/context/perl/cont_set.pm b/scripts/context/perl/cont_set.pm new file mode 100644 index 000000000..9c6d2cbcd --- /dev/null +++ b/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 ('', \&update_setup ) ; +$cw -> bind ('<1>' , \&update_setup ) ; +$cw -> bind ('' , \&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 () + { 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 ('', 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 ( "", sub { insert_request(shift, $chr) } ) } + +$mw -> bind ( "", 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 ( "", sub { delete_request } ) ; + +sub new_request + { $request -> delete (0,'end') ; + handle_request } + +$mw -> bind ( "", 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/scripts/context/perl/fdf2tan.pl b/scripts/context/perl/fdf2tan.pl new file mode 100644 index 000000000..c612f9886 --- /dev/null +++ b/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 () + { if (/\/MediaBox\s*\[\s*($D+)\s*($D+)\s*($D+)\s*($D+)/o) + { $PDFllx = $1 ; $PDFlly = $2 ; $PDFurx = $3 ; $PDFury = $4 ; + last } } + +$_ = "" ; while ($Line=) { 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/\\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/scripts/context/perl/fdf2tex.pl b/scripts/context/perl/fdf2tex.pl new file mode 100644 index 000000000..f9684cd9f --- /dev/null +++ b/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=) { chomp $Line; $_ .= $Line } + +# or faster: dan ///s gebruiken (ipv m) + +# $/ = "\0777" ; $_ = ; + +# zoom in on the objects and remove the header and trialer + +if ($InpFile =~ /\.xml$/) + +{ # begin kind of xml alternative + +s/\>\s*\\/\\FDFfield\[$1\]\n/goms ; +s/(name|value)\=\"(.*?)\"/$1=\{$2\}/goms ; +s/\} (name|value)/\}\,$1/goms ; +s/\(.*?)\<\/fdfobject\>/\\beginFDFobject\n$1\\endFDFobject\n/goms ; +s/\(.*?)\<\/fdfdata\>/\\beginFDFdata\n$1\\endFDFdata\n/goms ; +s/\(.*?)\<\/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/\\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/\#/\\#/ ; + +# 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/scripts/context/perl/makempy.pl b/scripts/context/perl/makempy.pl new file mode 100644 index 000000000..3efbce4e0 --- /dev/null +++ b/scripts/context/perl/makempy.pl @@ -0,0 +1,355 @@ +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. + +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 , + "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 ps->pdf (on unix)") ; + report ("--pdftops : use pdftops (xpdf) ps->pdf") ; + report ("--ghostscript : use ghostscript (gs) for ps->pdf") ; + 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*",) % 65535 } ; + close (MPO) ; + return unless open (MPY,"$mpyfile") ; + my $str = ; 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 = ; + 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 () + { 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 () + { 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", + "-paperw 10000 -paperh 10000 $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 + { process ("metapost file") ; + run ($tmpfile, "$pstoedit", "-ssp -dt -f mpost $posfile $tmpfile") } + +if ($help) { show_help_info } + +check_input_file ; +verify_check_sum ; +cleanup_files ; +construct_tex_file ; +make_pdf_pages ; +make_mp_figures ; +make_mp_pictures ; +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/scripts/context/perl/mptopdf.pl b/scripts/context/perl/mptopdf.pl new file mode 100644 index 000000000..337869519 --- /dev/null +++ b/scripts/context/perl/mptopdf.pl @@ -0,0 +1,117 @@ +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=2000.05.29, +#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 = 0 ; +my $PassOn = '' ; + +&GetOptions + ( "help" => \$Help , + "rawmp" => \$RawMP, + "passon" => \$PassOn, + "latex" => \$Latex ) ; + +my $program = "MPtoPDF 1.2" ; +my $pattern = $ARGV[0] ; +my $done = 0 ; +my $report = '' ; +my $latexswitch = " --tex=latex --format=latex " ; + +## $dosish = ($Config{'osname'} =~ /dos|mswin/i) ; +my $dosish = ($Config{'osname'} =~ /^(ms)?dos|^os\/2|^(ms|cyg)win/i) ; + +my $miktex = ($ENV{"TEXSYSTEM"} =~ /miktex/io); + +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 () { 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 () + { if (/(documentstyle|documentclass|begin\{document\})/io) + { $Latex = 1 ; last } } + close (INP) } + if ($Latex) + { $rest .= " $latexswitch" } + if ($RawMP) + { $mpbin = 'mpost' } + else + { $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) + { if ($dosish) + { $command = "pdfetex &mptopdf" } + else + { $command = "pdfetex \\&mptopdf" } } + else +# { $command = "pdfetex -progname=pdfetex -efmt=mptopdf" } + { $command = "pdfetex -progname=context -efmt=mptopdf" } + if ($dosish) + { system ("$command \\relax $file") } + else + { system ("$command \\\\relax $file") } + 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/scripts/context/perl/path_tre.pm b/scripts/context/perl/path_tre.pm new file mode 100644 index 000000000..546afcd27 --- /dev/null +++ b/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/scripts/context/perl/texexec.pl b/scripts/context/perl/texexec.pl new file mode 100644 index 000000000..e3bf969ec --- /dev/null +++ b/scripts/context/perl/texexec.pl @@ -0,0 +1,2665 @@ +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=2003.09.16, +#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}. + +use strict ; + +# 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; + +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) % 1440; + +# 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 $DVIspec = 'dvispec'; +my $SGMLtoTeX = 'sgml2tex'; +my $FDFtoTeX = 'fdf2tex'; + +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 $MainBodyFont = 'standard'; +my $MainLanguage = 'standard'; +my $MainResponse = 'standard'; +my $MakeFormats = 0; +my $Markings = 0; +my $Mode = ''; +my $NoArrange = 0; +my $NoDuplex = 0; +my $NOfRuns = 7; +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 $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 $LogFile = ""; +my $MpyForce = 0; +my $InpPath = ""; +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; + +# 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, + "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, + "paper=s" => \$PaperFormat, + "passon=s" => \$PassOn, + "path=s" => \$InpPath, + "pdf" => \$ProducePdfT, + "pdm" => \$ProducePdfM, + "pdx" => \$ProducePdfX, + "pdfarrange" => \$PdfArrange, + "pdfselect" => \$PdfSelect, + "pdfcombine" => \$PdfCombine, + "pdfcopy" => \$PdfCopy, + "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, + "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 +); # don't check name + +# 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 ($ScreenSaver) { + $ForceFullScreen = 1; + $TypesetFigures = 'c'; + $ProducePdfT = 1; + $Purge = 1; +} + +if ( $DoMPTeX || $DoMPXTeX ) { + $RunOnce = 1; + $ProducePdfT = 0; + $ProducePdfX = 0; + $ProducePdfM = 0; +} + +if ( $PdfArrange || $PdfSelect || $PdfCopy || $PdfCombine ) { + $ProducePdfT = 1; + $RunOnce = 1; +} + +if ($ProducePdfT) { $OutputFormat = "pdftex" } +elsif ($ProducePdfM) { $OutputFormat = "dvipdfm" } +elsif ($ProducePdfX) { $OutputFormat = "dvipdfmx" } + +if ($AutoPdf) { + $PdfOpen = $PdfClose = 1 ; +} + +if ( $RunOnce || $Pages || $TypesetFigures || $TypesetListing ) { $NOfRuns = 1 } + +if ( ( $LogFile ne '' ) && ( $LogFile =~ /\w+\.log$/io ) ) { + open( LOGFILE, ">$LogFile" ); + *STDOUT = *LOGFILE; + *STDERR = *LOGFILE; +} + +my $Program = " TeXExec 4.3 - ConTeXt / PRAGMA ADE 1997-2004"; + +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 to +# for