[Roxygen-commits] r223 - in branches/manuel: R sandbox
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Jun 5 17:49:03 CEST 2009
Author: manuel
Date: 2009-06-05 17:49:03 +0200 (Fri, 05 Jun 2009)
New Revision: 223
Modified:
branches/manuel/R/Rd.R
branches/manuel/R/Rd_API.R
branches/manuel/R/Rd_merge.R
branches/manuel/sandbox/Rd2.R
Log:
Modified: branches/manuel/R/Rd.R
===================================================================
--- branches/manuel/R/Rd.R 2009-05-29 15:19:19 UTC (rev 222)
+++ branches/manuel/R/Rd.R 2009-06-05 15:49:03 UTC (rev 223)
@@ -162,9 +162,9 @@
#' make.Rd.roclet
make.Rd.roclet <- function(subdir=NULL,
verbose=TRUE,
- mergefn=Rd_merge,
exportonly=FALSE,
- debug=FALSE) {
+ documentedonly=TRUE,
+ mergefn=Rd_merge) {
writeRd <- TRUE
set.writeRd <- function()
@@ -175,9 +175,9 @@
reset.writeRd <- function()
set.writeRd()
+
+ rd <- NULL
- rd <- Rd()
-
write.Rd <- function() {
if ( writeRd ) {
#if ( !debug )
@@ -202,13 +202,6 @@
append.Rd <- function(x)
assign.parent('rd', Rd_append_tag(rd, x), environment())
- merge.Rd <- function(x) {
- assign.parent('rd', mergefn(x, rd), environment())
-
- if ( verbose )
- cat(sprintf(' merged,'))
- }
-
existing.Rd <- function()
parse_Rd(filename)
@@ -366,8 +359,10 @@
#' @param partitum the pre-parsed elements
#' @return \code{NULL}
parse.formals <- function(partitum) {
- formals <- partitum$formals
+ formals <- partitum$formals
if (!is.null(formals)) {
+ formals <- lapply(formals, trim)
+ formals <- lapply(formals, paste, collapse=" ")
name.defaults <- zip.c(names(formals), formals)
args <-
do.call(paste, c(Map(function(name.default) {
@@ -402,14 +397,21 @@
parse.expression('usage', partitum$usage)
}
+ is.documented <- function(partitum)
+ length(partitum) > 3
+
#' Reset params; parse name and usage.
#' @param partitum the pre-parsed elements
#' @return \code{NULL}
pre.parse <- function(partitum) {
+ if ( documentedonly && !is.documented(partitum) )
+ unset.writeRd()
if ( !is.null(partitum$nord) )
unset.writeRd()
if ( exportonly && is.null(partitum$export) )
unset.writeRd()
+
+ # TODO: interrupt the processing?
assign.parent('params', NULL, environment())
assign.parent('examples', NULL, environment())
@@ -430,8 +432,7 @@
write.Rd()
reset.Rd()
- if ( verbose )
- cat('\n')
+ if ( verbose ) cat('\n')
## Assuming the previous sink was successful;
## if not, it will destroy the sink stack.
@@ -440,9 +441,25 @@
reset.writeRd()
}
+ post.files <- function() {
+ for ( filename in names(roclet$rdtank$mergelist) ) {
+
+ base <- if ( file.exists(filename) ) parse_Rd(filename) else NULL
+ final <- roclet$rdtank$documents[roclet$rdtank$mergelist[[filename]]]
+
+ if ( length(final) > 1 || !is.null(base) )
+ final <- do.call('mergefn', list(final, base))
+
+ #rdtank.add(final, paste(filename, '2', sep=''), '1')
+ cat(tools:::as.character.Rd(final[[1]]),
+ sep='', collapse='\n', file=filename)
+ }
+ }
+
roclet <- make.roclet(parse.expression,
pre.parse,
- post.parse)
+ post.parse,
+ post.files=post.files)
roclet$register.default.parsers('references',
'note',
@@ -578,20 +595,6 @@
c(roclet$rdtank$mergelist[[filename]], name)
}
- roclet$write <- function() {
- for ( filename in names(roclet$rdtank$mergelist) ) {
-
- base <- if ( file.exists(filename) ) parse_Rd(filename) else NULL
- final <- roclet$rdtank$documents[roclet$rdtank$mergelist[[filename]]]
-
- if ( length(final) > 1 || !is.null(base) )
- final <- do.call('mergefn', list(final, base))
-
- #rdtank.add(final, paste(filename, '2', sep=''), '1')
- cat(tools:::as.character.Rd(final[[1]]),
- sep='', collapse='\n', file=filename)
- }
- }
roclet
}
Modified: branches/manuel/R/Rd_API.R
===================================================================
--- branches/manuel/R/Rd_API.R 2009-05-29 15:19:19 UTC (rev 222)
+++ branches/manuel/R/Rd_API.R 2009-06-05 15:49:03 UTC (rev 223)
@@ -42,11 +42,12 @@
list(textTag(y))), '\\method'))
}
-usageTag <- function(x, y, newline=TRUE) {
- if ( newline )
- x <- newlineSeperators(x)
-
- return(Rd_tag(list(x, rcodeTag(sprintf('(%s)', y))), '\\usage'))
+usageTag <- function(x, y) {
+ y <- sprintf('(%s)', paste(strwrap(y, exdent=4), collapse="\n"))
+ tag <- Rd_tag(list(x, rcodeTag(y)), '\\usage')
+ tag <- Rd_tag_append_tag(tag, newlineTag(), newline=FALSE)
+
+ return(tag)
}
newlineTag <- function() {
@@ -110,7 +111,7 @@
### Rd functions:
-Rd_append_tag <- function(rd, tag, at=NULL, newline=TRUE) {
+Rd_append_tag <- function(rd, tag, at=NULL, newline=FALSE) {
if ( is.null(at) )
at <- length(rd) + 1
Modified: branches/manuel/R/Rd_merge.R
===================================================================
--- branches/manuel/R/Rd_merge.R 2009-05-29 15:19:19 UTC (rev 222)
+++ branches/manuel/R/Rd_merge.R 2009-06-05 15:49:03 UTC (rev 223)
@@ -40,12 +40,12 @@
simplemergers <- function() {
return(list(DEFAULT=default.merger,
- name=omity.merger,
- description=omity.merger,
- author=omity.merger,
- title=omity.merger,
+ name=one.merger,
+ description=one.merger,
+ author=one.merger,
+ title=one.merger,
value=paragraph.merger,
- description=paragraph.merger,
+ details=paragraph.merger,
arguments=arguments.merger))
}
@@ -53,10 +53,13 @@
if ( is.null(x) )
return(y)
- return(Rd_tag_append_tag(x, y))
+ return(Rd_tag_append_tag(x, y, newline=FALSE))
}
-omity.merger <- function(x, y, yname) {
+one.merger <- function(x, y, yname) {
+ if ( is.null(x) )
+ return(y)
+
return(x)
}
@@ -78,7 +81,7 @@
}
paragraph.merger <- function(x, y, yname) {
- t <- textTag(sprintf('\\emph{%s}: ', yname))
+ t <- textTag(sprintf('\\code{%s}: ', yname))
attr <- attributes(y)
y <- c(t, y, newlineTag(), newlineTag())
attributes(y) <- attr
Modified: branches/manuel/sandbox/Rd2.R
===================================================================
--- branches/manuel/sandbox/Rd2.R 2009-05-29 15:19:19 UTC (rev 222)
+++ branches/manuel/sandbox/Rd2.R 2009-06-05 15:49:03 UTC (rev 223)
@@ -68,7 +68,6 @@
all.files=TRUE))
Rd <- make.Rd.roclet(man.dir)
do.call(Rd$parse, files)
- Rd$write()
namespace <- make.namespace.roclet(namespace.file)
do.call(namespace$parse, files)
@@ -83,8 +82,12 @@
return(Rd)
}
+setwd('Z:\\Projects\\Roxygen\\r-forge\\branches\\manuel\\sandbox')
+source('../R/Rd_API.R')
+source('../R/Rd.R')
+source('../R/Rd_merge.R')
+
setwd('Z:/Research/Benchmarking')
-
r <- roxygenize2('pkg', roxygen.dir='builds/benchmark')
r <- parse_Rd('builds/benchmark/man/basicplots.Rd')
More information about the Roxygen-commits
mailing list