#! @PERL@

# Convert old R documentation into the new format

# Copyright (C) 1997 Friedrich Leisch
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
# 
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details. 
# 
# A copy of the GNU General Public License is available via WWW at
# http://www.gnu.org/copyleft/gpl.html.  You can also obtain it by
# writing to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA  02111-1307  USA.

# Send any bug reports to Friedrich.Leisch@ci.tuwien.ac.at

use Getopt::Long;

$revision = ' $Revision: 1.5 $ ';
$revision =~ / ([\d\.]*) /;
$version = $1;

$revision =~ / ([\d\.]*) /;
$version = $1;
($name = $0) =~ s|.*/||;

sub version {
  print STDERR <<END;
Rman2Rd $version
Copyright (C) 1997 Fritz Leisch.
This is free software; see the GNU General Public Licence version 2
or later for copying conditions.  There is NO warranty.    
END
  exit 0;
}

sub usage {
  print STDERR <<END;
Usage: $name [options] FILE

Convert old-style Rman documentation FILE to R documentation format.

Options:
  -h, --help            print short help message and exit
  -v, --version         print version info and exit
  -d, --debug		turn on debugging (increase verbosity)

Email bug reports to <r-bugs\@lists.r-project.org>.
END
  exit 0; 
}

@knownoptions = ("d|debug", "h|help", "v|version");
GetOptions (@knownoptions) || usage();
&version() if $opt_v;
&usage() if $opt_h;

$max_parent = 0;
$NP = "normal_parent";
$PN = "parent_normal";
$EOP = "escaped_opening_parent";
$ECP = "escaped_closing_parent";
$ID = "$NP\\d+$PN";

undef $/;

$complete_text = <>;

$complete_text =~ s/BEGIN_ARGUMENTS(.*)END_ARGUMENTS/ARGUMENTS($1)/s;

print stderr "Marking Parantheses ... " if $opt_debug;

$text = mark_parents($complete_text);

print stderr "done\n" if $opt_debug;

print stderr "Searching logical blocks ... " if $opt_debug;

$text =~ /TITLE($ID)/;
$id = $1;
@args = get_two_args($id);
$text =~ s/TITLE$id(.*)$id/\\name\{$args[0]\}\n\\title\{$args[1]\}/s;
$title = $args[0];

replace_command("USAGE", "usage");
replace_command("ARGUMENTS", "arguments");
replace_command("DESCRIPTION", "description");

if(($text =~ /VALUE$ID/) && ($text =~ /VALUES$ID/)){
    print stderr "Warning: Both VALUE and VALUES environment found!\n";
}
replace_command("VALUE", "value");
replace_command("VALUES", "value");

replace_command("REFERENCES", "references");
replace_command("SEEALSO", "seealso");
replace_command("EXAMPLES", "examples");
replace_command("NOTE", "note");

replace_command_all("ALIAS", "alias");
replace_command_all("KEYWORD", "keyword");

while($text =~ /SECTION($ID)/){
    $id = $1;
    @args = get_two_args($id);
    if($args[0] =~ /author/i){
	$text =~ s/SECTION$id(.*)$id/\\author\{$args[1]\}/s;
    }
    else {
	$text =~ s/SECTION$id(.*)$id/\\section\{$args[0]\}\{$args[1]\}/s;
    }
}

print stderr "done\n" if $opt_debug;

print stderr "Parsing text commands ... " if $opt_debug;

$text =~ s/(\s*PARA\s*)+/\n\n/sg;
$text =~ s/(\s*BLANK\s*)+/\n\n/sg;

$text =~ s/\n?@@\nARG/\nARG/sg;

while($text =~ /ARG($ID)/){
    $id = $1;
    @args = get_two_args($id);
    $text =~ s/ARG$id(.*)$id/\\item\{$args[0]\}\{$args[1]\}/s;
}

replace_command_all("EQBOLD", "bold");
replace_command_all("ITALIC", "emph");
replace_command_all("BOLD", "bold");
replace_command_all("LANG", "code");
replace_command_all("LINK", "link");

$text =~ s/LDOTS/\\ldots/g;
$text =~ s/DOTS/\\dots/g;


$text =~ s/%/\\%/sg;
$text =~ s/&/\\&/sg;

while($text =~ /COMMENT($ID)/){
    $id = $1;
    $text =~ s/COMMENT$id(.*)$id(\n?\s*)/I_FOUND_A_COMMENT/s;
    $comment = " % $1";
    $comment =~ s/\n/\n% /g;
    $comment = "$comment\n" unless ($comment =~ /\n\s*$/s);
    $text =~ s/I_FOUND_A_COMMENT/$comment/;
}

print stderr "done\n" if $opt_debug;
print stderr "Parsing math commands ... " if $opt_debug;



# Now for the math stuff ...

print stderr "args: 0 " if $opt_debug;

$text =~ s/(\s+)EQUALS(\s+)/$1=$2/sg;
$text =~ s/(\s+)LT(\s+)/$1<$2/sg;
$text =~ s/(\s+)GT(\s+)/$1>$2/sg;
$text =~ s/(\s+)LE(\s+)/$1\\le$2/sg;
$text =~ s/(\s+)GE(\s+)/$1\\ge$2/sg;
$text =~ s/(\s+)LOG(\s+)/$1\\log$2/sg;
$text =~ s/(\s+)EXP(\s+)/$1\\exp$2/sg;
$text =~ s/(\s+)SP(\s+)/$1~$2/sg;

$text =~ s/greekGamma/\\Gamma/sg;
$text =~ s/greekalpha/\\alpha/sg;
$text =~ s/greekAlpha/\\Alpha/sg;
$text =~ s/greekpi/\\pi/sg;
$text =~ s/greekmu/\\mu/sg;
$text =~ s/greeksigma/\\sigma/sg;
$text =~ s/greeklambda/\\lambda/sg;
$text =~ s/boldgreekbeta/\\mathbf\{\\beta\}/sg;
$text =~ s/boldgreekepsilon/\\mathbf\{\\epsilon\}/sg;

print stderr "1 " if $opt_debug;

replace_command_all("SQRT", "sqrt");
replace_command_all("DISPLAYSTYLE", "displaystyle");

while($text =~ /PAREN($ID)/){
    $id = $1;
    $text =~ s/PAREN$id(.*)$id/\\left($1\\right)/s;
}

print stderr "2 ... " if $opt_debug;

while(($text =~ /(SUP)($ID)/) ||
      ($text =~ /(SUB)($ID)/) ||
      ($text =~ /(OVER)($ID)/) ||
      ($text =~ /(CHOOSE)($ID)/)){
    
    my $cmd = $1;
    my $id = $2;
    
    if($text =~ /$id(.*@@.*@@.*)$id/s){
	die("\n$title: Nested math structures - convert equations manually!\n");
    }
    else{
	
	if($cmd =~ /OVER/){
	    @args = get_two_args($id);
	    $text =~ s/OVER$id(.*)$id/\\frac\{$args[0]\}\{$args[1]\}/s;
	}
	
	if($cmd =~ /SUP/){
	    @args = get_two_args($id);
	    $text =~ s/SUP$id(.*)$id/\{$args[0]\}^\{$args[1]\}/s;
	}
	
	if($cmd =~ /SUB/){
	    @args = get_two_args($id);
	    $text =~ s/SUB$id(.*)$id/\{$args[0]\}_\{$args[1]\}/s;
	}
	
	if($cmd =~ /CHOOSE/){
	    @args = get_two_args($id);
	    $text =~ s/CHOOSE$id(.*)$id/\{$args[0] \\choose $args[1]\}/s;
	    }
    }
}


print stderr "deqn ... " if $opt_debug;

while(($text =~ /DEQN($ID)/)){
    $id = $1;
    @args = get_two_args($id);
    $text =~ s/DEQN$id(.*)$id/\\deqn\{$args[0]\}\{$args[1]\}/s;
}

print stderr "eqn ... " if $opt_debug;

replace_command_all("EQN", "eqn");

print stderr "done\n" if $opt_debug;

print stderr "Unmarking parantheses ... " if $opt_debug;

$text = unmark_parents($text);

print stderr "done\n" if $opt_debug;

print $text;





# Mark each matching opening and closing parenthesis with a unique id.
# Idea and original code from latex2html
sub mark_parents {
    my $text = $_[0];
    $text =~ s/([^\\])\\\(/$1$EOP/gso;
    $text =~ s/([^\\])\\\)/$1$ECP/gso;
    
    while($text =~ /\(([^\(\)]*)\)/s){
	my $id = $NP . ++$max_parent . $PN;
	$text =~ s/\(([^\(\)]*)\)/$id$1$id/s;
    }
    $text =~ s/$EOP/\\(/gso;
    $text =~ s/$ECP/\\(/gso;
    
    $text;
}

sub unmark_parents {
    my $text = $_[0];

    while($text =~ /($NP\d+$PN)/s){
	$id = $1;
	$text =~ s/$id(.*)$id/($1)/s;
    }
    $text;
}


sub get_two_args {

    my $id = $_[0];
    
    $text =~ /$id(.*)$id/s;
    my $x = $1;
    $x =~ /\s*([^@]*)\s*@@\s*(.*)\s*/s;

    $arg1 = $1;
    $arg2 = $2;
    
    $arg1 =~ s/^\s*//s;
    $arg1 =~ s/\s*$//s;
    $arg2 =~ s/^\s*//s;
    $arg2 =~ s/\s*$//s;

    ($arg1, $arg2);
}
	

sub replace_command {

    my $cmd = $_[0];
    my $newcmd = $_[1];

    if($text =~ /$cmd($ID)/s){
	my $id = $1;
	$text =~ s/$cmd$id(.*)$id/\\$newcmd\{$1\}/s;
    }
}

sub replace_command_all {

    my $cmd = $_[0];
    my $newcmd = $_[1];

    while(($text =~ /$cmd$ID/)){
	replace_command($cmd, $newcmd);
    }
	
}

### Local Variables: ***
### mode: perl ***
### End: ***