[Roxygen-commits] r146 - in pkg: . R sandbox
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Aug 2 09:21:33 CEST 2008
Author: pcd
Date: 2008-08-02 09:21:33 +0200 (Sat, 02 Aug 2008)
New Revision: 146
Modified:
pkg/DESCRIPTION
pkg/R/callgraph.R
pkg/R/roxygenize.R
pkg/README
pkg/sandbox/roxygenize.R
Log:
text-only alternative to callgraphs; suggests and require for Rgraphviz; Makefile.win idea
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2008-08-02 07:21:31 UTC (rev 145)
+++ pkg/DESCRIPTION 2008-08-02 07:21:33 UTC (rev 146)
@@ -7,4 +7,4 @@
Manuel Eugster <Manuel.Eugster at stat.uni-muenchen.de>
Maintainer: Peter Danenberg <pcd at roxygen.org>
URL: http://roxygen.org
-Depends: Rgraphviz
+Suggests: Rgraphviz
Modified: pkg/R/callgraph.R
===================================================================
--- pkg/R/callgraph.R 2008-08-02 07:21:31 UTC (rev 145)
+++ pkg/R/callgraph.R 2008-08-02 07:21:33 UTC (rev 146)
@@ -16,8 +16,13 @@
#' interesting functions
#' @param dir the directory to place the callgraphs in
#' @param verbose anounce what we're doing
-#' @importFrom Rgraphviz toFile
#' @export
+#' @TODO \itemize{
+#' \item{\file{index.html} in \file{inst/doc} for
+#' callgraphs, possibly with thumbnails in png}
+#' \item{Option for text-only callgraph (which are clearer,
+#' in my opinion)}
+#' }
make.callgraph.roclet <- function(dependencies=NULL,
dir='.',
verbose=TRUE) {
@@ -35,7 +40,8 @@
mapply(function(package)
tryCatch(require(package,
character.only=TRUE,
- quietly=TRUE),
+ quietly=TRUE,
+ warn.conflicts=FALSE),
warning=function(e) FALSE),
dependencies)
@@ -43,7 +49,8 @@
warning(sprintf(paste('Package(s) %s wouldn\'t load;',
'callgraphs might be incomplete.'),
do.call(Curry(paste, sep=', '),
- Map(sQuote, dependencies[!successes]))))
+ Map(sQuote, dependencies[!successes]))),
+ immediate.=TRUE)
}
reset.state <- function(partitum) {
@@ -62,7 +69,13 @@
else {
preorder.walk.expression(discover.subcalls,
parse(text=src.lines(partitum)))
- graphviz(subcalls)
+ if (require(Rgraphviz, quietly=TRUE))
+ graphviz(subcalls)
+ else {
+ warning(paste('Rgraphviz not present; replacing',
+ 'callgraphs with text-only call-lists.'))
+ text(subcalls)
+ }
}
}
}
@@ -130,21 +143,29 @@
PHI <- (1 + sqrt(5)) / 2
- #' @TODO Use svn version of Rgraphviz to de-necessitate formals-hack.
- formals(toFile) <- alist(graph=,
- layoutType=c("dot", "neato", "twopi",
- "circo", "fdp"),
- filename=,
- fileType=c("canon", "dot", "xdot",
- "dia", "fig", "gd", "gd2", "gif", "hpgl",
- "imap", "cmapx", "ismap", "mif", "mp", "pcl",
- "pdf", "pic", "plain", "plain-ext", "png", "ps",
- "ps2", "svg", "svgz", "vrml", "vtx", "wbmp"))
+ outfile <- function(dir, template, name, format)
+ file.path(dir, sprintf(template, name, format))
- OUTFILE <- '%s-callgraph.pdf'
+ OUTFILE <- '%s-callgraph.%s'
#' @note Thanks to Manuel for suggesting the all.names fix.
+ #' @TODO Use svn version of Rgraphviz to de-necessitate
+ #' formals-hack.
+ #' @TODO Fall back on native alternate if Rgraphviz not
+ #' available?
graphviz <- function(subcalls) {
+ FORMAT <- 'pdf'
+
+ formals(toFile) <- alist(graph=,
+ layoutType=c("dot", "neato", "twopi",
+ "circo", "fdp"),
+ filename=,
+ fileType=c("canon", "dot", "xdot",
+ "dia", "fig", "gd", "gd2", "gif", "hpgl",
+ "imap", "cmapx", "ismap", "mif", "mp",
+ "pcl", "pdf", "pic", "plain", "plain-ext",
+ "png", "ps", "ps2", "svg", "svgz", "vrml",
+ "vtx", "wbmp"))
supercalls <- ls(subcalls, all.names=TRUE)
if (length(supercalls) < 1 || is.null(supercalls))
warning(sprintf('Omitting call-less call-graph for %s.',
@@ -164,7 +185,7 @@
graphDataDefaults(ag, 'ratio') <- PHI
graphDataDefaults(ag, 'splines') <- 'true'
nodeDataDefaults(ag, 'fontname') <- 'monospace'
- outfile <- file.path(dir, sprintf(OUTFILE, name))
+ outfile <- outfile(dir, OUTFILE, name, FORMAT)
if (verbose)
cat(sprintf('Outputting call graph to %s\n', sQuote(outfile)))
toFile(ag,
@@ -174,6 +195,20 @@
}
}
+ text <- function(subcalls) {
+ FORMAT <- 'txt'
+ outfile <- outfile(dir, OUTFILE, name, FORMAT)
+ if (verbose)
+ cat(sprintf('Outputting text-only call-list to %s\n',
+ sQuote(outfile)))
+ cat(strwrap(capture.output(str(as.list(subcalls),
+ vec.len=2^10,
+ nchar.max=2^10)),
+ exdent=2),
+ sep='\n',
+ file=outfile)
+ }
+
roclet <- make.roclet(pre.parse=reset.state,
post.parse=post.parse)
Modified: pkg/R/roxygenize.R
===================================================================
--- pkg/R/roxygenize.R 2008-08-02 07:21:31 UTC (rev 145)
+++ pkg/R/roxygenize.R 2008-08-02 07:21:33 UTC (rev 146)
@@ -63,8 +63,8 @@
#' @return \code{NULL}
#' @callGraph
#' @callGraphDepth 1
-#' @TODO Options to enable/disable specific roclet (--no-callgraphs,
-#' etc.)
+#' @TODO Options to enable/disable specific roclet
+#' (\command{--no-callgraphs}, etc.)
roxygenize <- function(package.dir,
copy.package=TRUE) {
roxygen.dir <- sprintf(ROXYGEN.DIR, package.dir)
Modified: pkg/README
===================================================================
--- pkg/README 2008-08-02 07:21:31 UTC (rev 145)
+++ pkg/README 2008-08-02 07:21:33 UTC (rev 146)
@@ -27,6 +27,9 @@
* Convert the `sandbox/roxygenize.R' driver into an `R CMD roxygen'.
+ * Makefile.win which uses sed to chop off the first line; else:
+ simple script to `#! /bin/sh'. See Sweave.
+
* Create some automatic method for detecting S3 methods without
resorting to @method <generic> <class>.
Modified: pkg/sandbox/roxygenize.R
===================================================================
--- pkg/sandbox/roxygenize.R 2008-08-02 07:21:31 UTC (rev 145)
+++ pkg/sandbox/roxygenize.R 2008-08-02 07:21:33 UTC (rev 146)
@@ -1,4 +1,4 @@
-library(Rgraphviz)
+## library(Rgraphviz)
if (!file.exists('pkg/R/parse.R'))
stop('Run one directory above `pkg\'.')
More information about the Roxygen-commits
mailing list