[Roxygen-commits] r14 - pkg/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Jun 2 15:51:08 CEST 2008
Author: pcd
Date: 2008-06-02 15:51:08 +0200 (Mon, 02 Jun 2008)
New Revision: 14
Added:
pkg/R/functional.R
pkg/R/main.R
pkg/R/parse.R
Removed:
pkg/R/curry.R
pkg/R/roxygen.R
Log:
put parsers in own file; demarcate driver
Deleted: pkg/R/curry.R
===================================================================
--- pkg/R/curry.R 2008-06-02 13:28:31 UTC (rev 13)
+++ pkg/R/curry.R 2008-06-02 13:51:08 UTC (rev 14)
@@ -1,6 +0,0 @@
-## Thanks, Byron Ellis.
-## https://stat.ethz.ch/pipermail/r-devel/2007-November/047318.html
-Curry <- function(FUN,...) {
- .orig = list(...);
- function(...) do.call(FUN,c(.orig,list(...)))
-}
Copied: pkg/R/functional.R (from rev 13, pkg/R/curry.R)
===================================================================
--- pkg/R/functional.R (rev 0)
+++ pkg/R/functional.R 2008-06-02 13:51:08 UTC (rev 14)
@@ -0,0 +1,6 @@
+## Thanks, Byron Ellis.
+## https://stat.ethz.ch/pipermail/r-devel/2007-November/047318.html
+Curry <- function(FUN,...) {
+ .orig = list(...);
+ function(...) do.call(FUN,c(.orig,list(...)))
+}
Added: pkg/R/main.R
===================================================================
--- pkg/R/main.R (rev 0)
+++ pkg/R/main.R 2008-06-02 13:51:08 UTC (rev 14)
@@ -0,0 +1,7 @@
+source('list.R')
+source('parse.R')
+
+srcfile <- srcfile('example.R')
+srcrefs <- attributes(parse(srcfile$filename,
+ srcfile=srcfile))$srcref
+parse.refs(zip.list(prerefs(srcfile), srcrefs))
Copied: pkg/R/parse.R (from rev 13, pkg/R/roxygen.R)
===================================================================
--- pkg/R/parse.R (rev 0)
+++ pkg/R/parse.R 2008-06-02 13:51:08 UTC (rev 14)
@@ -0,0 +1,97 @@
+source('list.R')
+
+LINE.DELIMITER <- '#\''
+TAG.DELIMITER <- '@'
+
+trim <- function(string)
+ gsub('^[[:space:]]+', '',
+ gsub('[[:space:]]+$', '', string))
+
+#' Comment blocks (possibly null) that precede a file's expressions.
+prerefs <- function(srcfile) {
+ length.line <- function(lineno)
+ nchar(getSrcLines(srcfile, lineno, lineno))
+
+ pair.preref <- function(pair) {
+ start <- car(pair)
+ end <- cadr(pair)
+ structure(srcref(srcfile, c(start, 1, end, length.line(end))),
+ class='preref')
+ }
+
+ lines <- unlist(Map(function(srcref)
+ c(car(srcref) - 1,
+ caddr(srcref) + 1),
+ srcrefs))
+ pairs <- pairwise(c(1, lines))
+ Map(pair.preref, pairs)
+}
+
+parse.ref <- function(x, ...)
+ UseMethod('parse.ref')
+
+parse.ref.list <- function(preref.srcref)
+ append(parse.ref(car(preref.srcref)),
+ parse.ref(cadr(preref.srcref)))
+
+parse.default <- function(...) {
+ list(unknown=paste(...))
+}
+
+parse.element <- function(element) {
+ tokens <- car(strsplit(element, ' ', fixed=T))
+ parser <- parser(car(tokens))
+ do.call(parser, as.list(cdr(tokens)))
+}
+
+parse.description <- function(expression)
+ list(description=expression)
+
+parse.prototype <- function(...)
+ list(prototype=paste(...))
+
+parse.export <- function(...)
+ list(export=T)
+
+parse.name.description <- function(name, ...)
+ list(slot=list(name=name, description=paste(...)))
+
+parse.slot <- parse.name.description
+
+parse.param <- parse.name.description
+
+parser <- function(key) {
+ f <- sprintf('parse.%s', key)
+ if (length(ls(1, pattern=f)) > 0) f else parse.default
+}
+
+paste.list <- function(list) {
+ do.call(paste, list)
+}
+
+parse.ref.preref <- function(preref) {
+ lines <- getSrcLines(attributes(preref)$srcfile,
+ car(preref),
+ caddr(preref))
+ delimited.lines <-
+ Filter(function(line) grep(LINE.DELIMITER, line), lines)
+ trimmed.lines <-
+ Map(function(line) substr(line, nchar(LINE.DELIMITER) + 1, nchar(line)),
+ delimited.lines)
+ ## Presumption: white-space is insignificant; there are no
+ ## multi-line elements. This contradicts, for instance, verbatim or
+ ## latex.
+ joined.lines <- gsub(' {2,}', ' ', paste.list(trimmed.lines))
+ elements <- Map(trim, car(strsplit(joined.lines, TAG.DELIMITER, fixed=T)))
+ ## Map introduces magical name-mapping.
+ parsed.elements <- Reduce(function(parsed, element)
+ append(parsed, parse.element(element)),
+ cdr(elements), parse.description(car(elements)))
+}
+
+parse.ref.srcref <- function(srcref)
+ list(srcref=list(filename=attributes(srcref)$srcfile$filename,
+ lloc=as.vector(srcref)))
+
+parse.refs <- function(prerefs.srcrefs)
+ Map(parse.ref, prerefs.srcrefs)
Deleted: pkg/R/roxygen.R
===================================================================
--- pkg/R/roxygen.R 2008-06-02 13:28:31 UTC (rev 13)
+++ pkg/R/roxygen.R 2008-06-02 13:51:08 UTC (rev 14)
@@ -1,102 +0,0 @@
-source('list.R')
-
-LINE.DELIMITER <- '#\''
-TAG.DELIMITER <- '@'
-
-trim <- function(string)
- gsub('^[[:space:]]+', '',
- gsub('[[:space:]]+$', '', string))
-
-#' Comment blocks (possibly null) that precede a file's expressions.
-prerefs <- function(srcfile) {
- length.line <- function(lineno)
- nchar(getSrcLines(srcfile, lineno, lineno))
-
- pair.preref <- function(pair) {
- start <- car(pair)
- end <- cadr(pair)
- structure(srcref(srcfile, c(start, 1, end, length.line(end))),
- class='preref')
- }
-
- lines <- unlist(Map(function(srcref)
- c(car(srcref) - 1,
- caddr(srcref) + 1),
- srcrefs))
- pairs <- pairwise(c(1, lines))
- Map(pair.preref, pairs)
-}
-
-parse.ref <- function(x, ...)
- UseMethod('parse.ref')
-
-parse.ref.list <- function(preref.srcref)
- append(parse.ref(car(preref.srcref)),
- parse.ref(cadr(preref.srcref)))
-
-parse.default <- function(...) {
- list(unknown=paste(...))
-}
-
-parse.element <- function(element) {
- tokens <- car(strsplit(element, ' ', fixed=T))
- parser <- parser(car(tokens))
- do.call(parser, as.list(cdr(tokens)))
-}
-
-parse.description <- function(expression)
- list(description=expression)
-
-parse.prototype <- function(...)
- list(prototype=paste(...))
-
-parse.export <- function(...)
- list(export=T)
-
-parse.name.description <- function(name, ...)
- list(slot=list(name=name, description=paste(...)))
-
-parse.slot <- parse.name.description
-
-parse.param <- parse.name.description
-
-parser <- function(key) {
- f <- sprintf('parse.%s', key)
- if (length(ls(1, pattern=f)) > 0) f else parse.default
-}
-
-paste.list <- function(list) {
- do.call(paste, list)
-}
-
-parse.ref.preref <- function(preref) {
- lines <- getSrcLines(attributes(preref)$srcfile,
- car(preref),
- caddr(preref))
- delimited.lines <-
- Filter(function(line) grep(LINE.DELIMITER, line), lines)
- trimmed.lines <-
- Map(function(line) substr(line, nchar(LINE.DELIMITER) + 1, nchar(line)),
- delimited.lines)
- ## Presumption: white-space is insignificant; there are no
- ## multi-line elements. This contradicts, for instance, verbatim or
- ## latex.
- joined.lines <- gsub(' {2,}', ' ', paste.list(trimmed.lines))
- elements <- Map(trim, car(strsplit(joined.lines, TAG.DELIMITER, fixed=T)))
- ## Map introduces magical name-mapping.
- parsed.elements <- Reduce(function(parsed, element)
- append(parsed, parse.element(element)),
- cdr(elements), parse.description(car(elements)))
-}
-
-parse.ref.srcref <- function(srcref)
- list(srcref=list(filename=attributes(srcref)$srcfile$filename,
- lloc=as.vector(srcref)))
-
-parse.refs <- function(prerefs.srcrefs)
- Map(parse.ref, prerefs.srcrefs)
-
-srcfile <- srcfile('example.R')
-srcrefs <- attributes(parse(srcfile$filename,
- srcfile=srcfile))$srcref
-parse.refs(zip.list(prerefs(srcfile), srcrefs))
More information about the Roxygen-commits
mailing list