[Roxygen-commits] r234 - branches/manuel/R

[noreply at r-forge.r-project.org]

Author: manuel
Date: 2009-07-10 09:49:49 +0200 (Fri, 10 Jul 2009)
New Revision: 234

Modified:
   branches/manuel/R/Rd.R
   branches/manuel/R/parseS4.R
   branches/manuel/R/roclet.R
Log:


Modified: branches/manuel/R/Rd.R
===================================================================
--- branches/manuel/R/Rd.R	2009-07-09 06:44:08 UTC (rev 233)
+++ branches/manuel/R/Rd.R	2009-07-10 07:49:49 UTC (rev 234)
@@ -290,14 +290,27 @@
     else
       name
   }
- 
+
+  maybe.S4extend.name <- function(name, partitum) {
+    if ( !is.null(partitum$S4class) )
+      sprintf('%s-class', name)
+    else if ( !is.null(partitum$S4method) )
+      sprintf('%s,%s-method', name,
+              paste(partitum$S4formals$signature, collapse=','))
+    else if ( !is.null(partitum$S4generic) )
+      sprintf('%s-methods', name)
+    else
+      name
+  }
+  
   #' Reconstruct the \name directive from amongst
   #' \code{@@name}, \code{@@setMethod}, \code{@@setClass},
   #' \code{@@setGeneric}, \code{@@assignee}, etc.
   #' @param partitum the pre-parsed elements
   #' @return \code{NULL}
   parse.name <- function(partitum) {
-    name <- guess.name(partitum)
+    rawname <- guess.name(partitum)
+    name <- maybe.S4extend.name(rawname, partitum)
     if (is.null(name) && !is.null(subdir)) {
       filename <- partitum$srcref$filename
       first.line <- car(partitum$srcref$lloc)
@@ -325,7 +338,9 @@
       
       parse.expression('name', basename)
       parse.expression('alias', name)
-
+      if ( rawname != name )
+        parse.expression('alias', rawname)
+        
       assign.parent('name', name, environment())
     }
     if ((!is.null(name) || !is.null(partitum$title)) &&
@@ -425,7 +440,7 @@
                                partitum$S4formals$signature,
                                description)
     }
-    
+
     save.Rd()
     reset.Rd()
 

Modified: branches/manuel/R/parseS4.R
===================================================================
--- branches/manuel/R/parseS4.R	2009-07-09 06:44:08 UTC (rev 233)
+++ branches/manuel/R/parseS4.R	2009-07-10 07:49:49 UTC (rev 234)
@@ -1,20 +1,27 @@
 # NOTE: Most of the parsers require full specification, e.g.,
 # representation=representation(...) or signature=signature(object="numeric")
 
-cdr.expression <- function(expression)
+cdrpfe <- function(expression)
   cdr(preorder.flatten.expression(expression))
 
 parseS4.class <- function(expression) {
+  browser()
   formals <- list(representation=
-                  cdr.expression(expression$representation))
+                  cdrpfe(expression$representation))
+
+  if ( !is.na(i <- match('VIRTUAL', formals$representation)) ) {
+    formals$virtual <- TRUE
+    formals$representation[i] <- NULL
+  }
+  
   if ( !is.null(expression$contains) )
     formals <- append(formals,
                       list(contains=
-                           cdr.expression(expression$contains)))
+                           cdrpfe(expression$contains)))
   if ( !is.null(expression$prototype) )
     formals <- append(formals,
                       list(prototype=
-                           cdr.expression(expression$prototype)))
+                           cdrpfe(expression$prototype)))
   formals
 }
 
@@ -24,7 +31,7 @@
   def <- which(sapply(expression, is.call) & names(expression) == '')[1]
 
   formals <- list(signature=
-                  cdr.expression(expression$signature),
+                  cdrpfe(expression$signature),
                   definition=
                   parse.formals(expression[c(def, def+1)])[[1]])
   

Modified: branches/manuel/R/roclet.R
===================================================================
--- branches/manuel/R/roclet.R	2009-07-09 06:44:08 UTC (rev 233)
+++ branches/manuel/R/roclet.R	2009-07-10 07:49:49 UTC (rev 234)
@@ -110,31 +110,17 @@
 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) {
+guess.name <- function(partitum)
   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))
-}
+                 partitum$S4class,
+                 partitum$S4method,
+                 partitum$S4generic)
+
 #' Extract the source code from parsed elements
 #' @param partitum the parsed elements
 #' @return The lines of source code