Nothing
## Translate the tree representation generated by
## the R parser (parse) into a rectangular representation
sidekick <- function (x, ...)
UseMethod("sidekick")
sidekick.default <- function (x, ... )
.NotYetImplemented()
sidekick.function <- function (x, ...)
{
tf <- tempfile()
on.exit(unlink(tf))
dump("x" , file = tf)
sidekick.character(tf, encoding = getOption("encoding"),
delete.file = TRUE)
}
sidekick.character <- function (x, encoding = getOption("encoding"),
delete.file = FALSE, ...)
{
if (isTRUE(delete.file))
on.exit({unlink(x)})
## Try to parse and return an error if failed
f <- file(x, open = "r", encoding = encoding)
p <- try(parse(f, srcfile = srcfile(x, encoding)), silent = TRUE)
close(f)
if (inherits(p, "try-error"))
return(list(type = "error", data = parseError(p)))
## Calls the actual sidekick function
out <- .sidekickParse(p)
### TODO: replace this in the code so that no conversion is necessary at that point
out$id <- as.integer(out$id)
out$srcref1 <- as.integer(out$srcref1)
out$srcref2 <- as.integer(out$srcref2)
out$srcref3 <- as.integer(out$srcref3)
out$srcref4 <- as.integer(out$srcref4)
out$parent <- as.integer(out$parent)
list(type = "ok", data = out)
}
.sidekickParse <- function (p = try(parse(file), silent = TRUE), top = TRUE,
env = new.env(), parent = 0, file)
{
if (isTRUE(top)) {
env[["data"]] <- data.frame(
id = integer(0),
srcref1 = integer(0),
srcref2 = integer(0),
srcref3 = integer(0),
srcref4 = integer(0),
description = character(0),
parent = integer(0),
mode = character(0), stringsAsFactors = FALSE)
if (inherits(p, "try-error")) return(env[["data"]])
maxId <- 0
} else {
maxId <- max(env[["data"]][, "id"])
}
isIf <- .looksLikeAnIf(p)
atts <- attributes(p)
descriptions <- as.character(p)
hasAttrs <- "srcref" %in% names(atts)
ids <- maxId + 1:length(p)
if (isTRUE(hasAttrs)) {
srcrefs <- t(sapply(attr(p, "srcref"), function (y) {
as.integer(y)[1:4]
# if (length(positions) == 4) positions else positions[c(1,5,3,6)]
}))
colnames(srcrefs) <- paste("srcref", 1:4, sep = "")
srcrefs <- as.data.frame(srcrefs)
modes <- sapply(p, mode)
data <- data.frame(id = ids,
parent = rep(parent, length(p)),
mode = modes, srcrefs, description = descriptions,
stringsAsFactors = FALSE)
env[["data"]] <- rbind(env[["data"]], data)
}
calls <- sapply(p, mode) %in% c("call", "function")
if(isTRUE(isIf)) {
env[["data"]][parent, "mode"] <- "if"
pa <- try(.addIfNode(TRUE, env = env, parent = parent, p[[3]]),
silent = TRUE)
.sidekickParse(p[[3]], top = FALSE, env = env, parent = pa)
if (length(p) == 4) {
pa <- try(.addIfNode(FALSE, env = env, parent = parent, p[[4]]),
silent = TRUE)
if (.looksLikeAnIf(p[[4]])) {
data <- data.frame(
id = pa + 1, .getIfSrcRef(p[[4]]),
description = paste("if(", as.character(p[[4]][[2]]), ")",
sep = "" ), parent = pa, mode = "if")
env[["data"]] <- rbind(env[["data"]], data)
env[["data"]][pa, 2:5] <- data[, 2:5]
pa <- pa + 1
}
.sidekickParse(p[[4]], top = FALSE, env = env, parent = pa)
}
} else {
for (i in 1:length(p)) {
if (!is.null(p) && calls[i]) {
test <- try(.looksLikeAFunction(p[[i]]), silent = TRUE)
if (isTRUE(test)) {
env[["data"]][ids[i], "mode"] <- "function"
try(.sidekickParse(p[[i]], top = FALSE, env = env,
parent = if (isTRUE(hasAttrs)) ids[i] else parent),
silent = TRUE)
} else {
.sidekickParse(p[[i]], top = FALSE, env = env,
parent = if (isTRUE(hasAttrs)) ids[i] else parent)
}
}
}
}
if (isTRUE(top)) return(env[["data"]])
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.