R devel - Jun 1997 - R-alpha: rd2sd v0.1

Here is an updated version of the S doc -> R doc script.  New features
are automatic conversion of `xxx' to LANG(xxx) or LANG(LINK(xxx)) in
SEEALSO sections, respectively (thanks to Martin and Thomas for the
suggestions).

The keywords are saved as comments, and can easily be used as soon as
keywords are supported.

As usual, any feedback ...

-k

**********************************************************************
#!/usr/bin/perl -w

$VERSION = "0.1";

$\ = "\n";

$parenLevel = 0;
$doprint = 1;
$needArg = 1;
$needVal = 0;
$seealso = 0;
$output = "";

while (<>) {
    chop;
    &substitute;
    @word = split;

    if (/^[^.]/) { &output($_); }

    if (/^\.AG/) {
	if ($needArg) {
	    &section(0, "ARGUMENTS(");
	    $needArg = 0;
	}
	&section(1, "ARG($word[1] @@");
    }
    if (/^\.CS/) { &section(0, "USAGE("); }
    if (/^\.DN/) { $doprint = 0; }
    if (/^\.DT/) { &section(0, "DESCRIPTION("); }
    if (/^\.EX/) { &section(0, "EXAMPLES("); }
    if (/^\.FN/) { $fun = $word[1]; }
    if (/^\.(IP|PP)/) { &output("PARA"); }
    if (/^\.KW/) { 
	if ($parenLevel > 0) {
	    &section(0, "");
	    $parenLevel = 0;
	}
	&output("COMMENT(KEYWORD($word[1]))");
    }
    if (/^\.RC/) {
	if ($needVal) {
	    $needVal = 0;	    
	    &section(0, "VALUES(\n$output\n@@");
	    $doprint = 1;
	}
	&section(1, "ARG($word[1] @@");
    }
    if (/^\.RT/) {
	$needVal = 1;
	$doprint = 0;
	$output = "";
    }
    if (/^\.SA/) {
	&section(0, "SEEALSO(");
	$seealso = 1;
    }
    if (/^\.SE/) { &paragraph("SIDE EFFECTS"); }
    if (/^\.SH/) {
	if ($word[1] =~ /REFERENCE/) {
	    &section(0, "REFERENCES(");
	} else {
	    &paragraph($word[1]);
	}
    }
    if (/^\.sp/) { output("BLANK"); }
    if (/^\.TL/) { &section(0, "TITLE($fun @@"); }
    if (/^\.WR/) {
	&section(0, "");
	print("COMMENT(Converted by sd2rd version $VERSION.)");
    }

    if (/^\.AO/) {
	output("Arguments for function LANG($word[1]()) can also be");
	output("supplied to this function.");
    }
    if (/^\.GE/) {
	output("This is a generic function.");
	output("Functions with names beginning in LANG($fun.) will be");
	output("methods for this function.");
    }
    if (/^\.GR/) {
	output("Graphical parameters (see LANG(LINK(par)) may also be");
	output("supplied as arguments to this function.");
    }
    if (/^\.ME/) {
	output("This function is a method for the generic function");
	output("LANG($word[1]()) for class LANG($word[2]).");
	output("It can be invoked by calling LANG($word[1](x)) for an");
	output("object LANG(x) of the appropriate class, or directly by");
	output("calling LANG($word[1].$word[2](x)) regardless of the");
	output("class of the object.");
    }
    if (/^\.NA/) { output("Missing values (LANG(NA)s) are allowed.");
}
    if (/^\.Tl/) {
	output("In addition, the high-level graphics control arguments");
	output("described under LANG(LINK(par)) and the arguments to");
	output("LANG(LINK(title)) may be supplied to this function.");
    }
}

sub substitute {
    s/\\fB/BOLD\(/g;
    s/\\fR/\)/g;
    s/\.\.\./DOTS/g;
    if ($seealso) {
	s/\`([^\']*)\'/LANG(LINK($1))/g;
    } else {
	s/\`([^\']*)\'/LANG($1)/g;
    }
}

sub section {
    local($level, $text) = @_;
    $n = $parenLevel - $level;
    print(")" x $n) if ($n > 0);
    if ($needVal) {
	print("VALUE(\n$output\n)");
	$needVal = 0;
    }
    print("$text") if $text;    
    $parenLevel = $level + 1;
    $doprint = 1;
    $seealso = 0;
}

sub paragraph {
    local($name) = @_;
    &output("PARA\nBOLD($name): ");
}
    
sub output {
    local($text) = @_;
    if ($doprint) {
	print($text);
    } elsif ($output) {
	$output .= "\n$text";
    } else {
	$output = $text;
    }
}
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
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
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-