From 16e6dc8f53a9ae9af754fae24cb83aa82f933229 Mon Sep 17 00:00:00 2001
From: Christophe Rhodes <csr21@cantab.net>
Date: Fri, 8 Oct 2010 10:12:38 +0100
Subject: [PATCH] srcrefs in swank:compile-string-for-emacs

Wow, this was hard.  parse() constructs a vector with mode
"expression", consisting of multiple, possibly nested calls.
Scattered throughout this structure are srcrefs with absolute
locations.  This means that we need to walk the parsed data structure
and adjust every srcref that we can find, giving it an offset based on
the location information passed to compile-string-for-emacs (which
requires bleeding-edge 2010-10-08 slime, because earlier versions
don't pass line/column information in the position argument).

But we can't simply adjust the "srcref" attribute on our parsed data
structure, because R tries very hard to be pure.  Instead we need to
return a copy with the right modifications (but preserving everything
else of importance).  It's straightforward once you know how, but
there were many painful missteps to get to this point.  Still, now
M-. works on function names assigned with C-c C-c in source buffers.
---
 BUGS.org |  2 +-
 swank.R  | 39 +++++++++++++++++++++++++++++++++++----
 2 files changed, 36 insertions(+), 5 deletions(-)

diff --git a/BUGS.org b/BUGS.org
index 6ce7ba0..7ebda44 100644
--- a/BUGS.org
+++ b/BUGS.org
@@ -10,7 +10,7 @@
 * OPEN #2 popping beyond inspector history crashes                   :NORMAL:
   Inspecting something and hitting =l= causes the R debugger to pop
   up from trying to send =NULL= in a sexp to Emacs.
-* OPEN #3 source reference in compile-string-for-emacs             :WISHLIST:
+* RESOLVED #3 source reference in compile-string-for-emacs   :WISHLIST:FIXED:
   It would be good if we could associate the expressions in the string
   with a reference to the corresponding source.  Unfortunately, emacs
   only passes the buffer position in bytes (or maybe characters),
diff --git a/swank.R b/swank.R
index 747696a..fa22d64 100644
--- a/swank.R
+++ b/swank.R
@@ -401,11 +401,42 @@ computeRestartsForEmacs <- function (sldbState) {
 }
 
 `swank:compile-string-for-emacs` <- function(slimeConnection, sldbState, string, buffer, position, filename, policy) {
-  # FIXME: I think in parse() here we can use srcref to associate
-  # buffer/filename/position to the objects.  Or something.
-  withRestarts({ times <- system.time(eval(parse(text=string), envir = globalenv())) },
+  lineOffset <- charOffset <- colOffset <- NULL
+  for(pos in position) {
+    switch(as.character(pos[[1]]),
+           `:position` = {charOffset <- pos[[2]]},
+           `:line` = {lineOffset <- pos[[2]]; colOffset <- pos[[3]]},
+           warning("unknown content in pos", pos))
+  }
+  frob <- function(refs) {
+    lapply(refs,
+           function(x)
+           srcref(attr(x,"srcfile"),
+                  c(x[1]+lineOffset-1, ifelse(x[1]==1, x[2]+colOffset-1, x[2]),
+                    x[3]+lineOffset-1, ifelse(x[3]==1, x[4]+colOffset-1, x[4]),
+                    ifelse(x[1]==1, x[5]+colOffset-1, x[5]),
+                    ifelse(x[3]==1, x[6]+colOffset-1, x[6]))))
+  }
+  transformSrcrefs <- function(s) {
+    srcrefs <- attr(s, "srcref")
+    attribs <- attributes(s)
+    new <- 
+      switch(mode(s),
+             "call"=as.call(lapply(s, transformSrcrefs)),
+             "expression"=as.expression(lapply(s, transformSrcrefs)),
+             s)
+    attributes(new) <- attribs
+    if(!is.null(attr(s, "srcref"))) {
+      attr(new, "srcref") <- frob(srcrefs)
+    }
+    new
+  }
+  withRestarts({
+    times <- system.time({
+      exprs <- parse(text=string, srcfile=srcfile(filename))
+      eval(transformSrcrefs(exprs), envir = globalenv()) })},
                abort="abort compilation")
-  list(quote(`:compilation-result`), list(), TRUE, times[3])
+  list(quote(`:compilation-result`), list(), TRUE, times[3], FALSE, FALSE)
 }
 
 withRetryRestart <- function(description, expr) {
-- 
2.30.2