From Friedrich.Leisch@ci.tuwien.ac.at  Mon Sep  1 14:12:51 1997
From: Friedrich.Leisch@ci.tuwien.ac.at (Friedrich Leisch)
Date: Mon, 1 Sep 1997 15:12:51 +0200
Subject: R-alpha: old Rdoc 2 new Rdoc
Message-ID: <199709011312.PAA03979@galadriel.ci.tuwien.ac.at>


--xk+LtGr+JJ
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit


Attached is a conversion script for converting current R doc files to
the proposed new format ... I'm not sure if it handles everything
correctly, as I made just some random checks. The main purpose for
posting the thing to the list is such that those interested can get a
look at the new format.

Of course there is no proper indentation ... so the generated files
look really ugly ...

The script can't handle nested math environments with 2 arguments
(like sub, sup, ...), but in the whole base library (580+ files) there
are only 6 containing those, so I thought it's easier to convert these
manually.


--xk+LtGr+JJ
Content-Type: text/enriched
Content-Disposition: inline;
	filename="convert.pl"
Content-Transfer-Encoding: 7bit

#!/usr/bin/perl

use Getopt::Long;

@knownoptions = ("debug|d");
GetOptions (@knownoptions) || die("Unknown Option!\n");

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

undef $/;

$complete_text = <>;

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/\\title\{$args[0]\}\{$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("NOTES", "notes");

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\\blank\n/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("LANG", "code");
replace_command_all("BOLD", "textbf");
replace_command_all("EQBOLD", "mathbf");
replace_command_all("ITALIC", "emph");

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/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);
    }
	
}


    

--xk+LtGr+JJ
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit


Best,
Fritz



--xk+LtGr+JJ--
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
r-devel mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !)  To: r-devel-request@stat.math.ethz.ch
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-


R-alpha: old Rdoc 2 new Rdoc
Friedrich Leisch