The R Project SVN – R – Diff – /trunk/src/scripts/Sd2Rd.in


#! @PERL@
#
# ${R_HOME}/bin/Sd2Rd for converting S documentation to Rd format
 
# Copyright (C) 1997-2001 The R Core Development Team
#
# This document 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.
 
use Getopt::Long;
use R::Utils;
 
my $revision = ' $Revision: 1.21 $ ';
my $version;
my $name;
 
$revision =~ / ([\d\.]*) /;
$version = $1;
($name = $0) =~ s|.*/||;
 
sub usage {
  print STDERR <<END;
Usage: R CMD Sd2Rd [options] FILE
 
Convert S documentation in FILE to R documentation format.
 
Options:
  -h, --help		print short help message and exit
  -v, --version		print Sd2Rd version info and exit
  -n			render examples non-executable by wrapping them
			into a \\dontrun{} environment
  -x			(S3 docs) interpret all single-quoted names 
                        as code names
 
Email bug reports to <r-bugs\@r-project.org>.
END
  exit 0; 
}
 
@knownoptions = ("v|version", "h|help", "n", "x");
GetOptions(@knownoptions) || &usage();
&R_version($name, $version) if $opt_v;
&usage() if $opt_h;
 
@lines = <>;
## peek at the first line of the file, then dispatch to
## S3-style (nroff) or S4-style (SGML spec).
if(@lines[0] =~ /^<!doctype/) { doS4(); } else { doS3(); }
exit 0;
 
sub doS3 {
  $braceLevel = 0;
  $inReferences = 0;
  $inVerbatim = 0;
  $inSeeAlso = 0;
  $inCode = 0;
  $isDataSet = 0;
  $doprint = 1;
  $needArg = 1;
  $needVal = 0;
  $underlineNext = 0;
  $output = "";
 
  foreach $_ (@lines) {
    chop;
    &substitute unless /^\./;
    my @word = split;
 
    if (/^\s*$/) { &output("\n"); }
    if (/^[^.]/) { 
      if ($underlineNext) {
	$_ = "\\emph{" . $_ ."}";
	$underlineNext = 0;
      }
      &output($_);
    }
 
    ## Added by BDR 1998-08-27
    if (/^\.\\\"/o) {
      s/^\.\\\"/%/;
      &output($_);
    }
    ## End
 
    if (/^\.BG D/) {
      $isDataSet = 1;
    }
    if (/^\.AG/) {
      if ($isDataSet) {
	if ($needArg) {
	  &section(1, "\\describe\{");
	  $needArg = 0;
	}
	$arg = $_;
	$arg =~ s/^\.AG\s//;
	&section(2, "\\item\{\\code\{$arg\}\}\{");
      } else {
	if ($needArg) {
	  &section(0, "\\arguments\{");
	  $needArg = 0;
	}
	$arg = $_;
	$arg =~ s/^\.AG\s//;
	&section(1, "\\item\{$arg\}\{");
      }
    }
    if (/^\.CS/) {
      &section(0, "\\usage\{");
      $inVerbatim = 1;
    }
    if (/^\.DN/) { &section(0, "\\description\{"); }
    if (/^\.DT/) { &section(0, "\\details\{"); }
    if (/^\.EX/) {
      if ($opt_n) {
	&section(1, "\\examples\{\\dontrun\{");
      } else {
	&section(0, "\\examples\{");
      }
      $inVerbatim = 1;
    }
    if (/^\.FN/) {
      unless($fun) { $fun = $word[1]; }
      push(@aliases, $word[1]);
    }
    if (/^\.(IP|PP)/) { &output("\n"); }
    if (/^\.KW/) { 
      if ($braceLevel > 0) {
	&section(0, "");
	$braceLevel = 0;
      }
      if ($word[1] =~ /sysdata/) {
	&output("\\keyword\{datasets\}");
      } else {
	&output("\\keyword\{$word[1]\}");
      }
    }
    if (/^\.RC/) {
      if ($needVal) {
	$needVal = 0;	    
	&section(0, "\\value\{\n$output\n");
	$doprint = 1;
      }
      &section(1, "\\item\{" . join(" ", @word[1..$#word]) . "\}\{");
    }
    if (/^\.RT/) {
      $needVal = 1;
      $doprint = 0;
      $output = "";
    }
    if (/^\.SA/) {
      &section(0, "\\seealso\{");
      $inSeeAlso = 1;
    }
    if (/^\.SE/) { &section(0, "\\section\{Side Effects\}\{"); }
    if (/^\.SH/) {
      if ($word[1] =~ /REFERENCE/) {
	&section(0, "\\references\{");
	$inReferences = 1;
      } elsif ($word[1] =~ /AUTHOR/) {
	&section(0, "\\author\{");
      } elsif ($word[1] =~ /NOTE/) {
	&section(0, "\\note\{");
      } elsif ($word[1] =~ /SOURCE/) {
	&section(0, "\\source\{");
	$inReferences = 1;
      } elsif ($word[1] =~ /SUMMARY/) {
	&section(0, "\\description\{");
      } elsif ($word[1] =~ /WARNINGS/) {
	&section(0, "\\section{Warnings}\{");
      } elsif ($word[1] =~ /WARNING/) {
	&section(0, "\\section{Warning}\{");
      } elsif (join(" ", @word[1..2]) =~ /DATA DESCRIPTION/) {
	&section(0, "\\usage\{\ndata($fun)");
	&section(0, "\\format\{");
      } else {
	# This line may be of the form .SH "A B C"
	($tmp = join(" ", @word[1..$#word])) =~ s/\"(.*)\"/$1/;
	&section(0, "\\section\{$tmp\}\{");
      }
    }
    if (/^\.sp/) {
      if($word[1] == 0) {
	output("\\cr")
      } else {
	output("\n")
      }
    }
    if (/^\.TL/) {
      print("\\name\{$fun\}\n");
      print("\\alias\{", join("\}\n\\alias\{", @aliases), "\}\n");
      &section(0, "\\title\{");
      $inVerbatim = 1;
    }
    if (/^\.WR/) {
      &section(0, "");
      print("% Converted by $name version $version.\n");
    }
    if (/^\.AO/) {
      output("Arguments for function \\code\{$word[1]()\} can also be");
      output("supplied to this function.");
    }
    if (/^\.GE/) {
      output("This is a generic function.");
      output("Functions with names beginning in \\code\{$fun.\} will be");
      output("methods for this function.");
      output("Classes with methods for this function include:");
    }
    if (/^\.GR/) {
      output("Graphical parameters (see \\code\{\\link\{par\}\}) may also");
      output("be supplied as arguments to this function.");
    }
    if (/^\.ME/) {
      output("This function is a method for the generic function");
      output("\\code\{$word[1]()\} for class \\code\{\"$word[2]\"\}.");
      output("It can be invoked by calling \\code\{$word[1](x)\} for an");
      output("object \\code\{x\} of the appropriate class, or directly by");
      output("calling \\code\{$word[1].$word[2](x)\} regardless of the");
      output("class of the object.");
    }
    if (/^\.NA/) { output("Missing values (\\code\{NA\}s) are allowed."); }
    if (/^\.Tl/) {
      output("In addition, the high-level graphics control arguments");
      output("described under \\code\{\\link\{par\}\} and the arguments to");
      output("\\code\{\\link\{title\}\} may be supplied to this function.");
    }
    if (/^\.ul/) { $underlineNext = 1; }
    ## End
  }
}
 
sub substitute {
  if (!$inVerbatim) {
    s/\{/\\\{/g;
    s/\}/\\\}/g;
#    s/&/\\&/g; removed BDR 2000-02-10
    ## Added by BDR 1998-06-20
    s/\\\(aa/'/g;		# extra ' for highlight matching
    s/\\\(em/--/g;		# em dash
    s/\\\(tm/ (TM) /g;		# Trademark
    s/\\\(mu/ x /g;		# multiply sign
    s/\\\(\*a/\alpha/g;		# greek
    s/\\\(\*b/\beta/g;
    s/\\\(\*e/\epsilon/g;
    s/\\\(\*l/\lambda/g;
    s/\\\(\*m/\mu/g;
    s/\\\(\*p/\pi/g;
    s/\\\(\*s/\sigma/g;
    ## End
  }
  s/\.\.\./\\dots/g;
  s/\\fB/\\bold\{/g;
  s/\\fR/\}/g;
  ## Added by BDR 1998-06-20
  s/\\fI/\\emph\{/g;
  s/\\fP/\}/g;
  ## End
  s/\%/\\%/g;
  s/\\\.(.*)$/# $1)/g;
  if($inCode && s/\'/\}/) {
    $inCode = 0;
  }
  if ($inSeeAlso) {
    if ($opt_x) {
      s/\`?([\.\w]*\w+)\'?/\\code{\\link{$1}}/g;
    } else {
      s/\`([^\']*)\'/\\code{\\link{$1}}/g;
    }
  } elsif (!$inVerbatim) {
    if(s/\`([^\']*)$/\\code\{$1/) {
      $inCode = 1;
    }
    s/\`([^\']*)\'$/\\code{$1}/g;
    s/\`([^\']*)\'([^\'])/\\code{$1}$2/g;  
  }
  if ($inReferences) {
    s/([0-9])-([0-9])/$1--$2/g;
  }
}
 
sub section {
  my($level, $text) = @_;
  $n = $braceLevel - $level;
  print "\}" x $n, "\n" if ($n > 0);
  if ($needVal) {
    print("\\value\{\n$output\n\}\n");
    $needVal = 0;
  }
  print("$text\n") if $text;    
  $braceLevel = $level + 1;
  $inReferences = 0;
  $inVerbatim = 0;
  $inSeeAlso = 0;
  $doprint = 1;    
}
 
sub paragraph {
  my($name) = @_;
  &output("\n\\bold\{$name.\} ");
}
    
sub output {
  my($text) = @_;
  if ($doprint) {
    print("$text\n");
  } elsif ($output) {
    $output .= "\n$text";
  } else {
    $output = $text;
  }
}
 
 
## ---------------------------- S4 section -------------------------
 
my $skipping = 0;
my $nextskipping = 0;
my $text = "";
my $fun;
my $InArgs = 0;
 
my $nalias = 0;
my $nexamples = 0;
 
sub doS4 {
  foreach $_ (@lines) {
    # skip header
    if (/^<!doctype/) {
      $skipping = 1;
      $nextskipping = 1 unless />\s*$/s;
    }
    if($skipping && /^>/) { $nextskipping = 0;}
    # skip comments
    $skipping = $nextskipping = 1 if (/^\s*<\!-- /);
    if($skipping && /-->\s*$/) { $nextskipping = 0;}
    if(!$skipping) {
      $text = $text . $_;
    }
    $skipping = $nextskipping;
  }
 
  ($type, $text, $rest) = get_group($text); # s-function-doc or whatever
  if($type ne "function-doc" && $type ne "method-doc") {
    die "Document class 's-$type' is not supported";
  }
 
  chomp $text;
 
  while(length($text) > 0) {
    ($type, $body, $text) = get_group($text);
    process_group($type, $body);
  }
  print "% Converted by $name version $version.\n";
  ## End
}
 
sub get_group
{
    my $text = $_[0];
    my $body;
    my $rest;
 
    die "not at beginning of a group in |$text|" unless 
	$text =~ /^\s*<s-(.+?)>/s;
    my $type = $1;
    my $tt = $type;
    $tt =~ s/([a-zA-Z-]+).*/$1/;
    if($text =~ /^\s*<s-\Q$type\E>(.*?)<\/s-$tt>(.*)/s) {
	$body = $1;
	$rest = $2;
    } else { 
	warn "no match for 's-$tt'";
	$text =~ /^\s*<s-\Q$type\E>\s*(.*)/s;
	$body = $1;
	$rest = "";
    }
    ($type, $body, $rest);
}
 
sub process_group {
    my $type = $_[0];
    my $text = $_[1];
 
    if($InArgs && ($type =~ /^args/) != 1) {
	print "}\n";
	$InArgs = 0;
    }
 
    $text =~ s/^\n*//;
    $text =~ s/\n*$//;
 
    if ($type eq "topics") {
	process_sub_groups($text, "topic");
 
    } elsif ($type eq "title") {
	print "\\title{\n  $text\n}\n";
 
    } elsif ($type eq "description") {
	print "\\description{\n", sub4($text), "\n}\n";	
 
    } elsif ($type eq "usage") {
	## new-style usage is not catered for here: no examples seen
	## it will be passed through verbatim.
	if ($text =~ /^\s*<s-old-style-usage>\s*(.*?)\s*<\/s-old-style-usage>/s) {
	    $text = $1;
	}
	print "\\usage{\n$text\n}\n";	
 
    } elsif ($type eq "args" || $type eq "args-optional" 
	     || $type eq "args-required" ) {
	if(!$InArgs) {
	    print "\\arguments{\n";
	    $InArgs = 1;
	}
	## some files seem to have text before args
	my $pre = $text =~ /^\s*<s-arg/;
	if($pre != 1) {
	    my $pre;
	    if($text =~ s/^\s*(.*?)(<s-arg)/$2/s) {
		$pre = $1;
	    } else {
		## There are no <s-arg> groups!
		$pre = $text;
		$text = "";
	    }
	    print sub4($pre), "\n";
	}
	process_sub_groups($text, "arg");
 
    } elsif ($type eq "value") {
	print "\\value{\n";
	my $t;
	my @groups = split /<s-return-component /, $text;
	foreach $t (@groups) {
	    if ($t =~ /name=\"(.*?)\">\s*(.*)<\/s-return-component>/s) {
		my $name=$1;
		$t = $2;
		print "\\item{$1}{\n", sub4($t), "}\n";
	    } else {
		print sub4($t), "\n";
	    }
	}
	print "}\n";
 
    } elsif ($type eq "details") {
	print "\\details{\n", sub4($text), "\n}\n";	
 
    } elsif ($type eq "see") {
 	print "\\seealso{\n", makelinks($text), "\n}\n";	
 
    } elsif ($type eq "examples") {
	print "\\examples{\n";
	print "\\dontrun{\n" if $opt_n;
	process_sub_groups($text, "example");
	print "}\n" if $opt_n;
	print "}\n";
 
    } elsif ($type eq "note" || $type eq "notes") {
	print "\\note{\n", sub4($text), "\n}\n";	
 
    } elsif ($type eq "bugs") {
 	print "\\section{Bugs}{\n", sub4($text), "\n}\n";	
 
    } elsif ($type eq "references") {
	print "\\references{\n", inref(sub4($text)), "\n}\n";	
 
    } elsif ($type =~ /^section\s+name\s*=\s*(.*)/) {
	my $name = $1;
	$name =~ s/\s*\"(.*?)\"/$1/o;
	$name =~ s/^\s*//o;
	if ($name =~ /^reference$/io) {
	    print "\\references{\n", inref(sub4($text)), "\n}\n";	
	} elsif ($name =~ /^source$/io) {
	    print "\\source{\n", inref(sub4($text)), "\n}\n";	
	} elsif ($name =~ /^note$/io) {
	    print "\\note{\n", sub4($text), "\n}\n";	
	} elsif ($name =~ /^summary$/io) {
	    print "\\description{\n", sub4($text), "\n}\n";	
	} elsif ($name =~ /^data description$/io) {
	    print "\\usage{\ndata($fun)\n}\n";
	    print "\\format{\n", sub4($text), "\n}\n";	
	} else {
	    $name = lc($name);
	    $name =~ s/^([a-z])/\U$1/;
	    print "\\section{$name}{\n", sub4($text), "\n}\n";	
	}
 
    } elsif ($type eq "docclass") {
	print "% docclass is $text\n";
 
    } elsif ($type eq "warnings") {
	process_sub_groups($text, "warning");
 
    } elsif ($type eq "warning") {
	print "\\section{Warning}{\n", sub4($text), "\n}\n";	
 
    } elsif ($type eq "background") {
	print "\\section{Background}{\n", sub4($text), "\n}\n";	
 
    } elsif ($type eq "side-effects") {
	print "\\section{Side Effects}{\n", sub4($text), "\n}\n";	
 
    } elsif ($type eq "author") {
	print "\\author{\n", sub4($text), "\n}\n";	
 
    } elsif ($type eq "keywords") {
	process_sub_groups($text, "keyword");
 
    } else {
	warn "unknown SGML entity '$type'";
	print "%type:\n%$text\n";
    }
}
 
sub process_sub_groups {
  
    my $text = $_[0];
    my $topic = $_[1];
 
    while(length($text) > 0) {
	($type, $body, $text) = get_group($text);
	die "invalid subgroup" unless $type =~ /^$topic/;
	process_sub_group($type, $body);
    }
}
 
sub process_sub_group {
  
    my $topic = $_[0];
    my $text = $_[1];
 
 
 
    $text =~ s/^\n*//;
    $text =~ s/\n*$//;
    if ($type eq "topic") {
	 $text =~ s/^\s*//; $text =~ s/\s*$//;
	if(!$nalias) {
	    print "\\name{$text}\n";
	    $nalias = 1;
	    $fun = $text;
	}
	print "\\alias{$text}\n";
    } elsif ($type eq "warning") {
	print "\\section{Warning}{\n", sub4($text), "\n}\n";	
    } elsif ($type eq "keyword") {
	print "\\keyword{$text}\n";
    } elsif ($type =~ /^example/) {
	if ($nexample++ > 0) { print "\n"; }
	print verbsub($text), "\n";
    } elsif ($type =~ /^arg/) {
	$type =~ /^arg\s+name\s*=\s*(.*)/;
	my $name = $1;
	$name =~ s/\s*\"(.*?)\"/$1/o;
	$name =~ s/\s*(\w*)\s*/$1/o;
	$name =~ s/\.\.\./\\dots/;
	print "\\item{$name}{\n", sub4($text), "\n}\n";	
    } else {
	warn "unknown SGML entity '$type'";
	print "%type:\n%$text\n";
    }
}
 
sub inref {
    my $text = $_[0];
    $text =~ s/([0-9])-([0-9])/$1--$2/go;
    $text;
}
 
sub verbsub {
    my $text = $_[0];
    $text =~ s/&gt;/>/go;
    $text =~ s/&lt;/</go;
    $text =~ s/&#38;/&/go;
    $text =~ s/\%/\\%/go;
    $text;
}
 
sub sub4 {
    my $text = $_[0];
    $text =~ s/\{/\\\{/go;
    $text =~ s/\}/\\\}/go;
 
    ## These tags can have id's
    $text =~ s+<s-expression(.*?)>(.*?)</s-expression>+\\code{$2}+go;
    $text =~ s+<s-object(.*?)>(.*?)</s-object>+\\code{$2}+go;
    $text =~ s+<s-function(.*?)>(.*?)</s-function>+\\code{$2}+go;
    $text =~ s+<s-class(.*?)>(.*?)</s-class>+\\code{$2}+go;
    $text =~ s+<s-method(.*?)>(.*?)</s-method>+\\code{$2}+go;
    $text =~ s+<s-dataset(.*?)>(.*?)</s-dataset>+\\code{$2}+go;
    ## I have never seen these used
    $text =~ s+<s-expref(.*?)>(.*?)</s-expref>+\\code{$2}+go;
    $text =~ s+<s-objref(.*?)>(.*?)</s-objref>+\\code{$2}+go;
    $text =~ s+<s-function-ref(.*?)>(.*?)</s-function-ref>+\\code{$2}+go;
    $text =~ s+<s-clsref(.*?)>(.*?)</s-clsref>+\\code{$2}+go;
    $text =~ s+<s-mthref(.*?)>(.*?)</s-mthref>+\\code{$2}+go;
    $text =~ s+<s-datref(.*?)>(.*?)</s-datref>+\\code{$2}+go;
    $text =~ s+<s-chpref(.*?)>(.*?)</s-chpref>+\\code{$2}+go;
 
    $text =~ s+<it>(.*?)</it>+\\emph{$1}+go;
    $text =~ s+<sl>(.*?)</sl>+\\emph{$1}+go;
    $text =~ s+<em>(.*?)</em>+\\emph{$1}+go;
    # not clear what to do with <sf>
    $text =~ s+<sf>(.*?)</sf>+\\bold{$1}+go;
    $text =~ s+<bf>(.*?)</bf>+\\bold{$1}+go;
    $text =~ s+<tt>(.*?)</tt>+\\code{$1}+go;
    $text =~ s+<url>(.*?)</url>+\\url{$1}+go;
    $text =~ s/\n*<p>\n*/\n\n/go;
    $text =~ s/(<br>\n*)+/\n/go;
    $text =~ s/\$/\\\$/go;
    $text =~ s/@/\\@/go;
 
    verbsub($text);
}
 
sub makelinks {
    my $text = $_[0];
 
    $text =~ s+<s-function name="(.*?)">(.*?)</s-function>+\\code{\\link{$2}}+go;
    $text;
}
 
 
### Local Variables: ***
### mode: perl ***
### perl-indent-level: 2 ***
### End: ***

Rev 31770	Rev 34091
1	`#! @PERL@`	1	`#! @PERL@`
2	`#`	2	`#`
3	`# ${R_HOME}/bin/Sd2Rd for converting S documentation to Rd format`	3	`# ${R_HOME}/bin/Sd2Rd for converting S documentation to Rd format`
4		4
5	`# Copyright (C) 1997-2001 The R Core Development Team`	5	`# Copyright (C) 1997-2001 The R Core Development Team`
6	`#`	6	`#`
7	`# This document is free software; you can redistribute it and/or modify`	7	`# This document is free software; you can redistribute it and/or modify`
8	`# it under the terms of the GNU General Public License as published by`	8	`# it under the terms of the GNU General Public License as published by`
9	`# the Free Software Foundation; either version 2, or (at your option)`	9	`# the Free Software Foundation; either version 2, or (at your option)`
10	`# any later version.`	10	`# any later version.`
11	`#`	11	`#`
12	`# This program is distributed in the hope that it will be useful, but`	12	`# This program is distributed in the hope that it will be useful, but`
13	`# WITHOUT ANY WARRANTY; without even the implied warranty of`	13	`# WITHOUT ANY WARRANTY; without even the implied warranty of`
14	`# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU`	14	`# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU`
15	`# General Public License for more details.`	15	`# General Public License for more details.`
16	`#`	16	`#`
17	`# A copy of the GNU General Public License is available via WWW at`	17	`# A copy of the GNU General Public License is available via WWW at`
18	`# http://www.gnu.org/copyleft/gpl.html. You can also obtain it by`	18	`# http://www.gnu.org/copyleft/gpl.html. You can also obtain it by`
19	`# writing to the Free Software Foundation, Inc., 59 Temple Place,`	19	`# writing to the Free Software Foundation, Inc., 59 Temple Place,`
20	`# Suite 330, Boston, MA 02111-1307 USA.`	20	`# Suite 330, Boston, MA 02111-1307 USA.`
21		21
22	`use Getopt::Long;`	22	`use Getopt::Long;`
23	`use R::Utils;`	23	`use R::Utils;`
24		24
25	`my $revision = ' $Revision: 1.21 $ ';`	25	`my $revision = ' $Revision: 1.21 $ ';`
26	`my $version;`	26	`my $version;`
27	`my $name;`	27	`my $name;`
28		28
29	`$revision =~ / ([\d\.]*) /;`	29	`$revision =~ / ([\d\.]*) /;`
30	`$version = $1;`	30	`$version = $1;`
31	`($name = $0) =~ s\|.*/\|\|;`	31	`($name = $0) =~ s\|.*/\|\|;`
32		32
33	`sub usage {`	33	`sub usage {`
34	`print STDERR <<END;`	34	`print STDERR <<END;`
35	`Usage: R CMD Sd2Rd [options] FILE`	35	`Usage: R CMD Sd2Rd [options] FILE`
36		36
37	`Convert S documentation in FILE to R documentation format.`	37	`Convert S documentation in FILE to R documentation format.`
38		38
39	`Options:`	39	`Options:`
40	`-h, --help print short help message and exit`	40	`-h, --help print short help message and exit`
41	`-v, --version print Sd2Rd version info and exit`	41	`-v, --version print Sd2Rd version info and exit`
42	`-n render examples non-executable by wrapping them`	42	`-n render examples non-executable by wrapping them`
43	`into a \\dontrun{} environment`	43	`into a \\dontrun{} environment`
44	`-x (S3 docs) interpret all single-quoted names`	44	`-x (S3 docs) interpret all single-quoted names`
45	`as code names`	45	`as code names`
46		46
47	`Email bug reports to <r-bugs\@r-project.org>.`	47	`Email bug reports to <r-bugs\@r-project.org>.`
48	`END`	48	`END`
49	`exit 0;`	49	`exit 0;`
50	`}`	50	`}`
51		51
52	`@knownoptions = ("v\|version", "h\|help", "n", "x");`	52	`@knownoptions = ("v\|version", "h\|help", "n", "x");`
53	`GetOptions(@knownoptions) \|\| &usage();`	53	`GetOptions(@knownoptions) \|\| &usage();`
54	`&R_version($name, $version) if $opt_v;`	54	`&R_version($name, $version) if $opt_v;`
55	`&usage() if $opt_h;`	55	`&usage() if $opt_h;`
56		56
57	`@lines = <>;`	57	`@lines = <>;`
58	`## peek at the first line of the file, then dispatch to`	58	`## peek at the first line of the file, then dispatch to`
59	`## S3-style (nroff) or S4-style (SGML spec).`	59	`## S3-style (nroff) or S4-style (SGML spec).`
60	`if(@lines[0] =~ /^<!doctype/) { doS4(); } else { doS3(); }`	60	`if(@lines[0] =~ /^<!doctype/) { doS4(); } else { doS3(); }`
61	`exit 0;`	61	`exit 0;`
62		62
63	`sub doS3 {`	63	`sub doS3 {`
64	`$braceLevel = 0;`	64	`$braceLevel = 0;`
65	`$inReferences = 0;`	65	`$inReferences = 0;`
66	`$inVerbatim = 0;`	66	`$inVerbatim = 0;`
67	`$inSeeAlso = 0;`	67	`$inSeeAlso = 0;`
68	`$inCode = 0;`	68	`$inCode = 0;`
69	`$isDataSet = 0;`	69	`$isDataSet = 0;`
70	`$doprint = 1;`	70	`$doprint = 1;`
71	`$needArg = 1;`	71	`$needArg = 1;`
72	`$needVal = 0;`	72	`$needVal = 0;`
73	`$underlineNext = 0;`	73	`$underlineNext = 0;`
74	`$output = "";`	74	`$output = "";`
75		75
76	`foreach $_ (@lines) {`	76	`foreach $_ (@lines) {`
77	`chop;`	77	`chop;`
78	`&substitute unless /^\./;`	78	`&substitute unless /^\./;`
79	`my @word = split;`	79	`my @word = split;`
80		80
81	`if (/^\s*$/) { &output("\n"); }`	81	`if (/^\s*$/) { &output("\n"); }`
82	`if (/^[^.]/) {`	82	`if (/^[^.]/) {`
83	`if ($underlineNext) {`	83	`if ($underlineNext) {`
84	`$_ = "\\emph{" . $_ ."}";`	84	`$_ = "\\emph{" . $_ ."}";`
85	`$underlineNext = 0;`	85	`$underlineNext = 0;`
86	`}`	86	`}`
87	`&output($_);`	87	`&output($_);`
88	`}`	88	`}`
89		89
90	`## Added by BDR 1998-08-27`	90	`## Added by BDR 1998-08-27`
91	`if (/^\.\\\"/o) {`	91	`if (/^\.\\\"/o) {`
92	`s/^\.\\\"/%/;`	92	`s/^\.\\\"/%/;`
93	`&output($_);`	93	`&output($_);`
94	`}`	94	`}`
95	`## End`	95	`## End`
96		96
97	`if (/^\.BG D/) {`	97	`if (/^\.BG D/) {`
98	`$isDataSet = 1;`	98	`$isDataSet = 1;`
99	`}`	99	`}`
100	`if (/^\.AG/) {`	100	`if (/^\.AG/) {`
101	`if ($isDataSet) {`	101	`if ($isDataSet) {`
102	`if ($needArg) {`	102	`if ($needArg) {`
103	`&section(1, "\\describe\{");`	103	`&section(1, "\\describe\{");`
104	`$needArg = 0;`	104	`$needArg = 0;`
105	`}`	105	`}`
106	`$arg = $_;`	106	`$arg = $_;`
107	`$arg =~ s/^\.AG\s//;`	107	`$arg =~ s/^\.AG\s//;`
108	`&section(2, "\\item\{\\code\{$arg\}\}\{");`	108	`&section(2, "\\item\{\\code\{$arg\}\}\{");`
109	`} else {`	109	`} else {`
110	`if ($needArg) {`	110	`if ($needArg) {`
111	`&section(0, "\\arguments\{");`	111	`&section(0, "\\arguments\{");`
112	`$needArg = 0;`	112	`$needArg = 0;`
113	`}`	113	`}`
114	`$arg = $_;`	114	`$arg = $_;`
115	`$arg =~ s/^\.AG\s//;`	115	`$arg =~ s/^\.AG\s//;`
116	`&section(1, "\\item\{$arg\}\{");`	116	`&section(1, "\\item\{$arg\}\{");`
117	`}`	117	`}`
118	`}`	118	`}`
119	`if (/^\.CS/) {`	119	`if (/^\.CS/) {`
120	`&section(0, "\\usage\{");`	120	`&section(0, "\\usage\{");`
121	`$inVerbatim = 1;`	121	`$inVerbatim = 1;`
122	`}`	122	`}`
123	`if (/^\.DN/) { &section(0, "\\description\{"); }`	123	`if (/^\.DN/) { &section(0, "\\description\{"); }`
124	`if (/^\.DT/) { &section(0, "\\details\{"); }`	124	`if (/^\.DT/) { &section(0, "\\details\{"); }`
125	`if (/^\.EX/) {`	125	`if (/^\.EX/) {`
126	`if ($opt_n) {`	126	`if ($opt_n) {`
127	`&section(1, "\\examples\{\\dontrun\{");`	127	`&section(1, "\\examples\{\\dontrun\{");`
128	`} else {`	128	`} else {`
129	`&section(0, "\\examples\{");`	129	`&section(0, "\\examples\{");`
130	`}`	130	`}`
131	`$inVerbatim = 1;`	131	`$inVerbatim = 1;`
132	`}`	132	`}`
133	`if (/^\.FN/) {`	133	`if (/^\.FN/) {`
134	`unless($fun) { $fun = $word[1]; }`	134	`unless($fun) { $fun = $word[1]; }`
135	`push(@aliases, $word[1]);`	135	`push(@aliases, $word[1]);`
136	`}`	136	`}`
137	`if (/^\.(IP\|PP)/) { &output("\n"); }`	137	`if (/^\.(IP\|PP)/) { &output("\n"); }`
138	`if (/^\.KW/) {`	138	`if (/^\.KW/) {`
139	`if ($braceLevel > 0) {`	139	`if ($braceLevel > 0) {`
140	`&section(0, "");`	140	`&section(0, "");`
141	`$braceLevel = 0;`	141	`$braceLevel = 0;`
142	`}`	142	`}`
143	`if ($word[1] =~ /sysdata/) {`	143	`if ($word[1] =~ /sysdata/) {`
144	`&output("\\keyword\{datasets\}");`	144	`&output("\\keyword\{datasets\}");`
145	`} else {`	145	`} else {`
146	`&output("\\keyword\{$word[1]\}");`	146	`&output("\\keyword\{$word[1]\}");`
147	`}`	147	`}`
148	`}`	148	`}`
149	`if (/^\.RC/) {`	149	`if (/^\.RC/) {`
150	`if ($needVal) {`	150	`if ($needVal) {`
151	`$needVal = 0;`	151	`$needVal = 0;`
152	`&section(0, "\\value\{\n$output\n");`	152	`&section(0, "\\value\{\n$output\n");`
153	`$doprint = 1;`	153	`$doprint = 1;`
154	`}`	154	`}`
155	`&section(1, "\\item\{" . join(" ", @word[1..$#word]) . "\}\{");`	155	`&section(1, "\\item\{" . join(" ", @word[1..$#word]) . "\}\{");`
156	`}`	156	`}`
157	`if (/^\.RT/) {`	157	`if (/^\.RT/) {`
158	`$needVal = 1;`	158	`$needVal = 1;`
159	`$doprint = 0;`	159	`$doprint = 0;`
160	`$output = "";`	160	`$output = "";`
161	`}`	161	`}`
162	`if (/^\.SA/) {`	162	`if (/^\.SA/) {`
163	`&section(0, "\\seealso\{");`	163	`&section(0, "\\seealso\{");`
164	`$inSeeAlso = 1;`	164	`$inSeeAlso = 1;`
165	`}`	165	`}`
166	`if (/^\.SE/) { &section(0, "\\section\{Side Effects\}\{"); }`	166	`if (/^\.SE/) { &section(0, "\\section\{Side Effects\}\{"); }`
167	`if (/^\.SH/) {`	167	`if (/^\.SH/) {`
168	`if ($word[1] =~ /REFERENCE/) {`	168	`if ($word[1] =~ /REFERENCE/) {`
169	`&section(0, "\\references\{");`	169	`&section(0, "\\references\{");`
170	`$inReferences = 1;`	170	`$inReferences = 1;`
171	`} elsif ($word[1] =~ /AUTHOR/) {`	171	`} elsif ($word[1] =~ /AUTHOR/) {`
172	`&section(0, "\\author\{");`	172	`&section(0, "\\author\{");`
173	`} elsif ($word[1] =~ /NOTE/) {`	173	`} elsif ($word[1] =~ /NOTE/) {`
174	`&section(0, "\\note\{");`	174	`&section(0, "\\note\{");`
175	`} elsif ($word[1] =~ /SOURCE/) {`	175	`} elsif ($word[1] =~ /SOURCE/) {`
176	`&section(0, "\\source\{");`	176	`&section(0, "\\source\{");`
177	`$inReferences = 1;`	177	`$inReferences = 1;`
178	`} elsif ($word[1] =~ /SUMMARY/) {`	178	`} elsif ($word[1] =~ /SUMMARY/) {`
179	`&section(0, "\\description\{");`	179	`&section(0, "\\description\{");`
180	`} elsif ($word[1] =~ /WARNINGS/) {`	180	`} elsif ($word[1] =~ /WARNINGS/) {`
181	`&section(0, "\\section{Warnings}\{");`	181	`&section(0, "\\section{Warnings}\{");`
182	`} elsif ($word[1] =~ /WARNING/) {`	182	`} elsif ($word[1] =~ /WARNING/) {`
183	`&section(0, "\\section{Warning}\{");`	183	`&section(0, "\\section{Warning}\{");`
184	`} elsif (join(" ", @word[1..2]) =~ /DATA DESCRIPTION/) {`	184	`} elsif (join(" ", @word[1..2]) =~ /DATA DESCRIPTION/) {`
185	`&section(0, "\\usage\{\ndata($fun)");`	185	`&section(0, "\\usage\{\ndata($fun)");`
186	`&section(0, "\\format\{");`	186	`&section(0, "\\format\{");`
187	`} else {`	187	`} else {`
188	`# This line may be of the form .SH "A B C"`	188	`# This line may be of the form .SH "A B C"`
189	`($tmp = join(" ", @word[1..$#word])) =~ s/\"(.*)\"/$1/;`	189	`($tmp = join(" ", @word[1..$#word])) =~ s/\"(.*)\"/$1/;`
190	`&section(0, "\\section\{$tmp\}\{");`	190	`&section(0, "\\section\{$tmp\}\{");`
191	`}`	191	`}`
192	`}`	192	`}`
193	`if (/^\.sp/) {`	193	`if (/^\.sp/) {`
194	`if($word[1] == 0) {`	194	`if($word[1] == 0) {`
195	`output("\\cr")`	195	`output("\\cr")`
196	`} else {`	196	`} else {`
197	`output("\n")`	197	`output("\n")`
198	`}`	198	`}`
199	`}`	199	`}`
200	`if (/^\.TL/) {`	200	`if (/^\.TL/) {`
201	`print("\\name\{$fun\}\n");`	201	`print("\\name\{$fun\}\n");`
202	`print("\\alias\{", join("\}\n\\alias\{", @aliases), "\}\n");`	202	`print("\\alias\{", join("\}\n\\alias\{", @aliases), "\}\n");`
203	`&section(0, "\\title\{");`	203	`&section(0, "\\title\{");`
204	`$inVerbatim = 1;`	204	`$inVerbatim = 1;`
205	`}`	205	`}`
206	`if (/^\.WR/) {`	206	`if (/^\.WR/) {`
207	`&section(0, "");`	207	`&section(0, "");`
208	`print("% Converted by $name version $version.\n");`	208	`print("% Converted by $name version $version.\n");`
209	`}`	209	`}`
210	`if (/^\.AO/) {`	210	`if (/^\.AO/) {`
211	`output("Arguments for function \\code\{$word[1]()\} can also be");`	211	`output("Arguments for function \\code\{$word[1]()\} can also be");`
212	`output("supplied to this function.");`	212	`output("supplied to this function.");`
213	`}`	213	`}`
214	`if (/^\.GE/) {`	214	`if (/^\.GE/) {`
215	`output("This is a generic function.");`	215	`output("This is a generic function.");`
216	`output("Functions with names beginning in \\code\{$fun.\} will be");`	216	`output("Functions with names beginning in \\code\{$fun.\} will be");`
217	`output("methods for this function.");`	217	`output("methods for this function.");`
218	`output("Classes with methods for this function include:");`	218	`output("Classes with methods for this function include:");`
219	`}`	219	`}`
220	`if (/^\.GR/) {`	220	`if (/^\.GR/) {`
221	`output("Graphical parameters (see \\code\{\\link\{par\}\}) may also");`	221	`output("Graphical parameters (see \\code\{\\link\{par\}\}) may also");`
222	`output("be supplied as arguments to this function.");`	222	`output("be supplied as arguments to this function.");`
223	`}`	223	`}`
224	`if (/^\.ME/) {`	224	`if (/^\.ME/) {`
225	`output("This function is a method for the generic function");`	225	`output("This function is a method for the generic function");`
226	`output("\\code\{$word[1]()\} for class \\code\{\"$word[2]\"\}.");`	226	`output("\\code\{$word[1]()\} for class \\code\{\"$word[2]\"\}.");`
227	`output("It can be invoked by calling \\code\{$word[1](x)\} for an");`	227	`output("It can be invoked by calling \\code\{$word[1](x)\} for an");`
228	`output("object \\code\{x\} of the appropriate class, or directly by");`	228	`output("object \\code\{x\} of the appropriate class, or directly by");`
229	`output("calling \\code\{$word[1].$word[2](x)\} regardless of the");`	229	`output("calling \\code\{$word[1].$word[2](x)\} regardless of the");`
230	`output("class of the object.");`	230	`output("class of the object.");`
231	`}`	231	`}`
232	`if (/^\.NA/) { output("Missing values (\\code\{NA\}s) are allowed."); }`	232	`if (/^\.NA/) { output("Missing values (\\code\{NA\}s) are allowed."); }`
233	`if (/^\.Tl/) {`	233	`if (/^\.Tl/) {`
234	`output("In addition, the high-level graphics control arguments");`	234	`output("In addition, the high-level graphics control arguments");`
235	`output("described under \\code\{\\link\{par\}\} and the arguments to");`	235	`output("described under \\code\{\\link\{par\}\} and the arguments to");`
236	`output("\\code\{\\link\{title\}\} may be supplied to this function.");`	236	`output("\\code\{\\link\{title\}\} may be supplied to this function.");`
237	`}`	237	`}`
238	`if (/^\.ul/) { $underlineNext = 1; }`	238	`if (/^\.ul/) { $underlineNext = 1; }`
239	`## End`	239	`## End`
240	`}`	240	`}`
241	`}`	241	`}`
242		242
243	`sub substitute {`	243	`sub substitute {`
244	`if (!$inVerbatim) {`	244	`if (!$inVerbatim) {`
245	`s/\{/\\\{/g;`	245	`s/\{/\\\{/g;`
246	`s/\}/\\\}/g;`	246	`s/\}/\\\}/g;`
247	`# s/&/\\&/g; removed BDR 2000-02-10`	247	`# s/&/\\&/g; removed BDR 2000-02-10`
248	`## Added by BDR 1998-06-20`	248	`## Added by BDR 1998-06-20`
249	`s/\\\(aa/'/g; # extra ' for highlight matching`	249	`s/\\\(aa/'/g; # extra ' for highlight matching`
250	`s/\\\(em/--/g; # em dash`	250	`s/\\\(em/--/g; # em dash`
251	`s/\\\(tm/ (TM) /g; # Trademark`	251	`s/\\\(tm/ (TM) /g; # Trademark`
252	`s/\\\(mu/ x /g; # multiply sign`	252	`s/\\\(mu/ x /g; # multiply sign`
253	`s/\\\(\*a/\alpha/g; # greek`	253	`s/\\\(\*a/\alpha/g; # greek`
254	`s/\\\(\*b/\beta/g;`	254	`s/\\\(\*b/\beta/g;`
255	`s/\\\(\*e/\epsilon/g;`	255	`s/\\\(\*e/\epsilon/g;`
256	`s/\\\(\*l/\lambda/g;`	256	`s/\\\(\*l/\lambda/g;`
257	`s/\\\(\*m/\mu/g;`	257	`s/\\\(\*m/\mu/g;`
258	`s/\\\(\*p/\pi/g;`	258	`s/\\\(\*p/\pi/g;`
259	`s/\\\(\*s/\sigma/g;`	259	`s/\\\(\*s/\sigma/g;`
260	`## End`	260	`## End`
261	`}`	261	`}`
262	`s/\.\.\./\\dots/g;`	262	`s/\.\.\./\\dots/g;`
263	`s/\\fB/\\bold\{/g;`	263	`s/\\fB/\\bold\{/g;`
264	`s/\\fR/\}/g;`	264	`s/\\fR/\}/g;`
265	`## Added by BDR 1998-06-20`	265	`## Added by BDR 1998-06-20`
266	`s/\\fI/\\emph\{/g;`	266	`s/\\fI/\\emph\{/g;`
267	`s/\\fP/\}/g;`	267	`s/\\fP/\}/g;`
268	`## End`	268	`## End`
269	`s/\%/\\%/g;`	269	`s/\%/\\%/g;`
270	`s/\\\.(.*)$/# $1)/g;`	270	`s/\\\.(.*)$/# $1)/g;`
271	`if($inCode && s/\'/\}/) {`	271	`if($inCode && s/\'/\}/) {`
272	`$inCode = 0;`	272	`$inCode = 0;`
273	`}`	273	`}`
274	`if ($inSeeAlso) {`	274	`if ($inSeeAlso) {`
275	`if ($opt_x) {`	275	`if ($opt_x) {`
276	s/\`?([\.\w]*\w+)\'?/\\code{\\link{$1}}/g;	276	s/\`?([\.\w]*\w+)\'?/\\code{\\link{$1}}/g;
277	`} else {`	277	`} else {`
278	s/\`([^\']*)\'/\\code{\\link{$1}}/g;	278	s/\`([^\']*)\'/\\code{\\link{$1}}/g;
279	`}`	279	`}`
280	`} elsif (!$inVerbatim) {`	280	`} elsif (!$inVerbatim) {`
281	if(s/\`([^\']*)$/\\code\{$1/) {	281	if(s/\`([^\']*)$/\\code\{$1/) {
282	`$inCode = 1;`	282	`$inCode = 1;`
283	`}`	283	`}`
284	s/\`([^\']*)\'$/\\code{$1}/g;	284	s/\`([^\']*)\'$/\\code{$1}/g;
285	s/\`([^\']*)\'([^\'])/\\code{$1}$2/g;	285	s/\`([^\']*)\'([^\'])/\\code{$1}$2/g;
286	`}`	286	`}`
287	`if ($inReferences) {`	287	`if ($inReferences) {`
288	`s/([0-9])-([0-9])/$1--$2/g;`	288	`s/([0-9])-([0-9])/$1--$2/g;`
289	`}`	289	`}`
290	`}`	290	`}`
291		291
292	`sub section {`	292	`sub section {`
293	`my($level, $text) = @_;`	293	`my($level, $text) = @_;`
294	`$n = $braceLevel - $level;`	294	`$n = $braceLevel - $level;`
295	`print "\}" x $n, "\n" if ($n > 0);`	295	`print "\}" x $n, "\n" if ($n > 0);`
296	`if ($needVal) {`	296	`if ($needVal) {`
297	`print("\\value\{\n$output\n\}\n");`	297	`print("\\value\{\n$output\n\}\n");`
298	`$needVal = 0;`	298	`$needVal = 0;`
299	`}`	299	`}`
300	`print("$text\n") if $text;`	300	`print("$text\n") if $text;`
301	`$braceLevel = $level + 1;`	301	`$braceLevel = $level + 1;`
302	`$inReferences = 0;`	302	`$inReferences = 0;`
303	`$inVerbatim = 0;`	303	`$inVerbatim = 0;`
304	`$inSeeAlso = 0;`	304	`$inSeeAlso = 0;`
305	`$doprint = 1;`	305	`$doprint = 1;`
306	`}`	306	`}`
307		307
308	`sub paragraph {`	308	`sub paragraph {`
309	`my($name) = @_;`	309	`my($name) = @_;`
310	`&output("\n\\bold\{$name.\} ");`	310	`&output("\n\\bold\{$name.\} ");`
311	`}`	311	`}`
312		312
313	`sub output {`	313	`sub output {`
314	`my($text) = @_;`	314	`my($text) = @_;`
315	`if ($doprint) {`	315	`if ($doprint) {`
316	`print("$text\n");`	316	`print("$text\n");`
317	`} elsif ($output) {`	317	`} elsif ($output) {`
318	`$output .= "\n$text";`	318	`$output .= "\n$text";`
319	`} else {`	319	`} else {`
320	`$output = $text;`	320	`$output = $text;`
321	`}`	321	`}`
322	`}`	322	`}`
323		323
324		324
325	`## ---------------------------- S4 section -------------------------`	325	`## ---------------------------- S4 section -------------------------`
326		326
327	`my $skipping = 0;`	327	`my $skipping = 0;`
328	`my $nextskipping = 0;`	328	`my $nextskipping = 0;`
329	`my $text = "";`	329	`my $text = "";`
330	`my $fun;`	330	`my $fun;`
331	`my $InArgs = 0;`	331	`my $InArgs = 0;`
332		332
-		333	`my $nalias = 0;`
-		334	`my $nexamples = 0;`
-		335
333	`sub doS4 {`	336	`sub doS4 {`
334	`foreach $_ (@lines) {`	337	`foreach $_ (@lines) {`
335	`# skip header`	338	`# skip header`
336	`if (/^<!doctype/) {`	339	`if (/^<!doctype/) {`
337	`$skipping = 1;`	340	`$skipping = 1;`
338	`$nextskipping = 1 unless />\s*$/s;`	341	`$nextskipping = 1 unless />\s*$/s;`
339	`}`	342	`}`
340	`if($skipping && /^>/) { $nextskipping = 0;}`	343	`if($skipping && /^>/) { $nextskipping = 0;}`
341	`# skip comments`	344	`# skip comments`
342	`$skipping = $nextskipping = 1 if (/^\s*<\!-- /);`	345	`$skipping = $nextskipping = 1 if (/^\s*<\!-- /);`
343	`if($skipping && /-->\s*$/) { $nextskipping = 0;}`	346	`if($skipping && /-->\s*$/) { $nextskipping = 0;}`
344	`if(!$skipping) {`	347	`if(!$skipping) {`
345	`$text = $text . $_;`	348	`$text = $text . $_;`
346	`}`	349	`}`
347	`$skipping = $nextskipping;`	350	`$skipping = $nextskipping;`
348	`}`	351	`}`
349		352
350	`($type, $text, $rest) = get_group($text); # s-function-doc or whatever`	353	`($type, $text, $rest) = get_group($text); # s-function-doc or whatever`
351	`if($type ne "function-doc" && $type ne "method-doc") {`	354	`if($type ne "function-doc" && $type ne "method-doc") {`
352	die "Document class `s-$type' is not supported";	355	`die "Document class 's-$type' is not supported";`
353	`}`	356	`}`
354		357
355	`chomp $text;`	358	`chomp $text;`
356		359
357	`while(length($text) > 0) {`	360	`while(length($text) > 0) {`
358	`($type, $body, $text) = get_group($text);`	361	`($type, $body, $text) = get_group($text);`
359	`process_group($type, $body);`	362	`process_group($type, $body);`
360	`}`	363	`}`
361	`print "% Converted by $name version $version.\n";`	364	`print "% Converted by $name version $version.\n";`
362	`## End`	365	`## End`
363	`}`	366	`}`
364		367
365	`sub get_group`	368	`sub get_group`
366	`{`	369	`{`
367	`my $text = $_[0];`	370	`my $text = $_[0];`
368	`my $body;`	371	`my $body;`
369	`my $rest;`	372	`my $rest;`
370		373
371	`die "not at beginning of a group in \|$text\|" unless`	374	`die "not at beginning of a group in \|$text\|" unless`
372	`$text =~ /^\s*<s-(.+?)>/s;`	375	`$text =~ /^\s*<s-(.+?)>/s;`
373	`my $type = $1;`	376	`my $type = $1;`
374	`my $tt = $type;`	377	`my $tt = $type;`
375	`$tt =~ s/([a-zA-Z-]+).*/$1/;`	378	`$tt =~ s/([a-zA-Z-]+).*/$1/;`
376	`if($text =~ /^\s<s-\Q$type\E>(.?)<\/s-$tt>(.*)/s) {`	379	`if($text =~ /^\s<s-\Q$type\E>(.?)<\/s-$tt>(.*)/s) {`
377	`$body = $1;`	380	`$body = $1;`
378	`$rest = $2;`	381	`$rest = $2;`
379	`} else {`	382	`} else {`
380	warn "no match for `s-$tt'";	383	`warn "no match for 's-$tt'";`
381	`$text =~ /^\s<s-\Q$type\E>\s(.*)/s;`	384	`$text =~ /^\s<s-\Q$type\E>\s(.*)/s;`
382	`$body = $1;`	385	`$body = $1;`
383	`$rest = "";`	386	`$rest = "";`
384	`}`	387	`}`
385	`($type, $body, $rest);`	388	`($type, $body, $rest);`
386	`}`	389	`}`
387		390
388	`sub process_group {`	391	`sub process_group {`
389	`my $type = $_[0];`	392	`my $type = $_[0];`
390	`my $text = $_[1];`	393	`my $text = $_[1];`
391		394
392	`if($InArgs && ($type =~ /^args/) != 1) {`	395	`if($InArgs && ($type =~ /^args/) != 1) {`
393	`print "}\n";`	396	`print "}\n";`
394	`$InArgs = 0;`	397	`$InArgs = 0;`
395	`}`	398	`}`
396		399
397	`$text =~ s/^\n*//;`	400	`$text =~ s/^\n*//;`
398	`$text =~ s/\n*$//;`	401	`$text =~ s/\n*$//;`
399		402
400	`if ($type eq "topics") {`	403	`if ($type eq "topics") {`
401	`process_sub_groups($text, "topic");`	404	`process_sub_groups($text, "topic");`
402		405
403	`} elsif ($type eq "title") {`	406	`} elsif ($type eq "title") {`
404	`print "\\title{\n $text\n}\n";`	407	`print "\\title{\n $text\n}\n";`
405		408
406	`} elsif ($type eq "description") {`	409	`} elsif ($type eq "description") {`
407	`print "\\description{\n", sub4($text), "\n}\n";`	410	`print "\\description{\n", sub4($text), "\n}\n";`
408		411
409	`} elsif ($type eq "usage") {`	412	`} elsif ($type eq "usage") {`
410	`## new-style usage is not catered for here: no examples seen`	413	`## new-style usage is not catered for here: no examples seen`
411	`## it will be passed through verbatim.`	414	`## it will be passed through verbatim.`
412	`if ($text =~ /^\s<s-old-style-usage>\s(.?)\s<\/s-old-style-usage>/s) {`	415	`if ($text =~ /^\s<s-old-style-usage>\s(.?)\s<\/s-old-style-usage>/s) {`
413	`$text = $1;`	416	`$text = $1;`
414	`}`	417	`}`
415	`print "\\usage{\n$text\n}\n";`	418	`print "\\usage{\n$text\n}\n";`
416		419
417	`} elsif ($type eq "args" \|\| $type eq "args-optional"`	420	`} elsif ($type eq "args" \|\| $type eq "args-optional"`
418	`\|\| $type eq "args-required" ) {`	421	`\|\| $type eq "args-required" ) {`
419	`if(!$InArgs) {`	422	`if(!$InArgs) {`
420	`print "\\arguments{\n";`	423	`print "\\arguments{\n";`
421	`$InArgs = 1;`	424	`$InArgs = 1;`
422	`}`	425	`}`
423	`## some files seem to have text before args`	426	`## some files seem to have text before args`
424	`my $pre = $text =~ /^\s*<s-arg/;`	427	`my $pre = $text =~ /^\s*<s-arg/;`
425	`if($pre != 1) {`	428	`if($pre != 1) {`
426	`my $pre;`	429	`my $pre;`
427	`if($text =~ s/^\s(.?)(<s-arg)/$2/s) {`	430	`if($text =~ s/^\s(.?)(<s-arg)/$2/s) {`
428	`$pre = $1;`	431	`$pre = $1;`
429	`} else {`	432	`} else {`
430	`## There are no <s-arg> groups!`	433	`## There are no <s-arg> groups!`
431	`$pre = $text;`	434	`$pre = $text;`
432	`$text = "";`	435	`$text = "";`
433	`}`	436	`}`
434	`print sub4($pre), "\n";`	437	`print sub4($pre), "\n";`
435	`}`	438	`}`
436	`process_sub_groups($text, "arg");`	439	`process_sub_groups($text, "arg");`
437		440
438	`} elsif ($type eq "value") {`	441	`} elsif ($type eq "value") {`
439	`print "\\value{\n";`	442	`print "\\value{\n";`
440	`my $t;`	443	`my $t;`
441	`my @groups = split /<s-return-component /, $text;`	444	`my @groups = split /<s-return-component /, $text;`
442	`foreach $t (@groups) {`	445	`foreach $t (@groups) {`
443	`if ($t =~ /name=\"(.?)\">\s(.*)<\/s-return-component>/s) {`	446	`if ($t =~ /name=\"(.?)\">\s(.*)<\/s-return-component>/s) {`
444	`my $name=$1;`	447	`my $name=$1;`
445	`$t = $2;`	448	`$t = $2;`
446	`print "\\item{$1}{\n", sub4($t), "}\n";`	449	`print "\\item{$1}{\n", sub4($t), "}\n";`
447	`} else {`	450	`} else {`
448	`print sub4($t), "\n";`	451	`print sub4($t), "\n";`
449	`}`	452	`}`
450	`}`	453	`}`
451	`print "}\n";`	454	`print "}\n";`
452		455
453	`} elsif ($type eq "details") {`	456	`} elsif ($type eq "details") {`
454	`print "\\details{\n", sub4($text), "\n}\n";`	457	`print "\\details{\n", sub4($text), "\n}\n";`
455		458
456	`} elsif ($type eq "see") {`	459	`} elsif ($type eq "see") {`
457	`print "\\seealso{\n", makelinks($text), "\n}\n";`	460	`print "\\seealso{\n", makelinks($text), "\n}\n";`
458		461
459	`} elsif ($type eq "examples") {`	462	`} elsif ($type eq "examples") {`
460	`print "\\examples{\n";`	463	`print "\\examples{\n";`
461	`print "\\dontrun{\n" if $opt_n;`	464	`print "\\dontrun{\n" if $opt_n;`
462	`process_sub_groups($text, "example");`	465	`process_sub_groups($text, "example");`
463	`print "}\n" if $opt_n;`	466	`print "}\n" if $opt_n;`
464	`print "}\n";`	467	`print "}\n";`
465		468
466	`} elsif ($type eq "note" \|\| $type eq "notes") {`	469	`} elsif ($type eq "note" \|\| $type eq "notes") {`
467	`print "\\note{\n", sub4($text), "\n}\n";`	470	`print "\\note{\n", sub4($text), "\n}\n";`
468		471
469	`} elsif ($type eq "bugs") {`	472	`} elsif ($type eq "bugs") {`
470	`print "\\section{Bugs}{\n", sub4($text), "\n}\n";`	473	`print "\\section{Bugs}{\n", sub4($text), "\n}\n";`
471		474
472	`} elsif ($type eq "references") {`	475	`} elsif ($type eq "references") {`
473	`print "\\references{\n", inref(sub4($text)), "\n}\n";`	476	`print "\\references{\n", inref(sub4($text)), "\n}\n";`
474		477
475	`} elsif ($type =~ /^section\s+name\s=\s(.*)/) {`	478	`} elsif ($type =~ /^section\s+name\s=\s(.*)/) {`
476	`my $name = $1;`	479	`my $name = $1;`
477	`$name =~ s/\s\"(.?)\"/$1/o;`	480	`$name =~ s/\s\"(.?)\"/$1/o;`
478	`$name =~ s/^\s*//o;`	481	`$name =~ s/^\s*//o;`
479	`if ($name =~ /^reference$/io) {`	482	`if ($name =~ /^reference$/io) {`
480	`print "\\references{\n", inref(sub4($text)), "\n}\n";`	483	`print "\\references{\n", inref(sub4($text)), "\n}\n";`
481	`} elsif ($name =~ /^source$/io) {`	484	`} elsif ($name =~ /^source$/io) {`
482	`print "\\source{\n", inref(sub4($text)), "\n}\n";`	485	`print "\\source{\n", inref(sub4($text)), "\n}\n";`
483	`} elsif ($name =~ /^note$/io) {`	486	`} elsif ($name =~ /^note$/io) {`
484	`print "\\note{\n", sub4($text), "\n}\n";`	487	`print "\\note{\n", sub4($text), "\n}\n";`
485	`} elsif ($name =~ /^summary$/io) {`	488	`} elsif ($name =~ /^summary$/io) {`
486	`print "\\description{\n", sub4($text), "\n}\n";`	489	`print "\\description{\n", sub4($text), "\n}\n";`
487	`} elsif ($name =~ /^data description$/io) {`	490	`} elsif ($name =~ /^data description$/io) {`
488	`print "\\usage{\ndata($fun)\n}\n";`	491	`print "\\usage{\ndata($fun)\n}\n";`
489	`print "\\format{\n", sub4($text), "\n}\n";`	492	`print "\\format{\n", sub4($text), "\n}\n";`
490	`} else {`	493	`} else {`
491	`$name = lc($name);`	494	`$name = lc($name);`
492	`$name =~ s/^([a-z])/\U$1/;`	495	`$name =~ s/^([a-z])/\U$1/;`
493	`print "\\section{$name}{\n", sub4($text), "\n}\n";`	496	`print "\\section{$name}{\n", sub4($text), "\n}\n";`
494	`}`	497	`}`
495		498
496	`} elsif ($type eq "docclass") {`	499	`} elsif ($type eq "docclass") {`
497	`print "% docclass is $text\n";`	500	`print "% docclass is $text\n";`

The R Project SVN R

(root)/trunk/src/scripts/Sd2Rd.in @ 34412 – Rev 31770 → 34091