[Roxygen-commits] r73 - in pkg: . R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Jul 22 20:28:19 CEST 2008
Author: pcd
Date: 2008-07-22 20:28:19 +0200 (Tue, 22 Jul 2008)
New Revision: 73
Modified:
pkg/DESCRIPTION
pkg/R/Rd.R
pkg/R/collate.R
pkg/R/parse.R
pkg/R/roclet.R
Log:
correct roxygen and R CMD check infelicities
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2008-07-21 12:58:13 UTC (rev 72)
+++ pkg/DESCRIPTION 2008-07-22 18:28:19 UTC (rev 73)
@@ -7,3 +7,4 @@
Manuel Eugster <Manuel.Eugster at stat.uni-muenchen.de>
Maintainer: Peter Danenberg <r-forge at wikitex.org>
URL: http://roxygen.org
+Collate: list.R string.R functional.R parse.R roclet.R collate.R namespace.R Rd.R
Modified: pkg/R/Rd.R
===================================================================
--- pkg/R/Rd.R 2008-07-21 12:58:13 UTC (rev 72)
+++ pkg/R/Rd.R 2008-07-22 18:28:19 UTC (rev 73)
@@ -1,10 +1,11 @@
#' @include list.R
#' @include string.R
+#' @include roclet.R
roxygen()
#' Make an Rd roclet which parses the result of \code{parse.files}
#' and writes the Rd format to standard out (TODO: write
-#' to the file designated by \code{@name}). Requires the \code{@name}
+#' to the file designated by \code{@@name}). Requires the \code{@@name}
#' parameter.
#'
#' Contains the member function \code{parse} which parses the result
@@ -64,7 +65,7 @@
parse.split('keyword', expressions))
parse.description <- function(key, expressions) {
- paragraphs <- car(strsplit(car(expressions), '\n\n', fixed=T))
+ paragraphs <- car(strsplit(car(expressions), '\n\n', fixed=TRUE))
description <- car(paragraphs)
details <- do.call(paste, append(cdr(paragraphs), list(sep='\n\n')))
parse.expression('description', description)
Modified: pkg/R/collate.R
===================================================================
--- pkg/R/collate.R 2008-07-21 12:58:13 UTC (rev 72)
+++ pkg/R/collate.R 2008-07-22 18:28:19 UTC (rev 73)
@@ -3,7 +3,7 @@
roxygen()
#' Make collate roclet which parses the result of \code{parse.files},
-#' topologically sorting \code{@include}s and writing a \code{collate} directive
+#' topologically sorting \code{@@include}s and writing a \code{collate} directive
#' to standard out.
#'
#' Contains the member function \code{parse} which parses the result
@@ -16,7 +16,7 @@
make.vertex <- function(file) {
vertex <- new.env(parent=emptyenv())
vertex$file <- trim(file)
- vertex$discovered <- F
+ vertex$discovered <- FALSE
vertex$ancestors <- NULL
vertex
}
@@ -56,7 +56,7 @@
topological.sort <- function(vertices) {
sorted <- NULL
visit <- function(predecessor) {
- predecessor$discovered <- T
+ predecessor$discovered <- TRUE
for (ancestor in predecessor$ancestors)
if (!ancestor$discovered)
visit(ancestor)
Modified: pkg/R/parse.R
===================================================================
--- pkg/R/parse.R 2008-07-21 12:58:13 UTC (rev 72)
+++ pkg/R/parse.R 2008-07-22 18:28:19 UTC (rev 73)
@@ -1,5 +1,6 @@
#' @include string.R
#' @include list.R
+#' @include functional.R
LINE.DELIMITER <- '#\''
TAG.DELIMITER <- '@'
@@ -188,7 +189,7 @@
'include')
#' Parse an element containing a mandatory name
-#' and description (such as @param).
+#' and description (such as @@param).
#' @param key the parsing key
#' @param rest the expression to be parsed
#' @return A list containing the key, name and
@@ -230,7 +231,7 @@
#' @param rest the expression to be parsed
#' @return A list with the key and \code{TRUE}
parse.toggle <- function(key, rest)
- as.list(structure(T, names=key))
+ as.list(structure(TRUE, names=key))
register.preref.parsers(parse.toggle,
'listObject',
@@ -293,25 +294,26 @@
default=parse.srcref)
#' Parse either srcrefs, prerefs or pairs of the same.
-#' @param x the srcref, preref or pair of the same
+#' @param ref the srcref, preref or pair of the same
#' @return List containing the parsed srcref/preref
-parse.ref <- function(x, ...)
+parse.ref <- function(ref, ...)
UseMethod('parse.ref')
#' Parse a preref/srcrefs pair
-#' @param preref.srcref the preref/srcref pair
+#' @param ref the preref/srcref pair
#' @return List combining the parsed preref/srcref
-parse.ref.list <- function(preref.srcref)
- append(parse.ref(car(preref.srcref)),
- parse.ref(cadr(preref.srcref)))
+parse.ref.list <- function(ref, ...)
+ append(parse.ref(car(ref)),
+ parse.ref(cadr(ref)))
+
#' Parse a preref
-#' @param preref the preref to be parsed
+#' @param ref the preref to be parsed
#' @return List containing the parsed preref
-parse.ref.preref <- function(preref) {
- lines <- getSrcLines(attributes(preref)$srcfile,
- car(preref),
- caddr(preref))
+parse.ref.preref <- function(ref, ...) {
+ lines <- getSrcLines(attributes(ref)$srcfile,
+ car(ref),
+ caddr(ref))
delimited.lines <-
Filter(function(line) grep(LINE.DELIMITER, line), lines)
## Trim LINE.DELIMITER + one space (benign for spaceless delimeters).
@@ -330,7 +332,7 @@
TAG.DELIMITER,
TAG.DELIMITER,
TAG.DELIMITER),
- perl=T))
+ perl=TRUE))
## Compress the escaped delimeters.
elements <- Map(function(element)
gsub(sprintf('%s{2}', TAG.DELIMITER),
@@ -347,15 +349,15 @@
}
#' Parse a srcref
-#' @param srcref the srcref to be parsed
+#' @param ref the srcref to be parsed
#' @return List containing the parsed srcref
-parse.ref.srcref <- function(srcref) {
- srcfile <- attributes(srcref)$srcfile
- lines <- getSrcLines(srcfile, car(srcref), caddr(srcref))
+parse.ref.srcref <- function(ref, ...) {
+ srcfile <- attributes(ref)$srcfile
+ lines <- getSrcLines(srcfile, car(ref), caddr(ref))
expression <- parse(text=lines)
pivot <- tryCatch(caar(expression), error=function(e) NULL)
parsed <- list(srcref=list(filename=srcfile$filename,
- lloc=as.vector(srcref)))
+ lloc=as.vector(ref)))
if (!is.null(pivot)) {
parser <- parser.srcref(as.character(pivot))
parsed <- append(do.call(parser, list(pivot, expression)),
@@ -386,6 +388,6 @@
#' Parse many files at one.
#' @param \dots files to be parsed
#' @return List containing parsed directives
-#' @seealsa \code{\link{parse.file}}
+#' @seealso \code{\link{parse.file}}
parse.files <- function(...)
Reduce(append, Map(parse.file, list(...)), NULL)
Modified: pkg/R/roclet.R
===================================================================
--- pkg/R/roclet.R 2008-07-21 12:58:13 UTC (rev 72)
+++ pkg/R/roclet.R 2008-07-22 18:28:19 UTC (rev 73)
@@ -1,4 +1,5 @@
#' @include list.R
+#' @include parse.R
roxygen()
#' Abstract roclet that serves as a rudimentary API.
More information about the Roxygen-commits
mailing list