[Roxygen-commits] r218 - in branches: . manuel manuel/R manuel/sandbox

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Fri May 8 10:37:44 CEST 2009


Author: manuel
Date: 2009-05-08 10:37:43 +0200 (Fri, 08 May 2009)
New Revision: 218

Added:
   branches/manuel/
   branches/manuel/R/merge.Rd.R
   branches/manuel/sandbox/Rd2.R
Modified:
   branches/manuel/DESCRIPTION
   branches/manuel/R/Rd.R
   branches/manuel/sandbox/example-pseudoprime.R
Log:
New manuel-branch: use parse_Rd() in Rd-Roclet to allow things like merging of Rd files, etc.

Copied: branches/manuel (from rev 217, pkg)

Modified: branches/manuel/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2009-01-29 18:43:27 UTC (rev 217)
+++ branches/manuel/DESCRIPTION	2009-05-08 08:37:43 UTC (rev 218)
@@ -9,6 +9,7 @@
 Maintainer: Peter Danenberg <pcd at roxygen.org>
 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'
     'roclet.R' 'callgraph.R' 'description.R' 'collate.R' 'namespace.R'
     'Rd.R' 'roxygenize.R'

Modified: branches/manuel/R/Rd.R
===================================================================
--- pkg/R/Rd.R	2009-01-29 18:43:27 UTC (rev 217)
+++ branches/manuel/R/Rd.R	2009-05-08 08:37:43 UTC (rev 218)
@@ -157,7 +157,37 @@
 #' @TODO param method setClass setGeneric setMethod
 #' make.Rd.roclet
 make.Rd.roclet <- function(subdir=NULL,
-                           verbose=TRUE) {
+                           verbose=TRUE,
+                           mergefn=merge.Rd) {
+
+  Rd <- list()
+
+  nlTag.Rd <- function()
+    return(list(structure('\n', Rd_tag='TEXT')))
+    
+  tag.Rd <- function(x, tag='TEXT')
+    return(list(structure(x, Rd_tag=tag)))
+
+  itemTag.Rd <- function(x)
+    return(structure(list(tag.Rd(x[[1]]), tag.Rd(x[[2]])), Rd_tag='\\item'))
+
+  write.Rd <- function(plain=TRUE)
+    cat(tools:::as.character.Rd(structure(Rd, class='Rd')),
+        sep='', collapse='\n', file=filename)
+
+  reset.Rd <- function()
+    assign.parent('Rd', '', environment())
+
+  append.Rd <- function(x)
+    assign.parent('Rd', append(append(Rd, x), nlTag.Rd()), environment())
+
+  merge2.Rd <- function(x)
+    assign.parent('Rd', mergefn(x, Rd), environment())
+
+  existing.Rd <- function()
+    parse_Rd(filename)
+
+  
   #' Translate a key and expressions into an Rd expression;
   #' multiple expressions take their own braces.
   #' @param key the expression's key
@@ -165,12 +195,14 @@
   #' @return A string containing the key and arguments
   #' in LaTeX-like gestalt.
   Rd.expression <- function(key, ...)
-    sprintf('\\%s%s\n',
-            key,
-            Reduce.paste(function(expression)
-                         sprintf('{%s}', trim(expression)),
-                         c(...),
-                         ''))
+    #sprintf('\\%s%s\n',
+    #        key,
+    #        Reduce.paste(function(expression)
+    #                     sprintf('{%s}', trim(expression)),
+    #                     c(...),
+    #                     ''))
+    sapply(lapply(c(...), tag.Rd), tag.Rd, paste('\\', key, sep=''))
+    
 
   #' Push the Rd-expression to standard out (or current
   #' sink).
@@ -178,10 +210,12 @@
   #' @param \dots the arguments
   #' @return \code{NULL}
   parse.expression <- function(key, ...)
-    cat(Rd.expression(key, c(...)), file=filename, append=TRUE)
+    #cat(Rd.expression(key, c(...)), file=filename, append=TRUE)
+    append.Rd(Rd.expression(key, c(...)))
+    
 
   filename <- ''
-
+  
   reset.filename <- function()
     assign.parent('filename', '', environment())
 
@@ -272,7 +306,7 @@
                       environment())
         if (verbose)
           cat(sprintf('Writing %s to %s\n', name, filename))
-        unlink(filename)
+        #unlink(filename)
       }
       parse.expression('name', name)
       if (is.null(partitum$aliases))
@@ -348,6 +382,13 @@
   post.parse <- function(partitum) {
     parse.arguments()
     parse.examples(partitum)
+   
+    if ( file.exists(filename) )
+      merge2.Rd(existing.Rd())
+    
+    write.Rd()
+    reset.Rd()
+    
     ## Assuming the previous sink was successful;
     ## if not, it will destroy the sink stack.
     ## (Should fail if unwritable, anyway.)
@@ -421,19 +462,23 @@
   #' @param name.param name-param pair
   #' @return A list of Rd-readable expressions
   parse.params <- function()
-    Reduce.paste(function(name.param)
-                 Rd.expression('item',
-                     car(name.param),
-                     cadr(name.param)),
-                 params,
-                 '')
+    #Reduce.paste(function(name.param)
+    #             Rd.expression('item',
+    #                 car(name.param),
+    #                 cadr(name.param)),
+    #             params,
+    #             '')
+    lapply(params, itemTag.Rd)
+    
+    
 
   #' Paste and label the Rd-readable expressions
   #' returned by \code{parse.params}.
   #' @return \code{NULL}
   parse.arguments <- function()
     if (length(params) > 0)
-      parse.expression('arguments', parse.params())
+      #parse.expression('\\arguments', parse.params())
+      append.Rd(tag.Rd(parse.params(), '\\arguments'))
 
   roclet$register.parser('param', parse.param)
 

Added: branches/manuel/R/merge.Rd.R
===================================================================
--- branches/manuel/R/merge.Rd.R	                        (rev 0)
+++ branches/manuel/R/merge.Rd.R	2009-05-08 08:37:43 UTC (rev 218)
@@ -0,0 +1,67 @@
+
+merge.Rd <- function(x, y, ...) {
+  
+  nlTag.Rd <- function()
+    return(list(structure('\n', Rd_tag='TEXT')))
+
+  mymerge.default <- function(x, y) {
+    attr <- attributes(x)
+    
+    x <- c(x, nlTag.Rd(), y)
+    attributes(x) <- attr
+    
+    return(x)
+  }
+
+  mymerge.arguments <- function(x, y) {
+    attr <- attributes(x)
+    
+    xitems <- unlist(sapply(x, '[[', 1))
+    yitems <- unlist(sapply(y, '[[', 1))
+
+    for ( i in setdiff(yitems, xitems) )
+      x <- c(x, list(structure(y[[which(i == yitems)]], Rd_tag='\\item')))
+
+    attributes(x) <- attr
+    
+    return(x)
+  }
+    
+  
+  MULTIPLE_TAGS <- c('\\keyword', '\\alias')
+  IGNORE_IF_AVAILABLE_TAGS <- c('\\name', '\\description', '\\author',
+                                '\\title')
+  
+  
+  ytags <- tools:::RdTags(y)
+  iytags <- which(ytags != 'TEXT')
+
+  x <- unclass(x)
+  xtags <- tools:::RdTags(x)
+  
+  for ( i in iytags ) {
+    tag <- ytags[i]
+
+    if ( tag %in% xtags ) {
+      if ( !(tag %in% IGNORE_IF_AVAILABLE_TAGS) ) {
+        if ( tag %in% MULTIPLE_TAGS ) {
+          x <- c(x, y[i])
+        }
+        else {
+          j <- which(xtags == tag)
+
+          if ( tag == '\\arguments' )
+            x[[j]] <- mymerge.arguments(x[[j]], y[[i]])
+          else
+            x[[j]] <- mymerge.default(x[[j]], y[[i]])
+        }
+      }
+    }
+    else {
+      x <- c(x, y[i])
+    }
+  }
+  
+  return(structure(x, class='Rd'))
+}
+

Added: branches/manuel/sandbox/Rd2.R
===================================================================
--- branches/manuel/sandbox/Rd2.R	                        (rev 0)
+++ branches/manuel/sandbox/Rd2.R	2009-05-08 08:37:43 UTC (rev 218)
@@ -0,0 +1,40 @@
+
+# Roxygen base:
+sources <- c('%s/R/roxygen.R',
+             '%s/R/functional.R',
+             '%s/R/list.R',
+             '%s/R/parse.R',
+             '%s/R/string.R',
+             '%s/R/roclet.R',
+             '%s/R/Rd.R',
+             '%s/R/namespace.R',
+             '%s/R/collate.R',
+             '%s/R/roxygenize.R',
+             '%s/R/description.R',
+             '%s/R/callgraph.R')
+
+for (source in sources)
+  source(sprintf(source, '..'))
+
+# Changes:
+library(tools)
+
+source('../R/print.Rd.R')
+source('../R/merge.Rd.R')
+source('../R/Rd.R')
+
+rd <- make.Rd.roclet(subdir='.')
+rd$parse('example-pseudoprime.R')
+
+p <- parse_Rd('is.pseudoprime.Rd')
+p
+
+parse_Rd('fermat.Rd')
+
+p1 <- parse_Rd('fermat.test.Rd')
+p2 <- parse_Rd('is.pseudoprime.Rd')
+
+merge.Rd(p1, p2)
+
+
+merge.Rd(p2, p1)[[25]][[1]]

Modified: branches/manuel/sandbox/example-pseudoprime.R
===================================================================
--- pkg/sandbox/example-pseudoprime.R	2009-01-29 18:43:27 UTC (rev 217)
+++ branches/manuel/sandbox/example-pseudoprime.R	2009-05-08 08:37:43 UTC (rev 218)
@@ -11,6 +11,7 @@
 #'   for a randomized \eqn{0 < a < n}
 #' @note \code{fermat.test} doesn't work for integers above
 #'   approximately fifteen because modulus loses precision.
+#' @name fermat
 fermat.test <- function(n) {
   a <- floor(runif(1, min=1, max=n))
   a ^ n %% n == a
@@ -36,6 +37,7 @@
 #' @keywords pseudoprime fermat
 #' @examples
 #' is.pseudoprime(13, 4)  # TRUE most of the time
+#' @name fermat
 is.pseudoprime <- function(n, times) {
   if (times == 0) TRUE
   else if (fermat.test(n)) is.pseudoprime(n, times - 1)



More information about the Roxygen-commits mailing list