[Roxygen-commits] r133 - in pkg: R sandbox tests/runit

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Wed Jul 30 06:49:29 CEST 2008


Author: pcd
Date: 2008-07-30 06:49:28 +0200 (Wed, 30 Jul 2008)
New Revision: 133

Added:
   pkg/R/description.R
   pkg/sandbox/description.R
Modified:
   pkg/R/callgraph.R
   pkg/R/collate.R
   pkg/R/roclet.R
   pkg/sandbox/roxygenize.R
   pkg/tests/runit/runit.collate.R
Log:
DESCRIPTION parser; collate to use DESCRIPTION parser; explain the callgraph roclet


Modified: pkg/R/callgraph.R
===================================================================
--- pkg/R/callgraph.R	2008-07-30 04:49:02 UTC (rev 132)
+++ pkg/R/callgraph.R	2008-07-30 04:49:28 UTC (rev 133)
@@ -3,6 +3,21 @@
 #' @include functional.R
 roxygen()
 
+#' Make a callgraph roclet.
+#'
+#' The callgraph roclet is awkward in the sense that
+#' it requires a function's package to be loadable;
+#' which means, like calling LaTeX multiple times,
+#' one has to run roxygen on a package, install it,
+#' run roxygen again to get the callgraphs, and possibly
+#' install the package again.
+#'
+#' Messy. Aweful.
+#'
+#' @param dependencies packages required to evaluate
+#' interesting functions
+#' @param dir the directory to place the callgraphs in
+#' @param verbose anounce what we're doing
 #' @importFrom Rgraphviz toFile
 make.callgraph.roclet <- function(dependencies=NULL,
                                   dir='.',

Modified: pkg/R/collate.R
===================================================================
--- pkg/R/collate.R	2008-07-30 04:49:02 UTC (rev 132)
+++ pkg/R/collate.R	2008-07-30 04:49:28 UTC (rev 133)
@@ -1,5 +1,6 @@
 #' @include roxygen.R
 #' @include string.R
+#' @include functional.R
 #' @include roclet.R
 roxygen()
 
@@ -103,33 +104,32 @@
 
   COLLATE.FIELD <- 'Collate:'
 
-  merge <- function(directive) {
-    lines <- readLines(merge.file)
-    filtered.lines <- Filter(function(line)
-                             length(grep(sprintf('^%s', COLLATE.FIELD),
-                                         trim(line))) == 0,
-                             lines)
+  merge <- function(files) {
+    unlink(target.file)
     if (verbose && !is.null.string(target.file))
       cat(sprintf('Merging collate directive with %s to %s',
                   merge.file,
                   target.file), '\n')
-    cat(filtered.lines, directive, file=target.file, sep='\n')
+    post.parse <- function(parsed.fields)
+      cat.description('Collate', files, file=target.file)
+    parse.default <- Curry(cat.description, file=target.file)
+    parser <- make.description.parser(parse.default,
+                                      post.parse=post.parse)
+    parser$register.parser('Collate', noop.description)
+    parser$parse(parse.description.file(merge.file))
   }
 
   post.files <- function() {
-    directive <-
-      sprintf('Collate:%s',
-              Reduce.paste(function(vertex)
-                           sprintf("'%s'", vertex$file),
-                           topological.sort(vertices),
-                           ' '))
+    files <- do.call(paste, Map(function(vertex)
+                                sprintf("'%s'", vertex$file),
+                                topological.sort(vertices)))
     if (!is.null(cwd))
       setwd(cwd)
     assign.parent('cwd', NULL, environment())
     if (!is.null(merge.file))
-      merge(directive)
+      merge(files)
     else
-      cat(directive, '\n', file=target.file, sep='')
+      cat.description('Collate', files, file=target.file)
   }
 
   roclet <- make.roclet(parse.include,

Added: pkg/R/description.R
===================================================================
--- pkg/R/description.R	                        (rev 0)
+++ pkg/R/description.R	2008-07-30 04:49:28 UTC (rev 133)
@@ -0,0 +1,119 @@
+#' @include roxygen.R
+#' @include list.R
+roxygen()
+
+#' Parse lines of text corresponding to a package DESCRIPTION file.
+#' @param description the lines of tex
+#' @return A list of values indexed by field
+parse.description.text <- function(description) {
+  fields <- new.env(parent=emptyenv())
+  current.field <- NULL
+  FIELD <- '^[^:[:space:]]*'
+  SEPARATOR <- ':'
+
+  contains.field <- function(line)
+    length(grep(paste(FIELD, SEPARATOR, sep=''), line)) > 0
+
+  substr.regexp <- function(pattern, text) {
+    matches <- regexpr(pattern, text, perl=TRUE)
+    if (length(match) < 1)
+      NULL
+    else {
+      start <- car(matches)
+      end <- car(attr(matches, 'match.length'))
+      substr(text, start, end)
+    }
+  }
+
+  field <- function(line)
+    substr.regexp(FIELD, line)
+  
+  rest <- function(line)
+    substr(line, nchar(field(line)) + 2, nchar(line))
+
+  continue <- function(description) {
+    if (!is.nil(description)) {
+      line <- car(description)
+      if (contains.field(line)) {
+        field <- field(line)
+        rest <- rest(line)
+        fields[[field]] <- trim(rest)
+        current.field <<- field
+      } else {
+        fields[[current.field]] <-
+          paste(fields[[current.field]],
+                trim(line))
+      }
+      continue(cdr(description))
+    }
+  }
+  continue(description)
+  as.list(fields)
+}
+
+#' Convenience function to call
+#' \code{\link{parse.description.text}}
+#' with the given \file{DESCRIPTION} file.
+#' @param description.file the \file{DESCRIPTION} file to be parsed
+#' @return \code{NULL}
+parse.description.file <- function(description.file)
+  parse.description.text(readLines(description.file))
+
+#' Print the field-value pair to a given file or standard out.
+#' @param field the field to be printed
+#' @param value the value to be printed
+#' @param file the file whither to print (a blank string being
+#' standard out)
+#' @return \code{NULL}
+cat.description <- function(field, value, file='')
+  cat(strwrap(sprintf('%s: %s', field, value),
+              exdent=2),
+      sep='\n',
+      file=file,
+      append=TRUE)
+
+#' Description parser that does nothing
+#' @param field the field to be parsed
+#' @param value the value to be parsed
+#' @return \code{NULL}
+noop.description <- function(field, value) NULL
+
+#' Make a parser to parse \file{DESCRIPTION} files.
+#'
+#' Contains the member functions \code{register.parser},
+#' taking a field and parser; and \code{parse}, taking the
+#' parsed fields from \code{\link{parse.description.file}}
+#' or similar.
+#'
+#' @param parse.default the default parser receiving
+#' a field and value
+#' @param pre.parse a function receiving the parsed fields
+#' before individual parsing
+#' @param post.parse a function receiving the parsed fields
+#' after individual parsing
+#' @return \code{NULL}
+make.description.parser <- function(parse.default=cat.description,
+                                    pre.parse=noop.description,
+                                    post.parse=noop.description) {
+  parser <- new.env(parent=emptyenv())
+  parsers <- new.env(parent=emptyenv())
+  parser$register.parser <- function(field, parser)
+    parsers[[field]] <- parser
+  parser$parse <- function(parsed.fields) {
+    field.values <- function(parsed.fields)
+      zip.list(names(parsed.fields),
+               parsed.fields)
+    if (!is.null(pre.parse)) pre.parse(parsed.fields)
+    for (field.value in field.values(parsed.fields)) {
+      field <- car(field.value)
+      value <- cadr(field.value)
+      parser <- parsers[[field]]
+      if (is.null(parser))
+        parse.default(field, value)
+      else
+        parser(field, value)
+    }
+    if (!is.null(post.parse)) post.parse(parsed.fields)
+  }
+  parser
+}

Modified: pkg/R/roclet.R
===================================================================
--- pkg/R/roclet.R	2008-07-30 04:49:02 UTC (rev 132)
+++ pkg/R/roclet.R	2008-07-30 04:49:28 UTC (rev 133)
@@ -68,7 +68,7 @@
   #' @return \code{NULL}
   roclet$parse.parsed <- function(partita) {
     key.values <- function(partitum)
-      zip.list(attributes(partitum)$names, partitum)
+      zip.list(names(partitum), partitum)
     
     parse.noop <- function(key, value) NULL
 
@@ -120,6 +120,9 @@
                  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)

Added: pkg/sandbox/description.R
===================================================================
--- pkg/sandbox/description.R	                        (rev 0)
+++ pkg/sandbox/description.R	2008-07-30 04:49:28 UTC (rev 133)
@@ -0,0 +1,7 @@
+source('../R/list.R')
+source('../R/functional.R')
+source('../R/string.R')
+source('../R/description.R')
+
+parser <- make.description.parser()
+parser$parse(parse.description.file('../DESCRIPTION'))

Modified: pkg/sandbox/roxygenize.R
===================================================================
--- pkg/sandbox/roxygenize.R	2008-07-30 04:49:02 UTC (rev 132)
+++ pkg/sandbox/roxygenize.R	2008-07-30 04:49:28 UTC (rev 133)
@@ -11,6 +11,7 @@
 source('pkg/R/namespace.R')
 source('pkg/R/collate.R')
 source('pkg/R/roxygenize.R')
+source('pkg/R/description.R')
 
 PKG.DIR <- 'pkg'
 

Modified: pkg/tests/runit/runit.collate.R
===================================================================
--- pkg/tests/runit/runit.collate.R	2008-07-30 04:49:02 UTC (rev 132)
+++ pkg/tests/runit/runit.collate.R	2008-07-30 04:49:28 UTC (rev 133)
@@ -11,10 +11,9 @@
                                            'runit/collate/undershorts.R',
                                            'runit/collate/watch.R'))
   checkEquals(collation,
-              paste("Collate: 'runit/collate/shirt.R'",
-                    "'runit/collate/undershorts.R' 'runit/collate/pants.R'",
-                    "'runit/collate/belt.R' 'runit/collate/tie.R'",
-                    "'runit/collate/jacket.R' 'runit/collate/socks.R'",
-                    "'runit/collate/shoes.R' 'runit/collate/watch.R'"),
+              c("Collate: 'runit/collate/shirt.R' 'runit/collate/undershorts.R'",
+                "  'runit/collate/pants.R' 'runit/collate/belt.R' 'runit/collate/tie.R'",
+                "  'runit/collate/jacket.R' 'runit/collate/socks.R'",
+                "  'runit/collate/shoes.R' 'runit/collate/watch.R'"),
               msg=collation)
 }



More information about the Roxygen-commits mailing list