R devel - Jun 1997 - R-alpha: sd2rd 0.1-2

Another update of the S doc -> R doc conversion script is attached
below.  Relative to the previously released version, there are two
changes.

* Quoting of parentheses does not happen in verbatim-like sections

* More importantly, the way words in the .SA (SEEALSO) section are
treated is now controlled by an optional argument, `-x'.

Without this option, only words enclosed in single accents are mapped to
LANG(LINK(...)).  With `-x', there are xtra substitutions---all words in
the section are mapped.

I introduced this optional argument because on the one hand, Thomas
pointed out that many S doc files do not quote the object names (e.g. in
survival4), whereas Martin said that the clean way was to quote them, as
there is no reason why non-object names should not appear within .SA.
So, the optional argument should make everyone happy.

I still have several suggestions on my TODO list, but I think the
current version should be rather stable and pretty much usable, so
perhaps one could include it in the R distribution's `etc' directory.

-k

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

$VERSION = "0.1-2";

$\ = "\n";

$parenLevel = 0;
$inVerbatim = 0;
$inSeeAlso = 0;
$doprint = 1;
$needArg = 1;
$needVal = 0;
$output = "";

$opt_x = 0;
use Getopt::Long;
GetOptions (("x")) || &usage();

while (<>) {
    chop;
    &substitute unless /^\./;
    @word = split;

    if (/^\s*$/) {
	if ($inVerbatim) {
	    &output("BLANK");
	} else {
	    &output("PARA");
	}
    }
    if (/^[^.]/) { &output($_); }

    if (/^\.AG/) {
	if ($needArg) {
	    &section(0, "ARGUMENTS(");
	    $needArg = 0;
	}
	&section(1, "ARG($word[1] @@");
    }
    if (/^\.CS/) {
	&section(0, "USAGE(");
	$inVerbatim = 1;
    }
    if (/^\.DN/) { $doprint = 0; }
    if (/^\.DT/) { &section(0, "DESCRIPTION("); }
    if (/^\.EX/) {
	&section(0, "EXAMPLES(");
	$inVerbatim = 1;	
    }
    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(");
	$inSeeAlso = 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 {
    if (!$inVerbatim) {
	s/\(/\\\(/g;
	s/\)/\\\)/g;
    }
    s/\.\.\./DOTS/g;    
    s/\\fB/BOLD\(/g;
    s/\\fR/\)/g;
    s/\\\.(.*)$/COMMENT($1)/g;
    if ($inSeeAlso) {
	if ($opt_x) {
	    s/\`?([\.\w]*\w+)\'?/LANG(LINK($1))/g;
	} else {
	    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;
    $inVerbatim = 0;
    $inSeeAlso = 0;
    $doprint = 1;    
}

sub paragraph {
    local($name) = @_;
    &output("PARA\nBOLD($name): ");
}
    
sub output {
    local($text) = @_;
    if ($doprint) {
	print($text);
    } elsif ($output) {
	$output .= "\n$text";
    } else {
	$output = $text;
    }
}

sub usage {
    print("\nsd2rd version $VERSION\n\nusage:  sd2rd [-x] file\n");
    exit;
}
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
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
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-