From: Christophe Rhodes <csr21@cantab.net>
Date: Tue, 7 Sep 2010 07:27:59 +0000 (+0100)
Subject: implement withOutputToString
X-Git-Url: http://christophe.rhodes.io/gitweb/?a=commitdiff_plain;h=277c935e6f2d9f32bcd0786a71cf4b02e094f4d6;p=swankr.git

implement withOutputToString

Possibly, anyway.  I think the semantics are right.  Use it in
printToString and in swank:eval-and-grab-output.
---

diff --git a/swank.R b/swank.R
index 488ad56..a826c7a 100644
--- 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> "),
@@ -412,15 +415,11 @@ computeRestartsForEmacs <- function (sldbState) {
 `swank:eval-and-grab-output` <- function(slimeConnection, sldbState, string) {
   retry <- TRUE
   value <- ""
-  output <- NULL
-  f <- fifo("")
-  tryCatch({
-    sink(f)
-    while(retry) {
+  output <-
+    withOutputToString(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)})
+                   retry=list(description="retry SLIME interactive evaluation request", handler=function() retry <<- TRUE))})
   list(output, printToString(value))
 }