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   presentationCounter <<- presentationCounter + 1
   8   assign(as.character(presentationCounter), value, envir=slimeConnection$idToObject)
   9   presentationCounter
  10 }
  11
  12 presentReplResult <- function(slimeConnection, value) {
  13   id <- savePresentedObject(slimeConnection, value)
  14   sendToEmacs(slimeConnection,
  15               list(quote(`:presentation-start`), id, quote(`:repl-result`)))
  16   sendReplResult(slimeConnection, value)
  17   sendToEmacs(slimeConnection,
  18               list(quote(`:presentation-end`), id, quote(`:repl-result`)))
  19   sendToEmacs(slimeConnection,
  20               list(quote(`:write-string`), "\n", quote(`:repl-result`)))
  21 }
  22
  23 sendReplResultFunction <- presentReplResult
  24
  25 `cl:nth-value` <- function(slimeConnection, sldbState, n, values) {
  26   values[[n+1]]
  27 }
  28
  29 `swank:lookup-presented-object` <- function(slimeConnection, sldbState, id) {
  30   str(ls(slimeConnection))
  31   if(exists(as.character(id), envir=slimeConnection$idToObject)) {
  32     value <- get(as.character(id), envir=slimeConnection$idToObject)
  33     list(value, TRUE)
  34   } else {
  35     list(FALSE, FALSE)
  36   }
  37 }
  38
  39 `swank:lookup-presented-object-or-lose` <- function(slimeConnection, sldbState, id) {
  40   stuff <- `swank:lookup-presented-object`(slimeConnection, sldbState, id)
  41   if(stuff[[2]]) {
  42     stuff[[1]]
  43   } else {
  44     stop(sprintf("attempt to access unrecorded object (id %d)", id))
  45   }
  46 }
  47
  48 `swank:clear-repl-results` <- function(slimeConnection, sldbState) {
  49   if(!exists("idToObject", envir=slimeConnection)) {
  50     assign("idToObject", new.env(), envir=slimeConnection)
  51   }
  52   rm(list=ls(slimeConnection$idToObject), envir=slimeConnection$idToObject)
  53   TRUE
  54 }