swh:1:snp:a4c99a50dc49f82b591f268001b320f8c3ca0041
Tip revision: 1c016a1d9d1dc7690f7c256204f737661d261cb0 authored by jmc on 20 September 2007, 00:00:00 UTC
version 0.96
version 0.96
Tip revision: 1c016a1
demoSource.R
demoSource <- function(demo, inputCon = .demoFifo(), where = .GlobalEnv) {
if(!isOpen(inputCon))
stop("The connection for control input is not open: usually, you should call demoInput() in a separate R session.")
on.exit(if(!identical(inputCon, stdin()))
close(inputCon))
if(!is(demo, "demoSource"))
demo <- .sourceAsDemo(demo)
demo@envir <- as.environment(where)
while(.moreSource(demo)) {
.showPrompt(demo@state)
control <- .getNextLine(inputCon)
if(identical(control, "")) { # empty, alternate display & eval
demo <- .doParseEval(demo)
}
else {
key <- match(control, .keyStrings)
if(is.na(key)) {
demo@partial <- c(demo@partial, control)
cat(control,"\n", sep="", file = stderr())
demo <- .doParseEval(demo, eval = TRUE, read = FALSE)
}
else
switch(names(.keyStrings)[[key]],
complete = {
demo <- .doParseEval(demo, eval = TRUE)
},
continue = {
demo <- .nextSourceLine(demo)
},
quit = {
demo@state <- "quit"
break
},
stop("Oops, got a key (\"", key, "\"), but there's no corresponding action--looks like a bug in demoSource()")
)
}
}
## process last expression, if any
switch(demo@state,
parsed =
demo <- .doParseEval(demo),
partial =
warning("demo source ended with a partial expression: ", paste(demo@partial, collapse = "\n")))
invisible(demo)
}
demoExample <- function(name, package = "SoDA") {
file <- exampleFiles(name, package)
if(length(file) == 0)
stop("No example file found for \"",name, "\"")
demoSource(file)
}
setClass("demoSource",
representation(lines = "character",
pos = "numeric",
partial = "character",
expr = "expression",
value = "ANY",
envir = "environment",
state = "character"),
prototype = prototype(pos = 0, state = "initial")
)
exampleFiles <- function(names = character(), package = "SoDA") {
.matchFile <- function(thisName, files) {
i <- match(thisName, files)
if(is.na(i)) {
i <- match(paste(thisName, ".R", sep=""), files)
if(is.na(i)) {
candidates <- paste(thisName, c(".S", ".q", ".r", ".s"), sep = "")
i <- match(candidates, files)
i <- i[!is.na(i)]
if(length(i) > 1){
i <- i[[1]]
warning("ambiguous match, using \"", candidates[[i]], "\"")
}
else if(length(i) == 0)
i <- NA
}
}
if(is.na(i))
character()
else
files[i]
}
files <- list.files(system.file("Examples", package = package))
if(length(names) == 0 || identical(names, ""))
files
else {
found <- character()
for(thisName in names)
found <- c(found, .matchFile(thisName, files))
system.file("Examples", found, package = package)
}
}
## Utility functions used by the previous
.moreSource <- function(demo) {
(demo@pos < length(demo@lines) || (length(demo@partial) > 0))
}
.sourceAsDemo <- function(source) {
demo <- new("demoSource")
if(is.character(source))
source = file(source)
else if(!inherits(source, "connection"))
stop("source must be a connection or the name of a file (got class \"",class(source),
"\"")
if(!isOpen(source)) {
open(source, "r")
on.exit(close(source), add = TRUE)
}
demo@lines <- readLines(source)
demo@pos <- 0
demo
}
.evalWithVisible <- function(demo) {
exprs <- demo@expr
envir <- demo@envir
value <- NULL
for(expr in exprs) {
exp2 <- substitute(withVisible(expr))
val <- eval(exp2, envir = envir, enclos = parent.env(envir))
value <- val$value
if(val$visible)
print(value)
}
demo@value <- value
demo@state <- "evaluated"
demo
}
.tryParse <- function(text) {
tt = trySilent(parse(text = text))
if(inherits(tt, "try-error")) {
if(grep(fixed = TRUE, "unexpected end of input", tt) > 0)
tt
else {
message(tt)
expression() # do nothing
}
}
else
tt
}
.nextSourceLine <- function(demo) {
pos <- demo@pos
prompt <- getOption("continue")
while(pos < length(demo@lines)) {
pos <- pos+1
line <- demo@lines[[pos]]
cat(line, "\n", sep="", file = stderr())
demo@partial <- c(demo@partial, line)
demo@pos <- pos
if(.nonCommentLine(line)) {
demo@state <- "partial" # ?? probably will be set by caller
break
}
.showPrompt("partial")
}
demo
}
.keyStrings <- list(
complete = ".",
continue = ",",
quit = "q"
)
.doParseEval <- function(demo, eval = NA, read = TRUE) {
if(is.na(eval)) {
## alternately parse and evaluate
if(identical(demo@state, "parsed"))
return(.evalWithVisible(demo))
else
eval <- FALSE # do only the parse step this time
}
while(.moreSource(demo)) {
if(read)
demo <- .nextSourceLine(demo)
demo <- .parseDemo(demo)
if(identical(demo@state,"parsed")) {
if(eval)
demo<- .evalWithVisible(demo)
break ## finished either a parse or a parse-eval step
}
}
demo
}
.parseDemo <- function(demo) {
expr <- .tryParse(demo@partial)
if(inherits(expr, "try-error")) {
demo@expr <- expression()
demo@state <- "partial"
.showPrompt("partial")
}
else {
demo@state <- "parsed"
demo@partial <- character()
demo@expr <- expr
}
demo
}
.showPrompt <- function(state) {
switch(state,
partial = cat(getOption("continue"), file = stderr()),
parsed = return() ,# do nothing
# else, first time or evaluated or something else, like an error
cat(getOption("prompt"), file = stderr())
)
}
.getNextLine <- function(inputCon, pause = 1) {
repeat {
txt <- readLines(inputCon, 1)
if(length(txt) > 0)
return(txt)
## FIXME: would be better to use isIncomplete() here
}
}
.nonCommentLine <- function(line)
(regexpr("^[[:blank:]]*($|#)", line) < 0)
demoInput <- function(path = "./DemoSourceFifo") {
con <- .demoFifo(path, "w")
repeat{
control <- readLines(n=1)
cat(control, "\n", sep="", file = con)
if(identical(control, "q" ))
return(invisible())
}
}
.demoFifo <- function(path = "./DemoSourceFifo", open = "r") {
if(identical(open, "r"))
fifo(path, open)
else
file(path, open) # usually "w" to truncate
}