[Roxygen-commits] r228 - branches/manuel/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Jun 22 16:37:57 CEST 2009
Author: manuel
Date: 2009-06-22 16:37:57 +0200 (Mon, 22 Jun 2009)
New Revision: 228
Added:
branches/manuel/R/parseS4.R
Modified:
branches/manuel/R/Rd.R
branches/manuel/R/Rd_API.R
branches/manuel/R/parse.R
branches/manuel/R/roclet.R
Log:
Basic S4class support (slots, prototype, superclasses).
Modified: branches/manuel/R/Rd.R
===================================================================
--- branches/manuel/R/Rd.R 2009-06-19 11:25:45 UTC (rev 227)
+++ branches/manuel/R/Rd.R 2009-06-22 14:37:57 UTC (rev 228)
@@ -29,23 +29,27 @@
register.preref.parsers(parse.name.description,
'param',
- 'method')
+ 'method',
+ 'slot')
register.preref.parsers(parse.name,
'docType')
register.srcref.parser('setClass',
function(pivot, expression)
- list(S4class=car(expression)))
+ list(S4class=car(expression),
+ S4formals=parseS4.class(cdr(expression))))
register.srcref.parser('setGeneric',
function(pivot, expression)
list(S4generic=car(expression)))
register.srcref.parser('setMethod',
- function(pivot, expression)
- list(S4method=car(expression),
- signature=cadr(expression)))
+ function(pivot, expression) {
+ browser()
+ list(S4method=car(expression),
+ signature=cadr(expression))
+ })
#' Make an Rd roclet which parses the given files and, if specified, populates
#' the given subdirectory with Rd files; or writes to standard out. See
@@ -282,7 +286,7 @@
else
name
}
-
+
#' Reconstruct the \name directive from amongst
#' \code{@@name}, \code{@@setMethod}, \code{@@setClass},
#' \code{@@setGeneric}, \code{@@assignee}, etc.
@@ -386,6 +390,7 @@
# TODO: interrupt process?
assign.parent('params', NULL, environment())
+ assign.parent('slots', NULL, environment())
assign.parent('examples', NULL, environment())
parse.name(partitum)
parse.usage(partitum)
@@ -397,6 +402,11 @@
post.parse <- function(partitum) {
parse.arguments()
parse.examples(partitum)
+
+ if ( !is.null(partitum$S4class) ) {
+ parse.slots(partitum$S4formals)
+ parse.contains(partitum$S4formals)
+ }
save.Rd()
reset.Rd()
@@ -419,7 +429,9 @@
final <- do.call('mergefn', list(final, base))
writeRd(final[[1]], filename)
- }
+ }
+
+ reset.rdtank()
}
roclet <- make.roclet(parse.expression,
@@ -491,17 +503,45 @@
#' @param name.param name-param pair
#' @return A list of Rd-readable expressions
parse.params <- function()
- lapply(lapply(params, trim), itemTag)
+ lapply(params, itemTag)
#' Paste and label the Rd-readable expressions
#' returned by \code{parse.params}.
#' @return \code{NULL}
- parse.arguments <- function()
+ parse.arguments <- function() {
if (length(params) > 0)
append.Rd(argumentsTag(x=parse.params(), newline=TRUE))
+ }
roclet$register.parser('param', parse.param)
+ slots <- NULL
+
+ parse.slot <- function(key, expression)
+ assign.parent('slots',
+ append(slots, list(expression)),
+ environment())
+
+ parse.slots <- function(partitum) {
+ names <- sapply(slots, '[[', 'name')
+ repr <- partitum$representation
+ proto <- partitum$prototype
+
+ for ( i in match(names(repr), names) )
+ slots[[i]]$type <- repr[[slots[[i]]$name]]
+ for ( i in match(names(proto), names) )
+ slots[[i]]$default <- proto[[slots[[i]]$name]]
+
+ append.Rd(slotsTag(x=lapply(slots,
+ function(x) do.call('slotTag', x))))
+ }
+
+ roclet$register.parser('slot', parse.slot)
+
+ parse.contains <- function(partitum)
+ if ( !is.null(partitum$contains) )
+ append.Rd(containsTag(x=partitum$contains))
+
examples <- NULL
#' Parse individual \code{@@example} clauses by adding the
@@ -557,6 +597,10 @@
rdtank.filenames <- function()
names(roclet$rdtank$mergelist)
+ reset.rdtank <- function() {
+ roclet$rdtank$documents <- list()
+ roclet$rdtank$mergelist <- list()
+ }
baseRd <- function(filename)
if ( file.exists(filename) ) parse_Rd(filename) else NULL
Modified: branches/manuel/R/Rd_API.R
===================================================================
--- branches/manuel/R/Rd_API.R 2009-06-19 11:25:45 UTC (rev 227)
+++ branches/manuel/R/Rd_API.R 2009-06-22 14:37:57 UTC (rev 228)
@@ -1,5 +1,28 @@
+### Composed Rd tag elements (mainly for S4 purpose):
+
+slotTag <- function(name, description=NULL, type=NULL, default=NULL) {
+ return(itemTag(sprintf('\\code{%s} [\\code{\\link{%s}}]:',
+ name, trim(type)),
+ sprintf('%s. %s',
+ trim(description),
+ ifelse(is.null(default), '',
+ sprintf('(Default: \\code{%s})', default)))))
+}
+
+slotsTag <- function(..., x=list(...)) {
+ return(sectionTag('Slots', list(describeTag(x))))
+}
+
+containsTag <- function(..., x=list(...)) {
+ return(sectionTag('Superclasses',
+ list(textTag(paste('\\code{\\linkS4class{', x, '}}',
+ collapse=', ', sep='')))))
+}
+
+
+
### Rd tag elements:
nameTag <- function(x) {
@@ -23,11 +46,11 @@
}
itemTag <- function(x, y=NULL) {
- if ( is.null(y) )
+ if ( is.list(x) )
y <- x[[2]]; x <- x[[1]]
- return(Rd_tag(list(list(textTag(x)),
- list(textTag(y))), '\\item'))
+ return(Rd_tag(list(list(textTag(trim(x))),
+ list(textTag(trim(y)))), '\\item'))
}
argumentsTag <- function(..., x=list(...), newline=TRUE) {
@@ -50,6 +73,14 @@
return(tag)
}
+sectionTag <- function(x, y) {
+ return(Rd_tag(list(list(textTag(x)), y), '\\section'))
+}
+
+describeTag <- function(x) {
+ return(Rd_tag(x, '\\describe'))
+}
+
newlineTag <- function() {
return(textTag('\n'))
}
Modified: branches/manuel/R/parse.R
===================================================================
--- branches/manuel/R/parse.R 2009-06-19 11:25:45 UTC (rev 227)
+++ branches/manuel/R/parse.R 2009-06-22 14:37:57 UTC (rev 228)
@@ -309,10 +309,11 @@
#' @return NULL
preorder.walk.expression <- function(proc, expression) {
if (length(expression) > 0)
+ names <- names(expression)
for (i in c(1:length(expression))) {
member <- tryCatch(expression[[i]], error=function(e) NULL)
if (!is.null(member) && !identical(member, expression)) {
- proc(member)
+ proc(structure(list(member), names=names[i]))
try(preorder.walk.expression(proc, member),
silent=TRUE)
}
Added: branches/manuel/R/parseS4.R
===================================================================
--- branches/manuel/R/parseS4.R (rev 0)
+++ branches/manuel/R/parseS4.R 2009-06-22 14:37:57 UTC (rev 228)
@@ -0,0 +1,12 @@
+
+parseS4.class <- function(expression) {
+ formals <- list(representation=
+ cdr(preorder.flatten.expression(expression$representation)))
+ if ( !is.null(expression$contains) )
+ formals <- append(formals, list(contains=expression$contains))
+ if ( !is.null(expression$prototype) )
+ formals <- append(formals,
+ list(prototype=
+ cdr(preorder.flatten.expression(expression$prototype))))
+ formals
+}
Modified: branches/manuel/R/roclet.R
===================================================================
--- branches/manuel/R/roclet.R 2009-06-19 11:25:45 UTC (rev 227)
+++ branches/manuel/R/roclet.R 2009-06-22 14:37:57 UTC (rev 228)
@@ -1,132 +1,137 @@
-#' @include roxygen.R
-#' @include list.R
-#' @include parse.R
-roxygen()
-
-#' Abstract roclet that serves as a rudimentary API.
-#'
-#' Contains the following member functions:
-#' \itemize{\item{register.parser}{takes \code{key} and \code{parser}}
-#' \item{register.parsers}{takes \code{parser} and \code{keys}}
-#' \item{register.default.parser}{takes a \code{key}}
-#' \item{register.default.parsers}{take \code{parsers}}
-#' \item{parse}{parses material contained in files}}
-#'
-#' @param parse.default the default parser taking \code{key}
-#' and \code{value}
-#' @param pre.parse a callback function taking a list of parsed
-#' elements; called before processing a file
-#' @param post.parse a callback function taking a list of parsed
-#' elements; called after processing a file
-#' @param pre.files a callback function with no arguments;
-#' called before any file has been parsed
-#' @param post.files a callback function with no arguments;
-#' called after every file has been parsed
-#' @export
-make.roclet <- function(parse.default=NULL,
- pre.parse=NULL,
- post.parse=NULL,
- pre.files=NULL,
- post.files=NULL) {
- roclet <- new.env(parent=emptyenv())
-
- roclet$parsers <- list()
-
- #' Register parser in the parser table.
- #' @param key key upon which to register
- #' @param parser the parser to register
- #' @return \code{NULL}
- roclet$register.parser <- function(key, parser)
- roclet$parsers[[key]] <- parser
-
- #' Register many parsers at once.
- #' @param parser the parser to register
- #' @param \dots the keys under which to register
- #' @return \code{NULL}
- roclet$register.parsers <- function(parser, ...)
- for (key in c(...))
- roclet$register.parser(key, parser)
-
- #' Register a default parser.
- #' @param key key upon which to register
- #' @return \code{NULL}
- roclet$register.default.parser <- function(key)
- roclet$parsers[[key]] <- parse.default
-
- #' Register many default parsers.
- #' @param \dots the keys under which to register
- #' @return \code{NULL}
- roclet$register.default.parsers <- function(...)
- for (parser in c(...))
- roclet$register.default.parser(parser)
-
- roclet$parse <- function(...)
- roclet$parse.parsed(parse.files(...))
-
- #' Parse material contained in files.
- #' @param partita the parsed elements
- #' (from e.g. \code{parse.files})
- #' @return \code{NULL}
- roclet$parse.parsed <- function(partita) {
- key.values <- function(partitum)
- zip.list(names(partitum), partitum)
-
- parse.noop <- function(key, value) NULL
-
- parser <- function(key)
- if (is.null(f <- roclet$parsers[[key]])) parse.noop else f
-
- maybe.call <- function(proc, ...)
- if (!is.null(proc))
- do.call(proc, list(...))
-
- maybe.call(pre.files)
- for (partitum in partita) {
- maybe.call(pre.parse, partitum)
- for (key.value in key.values(partitum)) {
- key <- car(key.value)
- do.call(parser(key), c(key, cdr(key.value)))
- }
- maybe.call(post.parse, partitum)
- }
- maybe.call(post.files)
- }
-
- structure(roclet, class='roclet')
-}
-
-#' Assign a variable in the parent environment when \code{<<-}
-#' doesn't seem to work.
-#' @param var string of the variable to assign
-#' @param value value to be assigned
-#' @param env environment of the assignment (\code{environment()})
-#' @return NULL
-assign.parent <- function(var, value, env)
- assign(var, value, envir=parent.env(env))
-
-#' Find the first non-null argument.
-#' @param \dots the arguments
-#' @return The first non-null argument
-first.non.null <- function(...)
- append(NULL, c(...))[[1]]
-
-#' Pluck name from a hierarchy of candidates; viz. name,
-#' assignee, S4class, S4method, S4generic.
-#' @param partitum the parsed elements
-#' @return The guessed name (possibly \code{NULL})
-guess.name <- function(partitum)
- first.non.null(partitum$name,
- partitum$assignee,
- partitum$S4class,
- partitum$S4method,
- partitum$S4generic)
-
-#' Extract the source code from parsed elements
-#' @param partitum the parsed elements
-#' @return The lines of source code
-src.lines <- function(partitum) {
- srcfile <- srcfile(partitum$srcref$filename)
- first.line <- car(partitum$srcref$lloc)
- last.line <- caddr(partitum$srcref$lloc)
- getSrcLines(srcfile, first.line, last.line)
-}
+#' @include roxygen.R
+#' @include list.R
+#' @include parse.R
+roxygen()
+
+#' Abstract roclet that serves as a rudimentary API.
+#'
+#' Contains the following member functions:
+#' \itemize{\item{register.parser}{takes \code{key} and \code{parser}}
+#' \item{register.parsers}{takes \code{parser} and \code{keys}}
+#' \item{register.default.parser}{takes a \code{key}}
+#' \item{register.default.parsers}{take \code{parsers}}
+#' \item{parse}{parses material contained in files}}
+#'
+#' @param parse.default the default parser taking \code{key}
+#' and \code{value}
+#' @param pre.parse a callback function taking a list of parsed
+#' elements; called before processing a file
+#' @param post.parse a callback function taking a list of parsed
+#' elements; called after processing a file
+#' @param pre.files a callback function with no arguments;
+#' called before any file has been parsed
+#' @param post.files a callback function with no arguments;
+#' called after every file has been parsed
+#' @export
+make.roclet <- function(parse.default=NULL,
+ pre.parse=NULL,
+ post.parse=NULL,
+ pre.files=NULL,
+ post.files=NULL) {
+ roclet <- new.env(parent=emptyenv())
+
+ roclet$parsers <- list()
+
+ #' Register parser in the parser table.
+ #' @param key key upon which to register
+ #' @param parser the parser to register
+ #' @return \code{NULL}
+ roclet$register.parser <- function(key, parser)
+ roclet$parsers[[key]] <- parser
+
+ #' Register many parsers at once.
+ #' @param parser the parser to register
+ #' @param \dots the keys under which to register
+ #' @return \code{NULL}
+ roclet$register.parsers <- function(parser, ...)
+ for (key in c(...))
+ roclet$register.parser(key, parser)
+
+ #' Register a default parser.
+ #' @param key key upon which to register
+ #' @return \code{NULL}
+ roclet$register.default.parser <- function(key)
+ roclet$parsers[[key]] <- parse.default
+
+ #' Register many default parsers.
+ #' @param \dots the keys under which to register
+ #' @return \code{NULL}
+ roclet$register.default.parsers <- function(...)
+ for (parser in c(...))
+ roclet$register.default.parser(parser)
+
+ roclet$parse <- function(...)
+ roclet$parse.parsed(parse.files(...))
+
+ #' Parse material contained in files.
+ #' @param partita the parsed elements
+ #' (from e.g. \code{parse.files})
+ #' @return \code{NULL}
+ roclet$parse.parsed <- function(partita) {
+ key.values <- function(partitum)
+ zip.list(names(partitum), partitum)
+
+ parse.noop <- function(key, value) NULL
+
+ parser <- function(key)
+ if (is.null(f <- roclet$parsers[[key]])) parse.noop else f
+
+ maybe.call <- function(proc, ...)
+ if (!is.null(proc))
+ do.call(proc, list(...))
+
+ maybe.call(pre.files)
+ for (partitum in partita) {
+ maybe.call(pre.parse, partitum)
+ for (key.value in key.values(partitum)) {
+ key <- car(key.value)
+ do.call(parser(key), c(key, cdr(key.value)))
+ }
+ maybe.call(post.parse, partitum)
+ }
+ maybe.call(post.files)
+ }
+
+ structure(roclet, class='roclet')
+}
+
+#' Assign a variable in the parent environment when \code{<<-}
+#' doesn't seem to work.
+#' @param var string of the variable to assign
+#' @param value value to be assigned
+#' @param env environment of the assignment (\code{environment()})
+#' @return NULL
+assign.parent <- function(var, value, env)
+ assign(var, value, envir=parent.env(env))
+
+#' Find the first non-null argument.
+#' @param \dots the arguments
+#' @return The first non-null argument
+first.non.null <- function(...)
+ append(NULL, c(...))[[1]]
+
+#' Pluck name from a hierarchy of candidates; viz. name,
+#' assignee, S4class, S4method, S4generic.
+#' @param partitum the parsed elements
+#' @return The guessed name (possibly \code{NULL})
+guess.name <- function(partitum) {
+ name <- first.non.null(partitum$name,
+ partitum$assignee,
+ partitum$S4class,
+ partitum$S4method,
+ partitum$S4generic)
+ if ( !is.null(partitum$S4class) )
+ name <- sprintf('%s-class', name)
+
+ name
+}
+
+#' Extract the source code from parsed elements
+#' @param partitum the parsed elements
+#' @return The lines of source code
+src.lines <- function(partitum) {
+ srcfile <- srcfile(partitum$srcref$filename)
+ first.line <- car(partitum$srcref$lloc)
+ last.line <- caddr(partitum$srcref$lloc)
+ getSrcLines(srcfile, first.line, last.line)
+}
More information about the Roxygen-commits
mailing list