[Roxygen-commits] r233 - in branches/manuel: . R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Jul 9 08:44:11 CEST 2009
Author: manuel
Date: 2009-07-09 08:44:08 +0200 (Thu, 09 Jul 2009)
New Revision: 233
Modified:
branches/manuel/DESCRIPTION
branches/manuel/R/Rd.R
branches/manuel/R/Rd_API.R
branches/manuel/R/Rdtank.R
branches/manuel/R/namespace.R
branches/manuel/R/parseS4.R
branches/manuel/R/roclet.R
branches/manuel/R/roxygenize.R
Log:
Modified: branches/manuel/DESCRIPTION
===================================================================
--- branches/manuel/DESCRIPTION 2009-07-04 06:06:12 UTC (rev 232)
+++ branches/manuel/DESCRIPTION 2009-07-09 06:44:08 UTC (rev 233)
@@ -10,6 +10,7 @@
URL: http://roxygen.org
Suggests: Rgraphviz (>= 1.19.2)
Depends: R (>= 2.9.0)
-Collate: 'functional.R' 'list.R' 'roxygen.R' 'string.R' 'parse.R'
+Collate: 'Rd_API.R' 'Rd_merge.R' 'Rdtank.R' 'parseS4.R'
+ 'functional.R' 'list.R' 'roxygen.R' 'string.R' 'parse.R'
'roclet.R' 'callgraph.R' 'description.R' 'collate.R' 'namespace.R'
'Rd.R' 'roxygenize.R'
Modified: branches/manuel/R/Rd.R
===================================================================
--- branches/manuel/R/Rd.R 2009-07-04 06:06:12 UTC (rev 232)
+++ branches/manuel/R/Rd.R 2009-07-09 06:44:08 UTC (rev 233)
@@ -335,7 +335,11 @@
parse.function.name <- function(partitum) {
if (!is.null(partitum$method))
- methodTag(trim(car(partitum$method)), trim(cadr(partitum$method)))
+ methodTag(trim(car(partitum$method)),
+ trim(cadr(partitum$method)))
+ else if (!is.null(partitum$S4method))
+ S4methodTag(partitum$S4method,
+ paste(partitum$S4formals$signature, collapse=','))
else
textTag(partitum$assignee)
}
@@ -345,7 +349,7 @@
#' @param partitum the pre-parsed elements
#' @return \code{NULL}
parse.formals <- function(partitum) {
- formals <- partitum$formals
+ formals <- partitum$formals
if (!is.null(formals)) {
formals <- lapply(formals, trim)
formals <- lapply(formals, paste, collapse=" ")
@@ -395,6 +399,7 @@
assign.parent('params', NULL, environment())
assign.parent('slots', NULL, environment())
assign.parent('examples', NULL, environment())
+ assign.parent('description', NULL, environment())
parse.name(partitum)
parse.usage(partitum)
}
@@ -411,13 +416,14 @@
parse.slots(partitum$S4formals)
parse.contains(partitum$S4formals)
+ parse.prototypes(partitum$S4formals)
}
if ( !is.null(partitum$S4method) ) {
rdtank$register.S4method(partitum$S4method,
name,
partitum$S4formals$signature,
- partitum$description)
+ description)
}
save.Rd()
@@ -456,19 +462,19 @@
}
}
- 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.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.methods()
post.files.write()
rdtank$reset()
}
@@ -510,6 +516,8 @@
function(key, expressions)
parse.split('keyword', expressions))
+ description <- NULL
+
#' Split the introductory matter into its description followed
#' by details (separated by a blank line).
#' @param key ignored
@@ -520,6 +528,7 @@
description <- car(paragraphs)
details <- do.call(paste, append(cdr(paragraphs), list(sep='\n\n')))
parse.expression('description', description)
+ assign.parent('description', description, environment())
if (length(details) > 0 && !is.null.string(details))
parse.expression('details', details)
}
@@ -563,20 +572,35 @@
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]]
+ if ( !is.nil(names) ) {
+ repr <- partitum$representation
+
+ for ( i in match(names(repr), names) )
+ slots[[i]]$type <- repr[[slots[[i]]$name]]
- append.Rd(slotsTag(x=lapply(slots,
- function(x) do.call('slotTag', x))))
+ append.Rd(slotsTag(x=lapply(slots,
+ function(x) do.call('slotTag', x))))
+ }
}
+ parse.prototypes <- function(partitum) {
+ if ( !is.null(partitum$prototype) ) {
+ slotnames <- sapply(slots, '[[', 'name')
+
+ proto <- lapply(names(partitum$prototype),
+ function(x)
+ list(name=x,
+ value=maybe.quote(partitum$prototype[[x]]),
+ inherit=!(x %in% slotnames)))
+
+ append.Rd(prototypesTag(x=lapply(proto,
+ function(x) do.call('prototypeTag', x))))
+ }
+ }
+
roclet$register.parser('slot', parse.slot)
-
+
parse.contains <- function(partitum)
if ( !is.null(partitum$contains) )
append.Rd(containsTag(x=partitum$contains))
Modified: branches/manuel/R/Rd_API.R
===================================================================
--- branches/manuel/R/Rd_API.R 2009-07-04 06:06:12 UTC (rev 232)
+++ branches/manuel/R/Rd_API.R 2009-07-09 06:44:08 UTC (rev 233)
@@ -1,22 +1,34 @@
### Composed Rd tag elements (mainly for S4 purpose):
+### TODO: rewrite using code, emph, etc. tags and overload +
+### to compose tags.
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)))))
+ return(itemTag(sprintf('\\code{%s}:',
+ name),
+ sprintf('(\\code{\\link{%s}}) %s',
+ trim(type),
+ trim(description))))
}
slotsTag <- function(..., x=list(...)) {
return(sectionTag('Slots', list(describeTag(x))))
}
+prototypeTag <- function(name, value, inherit) {
+ return(itemTag(sprintf(ifelse(inherit,
+ '\\emph{\\code{%s}} =',
+ '\\code{%s} ='),
+ name),
+ sprintf('%s',
+ trim(value))))
+}
+
+prototypesTag <- function(..., x=list(...)) {
+ return(sectionTag('Prototype', list(describeTag(x))))
+}
+
containsTag <- function(..., x=list(...)) {
return(sectionTag('Extends',
list(textTag(paste('\\code{\\linkS4class{', x, '}}',
@@ -41,23 +53,7 @@
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) {
@@ -100,6 +96,11 @@
list(textTag(y))), '\\method'))
}
+S4methodTag <- function(x, y) {
+ return(Rd_tag(list(list(textTag(x)),
+ list(textTag(y))), '\\S4method'))
+}
+
usageTag <- function(x, y) {
y <- sprintf('(%s)', paste(strwrap(y, exdent=4), collapse="\n"))
tag <- Rd_tag(list(x, rcodeTag(y)), '\\usage')
@@ -177,7 +178,7 @@
### Rd functions:
-Rd_append_tag <- function(rd, tag, at=NULL, newline=FALSE) {
+Rd_append_tag <- function(rd, tag, at=NULL, newline=TRUE) {
if ( is.null(at) )
at <- length(rd) + 1
Modified: branches/manuel/R/Rdtank.R
===================================================================
--- branches/manuel/R/Rdtank.R 2009-07-04 06:06:12 UTC (rev 232)
+++ branches/manuel/R/Rdtank.R 2009-07-09 06:44:08 UTC (rev 233)
@@ -8,6 +8,7 @@
tank$classmethods <- list()
tank$classlist <- list()
tank$methods <- list()
+ tank$generics <- list()
tank$add.Rd <- function(rd, name, filename=NULL) {
tank$documents[[name]] <- rd
@@ -25,7 +26,8 @@
tank$documents[[tank$classlist[[classname]]]] <- rd
}
- tank$get.Rd.by <- function(name=NULL, filename=NULL, classname=NULL) {
+ tank$get.Rd.by <- function(name=NULL, filename=NULL, classname=NULL,
+ generic=NULL) {
if ( !is.null(name) )
return(tank$documents[name])
if ( !is.null(filename) )
@@ -59,8 +61,8 @@
tank$generics <- function()
names(tank$methods)
- tank$class.exists <- function(class)
- !is.null(tank$documents[[class]])
+ tank$class.exists <- function(classname)
+ !is.null(tank$classlist[[classname]])
tank$get.class.methods <- function(class)
tank$classmethods[[class]]
Modified: branches/manuel/R/namespace.R
===================================================================
--- branches/manuel/R/namespace.R 2009-07-04 06:06:12 UTC (rev 232)
+++ branches/manuel/R/namespace.R 2009-07-09 06:44:08 UTC (rev 233)
@@ -16,7 +16,7 @@
'importFrom',
'importClassesFrom',
'importMethodsFrom',
- 'useDynLib')
+ 'useDynLib')
#' Make a namespace roclet which parses the given files and writes a list of
#' namespace directives to a given file or standard out; see
Modified: branches/manuel/R/parseS4.R
===================================================================
--- branches/manuel/R/parseS4.R 2009-07-04 06:06:12 UTC (rev 232)
+++ branches/manuel/R/parseS4.R 2009-07-09 06:44:08 UTC (rev 233)
@@ -1,17 +1,20 @@
# NOTE: Most of the parsers require full specification, e.g.,
# representation=representation(...) or signature=signature(object="numeric")
+cdr.expression <- function(expression)
+ cdr(preorder.flatten.expression(expression))
parseS4.class <- function(expression) {
formals <- list(representation=
- cdr(preorder.flatten.expression(expression$representation)))
+ cdr.expression(expression$representation))
if ( !is.null(expression$contains) )
formals <- append(formals,
- list(contains=expression$contains))
+ list(contains=
+ cdr.expression(expression$contains)))
if ( !is.null(expression$prototype) )
formals <- append(formals,
list(prototype=
- cdr(preorder.flatten.expression(expression$prototype))))
+ cdr.expression(expression$prototype)))
formals
}
@@ -21,7 +24,7 @@
def <- which(sapply(expression, is.call) & names(expression) == '')[1]
formals <- list(signature=
- cdr(preorder.flatten.expression(expression$signature)),
+ cdr.expression(expression$signature),
definition=
parse.formals(expression[c(def, def+1)])[[1]])
Modified: branches/manuel/R/roclet.R
===================================================================
--- branches/manuel/R/roclet.R 2009-07-04 06:06:12 UTC (rev 232)
+++ branches/manuel/R/roclet.R 2009-07-09 06:44:08 UTC (rev 233)
@@ -110,24 +110,31 @@
first.non.null <- function(...)
append(NULL, c(...))[[1]]
+#' Similar to sprintf, but returns NULL instead of
+#' character(0) if value is NULL.
+#' @param fmt the format string
+#' @param \dots the values
+#' @return The \code{sprintf} return value or \code{NULL}
+sprintf.null <- function(fmt, ...) {
+ if ( length(s <- sprintf(fmt, ...)) == 0 )
+ NULL
+ else
+ s
+}
+
#' 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)
- if ( !is.null(partitum$S4method) )
- name <- sprintf('%s,%s-method', name,
- paste(partitum$S4formals$signature, collapse=','))
- name
+ first.non.null(partitum$name,
+ partitum$assignee,
+ sprintf.null('%s-class', partitum$S4class),
+ sprintf.null('%s,%s-method', partitum$S4method,
+ paste(partitum$S4formals$signature,
+ collapse=',')),
+ sprintf.null('%s-methods', partitum$S4generic))
}
-
#' Extract the source code from parsed elements
#' @param partitum the parsed elements
#' @return The lines of source code
Modified: branches/manuel/R/roxygenize.R
===================================================================
--- branches/manuel/R/roxygenize.R 2009-07-04 06:06:12 UTC (rev 232)
+++ branches/manuel/R/roxygenize.R 2009-07-09 06:44:08 UTC (rev 233)
@@ -109,15 +109,14 @@
all.files=TRUE))
Rd <- make.Rd.roclet(man.dir)
do.call(Rd$parse, files)
- Rd$write()
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)
+ #callgraph <-
+ # make.callgraph.roclet(description.dependencies(package.description),
+ # doc.dir)
+ #do.call(callgraph$parse, files)
}
More information about the Roxygen-commits
mailing list