the beginnings of an inspector

[swankr.git] / swank.R

diff --git a/swank.R b/swank.R
index 488ad56943417d0414b9eba804fc14d63cd0a4b1..2d2bf779cdb126f8a62af59429d0156257bedc5f 100644 (file)
--- a/swank.R
+++ b/swank.R
@@ -245,16 +245,19 @@ writeSexpToString <- function(obj) {
   writeSexpToStringLoop(obj)
 }
 
-printToString <- function(val) {
+withOutputToString <- function(expr) {
+  call <- substitute(expr)
   f <- fifo("")
   sink(f)
-  tryCatch({
-    tryCatch(str(val, indent.str="", list.len=5, max.level=2),
-             finally=sink())
-    readLines(f) },
+  tryCatch({ tryCatch(eval.parent(call), finally=sink())
+             readLines(f) },
            finally=close(f))
 }
 
+printToString <- function(val) {
+  withOutputToString(str(val, indent.str="", list.len=5, max.level=2))
+}
+
 `swank:connection-info` <- function (slimeConnection, sldbState) {
   list(quote(`:pid`), Sys.getpid(),
        quote(`:package`), list(quote(`:name`), "R", quote(`:prompt`), "R> "),
@@ -398,29 +401,28 @@ computeRestartsForEmacs <- function (sldbState) {
   list(quote(`:compilation-result`), list(), TRUE, times[3])
 }
 
-`swank:interactive-eval` <-  function(slimeConnection, sldbState, string) {
+withRetryRestart <- function(description, expr) {
+  call <- substitute(expr)
   retry <- TRUE
-  value <- ""
   while(retry) {
     retry <- FALSE
-    withRestarts(value <- eval(parse(text=string), envir = globalenv()),
-                 retry=list(description="retry SLIME interactive evaluation request", handler=function() retry <<- TRUE))
+    withRestarts(eval.parent(call),
+                 retry=list(description=description,
+                   handler=function() retry <<- TRUE))
   }
+}
+
+`swank:interactive-eval` <-  function(slimeConnection, sldbState, string) {
+  withRetryRestart("retry SLIME interactive evaluation request",
+                   value <- eval(parse(text=string), envir=globalenv()))
   printToString(value)
 }
 
 `swank:eval-and-grab-output` <- function(slimeConnection, sldbState, string) {
-  retry <- TRUE
-  value <- ""
-  output <- NULL
-  f <- fifo("")
-  tryCatch({
-    sink(f)
-    while(retry) {
-      retry <- FALSE
-      withRestarts(value <- eval(parse(text=string), envir = globalenv()),
-                   retry=list(description="retry SLIME interactive evaluation request", handler=function() retry <<- TRUE))}},
-           finally={sink(); output <- readLines(f); close(f)})
+  withRetryRestart("retry SLIME interactive evaluation request",
+                   { output <-
+                       withOutputToString(value <- eval(parse(text=string),
+                                                        envir=globalenv())) })
   list(output, printToString(value))
 }
 
@@ -458,3 +460,79 @@ computeRestartsForEmacs <- function (sldbState) {
   eval(parse(text=sprintf("%s <- %s", string, value)), envir = globalenv())
   TRUE
 }
+
+resetInspector <- function(slimeConnection) {
+  assign("istate", list(), envir=slimeConnection)
+  assign("inspectorHistory", NULL, envir=slimeConnection)
+}
+
+`swank:init-inspector` <- function(slimeConnection, sldbState, string) {
+  withRetryRestart("retry SLIME inspection request",
+                   { resetInspector(slimeConnection)
+                     value <- inspectObject(slimeConnection, eval(parse(text=string), envir=globalenv()))
+                   })
+  value
+}
+
+inspectObject <- function(slimeConnection, object) {
+  slimeConnection$istate <- list(object=object, previous=slimeConnection$istate)
+  slimeConnection$istate$content <- emacsInspect(object)
+  if(!object %in% slimeConnection$inspectorHistory) {
+    slimeConnection$inspectorHistory <- c(slimeConnection$inspectorHistory, object)
+  }
+  if(!is.null(slimeConnection$istate$previous)) {
+    slimeConnection$istate$previous$`next` <- slimeConnection$istate
+  }
+  istateToElisp(slimeConnection$istate)
+}
+
+valuePart <- function(istate, object, string) {
+  list(quote(`:value`),
+       if(is.null(string)) printToString(object) else string,
+       assignIndexInParts(object, istate))
+}
+
+preparePart <- function(istate, part) {
+  if(is.character(part)) {
+    list(part)
+  } else {
+    switch(as.character(part[[1]]),
+           `:newline` = list("\n"),
+           `:value` = valuePart(istate, part[[2]], part[[3]]),
+           `:line` = list(printToString(part[[2]]), ": ",
+             valuePart(istate, part[[3]], NULL), "\n"))
+  }
+}
+
+prepareRange <- function(istate, start, end) {
+  range <- istate$content[start+1:min(end+1, length(istate$content))]
+  ps <- NULL
+  for(part in range) {
+    ps <- c(ps, preparePart(istate, part))
+  }
+  list(ps, if(length(ps)<end-start) { start+length(ps) } else { end+1000 },
+       start, end)
+}
+
+assignIndexInParts <- function(object, istate) {
+  ret <- 1+length(istate$parts)
+  istate$parts <- c(istate$parts, object)
+  ret
+}
+
+istateToElisp <- function(istate) {
+  list(quote(`:title`), deparse(istate$object, control="all", nlines=1),
+       quote(`:id`), assignIndexInParts(istate$object, istate),
+       quote(`:content`), prepareRange(istate, 0, 500))
+}
+
+emacsInspect <- function(object) {
+  UseMethod("emacsInspect")
+}
+
+emacsInspect.list <- function(list) {
+  c(list("a list", list(quote(`:newline`))),
+    mapply(function(name, value) { list(list(quote(`:line`), name, value)) },
+           names(list), list))
+}
+