swank-presentations.R

   1 presentationCounter <- 0
   2
   3 savePresentedObject <- function(slimeConnection, value) {
   4   if(!exists("idToObject", envir=slimeConnection)) {
   5     assign("idToObject", new.env(), envir=slimeConnection)
   6   }
   7   ## FIXME this should check for value already being present in the
   8   ## idToObject map
   9   presentationCounter <<- presentationCounter + 1
  10   assign(as.character(presentationCounter), value, envir=slimeConnection$idToObject)
  11   presentationCounter
  12 }
  13
  14 presentReplResult <- function(slimeConnection, value) {
  15   id <- savePresentedObject(slimeConnection, value)
  16   sendToEmacs(slimeConnection,
  17               list(quote(`:presentation-start`), id, quote(`:repl-result`)))
  18   sendReplResult(slimeConnection, value)
  19   sendToEmacs(slimeConnection,
  20               list(quote(`:presentation-end`), id, quote(`:repl-result`)))
  21   sendToEmacs(slimeConnection,
  22               list(quote(`:write-string`), "\n", quote(`:repl-result`)))
  23 }
  24
  25 sendReplResultFunction <- presentReplResult
  26
  27 `cl:nth-value` <- function(slimeConnection, sldbState, n, values) {
  28   values[[n+1]]
  29 }
  30
  31 `swank:lookup-presented-object` <- function(slimeConnection, sldbState, id) {
  32   if(exists(as.character(id), envir=slimeConnection$idToObject)) {
  33     value <- get(as.character(id), envir=slimeConnection$idToObject)
  34     list(value, TRUE)
  35   } else {
  36     list(FALSE, FALSE)
  37   }
  38 }
  39
  40 `swank:lookup-presented-object-or-lose` <- function(slimeConnection, sldbState, id) {
  41   stuff <- `swank:lookup-presented-object`(slimeConnection, sldbState, id)
  42   if(stuff[[2]]) {
  43     stuff[[1]]
  44   } else {
  45     stop(sprintf("attempt to access unrecorded object (id %d)", id))
  46   }
  47 }
  48
  49 `swank:lookup-and-save-presented-object-or-lose` <- function(slimeConnection, sldbState, id) {
  50   obj <- `swank:lookup-presented-object-or-lose`(slimeConnection, sldbState, id)
  51   savePresentedObject(slimeConnection, obj)
  52 }
  53
  54 `swank:clear-repl-results` <- function(slimeConnection, sldbState) {
  55   if(!exists("idToObject", envir=slimeConnection)) {
  56     assign("idToObject", new.env(), envir=slimeConnection)
  57   }
  58   rm(list=ls(slimeConnection$idToObject), envir=slimeConnection$idToObject)
  59   TRUE
  60 }