[Roxygen-commits] r230 - in branches/manuel: R sandbox
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Jul 3 19:25:38 CEST 2009
Author: manuel
Date: 2009-07-03 19:25:36 +0200 (Fri, 03 Jul 2009)
New Revision: 230
Modified:
branches/manuel/R/Rd.R
branches/manuel/R/Rd_API.R
branches/manuel/R/Rdtank.R
branches/manuel/R/parseS4.R
branches/manuel/R/roclet.R
branches/manuel/sandbox/Rd2.R
branches/manuel/sandbox/example-S4-person.R
Log:
Modified: branches/manuel/R/Rd.R
===================================================================
--- branches/manuel/R/Rd.R 2009-06-23 15:56:40 UTC (rev 229)
+++ branches/manuel/R/Rd.R 2009-07-03 17:25:36 UTC (rev 230)
@@ -45,9 +45,12 @@
list(S4generic=car(expression)))
register.srcref.parser('setMethod',
- function(pivot, expression)
- list(S4method=car(expression),
- S4formals=parseS4.method(cdr(expression))))
+ function(pivot, expression) {
+ S4formals <- parseS4.method(cdr(expression))
+ list(S4method=car(expression),
+ S4formals=S4formals,
+ formals=S4formals$definition)
+ })
#' 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
@@ -411,8 +414,10 @@
}
if ( !is.null(partitum$S4method) ) {
- rdtank$register.S4method(name, partitum$S4formals$signature,
- partitum$description)
+ rdtank$register.S4method(partitum$S4method,
+ name,
+ partitum$S4formals$signature,
+ partitum$description)
}
save.Rd()
@@ -450,9 +455,20 @@
}
}
}
+
+ post.files.methods <- function() {
+ for ( generic in rdtank$generics() ) {
+ rd <- rdtank$get.Rd.by(name=generic)
+ tag <- do.call('genericmethodsTag',
+ lapply(rdtank$get.methods(generic),
+ function(x) do.call('genericmethodTag', x)))
+ rdtank$update.Rd(Rd_append_tag(rd, tag), name=generic)
+ }
+ }
post.files <- function() {
post.files.classmethods()
+ post.files.methods()
post.files.write()
rdtank$reset()
}
Modified: branches/manuel/R/Rd_API.R
===================================================================
--- branches/manuel/R/Rd_API.R 2009-06-23 15:56:40 UTC (rev 229)
+++ branches/manuel/R/Rd_API.R 2009-07-03 17:25:36 UTC (rev 230)
@@ -4,11 +4,13 @@
slotTag <- function(name, description=NULL, type=NULL, default=NULL) {
return(itemTag(sprintf('\\code{%s} [\\code{\\link{%s}}]:',
- name, trim(type)),
+ name,
+ trim(type)),
sprintf('%s. %s',
trim(description),
ifelse(is.null(default), '',
- sprintf('(Default: \\code{%s})', default)))))
+ sprintf('(Default: \\code{%s})',
+ default)))))
}
slotsTag <- function(..., x=list(...)) {
@@ -21,10 +23,17 @@
collapse=', ', sep='')))))
}
-classmethodTag <- function(name, signature, description) {
- return(itemTag(name,
- sprintf('\\code{signature(%s)}: %s',
- paste(names(signature), dQuote(signature), sep=' = ', collapse=', '),
+classmethodSignature <- function(signature)
+ sprintf('signature(%s)',
+ paste(names(signature), dQuote(signature),
+ sep=' = ', collapse=', '))
+
+classmethodTag <- function(generic, name, signature, description) {
+ return(itemTag(sprintf('\\code{\\link[=%s]{%s}}',
+ name,
+ generic),
+ sprintf('\\code{%s}: %s',
+ classmethodSignature(signature),
trim(description))))
}
@@ -32,7 +41,23 @@
return(sectionTag('Methods', list(describeTag(x))))
}
+genericmethodSignature <- function(signature)
+ sprintf('signature(%s)',
+ paste(names(signature), dQuote(sprintf('\\link{%s}', signature)),
+ sep=' = ', collapse=', '))
+genericmethodTag <- function(name, signature, description) {
+ return(itemTag(sprintf('\\code{%s}',
+ genericmethodSignature(signature)),
+ sprintf('\\link[=%s]{Details}',
+ name)))
+}
+
+genericmethodsTag <- function(..., x=list(...)) {
+ return(sectionTag('Methods', list(describeTag(x))))
+}
+
+
### Rd tag elements:
nameTag <- function(x) {
Modified: branches/manuel/R/Rdtank.R
===================================================================
--- branches/manuel/R/Rdtank.R 2009-06-23 15:56:40 UTC (rev 229)
+++ branches/manuel/R/Rdtank.R 2009-07-03 17:25:36 UTC (rev 230)
@@ -7,6 +7,7 @@
tank$mergelist <- list()
tank$classmethods <- list()
tank$classlist <- list()
+ tank$methods <- list()
tank$add.Rd <- function(rd, name, filename=NULL) {
tank$documents[[name]] <- rd
@@ -36,13 +37,17 @@
tank$register.S4class <- function(classname, name)
tank$classlist[[classname]] <- name
- tank$register.S4method <- function(name, signature, description) {
+ tank$register.S4method <- function(generic, name, signature, description) {
for ( class in signature )
tank$classmethods[[class]] <-
c(tank$classmethods[[class]],
- list(list(name=name, signature=signature, description=description)))
+ list(list(generic=generic, name=name,
+ signature=signature, description=description)))
- invisible(NULL)
+ tank$methods[[generic]] <-
+ c(tank$methods[[generic]], list(list(name=name,
+ signature=signature,
+ description=description)))
}
tank$filenames <- function()
@@ -51,12 +56,17 @@
tank$classnames <- function()
names(tank$classmethods)
+ tank$generics <- function()
+ names(tank$methods)
+
tank$class.exists <- function(class)
!is.null(tank$documents[[class]])
tank$get.class.methods <- function(class)
tank$classmethods[[class]]
+ tank$get.methods <- function(generic)
+ tank$methods[[generic]]
tank$reset <- function() {
tank$documents <- list()
Modified: branches/manuel/R/parseS4.R
===================================================================
--- branches/manuel/R/parseS4.R 2009-06-23 15:56:40 UTC (rev 229)
+++ branches/manuel/R/parseS4.R 2009-07-03 17:25:36 UTC (rev 230)
@@ -16,8 +16,14 @@
}
parseS4.method <- function(expression) {
+ # Heuristic that the first unnamed language
+ # object is the definition:
+ def <- which(sapply(expression, is.call) & names(expression) == '')[1]
+
formals <- list(signature=
- cdr(preorder.flatten.expression(expression$signature)))
+ cdr(preorder.flatten.expression(expression$signature)),
+ definition=
+ parse.formals(expression[c(def, def+1)])[[1]])
formals
}
Modified: branches/manuel/R/roclet.R
===================================================================
--- branches/manuel/R/roclet.R 2009-06-23 15:56:40 UTC (rev 229)
+++ branches/manuel/R/roclet.R 2009-07-03 17:25:36 UTC (rev 230)
@@ -122,7 +122,9 @@
partitum$S4generic)
if ( !is.null(partitum$S4class) )
name <- sprintf('%s-class', name)
-
+ if ( !is.null(partitum$S4method) )
+ name <- sprintf('%s,%s-method', name,
+ paste(partitum$S4formals$signature, collapse=','))
name
}
Modified: branches/manuel/sandbox/Rd2.R
===================================================================
--- branches/manuel/sandbox/Rd2.R 2009-06-23 15:56:40 UTC (rev 229)
+++ branches/manuel/sandbox/Rd2.R 2009-07-03 17:25:36 UTC (rev 230)
@@ -21,10 +21,13 @@
# Changes:
library(tools)
+source('../R/roclet.R')
+
source('../R/Rd_merge.R')
source('../R/Rd_API.R')
source('../R/parseS4.R')
source('../R/Rd.R')
+source('../R/Rdtank.R')
roc <- make.Rd.roclet(subdir='.')
Modified: branches/manuel/sandbox/example-S4-person.R
===================================================================
--- branches/manuel/sandbox/example-S4-person.R 2009-06-23 15:56:40 UTC (rev 229)
+++ branches/manuel/sandbox/example-S4-person.R 2009-07-03 17:25:36 UTC (rev 230)
@@ -26,7 +26,10 @@
#' The naming of an object.
#'
+#' Details about the generic naming of an object.
+#'
#' @param object A object which gets a name
+#' @param y Another argument
setGeneric('name', function(object, y, ...) standardGeneric('name'), valueClass='character')
#' Name a person, the baptism.
@@ -38,6 +41,15 @@
return(object at fullname)
})
+#' Name a person, the baptism.
+#'
+#' @param object A Person's name
+#' @export
+setMethod('name', signature=signature(object='character', y='numeric'),
+function(object, y, ...) {
+ return(object)
+})
+
#' Blub a person.
#'
#' @param object A Person object
More information about the Roxygen-commits
mailing list