X-Git-Url: http://christophe.rhodes.io/gitweb/?p=swankr.git;a=blobdiff_plain;f=swank-presentations.R;h=22ce24c2b9a4d56dce5ef4f1f558896aac876a0b;hp=d2ed3f71efe45542bb3454a3fec4a815cd4d987e;hb=bf3b2b6574042d5001c63bc3a54c82bcd0d29e86;hpb=e35149b43e4da28f542c6bdf2decd802e84dd440 diff --git a/swank-presentations.R b/swank-presentations.R index d2ed3f7..22ce24c 100644 --- a/swank-presentations.R +++ b/swank-presentations.R @@ -4,6 +4,8 @@ savePresentedObject <- function(slimeConnection, value) { if(!exists("idToObject", envir=slimeConnection)) { assign("idToObject", new.env(), envir=slimeConnection) } + ## FIXME this should check for value already being present in the + ## idToObject map presentationCounter <<- presentationCounter + 1 assign(as.character(presentationCounter), value, envir=slimeConnection$idToObject) presentationCounter @@ -20,14 +22,11 @@ presentReplResult <- function(slimeConnection, value) { 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) @@ -44,4 +43,21 @@ sendReplResultFunction <- presentReplResult stop(sprintf("attempt to access unrecorded object (id %d)", id)) } } - + +`swank:lookup-and-save-presented-object-or-lose` <- function(slimeConnection, sldbState, id) { + obj <- `swank:lookup-presented-object-or-lose`(slimeConnection, sldbState, id) + savePresentedObject(slimeConnection, obj) +} + +`swank:clear-repl-results` <- function(slimeConnection, sldbState) { + if(!exists("idToObject", envir=slimeConnection)) { + assign("idToObject", new.env(), envir=slimeConnection) + } + rm(list=ls(slimeConnection$idToObject), envir=slimeConnection$idToObject) + TRUE +} + +`swank:init-presentations` <- function(slimeConnection, sldbState) { + sendReplResultFunction <<- presentReplResult + TRUE +}