#!/usr/local/bin/perl -w
#
# $Id: pp2latex,v 1.11 2001/06/15 15:56:02 lorenz Exp lorenz $
# $Revision: 1.11 $
# $Date: 2001/06/15 15:56:02 $
#
# $Author: lorenz $
#
# Revision History: See end of file
#===================================================================

# declare script package
package PerlPoint::Converter::pp2latex;

use Pod::Text;
use Getopt::ArgvFile qw(argvFile);
use Getopt::Long;
use Data::Dumper;
                     

# pragmata
use strict;
use subs "flush", "push_page", "pp_warn";

# load modules
use File::Basename;
use Carp;
use Safe;
use PerlPoint::Tags::HTML;
use PerlPoint::Tags::LaTeX;
use PerlPoint::Backend;
use PerlPoint::Parser 0.34;
use PerlPoint::Constants;

(my $me = $0) =~ s#.*/##;

my $VERSION = sprintf("%d.%02d", q/$Revision: 1.11.01 $/ =~ /(\d+)\.(\d+)/);
my $PACK_VERSION = "0.11";
$main::VERSION = $VERSION;

my $nix = "";                      # for using RCS keys in Usage, ...
my $Date = "Date ";


#============================================================= Usage

sub Usage {
  no strict;
  $^W = 0;
  my $tmpfile = "/tmp/$me.$$_help";
  open(ME, "< $0") or die "Can't open $me: $!\n";
  open(TMP, "> $tmpfile") or die "Can't open $tmpfile: $!\n";
  while(<ME>){
    s/PROGRAM/$me/g;
    s/P_VERSION/$VERSION/g;
    print TMP $_;
  }
  close(TMP);
  pod2text( $tmpfile );
  unlink $tmpfile;
  exit;  # we're done
} # Usage

#==================================================== Parameter Loop

my %OPT = (

  slide_dir       => ".",
  no_index        => 0,

);

argvFile( home => 1, default => 1);

if (defined $ARGV[0] and $ARGV[0] =~ /-v$/){
  @ARGV =("-version");  # to avoid ambiguities
}
my $verbose = 1;

GetOptions( \%OPT,

  "activeContents",
  "cache",
  "cacheCleanup",
  "filter=s",
  "no_index",
  "nocopyright",
  "noinfo",
  "nowarn",
  "quiet",
  "safeOpcode=s@",
  "set=s@",
  "slide_dir=s",
  "trace:i",
  "prolog=s",
  "help",
  "version",

);

# propagate options as necessary
@OPT{qw(nocopyright noinfo nowarn)}=(1,1,1) if exists $OPT{quiet};
$OPT{trace}=$ENV{SCRIPTDEBUG} if not exists $OPT{trace} and exists $ENV{SCRIPTDEBUG};


#======================================================= Script Body
Usage(1) if ($OPT{help});
print STDERR "This is $me, build $VERSION from PerlPoint-Converters $PACK_VERSION\n" unless $OPT{quiet};
print STDERR "$Date: 2001/06/15 15:56:02 $nix\n" unless $OPT{quiet};
print STDERR "(c) Lorenz Domke <lorenz.domke\@gmx.de> 2001.\n\n" unless $OPT{nocopyright};
exit if $OPT{version};


$verbose = 0 if ($OPT{quiet});

my ($li_start, $li_end);
$li_start = "\\item ";
$li_end = "\n";

# declare variables
# Data Structures
# 000000000000000
my $embedded_latex = 0;

my (@streamData);
my $verbatim_flag = 0;

my $page_ref;  # pointer to current page buffer

my @PAGES;     # Array of pointers to PAGE structures
#  $PAGES[ $m ] = {
#                    BODY => [ ... ],
#                    LEVEL => ...,
#                    HD => ...,
#                    PREV => ...,
#                    NEXT => ...,
#                    UP => ...,
#                    DOWN => ...,
#                 }
my $page_cnt = -1;
my %ANCHOR;  # $ANCHOR{a_name} = $page_cnt

my %INDEX;
my $idx_cnt = 0;



# declare list of tag openers
# some are only needed for compatibility with pp2htm

# build parser
my ($parser)=new PerlPoint::Parser;


# build and configure a Safe object
my $safe = new Safe;
if (exists $OPT{safeOpcode}){
  unless (grep($_ eq 'ALL', @{$OPT{safeOpcode}})) {
     # configure compartment
     $safe->permit(@{$OPT{safeOpcode}});
  } else {
     # simply flag that we want to execute active contents
     $safe=1;
  }
}

# and call it
$parser->run(
             stream  => \@streamData,
             files   => \@ARGV,
             safe    => exists $OPT{activeContents} ? $safe : undef,
             filter  => exists $OPT{filter} ? $OPT{filter} : "perl|latex",
             activeBaseData => {
                                targetLanguage => 'SDF',
                                userSettings   => {map {$_=>1} exists $OPT{set} ? @{$OPT{set}} : ()},
                               },
             vispro  => 1,
             nestedTables => 1,
             var2stream   => 1,
             predeclaredVars => {
                                 CONVERTER_NAME    => basename($0),
                                 CONVERTER_VERSION => $main::VERSION,
                                },
             trace   => TRACE_NOTHING
                      + ((exists $OPT{trace} and $OPT{trace} &  1) ? TRACE_PARAGRAPHS : 0) 
                      + ((exists $OPT{trace} and $OPT{trace} &  2) ? TRACE_LEXER      : 0)
                      + ((exists $OPT{trace} and $OPT{trace} &  4) ? TRACE_PARSER     : 0)
                      + ((exists $OPT{trace} and $OPT{trace} &  8) ? TRACE_SEMANTIC   : 0)
                      + ((exists $OPT{trace} and $OPT{trace} & 16) ? TRACE_ACTIVE     : 0),
             display => DISPLAY_ALL
                      + (exists $OPT{noinfo} ? DISPLAY_NOINFO : 0)                                
                      + (exists $OPT{nowarn} ? DISPLAY_NOWARN : 0),
             cache   => (exists $OPT{cache} ? CACHE_ON : CACHE_OFF)
                      + (exists $OPT{cacheCleanup} ? CACHE_CLEANUP : 0),
            ) or exit 1;


# build a backend
my $backend=new PerlPoint::Backend(name=>$me, trace=>TRACE_NOTHING);
#my $backend=new PerlPoint::Backend(name=>$me, trace=>TRACE_BACKEND);

# register backend handlers
$backend->register(DIRECTIVE_BLOCK,        \&handleBlock);
$backend->register(DIRECTIVE_COMMENT,      \&handleComment);
$backend->register(DIRECTIVE_DOCUMENT,     \&handleDocument);
$backend->register(DIRECTIVE_HEADLINE,     \&handleHeadline);
$backend->register(DIRECTIVE_LIST_LSHIFT,  \&handleLShift);
$backend->register(DIRECTIVE_LIST_RSHIFT,  \&handleRShift);
$backend->register(DIRECTIVE_ULIST,        \&handleList);
$backend->register(DIRECTIVE_UPOINT,       \&handlePoint);
$backend->register(DIRECTIVE_OLIST,        \&handleList);
$backend->register(DIRECTIVE_OPOINT,       \&handlePoint);
$backend->register(DIRECTIVE_DLIST,        \&handleList);
$backend->register(DIRECTIVE_DPOINT,       \&handleDPoint);
$backend->register(DIRECTIVE_DPOINT_ITEM,  \&handleDPointItem);
$backend->register(DIRECTIVE_SIMPLE,       \&handleSimple);
$backend->register(DIRECTIVE_TAG,          \&handleTag);
$backend->register(DIRECTIVE_TEXT,         \&handleText);
$backend->register(DIRECTIVE_VERBATIM ,    \&handleVerbatim);

my @BUFFER;
my @ERRBUFFER;  # buffer for context of error 
my $box_bg_color= "blue";
my $box_fg_color= "white";

# and run it
$backend->run(\@streamData,
             display => DISPLAY_ALL
                      + (exists $OPT{noinfo} ? DISPLAY_NOINFO : 0)                                
                      + (exists $OPT{nowarn} ? DISPLAY_NOWARN : 0),
);

begin_doc();

## Now do your job: output the pages ...
for (my $i = 0; $i <= $page_cnt; $i++){
  print STDERR "New Page $i: Level ",
   $PAGES[$i]->{LEVEL}, " ===> ",
   $PAGES[$i]->{HD},
   , " <===\n" if $verbose;

  # print page body
  foreach my $line ( @{$PAGES[$i]->{BODY}} ){
    # Replace _INTERNAL_SECTION with correct hyperlink
    while ($line =~ /_INTERN_SECTION:(.*?):_END/){
      my $a_name = $1;
      if (! defined $ANCHOR{$a_name}) {
        warn "**** SECTIONREF with undefined anchor name '$a_name' detected\n";
        $line =~ s/_INTERN_SECTION:.*?:_END/_UNDEF_/;  # will flag an error while processing with latex !
        next;
      }
      my $hd = $PAGES[$ANCHOR{$a_name}] -> {HD};
      $line =~ s/_INTERN_SECTION:.*?:_END/$hd/;
    }

    # Replace _INTERNAL_PAGE with correct hyperlink

    # Replace _INTERNAL_XREF with correct hyperlink

    print $line;
  } # loop over body lines

}

gen_index() unless $OPT{no_index};
end_doc();

exit 0;

# SUBROUTINES ##############################################################

# helper function
#----------------------------------------------------------
sub begin_doc{
  if (defined $OPT{prolog}) {
    # get prolog definitions from file
    my $prolog_file = $OPT{prolog};
    if (-e $prolog_file) {
      open(PR, "< $prolog_file") or die "Cannot open prolog file $prolog_file: $!\n";
    } else {
      die "Cannot find prolog file $prolog_file\n";
    }
    while(<PR>){
      print;
    }
    close(PR);
  } else {
  print <<'EOT';
\documentclass [11pt] {article}   % 
\usepackage{german}               % ISO-Latin-Zeichensatz ()
\usepackage{isolatin1}            % ISO-Latin-Zeichensatz ()
\parindent0pt                     % no indentation of first line
\parskip1ex                       % white space between chapters
\pagestyle{headings}     %
\usepackage{epsf}
\usepackage{makeidx}

% setup for DIN A4
\oddsidemargin3cm
\evensidemargin3cm
\setlength{\hoffset}{-1in}            % compensation of
\setlength{\voffset}{-2cm}            % printer offset

\textwidth15cm
\topmargin1cm
\headheight3ex
\headsep12pt
\textheight23cm
\setlength{\footskip}{1.5cm}

\makeindex

\begin{document}

\begin{flushleft}

EOT
  }
} # begin_doc

# flushleft ist fix alex

#----------------------------------------------------------
sub end_doc{

# fix alex
print "\n\n\\end{flushleft}\n";

print "\n\n\\end{document}\n";
} # end_doc


#----------------------------------------------------------
sub gen_index {
# print "\n\\section{INDEX}\n\n";
# foreach my $idx (sort keys %INDEX) {
#   print "$idx \\textbf{ \\pageref{$INDEX{$idx}}}\\\\\n";
# }
  print "\n\\printindex\n\n";
} # gen_index

#----------------------------------------------------------


#----------------------------------------------------------
sub start_new_page {
  my ($level, @BF) = @_;
  $page_cnt ++;
  $PAGES[$page_cnt] = {
         BODY => [],
         LEVEL => $level,
         HD  => join("", @BF),

       };
  $page_ref = $PAGES[$page_cnt] -> {BODY};
  my $hd = $PAGES[$page_cnt] -> {HD};
  $ANCHOR{$hd} = $page_cnt; # insert anchor for this page
 #push @{$PAGES[$page_cnt]->{BODY}}, "<a name=\"$hd\">";
} # start_new_page

#----------------------------------------------------------
# simple directive handlers
sub handleSimple {
  push @BUFFER, escapes($_[2]);
} # handleSimple

#----------------------------------------------------------
sub handleHeadline {
  # $_[2] contains the level number of this header
  if ($_[1]==DIRECTIVE_START) {
    flush;
  } else {
    start_new_page($_[2], @BUFFER);
    my $section;
    if      ($_[2] == 0){
      $section = 'chapter';
    } elsif ($_[2] == 1){
      $section = 'section';
    } elsif ($_[2] == 2){
      $section = 'subsection';
    } elsif ($_[2] == 3){
      $section = 'subsubsection';
    } elsif ($_[2] == 4){
      $section = 'paragraph';
    } elsif ($_[2] == 5){
      $section = 'subparagraph';
    } else {
      $section = '\\textbf';
    }
    push_page $page_ref, "\n\n\\$section\{";
    flush;
    push_page $page_ref, "}\n";
  }
} # handleHeadline

#----------------------------------------------------------
sub handleList {
  flush;
  my $LIST;
  if ($_[0]==DIRECTIVE_ULIST){
     $LIST = "itemize";
  } elsif ($_[0]==DIRECTIVE_OLIST){
     $LIST = "enumerate";
  } elsif ($_[0]==DIRECTIVE_DLIST){
     $LIST = "itemize";
  }
  if ($_[1]==DIRECTIVE_START){
    push_page $page_ref, "\n\\begin{$LIST}\n";
  } else {
    push_page $page_ref, "\\end{$LIST}\n";
    @BUFFER = ();
  }
  
} # handleList

#----------------------------------------------------------
sub handlePoint {
  flush;
  if ($_[1]==DIRECTIVE_START){
    push_page $page_ref, $li_start;
  } else {
    push_page $page_ref, $li_end;
    @BUFFER = ();
  }
} # handlePoint

#----------------------------------------------------------
sub handleDPoint {
  flush;
  if ($_[1]==DIRECTIVE_START){
    push_page $page_ref, "\\item ";
  } else {
    push_page $page_ref, "\n\n";
    @BUFFER = ();
  }
} # handleDPoint

#----------------------------------------------------------
sub handleDPointItem {
  flush;
  if ($_[1]==DIRECTIVE_START){
    # no action
  } else {
    push_page $page_ref, "\n\n";
    @BUFFER = ();
  }
} # handleDPointItem

#----------------------------------------------------------
sub handleText {
  flush;
  if ($_[1]==DIRECTIVE_START){
    push_page $page_ref, "\n";
  } else {
    push_page $page_ref, "\n";
  }
} # handleText

#----------------------------------------------------------
sub handleBlock { # code block with TAG recognition
#TODO Es muessen alle PerlPoint tags aus dem BUFFER des
#     Blocks entfernt werden, da Latex in \begin{verbatim} ...
#     keine Ersetzungen wie \textbf etc. vornehmen kann !!
  handleVerbatim( $_[0], $_[1], $_[2]);
} # handleBlock

#----------------------------------------------------------
sub handleLShift {
} # handleLShift

#----------------------------------------------------------
sub handleRShift {
} # handleRShift

#----------------------------------------------------------
sub handleVerbatim { # verbatim block without TAG recognition
  flush;
  if ($_[1]==DIRECTIVE_START){
    $verbatim_flag = 1;
#   push_page $page_ref, "\n\\rule{\\textwidth}{1pt}\n";
    push_page $page_ref, "\\begin{verbatim}\n";
  } else {
    push_page $page_ref, "\\end{verbatim}";
#   push_page $page_ref, "\\rule{\\textwidth}{1pt}\n";
    $verbatim_flag = 0;
  }
} # handleVerbatim

#----------------------------------------------------------
sub handleComment {
    @BUFFER = (); # skip buffer contents
} # handleComment

#----------------------------------------------------------
sub e_escapes{
  my ($flag) = @_;
  if ($flag eq "micro"){
    return "\$\\mu\$";
  } elsif ($flag eq "uuml"){
    return "";
  } elsif ($flag eq "Uuml"){
    return "";
  } elsif ($flag eq "auml"){
    return "";
  } elsif ($flag eq "Auml"){
    return "";
  } elsif ($flag eq "ouml"){
    return "";
  } elsif ($flag eq "Ouml"){
    return "";
  } elsif ($flag eq "szlig"){
    return "";
  } elsif ($flag eq "nbsp"){
    return "\\nolinebreak ";
  } else {
    return "__ this was HTML escape: $flag __";  #  --> syntax error in latex
  }
} # e_escapes

#----------------------------------------------------------
sub handleTag {

  # special tags

  if ($_[2] eq "C") {                                           # special HTML escapes
    flush;
    if ($_[1]==DIRECTIVE_COMPLETE) {
      push_page $page_ref, "}";
    } else {
      push_page $page_ref, "\\texttt{";
    }
    return;
  }
  if ($_[2] eq "E") {                                           # special HTML escapes
    if ($_[1]==DIRECTIVE_COMPLETE) {
      push_page $page_ref, e_escapes( "@BUFFER");
      @BUFFER = ();
    } else {
      flush;
    }
    return;
  }

  # character formatting Tags: handle B I U SUP SUB
  if ($_[2] eq "B"){
    flush;
    return if $verbatim_flag;
    if ($_[1]==DIRECTIVE_START){
      push_page $page_ref, "\\textbf{";
    } else {
      push_page $page_ref, "}";
    }
    return;
  }

  if ($_[2] eq "I"){
    flush;
    return if $verbatim_flag;
    if ($_[1]==DIRECTIVE_START){
      push_page $page_ref, "\\textit{";
    } else {
      push_page $page_ref, "}";
    }
    return;
  }

  if ($_[2] eq "U"){
    flush;
    return if $verbatim_flag;
    if ($_[1]==DIRECTIVE_START){
      push_page $page_ref, "\\underline{";
    } else {
      push_page $page_ref, "}";
    }
    return;
  }

  if ($_[2] eq "SUP"){
    flush;
    return if $verbatim_flag;
    if ($_[1]==DIRECTIVE_START){
      push_page $page_ref, "\$^{";
    } else {
      push_page $page_ref, "}\$";
    }
    return;
  }

  if ($_[2] eq "SUB"){
    flush;
    return if $verbatim_flag;
    if ($_[1]==DIRECTIVE_START){
      push_page $page_ref, "\$_{";
    } else {
      push_page $page_ref, "}\$";
    }
    return;
  }

  if ($_[2] eq "PRINT_TOC"){
    flush;
    if ($_[1]==DIRECTIVE_START){
      push_page $page_ref, "\n\\tableofcontents\n\n\\newpage\n";
    }
    return;
  }

  if ($_[2] eq "MBOX"){
    flush;
    if ($_[1]==DIRECTIVE_START){
      push_page $page_ref, "\\mbox{";
    } else {
      push_page $page_ref, "}\$";
    }
    return;
  }

  if ($_[2] eq "LINE_BREAK" or $_[2] eq "BR") {                       # line break
    if ($_[1]==DIRECTIVE_COMPLETE) {
      @BUFFER = ();
      push_page $page_ref, "\\linebreak ";
    } else {
      flush;
    }
    return;
  }
#TODO anpassen; linie malen
  if ($_[2] eq "HR" ) {                       # horizontal line
    if ($_[1]==DIRECTIVE_COMPLETE) {
      @BUFFER = ();
      push_page $page_ref, "\n\n----------------------------------------------------------\n\n";
    } else {
      flush;
    }
    return;
  }
  if ($_[2] eq "BOXCOLORS") {                                          # box color
    return
  }

  if ($_[2] eq "BOXCOLOR") {                                          # box color
    if ($_[1]==DIRECTIVE_COMPLETE) {
      $box_bg_color = $BUFFER[0];
      @BUFFER = ();
    } else {
      flush;
    }
    return;
  }
  if ($_[2] eq "BOXTEXT") {                                          # box text color
    if ($_[1]==DIRECTIVE_COMPLETE) {
      $box_fg_color = $BUFFER[0];
      @BUFFER = ();
    } else {
      flush;
    }
    return;
  }

#TODO anpassen
  if ($_[2] eq "IMAGE") {                                          # image
    flush;
    if ($_[1]==DIRECTIVE_COMPLETE) {
      if ( !defined $_[3]->{'src'}) {
        die "*** ERROR: Image without 'src' parameter\n";
      }
      my $file = $_[3]->{'src'};
      my $opt = "";
      push_page $page_ref, "\n\n \% cool image from file $file \n\n";
      push_page $page_ref, "\n \\begin{center}\n";
      if ( defined $_[3]->{'epsfysize'}) {
        my $ysize = $_[3]->{'epsfysize'};
        push_page $page_ref, "\n\n \\epsfysize=$ysize\n";
      }
      if ( defined $_[3]->{'epsfxsize'}) {
        my $xsize = $_[3]->{'epsfxsize'};
        push_page $page_ref, "\n\n \\epsfxsize=$xsize\n";
      }
      my $ps_file = "$OPT{slide_dir}/$file";
      $ps_file =~ s/\.[^.]*$/.eps/;
      print STDERR " ... image: $ps_file\n" if $verbose;
      if (-e $ps_file) {
        push_page $page_ref, "\n\n\\epsffile{$ps_file}\n\n";
      } else {
        push_page $page_ref, "\n\n (image from file $file) \n\n";
      }
      push_page $page_ref, "\n \\end{center}\n";
    }
    return;
  }

#TODO anpassen
  if ($_[2] eq "F" ) {                       # set color and size
    flush;
    if ($_[1]==DIRECTIVE_START){
      my $params = "";
      if ( defined $_[3]->{'color'}) {
        $params = "$params color=$_[3]->{'color'}";
      }
      if ( defined $_[3]->{'size'}) {
        $params = "$params size=$_[3]->{'size'}";
      }
      push_page $page_ref, "";
    } else {
      push_page $page_ref, "";
    }
    return;
  }

  if ($_[2] eq "A") {                                                # Anchor Tag
    flush;
  # print STDERR "@_\n" if $verbose;
  # print STDERR Dumper($_[3]) if $verbose;
    if ($_[1]==DIRECTIVE_COMPLETE) {
      if ( !defined $_[3]->{'name'}) {
        die "*** ERROR: Anchor without 'name' parameter\n";
      }
      my $a_name = $_[3]->{'name'};
      push_page $page_ref, "\\label{$a_name}";
      # Remember page number for later reference:
      if (defined $ANCHOR{$a_name}){
        warn "**** anchor name $a_name used twice !!\n";
      } else {
        $ANCHOR{$a_name} = $page_cnt;
      }
    }
    return;
  }
  if ($_[2] eq "L") {                                                # general URL
    if ($_[1]==DIRECTIVE_COMPLETE) {
      if ( !defined $_[3]->{'url'}) {
        warn "*** ERROR: Hyperlink \L without 'url' parameter\n";
      }
      # my $link_text = join("",@BUFFER);

# fix alex!! 2001-04-17

      my $url = $_[3]->{'url'};

      # print "\n", Dumper($url), "\n";

      my $offset = 80; # 80 Zeichen breite URLs, dann Zeilenumbruch

      sub format_url {
        my ($url, $offset) = @_;
        my $breaksign = " \\linebreak ";
        my $newurl = "";
        while (length($url) > $offset) {
          $newurl .= substr($url, 0, $offset) . $breaksign;
          substr($url, 0, $offset) = '';
        }
        return $newurl . $url;
      } # format_url


      push_page $page_ref, 
                           # "\\begin{flushright}",
                           "{\\scriptsize \\begin{math} [URL: ",
                           format_url(escapes($url), $offset),
                           "] \\end{math} } ";
                           # "\\end{flushright} ";

      # @BUFFER=();

    } else {
      flush;
    }
    return;
  }
  if ($_[2] eq "PAGEREF") {                                          # page reference
    if ($_[1]==DIRECTIVE_COMPLETE) {
      if ( !defined $_[3]->{'name'}) {
        warn "*** ERROR: PAGEREF without 'name' parameter\n";
      }
      my $a_name = $_[3]->{'name'};
      push_page $page_ref, "\\ref{$a_name}";
    } else {
      flush;
    }
    return;
  }
  if ($_[2] eq "SECTIONREF") {                                       # section header reference
    if ($_[1]==DIRECTIVE_COMPLETE) {
      if ( !defined $_[3]->{'name'}) {
        warn "*** ERROR: PAGEREF without 'name' parameter\n";
      }
      my $a_name = $_[3]->{'name'};
      push_page $page_ref, "_INTERN_SECTION:$a_name:_END"; # to be replaced later ...
    } else {
      flush;
    }
    return;
  }
  if ($_[2] eq "XREF") {                                       # internal cross reference
    if ($_[1]==DIRECTIVE_COMPLETE) {
      if ( !defined $_[3]->{'name'}) {
        warn "*** ERROR: XREF without 'name' parameter\n";
      }
      my $ref_text = join("",@BUFFER);
      my $a_name = $_[3]->{'name'};
      push_page $page_ref, "\\pageref{$a_name} $ref_text";
      @BUFFER = ();
    } else {
      flush;
    }
    return;
  }

  if ($_[2] eq "X") {                                          # index entry
    if ($_[1]==DIRECTIVE_COMPLETE) {
      my $idx = join("",@BUFFER);
      $idx_cnt ++;
      my $index_anchor = "index:$page_cnt" . ":$idx_cnt";
      $INDEX{$idx} = $index_anchor;
      push_page $page_ref, "\\label{$index_anchor}";

      push_page $page_ref, "\\index{$idx}";

      if ( defined $_[3]->{'mode'} and $_[3]->{'mode'} eq "index_only"){
        @BUFFER = ();
      }
    } else {
      flush;
    }
    return;
  }

  if ($_[2] eq "TABLE") {                                       # TABLE
    flush;
    if ($_[1]==DIRECTIVE_START) {
      my $cols = "|c|c|c|c|";
      if ( defined $_[3]->{'columns'}) {
         $cols = $_[3]->{'columns'};
      }
      push_page $page_ref, "\n\n\\vspace{1ex}\n\\begin{tabular}{$cols}\n";
    } else {
      push_page $page_ref, "\n\n\\end{tabular}\n\n";
    }
    return;
  }

  if ($_[2] eq "TABLE_HL") {                                       # TABLE
    flush;
    if ($_[1]==DIRECTIVE_START) {
      push_page $page_ref, "\\bf ";
    } else {
      push_page $page_ref, " & "; # &
    }
    return;
  }

  if ($_[2] eq "TABLE_ROW") {                                       # TABLE
    flush;
    if ($_[1]==DIRECTIVE_START) {
      push_page $page_ref, "\\hline\n";
    } else {
      pop (@$page_ref); # to remove extra '&'
      push_page $page_ref, "\\\\\\hline\n";
    }
    return;
  }

  if ($_[2] eq "TABLE_COL") {                                       # TABLE
    flush;
    if ($_[1]==DIRECTIVE_START) {
      push_page $page_ref, "";
    } else {
      push_page $page_ref, " & "; # &
    }
    return;
  }


  if ($_[2] eq "EMBED") {                                       # embeded LaTeX
    flush;
    if ($_[1]==DIRECTIVE_START) {
      if ( !defined $_[3]->{'lang'}) {
        pp_warn "ERROR: EMBED without 'lang' parameter\n";
      }
      elsif ($_[3]->{'lang'} =~ /latex/i){
        $embedded_latex = 1;
      }
    } else {
      $embedded_latex = 0;
    }
    @BUFFER=();
    return;
  }


  warn "**** $me: unkown or not yet implemented tag: $_[2]\n";
} # handleTag

#----------------------------------------------------------
sub handleDocument {
  if ($_[1]==DIRECTIVE_START) {
    warn "Document (base $_[2]).\n";

  }
  else {

    warn "Document (base $_[2]).\n";
  }
} # handleDocument

#----------------------------------------------------------
sub flush {
  push_page $page_ref, @BUFFER;
  push @ERRBUFFER, @BUFFER;
  @BUFFER = ();
  # trim ERRBUFFER:
  @ERRBUFFER = grep (!/^\s*$/ ,@ERRBUFFER);
  for (my $k=1;$k<scalar(@ERRBUFFER)-6;$k++){
    shift @ERRBUFFER;
  }
}

#----------------------------------------------------------
sub push_page {
  # push $text to current page buffer
  my ($page_ref, @text) = @_;
  push @$page_ref, @text;
} # push_page

#---------------------------------------------------------------
sub save {
    my $it = $_[0];
    $it =~ y/\000-\177/\200-\377/;
    return $it;
} # save
#----------------------------------------------------------
sub escapes {
  my $line = shift;
  return $line if $embedded_latex;
  return $line if $verbatim_flag;
  $line =~ s!\334!save('"U')!ge; #"
  $line =~ s!\374!save('"u')!ge; #"
  $line =~ s!\326!save('"O')!ge; #"
  $line =~ s!\366!save('"o')!ge; #"
  $line =~ s!\304!save('"A')!ge; #"
  $line =~ s!\344!save('"a')!ge; #"
  $line =~ s!\337!save('"s')!ge; #"
    $line =~ s!\$!save("\\\$")!ge;
    $line =~ s!\\!\$\\backslash\$!g;
    $line =~ s!&!\\&!g;
    $line =~ s!#!\\#!g;
    $line =~ s!%!\\%!g;
    $line =~ s!~!\\char126!g;
    $line =~ s!_!\\_!g;
    $line =~ s!\^!\\char94!g;
    $line =~ s!{!\\{!g;
    $line =~ s!}!\\}!g;
    $line =~ s!>!{\\tt>}!g;
    $line =~ s!<!{\\tt<}!g;
    $line =~ s!"!{\\char34}!g; #'
    $line =~ y/\200-\377/\000-\177/;

    return $line;
} #" escapes

#----------------------------------------------------------
sub insert_template {
  my ($f, $page_no, $what) = @_;
} # insert_template
#----------------------------------------------------------

#----------------------------------------------------------
sub pp_warn {
  my ($message) = @_;
  print STDERR "*** $me: $message\n";
  print STDERR "context: ------\n@ERRBUFFER\n---------------\n";
} # pp_warn


__END__



# = POD SECTION ============================================================

=head1 NAME

B<pp2latex> - PerlPoint to LaTeX converter

=head1 VERSION

This manual describes version B<0.11, build 1.11>.

=head1 SYNOPSIS

  pp2latex --help
  pp2latex [@options_file] [options] slide_text 

=head1 DESCRIPTION

C<pp2latex> creates a LaTeX file from a PerlPoint input file.


=head1 SYNTAX of PerlPoint Files

For a detailed description of the PerlPoint language please refer to the
excellent POD documentation of the B<PerlPoint::Parser> Module by Jochen Stenzel.
There you will find everything you ever wanted to know about PerlPoint ;-)


=head1 OPTIONS

=over 4

=item --filter=regexp

This specifies a regular expression C<regexp> which should match
all allowed languages for EMBEDed code. The expression is evaluated
caseinsensitively.

Example: --filter="perl|latex"

=item --prolog=filename

Specifies a file which must contain the LaTeX Declarations for the document.
C<\documentclass> and C<\begin{document}> must be defined there.

=item --activeContents

PerlPoint sources can embed Perl code which is evaluated while the source is parsed. For
reasons of security this feature is deactivated by default. Set this option to active
it. You can use I<--safeOpcode> to fine tune which operations shall be permitted.

=item --cache

parsing of one and the same document several times can be accelerated by activating the
PerlPoint parser cache by this option. The performance boost depends on your document
structure.

Cache files are written besides the source and named ".<source file>.ppcache".

It can be useful to (temporarily) deactivate the cache to get correct line numbers in
parser error messages (currently numbers cannot always reported correctly with activated
cache because of a special perl behaviour).

=item --cacheCleanup

PerlPoint parser cache files grow (with every modified version of a source parsed)
because they store expressions for every parsed variant of a paragraph. This is usually
uncritical but you may wish to clean up the cache occasionally. Use this option to
perform the task (or remove the cache file manually).


=item -nocopyright

suppresses the copyright message;

=item -noinfo

supresses runtime informations;

=item --nowarn

supresses warnings;

=item --quiet

a shortcut for "--nocopyright --noinfo --nowarn": all non critical runtime messages are suppressed;

=item --safeOpcode <opcode>

If active contents is enabled (I<--activeContents>), Perl code embedded into the translated PerlPoint sources will be
evaluated. To keep security this is done via an object of class B<Safe> which restricts code
to permitted operations. By this option you can declare which opcode (or opcode tag) is
permitted. Please see the B<Safe> and B<Opcode> manual pages for further details. (These modules
come with perl.)

This option can be used multiply.

You may want to store these options in default option files, see below for details.


For the examples used in I<ppdoc.pp> you should use

 --safeOpcode=:filesys_open --safeOpcode=:still_to_be_decided --safeOpcode=:browse


=item --set <flag>

This option allows you to pass certain settings - of your choice - to active contents
(like conditions) where it can be accessed via the $PerlPoint hash reference. For
example, your PerlPoint code could contain a condition like

  ? $PerlPoint->{userSettings}{special}

  Special part.

  ? 1

. The special part enclosed by the two conditions would then be processed I<only> if you
call C<pp2html> with

  --set special

- and if active contents was enabled by I<-active>, of course.

This option can be used multiply.

=item --trace [<level>]

activates traces of the specified level. You may use the environment variable SCRIPTDEBUG
alternatively (but an option overwrites environment settings). The following levels are
defined  (use the I<numeric> values) - if a description sounds cryptic to you, just ignore
the setting:

=item --help

Output of usage.

=item --version

Output of version information.

=back

=head1 FILES

Configuration file $HOME/.pp2latex

=head1 ENVIRONMENT

The following environment variables have influence on the program:

=over 4

=item SCRIPTDEBUG

may be set to a numeric value to activate certain trace levels. You can use option I<-trace>
alternatively (note that a used option overwrites an environment setting). The several levels
are described with this option.

=back


=head1 SEE ALSO

C<pp2html>

=head1 AUTHOR

Lorenz Domke (lorenz.domke@gmx.de), 2001. All rights reserved.

=cut


# = HISTORY SECTION ========================================================

# --------------------------------------------------------------------------
# version | date   | author | changes
# --------------------------------------------------------------------------
# 0.02    |12.10.99| ste    | added a simple backend;
# 0.01    |09.10.99| ste    | derived from the PP::Parser draft.
# --------------------------------------------------------------------------

$Log: pp2latex,v $
Revision 1.11  2001/06/15 15:56:02  lorenz
ci for Release 0.10 (final)

Revision 1.10  2001/06/14 12:00:56  lorenz
checkin for version 0.10_05

Revision 1.9  2001/03/11 11:55:11  lorenz
checkin for version 0.009

Revision 1.8  2001/03/06 21:21:28  lorenz
checkin for 0.009

Revision 1.7  2001/01/17 22:24:16  lorenz
checkin for version 0.008

Revision 1.6  2000/12/10 22:48:37  lorenz
check in for firest CPAN version

Revision 1.5  2000/11/02 19:37:48  lorenz
checkin for 0.006

Revision 1.4  2000/10/25 20:02:39  lorenz
support eps

Revision 1.3  2000/08/04 19:56:52  lorenz
check

Revision 1.2  2000/08/04 17:29:42  lorenz
sub save

Revision 1.1  2000/07/11 20:02:59  lorenz
Initial revision

Revision 1.1  2000/04/27 21:28:36  lorenz
Initial revision


