initial implementation of support for REPL presentations

[swankr.git] / swank-presentations.R

diff --git a/swank-presentations.R b/swank-presentations.R
new file mode 100644 (file)
index 0000000..d2ed3f7
--- /dev/null
+++ b/swank-presentations.R
@@ -0,0 +1,47 @@
+presentationCounter <- 0
+
+savePresentedObject <- function(slimeConnection, value) {
+  if(!exists("idToObject", envir=slimeConnection)) {
+    assign("idToObject", new.env(), envir=slimeConnection)
+  }
+  presentationCounter <<- presentationCounter + 1
+  assign(as.character(presentationCounter), value, envir=slimeConnection$idToObject)
+  presentationCounter
+}
+
+presentReplResult <- function(slimeConnection, value) {
+  id <- savePresentedObject(slimeConnection, value)
+  sendToEmacs(slimeConnection,
+              list(quote(`:presentation-start`), id, quote(`:repl-result`)))
+  sendReplResult(slimeConnection, value)
+  sendToEmacs(slimeConnection,
+              list(quote(`:presentation-end`), id, quote(`:repl-result`)))
+  sendToEmacs(slimeConnection,
+              list(quote(`:write-string`), "\n", quote(`:repl-result`)))
+}
+
+sendReplResultFunction <- presentReplResult
+
+`cl:nth-value` <- function(slimeConnection, sldbState, n, values) {
+  values[[n+1]]
+}
+
+`swank:lookup-presented-object` <- function(slimeConnection, sldbState, id) {
+  str(ls(slimeConnection))
+  if(exists(as.character(id), envir=slimeConnection$idToObject)) {
+    value <- get(as.character(id), envir=slimeConnection$idToObject)
+    list(value, TRUE)
+  } else {
+    list(FALSE, FALSE)
+  }
+}
+
+`swank:lookup-presented-object-or-lose` <- function(slimeConnection, sldbState, id) {
+  stuff <- `swank:lookup-presented-object`(slimeConnection, sldbState, id)
+  if(stuff[[2]]) {
+    stuff[[1]]
+  } else {
+    stop(sprintf("attempt to access unrecorded object (id %d)", id))
+  }
+}
+