From: Christophe Rhodes <csr21@cantab.net>
Date: Sat, 14 Aug 2010 20:55:14 +0000 (+0100)
Subject: The beginnings of a vaguely-useful sldb
X-Git-Url: http://christophe.rhodes.io/gitweb/?a=commitdiff_plain;h=f96797f439428627da5c5435a03ad8fb0828e5cb;p=swankr.git

The beginnings of a vaguely-useful sldb

Implement swank:frame-locals-and-catch-tags.  There are problems:

1. it seems that some names can be present in an environment but not have
   a value, causing eval to blow up;
2. the default printing routines aren't really adapted to the constraints
   of rendering in sldb;
3. trying to display locals of some of the swank frames (perhaps anything
   with a tryCatch or similar block?) causes R to complain about a promise
   already in the process of evaluation;
4. (probably) other things I haven't yet found
---

diff --git a/swank.R b/swank.R
index b5fd98c..b7c4df3 100644
--- a/swank.R
+++ b/swank.R
@@ -224,6 +224,14 @@ writeSexpToString <- function(obj) {
   writeSexpToStringLoop(obj)
 }
 
+printToString <- function(val) {
+  f <- fifo("")
+  sink(f)
+  print(val)
+  sink()
+  readLines(f)
+}
+
 `swank:connection-info` <- function (io, sldbState) {
   list(quote(`:pid`), Sys.getpid(),
        quote(`:package`), list(quote(`:name`), "R", quote(`:prompt`), "R> "),
@@ -242,12 +250,8 @@ writeSexpToString <- function(obj) {
 
 `swank:listener-eval` <- function(io, sldbState, string) {
   val <- eval(parse(text=string), envir = globalenv())
-  f <- fifo("")
-  sink(f)
-  print(val)
-  sink()
-  lines <- readLines(f)
-  list(quote(`:values`), paste(lines, collapse="\n"))
+  string <- printToString(val)
+  list(quote(`:values`), paste(string, collapse="\n"))
 }
 
 `swank:autodoc` <- function(io, sldbState, rawForm, ...) {
@@ -273,3 +277,13 @@ writeSexpToString <- function(obj) {
 `swank:buffer-first-change` <- function(io, sldbState, filename) {
   FALSE
 }
+
+`swank:frame-locals-and-catch-tags` <- function(io, sldbState, index) {
+  str(sldbState$frames)
+  frame <- sldbState$frames[[1+index]]
+  objs <- ls(envir=frame)
+  list(lapply(objs, function(name) { list(quote(`:name`), name,
+                                          quote(`:id`), 0,
+                                          quote(`:value`), paste(printToString(eval(parse(text=name), envir=frame)), sep="", collapse="\n")) }),
+       list())
+}