implement withRetryRestart

[swankr.git] / swank.R

diff --git a/swank.R b/swank.R
index 1dc95b48800c305489292bc95f4cdb92f381e16e..22dd53286c467fc02abb8a162e942fb04f10c5d8 100644 (file)
--- a/swank.R
+++ b/swank.R
@@ -113,6 +113,7 @@ sldbLoop <- function(slimeConnection, sldbState, id) {
 }
 
 readPacket <- function(io) {
+  socketSelect(list(io))
   header <- readChunk(io, 6)
   len <- strtoi(header, base=16)
   payload <- readChunk(io, len)
@@ -244,12 +245,19 @@ writeSexpToString <- function(obj) {
   writeSexpToStringLoop(obj)
 }
 
-printToString <- function(val) {
+withOutputToString <- function(expr) {
+  call <- substitute(expr)
   f <- fifo("")
-  tryCatch({ sink(f); print(val); sink(); readLines(f) },
+  sink(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> "),
@@ -393,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))
 }
 
@@ -443,3 +450,13 @@ computeRestartsForEmacs <- function (sldbState) {
     list()
   }
 }
+
+`swank:value-for-editing` <- function(slimeConnection, sldbState, string) {
+  paste(deparse(eval(parse(text=string), envir = globalenv()), control="all"),
+        collapse="\n", sep="")
+}
+
+`swank:commit-edited-value` <- function(slimeConnection, sldbState, string, value) {
+  eval(parse(text=sprintf("%s <- %s", string, value)), envir = globalenv())
+  TRUE
+}