swank-presentations.R 2.13 KB
Newer Older
1
2
3
4
5
6
presentationCounter <- 0

savePresentedObject <- function(slimeConnection, value) {
  if(!exists("idToObject", envir=slimeConnection)) {
    assign("idToObject", new.env(), envir=slimeConnection)
  }
7
8
  ## FIXME this should check for value already being present in the
  ## idToObject map
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
  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`)))
}

`cl:nth-value` <- function(slimeConnection, sldbState, n, values) {
  values[[n+1]]
}

`swank:lookup-presented-object` <- function(slimeConnection, sldbState, id) {
  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))
  }
}
46
47
48
49
50
51

`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)
}

52
53
54
55
56
57
58
`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
}
59
60
61
62
63

`swank:init-presentations` <- function(slimeConnection, sldbState) {
  sendReplResultFunction <<- presentReplResult
  TRUE
}