writeSexpToStringLoop(obj)
}
-withOutputToString <- function(expr) {
- call <- substitute(expr)
- f <- fifo("")
- sink(f)
- tryCatch({ tryCatch(eval.parent(call), finally=sink())
- readLines(f) },
- finally=close(f))
+prin1ToString <- function(val) {
+ paste(deparse(val, backtick=TRUE, control=c("delayPromises", "keepNA")),
+ sep="", collapse="\n")
}
printToString <- function(val) {
- withOutputToString(str(val, indent.str="", list.len=5, max.level=2))
+ paste(capture.output(print(val)), sep="", collapse="\n")
}
`swank:connection-info` <- function (slimeConnection, sldbState) {
list("R", "R")
}
-sendReplResult <- function(slimeConnection, value) {
+makeReplResult <- function(value) {
string <- printToString(value)
- sendToEmacs(slimeConnection,
- list(quote(`:write-string`),
- paste(string, collapse="\n"),
- quote(`:repl-result`)))
+ list(quote(`:write-string`), string,
+ quote(`:repl-result`))
+}
+
+makeReplResultFunction <- makeReplResult
+
+sendReplResult <- function(slimeConnection, value) {
+ result <- makeReplResultFunction(value)
+ sendToEmacs(slimeConnection, result)
}
sendReplResultFunction <- sendReplResult
FALSE
}
+`swank:eval-string-in-frame` <- function(slimeConnection, sldbState, string, index) {
+ frame <- sldbState$frames[[1+index]]
+ withRetryRestart("retry SLIME interactive evaluation request",
+ value <- eval(parse(text=string), envir=frame))
+ printToString(value)
+}
+
`swank:frame-locals-and-catch-tags` <- function(slimeConnection, sldbState, index) {
- str(sldbState$frames)
frame <- sldbState$frames[[1+index]]
objs <- ls(envir=frame)
list(lapply(objs, function(name) { list(quote(`:name`), name,
quote(`:id`), 0,
- quote(`:value`), paste(printToString(eval(parse(text=name), envir=frame)), sep="", collapse="\n")) }),
+ quote(`:value`), printToString(eval(parse(text=name), envir=frame))) }),
list())
}
}
`swank:compile-string-for-emacs` <- function(slimeConnection, sldbState, string, buffer, position, filename, policy) {
- # FIXME: I think in parse() here we can use srcref to associate
- # buffer/filename/position to the objects. Or something.
- withRestarts({ times <- system.time(eval(parse(text=string), envir = globalenv())) },
+ lineOffset <- charOffset <- colOffset <- NULL
+ for(pos in position) {
+ switch(as.character(pos[[1]]),
+ `:position` = {charOffset <- pos[[2]]},
+ `:line` = {lineOffset <- pos[[2]]; colOffset <- pos[[3]]},
+ warning("unknown content in pos", pos))
+ }
+ frob <- function(refs) {
+ lapply(refs,
+ function(x)
+ srcref(attr(x,"srcfile"),
+ c(x[1]+lineOffset-1, ifelse(x[1]==1, x[2]+colOffset-1, x[2]),
+ x[3]+lineOffset-1, ifelse(x[3]==1, x[4]+colOffset-1, x[4]),
+ ifelse(x[1]==1, x[5]+colOffset-1, x[5]),
+ ifelse(x[3]==1, x[6]+colOffset-1, x[6]))))
+ }
+ transformSrcrefs <- function(s) {
+ srcrefs <- attr(s, "srcref")
+ attribs <- attributes(s)
+ new <-
+ switch(mode(s),
+ "call"=as.call(lapply(s, transformSrcrefs)),
+ "expression"=as.expression(lapply(s, transformSrcrefs)),
+ s)
+ attributes(new) <- attribs
+ if(!is.null(attr(s, "srcref"))) {
+ attr(new, "srcref") <- frob(srcrefs)
+ }
+ new
+ }
+ withRestarts({
+ times <- system.time({
+ exprs <- parse(text=string, srcfile=srcfile(filename))
+ eval(transformSrcrefs(exprs), envir = globalenv()) })},
abort="abort compilation")
- list(quote(`:compilation-result`), list(), TRUE, times[3])
+ list(quote(`:compilation-result`), list(), TRUE, times[3], FALSE, FALSE)
}
withRetryRestart <- function(description, expr) {
`swank:interactive-eval` <- function(slimeConnection, sldbState, string) {
withRetryRestart("retry SLIME interactive evaluation request",
value <- eval(parse(text=string), envir=globalenv()))
- printToString(value)
+ prin1ToString(value)
}
`swank:eval-and-grab-output` <- function(slimeConnection, sldbState, string) {
withRetryRestart("retry SLIME interactive evaluation request",
{ output <-
- withOutputToString(value <- eval(parse(text=string),
- envir=globalenv())) })
- list(output, printToString(value))
+ capture.output(value <- eval(parse(text=string),
+ envir=globalenv())) })
+ output <- paste(output, sep="", collapse="\n")
+ list(output, prin1ToString(value))
}
`swank:find-definitions-for-emacs` <- function(slimeConnection, sldbState, string) {
list()
} else {
filename <- get("filename", srcfile)
+ ## KLUDGE: what this means is "is the srcfile filename
+ ## absolute?"
+ if(substr(filename, 1, 1) == "/") {
+ file <- filename
+ } else {
+ file <- sprintf("%s/%s", srcfile$wd, filename)
+ }
list(list(sprintf("function %s", string),
list(quote(`:location`),
- list(quote(`:file`), sprintf("%s/%s", srcfile$wd, srcfile$filename)),
+ list(quote(`:file`), file),
list(quote(`:line`), srcref[[2]][[1]], srcref[[2]][[2]]-1),
list())))
}
}
inspectObject <- function(slimeConnection, object) {
- slimeConnection$istate <- list(object=object, previous=slimeConnection$istate)
+ previous <- slimeConnection$istate
+ slimeConnection$istate <- new.env()
+ slimeConnection$istate$object <- object
+ slimeConnection$istate$previous <- previous
slimeConnection$istate$content <- emacsInspect(object)
- if(!object %in% slimeConnection$inspectorHistory) {
+ if(!(object %in% slimeConnection$inspectorHistory)) {
slimeConnection$inspectorHistory <- c(slimeConnection$inspectorHistory, object)
}
if(!is.null(slimeConnection$istate$previous)) {
assignIndexInParts <- function(object, istate) {
ret <- 1+length(istate$parts)
- istate$parts <- c(istate$parts, object)
+ istate$parts <- c(istate$parts, list(object))
ret
}
UseMethod("emacsInspect")
}
+emacsInspect.default <- function(thing) {
+ c(list(paste("a ", class(thing)[[1]], sep=""), list(quote(`:newline`))))
+}
+
emacsInspect.list <- function(list) {
c(list("a list", list(quote(`:newline`))),
mapply(function(name, value) { list(list(quote(`:line`), name, value)) },
names(list), list))
}
+emacsInspect.numeric <- function(numeric) {
+ c(list("a numeric", list(quote(`:newline`))),
+ mapply(function(name, value) { list(list(quote(`:line`), name, value)) },
+ (1:length(numeric)), numeric))
+}
+
`swank:quit-inspector` <- function(slimeConnection, sldbState) {
resetInspector(slimeConnection)
FALSE
}
+
+`swank:inspector-nth-part` <- function(slimeConnection, sldbState, index) {
+ slimeConnection$istate$parts[[index]]
+}
+
+`swank:inspect-nth-part` <- function(slimeConnection, sldbState, index) {
+ object <- `swank:inspector-nth-part`(slimeConnection, sldbState, index)
+ inspectObject(slimeConnection, object)
+}
+
+`swank:inspector-pop` <- function(slimeConnection, sldbState) {
+ if(!is.null(slimeConnection$istate$previous)) {
+ slimeConnection$istate <- slimeConnection$istate$previous
+ istateToElisp(slimeConnection$istate)
+ } else {
+ FALSE
+ }
+}
+
+`swank:inspector-next` <- function(slimeConnection, sldbState) {
+ if(!is.null(slimeConnection$istate$`next`)) {
+ slimeConnection$istate <- slimeConnection$istate$`next`
+ istateToElisp(slimeConnection$istate)
+ } else {
+ FALSE
+ }
+}
+
+`swank:inspector-eval` <- function(slimeConnection, sldbState, string) {
+ expr <- parse(text=string)[[1]]
+ object <- slimeConnection$istate$object
+ if(inherits(object, "list")|inherits(object, "environment")) {
+ substituted <- substituteDirect(expr, object)
+ eval(substituted, envir=globalenv())
+ } else {
+ eval(expr, envir=globalenv())
+ }
+}
+
+`swank:inspect-current-condition` <- function(slimeConnection, sldbState) {
+ resetInspector(slimeConnection)
+ inspectObject(slimeConnection, sldbState$condition)
+}
+
+`swank:inspect-frame-var` <- function(slimeConnection, sldbState, frame, var) {
+ resetInspector(slimeConnection)
+ frame <- sldbState$frames[[1+frame]]
+ name <- ls(envir=frame)[[1+var]]
+ object <- get(name, envir=frame)
+ inspectObject(slimeConnection, object)
+}
+
+`swank:default-directory` <- function(slimeConnection, sldbState) {
+ getwd()
+}
+
+`swank:set-default-directory` <- function(slimeConnection, sldbState, directory) {
+ setwd(directory)
+ `swank:default-directory`(slimeConnection, sldbState)
+}
+
+`swank:load-file` <- function(slimeConnection, sldbState, filename) {
+ source(filename, local=FALSE)
+ TRUE
+}
+
+`swank:compile-file-for-emacs` <- function(slimeConnection, sldbState, filename, loadp, ...) {
+ times <- system.time(parse(filename))
+ list(quote(`:compilation-result`), list(), TRUE, times[3], substitute(loadp), filename)
+}
projects / swankr.git / blobdiff