[Roxygen-commits] r102 - in pkg: R sandbox tests/runit
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Jul 27 06:29:08 CEST 2008
Author: pcd
Date: 2008-07-27 06:29:08 +0200 (Sun, 27 Jul 2008)
New Revision: 102
Modified:
pkg/R/Rd.R
pkg/R/collate.R
pkg/R/namespace.R
pkg/R/parse.R
pkg/R/roxygenize.R
pkg/sandbox/collate.R
pkg/sandbox/roxygenize.R
pkg/tests/runit/runit.collate.R
Log:
fixed grave collate error: use member instead of %in%; merge for collate; outfile for namespace; optional verbosity; setwd() hack for roxygenizing collate; msg on test.collate
Modified: pkg/R/Rd.R
===================================================================
--- pkg/R/Rd.R 2008-07-27 02:28:14 UTC (rev 101)
+++ pkg/R/Rd.R 2008-07-27 04:29:08 UTC (rev 102)
@@ -81,6 +81,8 @@
#'
#' @param subdir directory into which to place the Rd files; if
#' \code{NULL}, standard out.
+#' @param verbose whether to declare what we're doing in the
+#' \var{subdir}
#' @return Rd roclet
#' @examples
#' #' This sentence describes the function.
@@ -106,7 +108,8 @@
#' roclet <- make.Rd.roclet('man')
#' \dontrun{roclet$parse('example.R')}
#' @export
-make.Rd.roclet <- function(subdir=NULL) {
+make.Rd.roclet <- function(subdir=NULL,
+ verbose=TRUE) {
#' Translate a key and expressions into an Rd expression;
#' multiple expressions take their own braces.
#' @param key the expression's key
@@ -224,7 +227,8 @@
assign.parent('filename',
file.path(subdir, sprintf('%s.Rd', name)),
environment())
- cat(sprintf('Writing %s to %s\n', name, filename))
+ if (verbose)
+ cat(sprintf('Writing %s to %s\n', name, filename))
unlink(filename)
}
parse.expression('name', name)
Modified: pkg/R/collate.R
===================================================================
--- pkg/R/collate.R 2008-07-27 02:28:14 UTC (rev 101)
+++ pkg/R/collate.R 2008-07-27 04:29:08 UTC (rev 102)
@@ -1,7 +1,6 @@
#' @include roxygen.R
-#' @include parse.R
+#' @include string.R
#' @include roclet.R
-#' @include string.R
roxygen()
#' Make collate roclet which parses the given files; topologically
@@ -14,8 +13,14 @@
#' Contains the member function \code{parse} which parses an arbitrary number
#' of files.
#'
+#' @param merge.file \file{DESCRIPTION} file with which to merge directive;
+#' or \code{NULL} for none
+#' @param target.file whither to \code{cat} directive (whether merged or
+#' not); blank line is standard out
+#' @param verbose whether to describe what we're doing with the
+#' target.file
+#' @return Rd roclet
#' @seealso \code{\link{make.roclet}}
-#' @return Rd roclet
#' @examples
#' #' An example source file, example.R
#' #' @@include roxygen.R
@@ -25,7 +30,9 @@
#' roclet <- make.collate.roclet()
#' \dontrun{roclet$parse('example.R')}
#' @export
-make.collate.roclet <- function() {
+make.collate.roclet <- function(merge.file=NULL,
+ target.file='',
+ verbose=TRUE) {
vertices <- NULL
make.vertex <- function(file) {
@@ -44,8 +51,15 @@
names=file))),
environment())
+ member <- function(ancestor, ancestors) {
+ for (vertex in ancestors)
+ if (identical(ancestor, vertex))
+ TRUE
+ FALSE
+ }
+
maybe.append.ancestor <- function(predecessor, ancestor)
- if (!c(ancestor) %in% predecessor$ancestors)
+ if (!member(ancestor, predecessor$ancestors))
predecessor$ancestors <-
append(ancestor, predecessor$ancestors)
@@ -84,15 +98,34 @@
visit(vertex)
}
- post.files <-
- function() cat('Collate:',
- Reduce.paste(function(vertex)
- sprintf("'%s'", vertex$file),
- topological.sort(vertices),
- ' '),
- '\n',
- sep='')
+ COLLATE.FIELD <- 'Collate:'
+ merge <- function(directive) {
+ lines <- readLines(merge.file)
+ filtered.lines <- Filter(function(line)
+ length(grep(sprintf('^%s', COLLATE.FIELD),
+ trim(line))) == 0,
+ lines)
+ if (verbose && !is.null.string(target.file))
+ cat(sprintf('Merging `Collate:\' from %s to %s',
+ merge.file,
+ target.file), '\n')
+ cat(filtered.lines, directive, file=target.file, sep='\n')
+ }
+
+ post.files <- function() {
+ directive <-
+ sprintf('Collate:%s',
+ Reduce.paste(function(vertex)
+ sprintf("'%s'", vertex$file),
+ topological.sort(vertices),
+ ' '))
+ if (!is.null(merge.file))
+ merge(directive)
+ else
+ cat(directive, '\n', file=target.file, sep='')
+ }
+
roclet <- make.roclet(parse.include,
pre.parse=pre.parse,
post.files=post.files)
Modified: pkg/R/namespace.R
===================================================================
--- pkg/R/namespace.R 2008-07-27 02:28:14 UTC (rev 101)
+++ pkg/R/namespace.R 2008-07-27 04:29:08 UTC (rev 102)
@@ -49,6 +49,8 @@
#' }
#'
#' @param outfile whither to send output; '' == standard out
+#' @param verbose whether to anounce what we're doing with
+#' the \var{outfile}
#' @return Namespace roclet
#' @examples
#' #' An example file, example.R, which imports
@@ -63,7 +65,8 @@
#' roclet <- make.namespace.roclet()
#' \dontrun{roclet$parse('example.R')}
#' @export
-make.namespace.roclet <- function(outfile='') {
+make.namespace.roclet <- function(outfile='',
+ verbose=TRUE) {
parse.directive <- function(proc, parms)
cat(sprintf('%s(%s)\n', proc, strmap(Identity, ', ', parms)),
file=outfile,
@@ -78,8 +81,11 @@
S4generic=partitum$S4method,
S4class=partitum$S4class)
- pre.files <- function()
+ pre.files <- function() {
+ if (verbose && !is.null.string(outfile))
+ cat(sprintf('Writing namespace directives to %s', outfile), '\n')
unlink(outfile)
+ }
roclet <- make.roclet(parse.directive,
pre.parse=pre.parse,
Modified: pkg/R/parse.R
===================================================================
--- pkg/R/parse.R 2008-07-27 02:28:14 UTC (rev 101)
+++ pkg/R/parse.R 2008-07-27 04:29:08 UTC (rev 102)
@@ -1,7 +1,7 @@
#' @include roxygen.R
+#' @include functional.R
#' @include string.R
#' @include list.R
-#' @include functional.R
roxygen()
#' Sequence that distinguishes roxygen comment from normal comment.
Modified: pkg/R/roxygenize.R
===================================================================
--- pkg/R/roxygenize.R 2008-07-27 02:28:14 UTC (rev 101)
+++ pkg/R/roxygenize.R 2008-07-27 04:29:08 UTC (rev 102)
@@ -55,12 +55,14 @@
#' @param copy.package if R.utils is present, copies the package
#' over before adding/manipulating files.
#' @return \code{NULL}
+#' @importFrom tools file_path_as_absolute
roxygenize <- function(package.dir,
copy.package=TRUE) {
roxygen.dir <- sprintf(ROXYGEN.DIR, package.dir)
man.dir <- file.path(roxygen.dir, MAN.DIR)
namespace.file <- file.path(roxygen.dir, NAMESPACE.FILE)
- description.file <- file.path(roxygen.dir, DESCRIPTION.FILE)
+ package.description <- file_path_as_absolute(file.path(package.dir, DESCRIPTION.FILE))
+ roxygen.description <- file_path_as_absolute(file.path(roxygen.dir, DESCRIPTION.FILE))
skeleton <- c(roxygen.dir, man.dir)
if (copy.package)
@@ -72,9 +74,14 @@
for (dir in skeleton) dir.create(dir, showWarnings=FALSE)
r.dir <- file.path(package.dir, R.DIR)
- source.files <- as.list(list.files(r.dir, recursive=TRUE, full.names=TRUE))
+ files <- as.list(list.files(r.dir, recursive=TRUE, full.names=TRUE))
Rd <- make.Rd.roclet(man.dir)
- do.call(Rd$parse, source.files)
+ do.call(Rd$parse, files)
namespace <- make.namespace.roclet(namespace.file)
- do.call(namespace$parse, source.files)
+ do.call(namespace$parse, files)
+ setwd(r.dir)
+ files <- as.list(list.files('.', recursive=TRUE))
+ collate <- make.collate.roclet(merge.file=package.description,
+ target.file=roxygen.description)
+ do.call(collate$parse, files)
}
Modified: pkg/sandbox/collate.R
===================================================================
--- pkg/sandbox/collate.R 2008-07-27 02:28:14 UTC (rev 101)
+++ pkg/sandbox/collate.R 2008-07-27 04:29:08 UTC (rev 102)
@@ -1,3 +1,4 @@
+source('../R/roxygen.R')
source('../R/functional.R')
source('../R/list.R')
source('../R/parse.R')
Modified: pkg/sandbox/roxygenize.R
===================================================================
--- pkg/sandbox/roxygenize.R 2008-07-27 02:28:14 UTC (rev 101)
+++ pkg/sandbox/roxygenize.R 2008-07-27 04:29:08 UTC (rev 102)
@@ -1,3 +1,5 @@
+library(tools)
+
if (!file.exists('pkg/R/parse.R'))
stop('Run one directory above `pkg\'.')
Modified: pkg/tests/runit/runit.collate.R
===================================================================
--- pkg/tests/runit/runit.collate.R 2008-07-27 02:28:14 UTC (rev 101)
+++ pkg/tests/runit/runit.collate.R 2008-07-27 04:29:08 UTC (rev 102)
@@ -1,17 +1,20 @@
+## TODO: merge test
test.collate <- function() {
roclet <- make.collate.roclet()
- checkEquals(capture.output(roclet$parse('runit/collate/belt.R',
- 'runit/collate/jacket.R',
- 'runit/collate/pants.R',
- 'runit/collate/shirt.R',
- 'runit/collate/shoes.R',
- 'runit/collate/socks.R',
- 'runit/collate/tie.R',
- 'runit/collate/undershorts.R',
- 'runit/collate/watch.R')),
- paste("Collate: 'runit/collate/undershorts.R'",
- "'runit/collate/pants.R' 'runit/collate/belt.R'",
- "'runit/collate/shirt.R' 'runit/collate/tie.R'",
+ collation <- capture.output(roclet$parse('runit/collate/belt.R',
+ 'runit/collate/jacket.R',
+ 'runit/collate/pants.R',
+ 'runit/collate/shirt.R',
+ 'runit/collate/shoes.R',
+ 'runit/collate/socks.R',
+ 'runit/collate/tie.R',
+ 'runit/collate/undershorts.R',
+ 'runit/collate/watch.R'))
+ checkEquals(collation,
+ paste("Collate: 'runit/collate/shirt.R'",
+ "'runit/collate/undershorts.R' 'runit/collate/pants.R'",
+ "'runit/collate/belt.R' 'runit/collate/tie.R'",
"'runit/collate/jacket.R' 'runit/collate/socks.R'",
- "'runit/collate/shoes.R' 'runit/collate/watch.R'"))
+ "'runit/collate/shoes.R' 'runit/collate/watch.R'"),
+ msg=collation)
}
More information about the Roxygen-commits
mailing list