[Roxygen-commits] r220 - in branches/manuel: R sandbox
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri May 29 08:54:03 CEST 2009
Author: manuel
Date: 2009-05-29 08:54:02 +0200 (Fri, 29 May 2009)
New Revision: 220
Added:
branches/manuel/R/Rd_API.R
branches/manuel/R/Rd_merge.R
Removed:
branches/manuel/R/merge.Rd.R
Modified:
branches/manuel/R/Rd.R
branches/manuel/sandbox/Rd2.R
branches/manuel/sandbox/example-pseudoprime.R
Log:
Rd with original workflow, i.e., each R file is parsed, the Rd is immediatly written to file, and for merging the corresponding Rd files (the already existing one and the new one from the R file) are read, merged and written back to the Rd file.
This workflow makes it hard to merge in a clean way.
Modified: branches/manuel/R/Rd.R
===================================================================
--- branches/manuel/R/Rd.R 2009-05-08 08:40:45 UTC (rev 219)
+++ branches/manuel/R/Rd.R 2009-05-29 06:54:02 UTC (rev 220)
@@ -5,6 +5,9 @@
#' @include parse.R
roxygen()
+register.preref.parsers(parse.default,
+ 'nord')
+
register.preref.parsers(parse.value,
'name',
'aliases',
@@ -21,7 +24,8 @@
'author',
'TODO',
'format',
- 'source')
+ 'source',
+ 'rdname')
register.preref.parsers(parse.name.description,
'param',
@@ -158,31 +162,52 @@
#' make.Rd.roclet
make.Rd.roclet <- function(subdir=NULL,
verbose=TRUE,
- mergefn=merge.Rd) {
+ mergefn=Rd_merge,
+ exportonly=FALSE,
+ debug=FALSE) {
+
+ writeRd <- TRUE
- Rd <- list()
+ set.writeRd <- function()
+ assign.parent('writeRd', TRUE, environment())
- nlTag.Rd <- function()
- return(list(structure('\n', Rd_tag='TEXT')))
-
- tag.Rd <- function(x, tag='TEXT')
- return(list(structure(x, Rd_tag=tag)))
+ unset.writeRd <- function()
+ assign.parent('writeRd', FALSE, environment())
- itemTag.Rd <- function(x)
- return(structure(list(tag.Rd(x[[1]]), tag.Rd(x[[2]])), Rd_tag='\\item'))
+ reset.writeRd <- function()
+ set.writeRd()
- write.Rd <- function(plain=TRUE)
- cat(tools:::as.character.Rd(structure(Rd, class='Rd')),
- sep='', collapse='\n', file=filename)
+
+ rd <- Rd()
+ write.Rd <- function() {
+ if ( writeRd ) {
+ if ( !debug )
+ cat(tools:::as.character.Rd(rd),
+ sep='', collapse='\n', file=filename)
+ else
+ save(rd, file=paste(filename, 'Rdata', sep='.'))
+ }
+
+ if ( verbose )
+ if ( writeRd )
+ cat(sprintf(' witten to %s', filename))
+ else
+ cat(' omitted')
+ }
+
reset.Rd <- function()
- assign.parent('Rd', '', environment())
+ assign.parent('rd', Rd(), environment())
append.Rd <- function(x)
- assign.parent('Rd', append(append(Rd, x), nlTag.Rd()), environment())
+ assign.parent('rd', Rd_append_tag(rd, x), environment())
- merge2.Rd <- function(x)
- assign.parent('Rd', mergefn(x, Rd), environment())
+ merge.Rd <- function(x) {
+ assign.parent('rd', mergefn(x, rd), environment())
+
+ if ( verbose )
+ cat(sprintf(' merged,'))
+ }
existing.Rd <- function()
parse_Rd(filename)
@@ -201,8 +226,10 @@
# sprintf('{%s}', trim(expression)),
# c(...),
# ''))
- sapply(lapply(c(...), tag.Rd), tag.Rd, paste('\\', key, sep=''))
+ #lapply(lapply(c(...), textTag), Rd_tag, paste('\\', key, sep=''))
+ Rd_tag(textTag(trim(c(...))), paste('\\', key, sep=''))
+
#' Push the Rd-expression to standard out (or current
#' sink).
@@ -300,17 +327,20 @@
immediate.=TRUE)
} else if (!is.null(name)) {
name <- trim(name)
+ rdname <- trim(partitum$rdname)
+ basename <- if ( length(rdname) == 0 ) name else rdname
+
if (!is.null(subdir)) {
assign.parent('filename',
- file.path(subdir, sprintf('%s.Rd', name)),
+ file.path(subdir, sprintf('%s.Rd', basename)),
environment())
if (verbose)
- cat(sprintf('Writing %s to %s\n', name, filename))
+ cat(sprintf('Processing %s:', name))
#unlink(filename)
}
- parse.expression('name', name)
- if (is.null(partitum$aliases))
- parse.expression('alias', name)
+
+ parse.expression('name', basename)
+ parse.expression('alias', name)
}
if ((!is.null(name) || !is.null(partitum$title)) &&
!is.null(title <- parse.title(partitum, name)))
@@ -319,11 +349,13 @@
parse.function.name <- function(partitum) {
if (!is.null(partitum$method))
- Rd.expression('method',
- car(partitum$method),
- cadr(partitum$method))
+ #Rd.expression('method',
+ # car(partitum$method),
+ # cadr(partitum$method))
+ methodTag(trim(car(partitum$method)), trim(cadr(partitum$method)))
else
- partitum$assignee
+ #partitum$assignee
+ textTag(partitum$assignee)
}
#' Turn a list of formal arguments into a human-readable
@@ -345,14 +377,15 @@
},
name.defaults),
sep=', '))
- parse.expression('usage',
- do.call(paste,
- c(as.list(strwrap
- (sprintf('%s(%s)',
- parse.function.name(partitum),
- args),
- exdent=4)),
- sep='\n')))
+ #parse.expression('usage',
+ # do.call(paste,
+ # c(as.list(strwrap
+ # (sprintf('%s(%s)',
+ # parse.function.name(partitum),
+ # args),
+ # exdent=4)),
+ # sep='\n')))
+ append.Rd(usageTag(parse.function.name(partitum), args))
}
}
@@ -370,6 +403,11 @@
#' @param partitum the pre-parsed elements
#' @return \code{NULL}
pre.parse <- function(partitum) {
+ if ( !is.null(partitum$nord) )
+ unset.writeRd()
+ if ( exportonly && is.null(partitum$export) )
+ unset.writeRd()
+
assign.parent('params', NULL, environment())
assign.parent('examples', NULL, environment())
parse.name(partitum)
@@ -382,17 +420,21 @@
post.parse <- function(partitum) {
parse.arguments()
parse.examples(partitum)
-
+
if ( file.exists(filename) )
- merge2.Rd(existing.Rd())
+ merge.Rd(existing.Rd())
write.Rd()
reset.Rd()
+
+ if ( verbose )
+ cat('\n')
## Assuming the previous sink was successful;
## if not, it will destroy the sink stack.
## (Should fail if unwritable, anyway.)
reset.filename()
+ reset.writeRd()
}
roclet <- make.roclet(parse.expression,
@@ -410,6 +452,7 @@
function(key, expressions)
parse.expression('value', expressions))
+
#' Split a plural into its constituent singulars.
#' @param key the singular key
#' @param expressions the plurality of expressions
@@ -468,7 +511,7 @@
# cadr(name.param)),
# params,
# '')
- lapply(params, itemTag.Rd)
+ lapply(lapply(params, trim), itemTag)
@@ -478,7 +521,7 @@
parse.arguments <- function()
if (length(params) > 0)
#parse.expression('\\arguments', parse.params())
- append.Rd(tag.Rd(parse.params(), '\\arguments'))
+ append.Rd(argumentsTag(x=parse.params()))
roclet$register.parser('param', parse.param)
Added: branches/manuel/R/Rd_API.R
===================================================================
--- branches/manuel/R/Rd_API.R (rev 0)
+++ branches/manuel/R/Rd_API.R 2009-05-29 06:54:02 UTC (rev 220)
@@ -0,0 +1,116 @@
+
+
+### Rd tag elements:
+
+nameTag <- function(x) {
+ return(Rd_tag(verbTag(x), '\\name'))
+}
+
+aliasTag <- function(x) {
+ return(Rd_tag(verbTag(x), '\\alias'))
+}
+
+keywordTag <- function(x) {
+ return(Rd_tag(textTag(x), '\\keyword'))
+}
+
+detailsTag <- function(..., x=list(...)) {
+ .totext <- function(t) {
+ if ( is(t, 'Rd_tag') ) t else textTag(t)
+ }
+
+ return(Rd_tag(lapply(x, .totext), '\\details'))
+}
+
+itemTag <- function(x, y=NULL) {
+ if ( is.null(y) )
+ y <- x[[2]]; x <- x[[1]]
+
+ return(Rd_tag(list(list(textTag(x)),
+ list(textTag(y))), '\\item'))
+}
+
+argumentsTag <- function(..., x=list(...)) {
+ return(Rd_tag(x, '\\arguments'))
+}
+
+methodTag <- function(x, y) {
+ return(Rd_tag(list(list(textTag(x)),
+ list(textTag(y))), '\\method'))
+}
+
+usageTag <- function(x, y, newline=TRUE) {
+ return(Rd_tag(list(x, rcodeTag(sprintf('(%s)', y))), '\\usage'))
+}
+
+newlineTag <- function() {
+ return(textTag('\n'))
+}
+
+
+
+### Basic tag elements:
+
+Rd_tag <- function(x, tag) {
+ UseMethod('Rd_tag')
+}
+
+Rd_tag.default <- function(x, tag) {
+ return(structure(as.character(x), Rd_tag=tag, class='Rd_tag'))
+}
+
+Rd_tag.Rd_tag <- function(x, tag) {
+ return(structure(list(x), Rd_tag=tag, class='Rd_tag'))
+}
+
+Rd_tag.list <- function(x, tag) {
+ return(structure(x, Rd_tag=tag, class='Rd_tag'))
+}
+
+verbTag <- function(x) {
+ return(Rd_tag(x, 'VERB'))
+}
+
+textTag <- function(x) {
+ return(Rd_tag(x, 'TEXT'))
+}
+
+rcodeTag <- function(x) {
+ return(Rd_tag(x, 'RCODE'))
+}
+
+Rd_tag_append_tag <- function(tag1, tag2, newline=TRUE) {
+
+ attr <- attributes(tag1)
+ tag1 <- c(tag1, tag2)
+ attributes(tag1) <- attr
+
+ if ( newline )
+ tag1 <- Rd_tag_append_tag(tag1, newlineTag(), newline=FALSE)
+
+ return(tag1)
+}
+
+
+
+### Rd functions:
+
+Rd_append_tag <- function(rd, tag, at=NULL, newline=TRUE) {
+ if ( is.null(at) )
+ at <- length(rd) + 1
+
+ rd[[at]] <- tag
+
+ if ( newline )
+ rd[[at+1]] <- newlineTag()
+
+ return(rd)
+}
+
+
+
+### Rd element:
+
+Rd <- function() {
+ return(structure(list(), class='Rd'))
+}
Property changes on: branches/manuel/R/Rd_API.R
___________________________________________________________________
Name: svn:keywords
+ Date Revision Author URL Id
Name: svn:eol-style
+ native
Added: branches/manuel/R/Rd_merge.R
===================================================================
--- branches/manuel/R/Rd_merge.R (rev 0)
+++ branches/manuel/R/Rd_merge.R 2009-05-29 06:54:02 UTC (rev 220)
@@ -0,0 +1,98 @@
+
+Rd_merge <- function(x, y, appenders=simpleappenders(), mergers=simplemergers()) {
+ # x is the base Rd, all tags from y are merged into x.
+
+ getMerger <- function(name)
+ if ( !is.null(mergers[[name]]) ) mergers[[name]] else mergers$DEFAULT
+
+ getAppender <- function(name)
+ if ( !is.null(appenders[[name]]) ) appenders[[name]] else appenders$DEFAULT
+
+
+ yname <- unlist(y[[which(sapply(y, attr, 'Rd_tag') == '\\alias')[1]]])
+
+ MULTIPLE <- c('\\alias', '\\keyword')
+
+ xtagnames <- tools:::RdTags(x)
+ ytagnames <- tools:::RdTags(y)
+
+ for ( yat in which(ytagnames != 'TEXT') ) {
+ ytagname <- ytagnames[yat]
+ ytag <- y[[yat]]
+
+ xat <- NULL
+
+ if ( !(ytagname %in% MULTIPLE) ) {
+ if ( ytagname %in% xtagnames ) {
+ xat <- which(xtagnames == ytagname)
+ merger <- getMerger(substring(ytagname, 2))
+
+ ytag <- merger(x[[xat]], ytag, yname)
+ }
+ }
+
+ #x <- Rd_append_tag(x, ytag, xat)
+ appender <- getAppender(substring(ytagname, 2))
+ x <- appender(x, ytag, xat, yname)
+ }
+
+ return(x)
+}
+
+
+
+### Appender:
+
+simpleappenders <- function() {
+ return(list(DEFAULT=default.appender,
+ value=value.appender))
+}
+
+default.appender <- function(x, y, at, name) {
+ return(Rd_append_tag(x, y, at))
+}
+
+value.appender <- function(x, y, at, name) {
+ x <- Rd_tag_append_tag(x, textTag(sprintf('\\code{%s}:', name)))
+ return(Rd_append_tag(x, y))
+}
+
+
+
+### Merger:
+
+simplemergers <- function() {
+ return(list(DEFAULT=default.merger,
+ name=omity.merger,
+ description=omity.merger,
+ author=omity.merger,
+ title=omity.merger,
+ value=value.merger,
+ arguments=arguments.merger))
+}
+
+default.merger <- function(x, y, name) {
+ return(Rd_tag_append_tag(x, y))
+}
+
+omity.merger <- function(x, y, name) {
+ return(x)
+}
+
+arguments.merger <- function(x, y, name) {
+ attr <- attributes(x)
+
+ xitems <- unlist(sapply(x, '[[', 1))
+ yitems <- unlist(sapply(y, '[[', 1))
+
+ for ( i in setdiff(yitems, xitems) )
+ x <- Rd_tag_append_tag(x, y[which(i == yitems)])
+
+ attributes(x) <- attr
+
+ return(x)
+}
+
+value.merger <- function(x, y, name) {
+ return(Rd_tag_append_tag(x, y))
+}
Property changes on: branches/manuel/R/Rd_merge.R
___________________________________________________________________
Name: svn:keywords
+ Date Revision Author URL Id
Name: svn:eol-style
+ native
Deleted: branches/manuel/R/merge.Rd.R
===================================================================
--- branches/manuel/R/merge.Rd.R 2009-05-08 08:40:45 UTC (rev 219)
+++ branches/manuel/R/merge.Rd.R 2009-05-29 06:54:02 UTC (rev 220)
@@ -1,67 +0,0 @@
-
-merge.Rd <- function(x, y, ...) {
-
- nlTag.Rd <- function()
- return(list(structure('\n', Rd_tag='TEXT')))
-
- mymerge.default <- function(x, y) {
- attr <- attributes(x)
-
- x <- c(x, nlTag.Rd(), y)
- attributes(x) <- attr
-
- return(x)
- }
-
- mymerge.arguments <- function(x, y) {
- attr <- attributes(x)
-
- xitems <- unlist(sapply(x, '[[', 1))
- yitems <- unlist(sapply(y, '[[', 1))
-
- for ( i in setdiff(yitems, xitems) )
- x <- c(x, list(structure(y[[which(i == yitems)]], Rd_tag='\\item')))
-
- attributes(x) <- attr
-
- return(x)
- }
-
-
- MULTIPLE_TAGS <- c('\\keyword', '\\alias')
- IGNORE_IF_AVAILABLE_TAGS <- c('\\name', '\\description', '\\author',
- '\\title')
-
-
- ytags <- tools:::RdTags(y)
- iytags <- which(ytags != 'TEXT')
-
- x <- unclass(x)
- xtags <- tools:::RdTags(x)
-
- for ( i in iytags ) {
- tag <- ytags[i]
-
- if ( tag %in% xtags ) {
- if ( !(tag %in% IGNORE_IF_AVAILABLE_TAGS) ) {
- if ( tag %in% MULTIPLE_TAGS ) {
- x <- c(x, y[i])
- }
- else {
- j <- which(xtags == tag)
-
- if ( tag == '\\arguments' )
- x[[j]] <- mymerge.arguments(x[[j]], y[[i]])
- else
- x[[j]] <- mymerge.default(x[[j]], y[[i]])
- }
- }
- }
- else {
- x <- c(x, y[i])
- }
- }
-
- return(structure(x, class='Rd'))
-}
-
Modified: branches/manuel/sandbox/Rd2.R
===================================================================
--- branches/manuel/sandbox/Rd2.R 2009-05-08 08:40:45 UTC (rev 219)
+++ branches/manuel/sandbox/Rd2.R 2009-05-29 06:54:02 UTC (rev 220)
@@ -19,22 +19,62 @@
# Changes:
library(tools)
-source('../R/print.Rd.R')
-source('../R/merge.Rd.R')
+setwd('Z:\\Projects\\Roxygen\\r-forge\\branches\\manuel\\sandbox')
+
+source('../R/Rd_API.R')
source('../R/Rd.R')
+source('../R/Rd_merge.R')
-rd <- make.Rd.roclet(subdir='.')
-rd$parse('example-pseudoprime.R')
-p <- parse_Rd('is.pseudoprime.Rd')
-p
+roxygenize2 <- function(package.dir,
+ roxygen.dir=NULL,
+ copy.package=TRUE,
+ overwrite=TRUE,
+ unlink.target=FALSE) {
+ if (is.null(roxygen.dir)) roxygen.dir <-
+ sprintf(ROXYGEN.DIR, package.dir)
+ man.dir <- file.path(roxygen.dir, MAN.DIR)
+ inst.dir <- file.path(roxygen.dir, INST.DIR)
+ doc.dir <- file.path(inst.dir, DOC.DIR)
+ namespace.file <- file.path(roxygen.dir, NAMESPACE.FILE)
+ package.description <- file.path(package.dir, DESCRIPTION.FILE)
+ roxygen.description <- file.path(roxygen.dir, DESCRIPTION.FILE)
+ skeleton <- c(roxygen.dir,
+ man.dir,
+ doc.dir)
-parse_Rd('fermat.Rd')
+ if (copy.package)
+ copy.dir(package.dir,
+ roxygen.dir,
+ unlink.target=unlink.target,
+ overwrite=overwrite,
+ verbose=FALSE)
-p1 <- parse_Rd('fermat.test.Rd')
-p2 <- parse_Rd('is.pseudoprime.Rd')
+ for (dir in skeleton) dir.create(dir,
+ recursive=TRUE,
+ showWarnings=FALSE)
+ r.dir <- file.path(package.dir, R.DIR)
+ files <- as.list(list.files(r.dir,
+ pattern='\\.(R|r)$',
+ recursive=TRUE,
+ full.names=TRUE,
+ all.files=TRUE))
+ Rd <- make.Rd.roclet(man.dir)
+ do.call(Rd$parse, files)
+ namespace <- make.namespace.roclet(namespace.file)
+ do.call(namespace$parse, files)
+ collate <- make.collate.roclet(merge.file=package.description,
+ target.file=roxygen.description)
+ collate$parse.dir(r.dir)
+ #callgraph <-
+ # make.callgraph.roclet(description.dependencies(package.description),
+ # doc.dir)
+ #do.call(callgraph$parse, files)
+}
-merge.Rd(p1, p2)
+setwd('Z:/Research/Benchmarking')
+roxygenize2('pkg', roxygen.dir='builds/benchmark')
-merge.Rd(p2, p1)[[25]][[1]]
+r <- parse_Rd('builds/benchmark/man/basicplots.Rd')
+r <- parse_Rd('builds/benchmark/man/bench-class.Rd')
Modified: branches/manuel/sandbox/example-pseudoprime.R
===================================================================
--- branches/manuel/sandbox/example-pseudoprime.R 2009-05-08 08:40:45 UTC (rev 219)
+++ branches/manuel/sandbox/example-pseudoprime.R 2009-05-29 06:54:02 UTC (rev 220)
@@ -11,7 +11,7 @@
#' for a randomized \eqn{0 < a < n}
#' @note \code{fermat.test} doesn't work for integers above
#' approximately fifteen because modulus loses precision.
-#' @name fermat
+#' @rdname fermat
fermat.test <- function(n) {
a <- floor(runif(1, min=1, max=n))
a ^ n %% n == a
@@ -37,7 +37,6 @@
#' @keywords pseudoprime fermat
#' @examples
#' is.pseudoprime(13, 4) # TRUE most of the time
-#' @name fermat
is.pseudoprime <- function(n, times) {
if (times == 0) TRUE
else if (fermat.test(n)) is.pseudoprime(n, times - 1)
More information about the Roxygen-commits
mailing list