From c0cf8f539050f90b8406b9ae7fff6063fc6ecff4 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Sun, 23 Oct 2011 10:48:55 +0100 Subject: [PATCH 01/16] log a couple more bugs --- BUGS.org | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/BUGS.org b/BUGS.org index 57e12a0..07c38d0 100644 --- a/BUGS.org +++ b/BUGS.org @@ -48,12 +48,19 @@ * OPEN #13 source location in sldb wrong :MINOR: I think there's an off-by-one in the association between frames and srcrefs. Test case is something like 1+"foo" at the repl, and then - hitting "v" on the `swank:listener-eval` frame. + hitting "v" on the `swank:listener-eval` frame. Also the arglists + seem weird to me; in a call like frob(foo), I would expect to see + the value of foo in the locals. * OPEN #14 thread argument to emacsRex unused :NORMAL: This is a problem not least because it causes all sorts of problems in inspecting swank-internal frames in sldb; test case is 1+"foo", then RET on the eval(expr, envir, enclos) frame just below `swank:listener-eval`. +* OPEN #15 write and use Rd2org instead of Rd2txt :WISHLIST: + org-mode is the future! +* OPEN #16 ESS configuration :MINOR: + sorting out the function regexp at least, but generally reducing + dependence might be good. * COMMENT: Local Variables: mode: org; -- 2.30.2 From 040918c27d8b569b277e62a47efa860a65f5fcab Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Sun, 23 Oct 2011 10:50:16 +0100 Subject: [PATCH 02/16] fix swank-media repl-result-maker for complex There ought to be some way of catching this mistake, which is passing a non-length-1 vector to the swank functions, which then vectorise and confuse the event stream. --- swank-media.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/swank-media.R b/swank-media.R index 1d7071d..59f7d77 100644 --- a/swank-media.R +++ b/swank-media.R @@ -30,7 +30,7 @@ makeMediaReplResult.numeric <- function(value) { list(quote(`:write-string`), string, quote(`:repl-result`)) } makeMediaReplResult.complex <- function(value) { - string <- deparse(value) + string <- paste(deparse(value), sep="", collapse="\n") list(quote(`:write-string`), string, quote(`:repl-result`)) } -- 2.30.2 From 3ca13eb5110013cf2348b3a840eff3bc4ff0ec69 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Sun, 23 Oct 2011 10:51:33 +0100 Subject: [PATCH 03/16] fix for visible values from region and interactive eval editing thinko: need tmp$value (not just value) --- swank.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/swank.R b/swank.R index 0b48ed3..ce757b3 100644 --- a/swank.R +++ b/swank.R @@ -519,7 +519,7 @@ withRetryRestart <- function(description, expr) { envir=globalenv()))) }) output <- paste(output, sep="", collapse="\n") if(tmp$visible) { - list(output, prin1ToString(value)) + list(output, prin1ToString(tmp$value)) } else { list(output, "# invisible value") } @@ -529,7 +529,7 @@ withRetryRestart <- function(description, expr) { withRetryRestart("retry SLIME interactive evaluation request", tmp <- withVisible(eval(parse(text=string), envir=globalenv()))) if(tmp$visible) { - prin1ToString(value) + prin1ToString(tmp$value) } else { "# invisible value" } -- 2.30.2 From 2fcb575405fcfbe8736d0188fce113af39c43f40 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Sun, 23 Oct 2011 10:54:19 +0100 Subject: [PATCH 04/16] don't print out "locals" from the global environment This is important because e.g. the repl evaluation happens in the global environment, so errors on code called from the repl will pull up a backtrace with that evaluation frame, which can be inspected for locals. But printing out all the locals is a hugely expensive and not helpful thing to do. --- swank.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/swank.R b/swank.R index ce757b3..c50114a 100644 --- a/swank.R +++ b/swank.R @@ -423,6 +423,9 @@ computeRestartsForEmacs <- function (sldbState) { `swank:frame-locals-and-catch-tags` <- function(slimeConnection, sldbState, index) { frame <- sldbState$frames[[1+index]] objs <- ls(envir=frame) + if(identical(frame, globalenv())) { + objs <- c() + } list(lapply(objs, function(name) { list(quote(`:name`), name, quote(`:id`), 0, quote(`:value`), -- 2.30.2 From 240e662189985696b3dda3ce442caf30da0e21c3 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Fri, 9 Dec 2011 10:44:36 +0000 Subject: [PATCH 05/16] pass an :encoding stanza in the connection information MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit Allows slime-repl to start again. I've said "utf-8-unix" but that is almost certainly a lie; I have no real idea how R handles encodings of text. Simply passing in "ë" to the R slime repl breaks things without too much effort. --- swank.R | 1 + 1 file changed, 1 insertion(+) diff --git a/swank.R b/swank.R index c50114a..24393e6 100644 --- a/swank.R +++ b/swank.R @@ -287,6 +287,7 @@ printToString <- function(val) { `swank:connection-info` <- function (slimeConnection, sldbState) { list(quote(`:pid`), Sys.getpid(), quote(`:package`), list(quote(`:name`), "R", quote(`:prompt`), "R> "), + quote(`:encoding`), list(quote(`:coding-systems`), list("utf-8-unix")), quote(`:lisp-implementation`), list(quote(`:type`), "R", quote(`:name`), "R", quote(`:version`), paste(R.version$major, R.version$minor, sep="."))) -- 2.30.2 From 24c95f1122fb2f12aaea143c6f1a33704a6a441f Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Fri, 9 Dec 2011 10:49:13 +0000 Subject: [PATCH 06/16] log the external-format / encoding bug --- BUGS.org | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/BUGS.org b/BUGS.org index 07c38d0..f4c5bf1 100644 --- a/BUGS.org +++ b/BUGS.org @@ -61,6 +61,12 @@ * OPEN #16 ESS configuration :MINOR: sorting out the function regexp at least, but generally reducing dependence might be good. +* OPEN #17 encoding / external-format confusion :NORMAL: + We declare ourselves capable of handling utf-8-unix encoding, but + whether we actually do anything close to being correct is unclear. + (Almost certainly not; I suspect we naïvely use nchar() in places). + We could either declare our encoding as latin1-unix, or make the + server utf8ly correct. To reproduce, simply type "ë" at the repl. * COMMENT: Local Variables: mode: org; -- 2.30.2 From a46793d3e275c91add4a5235bf1d812668714629 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Fri, 9 Dec 2011 18:20:04 +0000 Subject: [PATCH 07/16] give us a chance with utf-8 Calculate the length of the output to emacs using nchar(type="bytes") This makes help files sort-of work again --- swank.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/swank.R b/swank.R index 24393e6..dea28cf 100644 --- a/swank.R +++ b/swank.R @@ -62,7 +62,7 @@ dispatch <- function(slimeConnection, event, sldbState=NULL) { sendToEmacs <- function(slimeConnection, obj) { io <- slimeConnection$io payload <- writeSexpToString(obj) - writeChar(sprintf("%06x", nchar(payload)), io, eos=NULL) + writeChar(sprintf("%06x", nchar(payload, type="bytes")), io, eos=NULL) writeChar(payload, io, eos=NULL) flush(io) } -- 2.30.2 From b5398e520cf5ce15811f323f3d48b68804b335c9 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Thu, 15 Dec 2011 21:13:57 +0000 Subject: [PATCH 08/16] log and fix bug #20: infinite errors on disconnect. Check for a zero-element character vector return from readChar. (This is not documented as the EOF return value, no, but it makes sense). Also commit bug reports #18 and #19, and some README rearrangement. --- BUGS.org | 7 +++++ README | 91 +++++++++++++++++++++++++++++++++++++------------------- swank.R | 8 ++++- 3 files changed, 75 insertions(+), 31 deletions(-) diff --git a/BUGS.org b/BUGS.org index f4c5bf1..46fcb4e 100644 --- a/BUGS.org +++ b/BUGS.org @@ -67,6 +67,13 @@ (Almost certainly not; I suspect we naïvely use nchar() in places). We could either declare our encoding as latin1-unix, or make the server utf8ly correct. To reproduce, simply type "ë" at the repl. +* OPEN #18 ess-help needs to be loaded automatically :MINOR: + to reproduce: in a fresh emacs, type ?help +* OPEN #19 base graphics don't work automatically :NORMAL: + They can be made to by passing --interactive to R on startup, but + I'm not sure what else that does. +* RESOLVED #20 closing the connection causes infinite R errors :IMPORTANT: + reported by "Philipp Marek" by private mail. * COMMENT: Local Variables: mode: org; diff --git a/README b/README index ce8005c..d7dc564 100644 --- a/README +++ b/README @@ -21,37 +21,39 @@ SLIME is to ILISP. At present, ESS mode remains active in R source buffers, providing font-locking functionality among other things. * Installation -** Running - To begin using swankr: - - 1. start R; - 2. load the swank.R file: -#+BEGIN_SRC R - source("swank.R") -#+END_SRC - 3. at the R prompt, run -#+BEGIN_SRC R - swank(); -#+END_SRC - 4. within emacs, load and initialize slime; -#+BEGIN_SRC emacs-lisp - (require 'slime) - (slime-setup '(slime-repl)) -#+END_SRC - 5. run =M-x slime-connect=, accepting the default host and port, - and acknowledging the protocol version mismatch. +** Emacs configuration +*** Installing SLIME + SLIME is required separately from swankr. To install slime, + perhaps the simplest is to pull the CVS sources into a + user-specific site directory, and arrange for that to be on the + emacs =load-path=; I did +#+begin_src sh +mkdir -p ~/.emacs.d/site-lisp +cd ~/.emacs.d/site-lisp +cvs -z3 -d:pserver:anonymous:anonymous@common-lisp.net:/project/slime/cvsroot co slime +#+end_src - At this point, an R REPL should appear. -** Emacs customization - At a minimum, slime needs to be set up to function. I've - used the following forms in my =~/.emacs= -#+BEGIN_SRC emacs-lisp - (require 'slime) - (slime-setup '(slime-repl slime-scratch slime-media)) -#+END_SRC - The =slime-media= contrib is new and (at present) R-specific, - allowing for image results to be embedded in the REPL. + Following that, I have in my =~/.emacs= (you will need to adjust + paths to executables and source files): +#+begin_src emacs-lisp +;;; ~/.emacs.d/ +(let ((default-directory (concat user-emacs-directory (convert-standard-filename "site-lisp/")))) + (normal-top-level-add-subdirs-to-load-path)) +;;; SLIME +(require 'slime) +(setq slime-net-coding-system 'utf-8-unix) +(slime-setup '(slime-asdf slime-repl slime-scratch slime-presentations slime-media)) +(setq slime-lisp-implementations + '((sbcl ("sbcl" "--dynamic-space-size" "2048" "--load" "/home/csr21/src/lisp/quicklisp/setup.lisp")) + (git-sbcl ("sh" "/home/csr21/src/lisp/sbcl/run-sbcl.sh" "--dynamic-space-size" "2048")) + (R ("R" "--no-save" "--max-vsize=4096M") + :init (lambda (port-filename coding-system) + (format + "source('/home/csr21/src/R/swankr/swank.R', keep.source=TRUE, chdir=TRUE)\nstartSwank('%s')\n" port-filename))))) +(global-set-key (kbd "s-s") 'slime-selector) +#+end_src +*** Additional refinements In addition, for keybindings like =C-c C-c= to work properly, emacs needs to be told how to guess where a function definition begins. This can be achieved with /e.g./ @@ -72,11 +74,40 @@ 1 font-lock-function-name-face t)) ess-R-mode-font-lock-keywords))) #+END_SRC +*** Running + After performing the installation steps above, =M-- M-x slime RET R + RET= should start swank. You will be prompted to accept a version + mismatch -- simply accept -- then the SLIME REPL should start up, + giving a prompt. Enjoy! +** Proof-of-concept (OBSOLETE) + [ The instructions here are for the seriously impatient, and do not + give as good an experience ] + + To begin using swankr: + + 1. start R; + 2. load the swank.R file: +#+BEGIN_SRC R + source("swank.R") +#+END_SRC + 3. at the R prompt, run +#+BEGIN_SRC R + swank(); +#+END_SRC + 4. within emacs, load and initialize slime; +#+BEGIN_SRC emacs-lisp + (require 'slime) + (slime-setup '(slime-repl slime-presentations slime-media)) +#+END_SRC + 5. run =M-x slime-connect=, accepting the default host and port, + and acknowledging the protocol version mismatch. + + At this point, an R REPL should appear. * Development swankr's primary development repository is a git repository, accessible through and - git://common-lisp.net/crhodes/swankr/swankr.git; a web view of the + git://common-lisp.net/users/crhodes/swankr.git; a web view of the development history is [[http://common-lisp.net/gitweb?p=users/crhodes/swankr.git][available through gitweb]]. You can also view the current lists of [[file:BUGS.org]] and [[file:TODO.org]] items. * Acknowledgments diff --git a/swank.R b/swank.R index dea28cf..2031184 100644 --- a/swank.R +++ b/swank.R @@ -33,9 +33,10 @@ acceptConnections <- function(port, portFile) { cat(port, file=f) close(f) } + ## FIXME: maybe we should support dontClose here? s <- socketConnection(host="localhost", server=TRUE, port=port, open="r+b") on.exit(close(s)) - serve(s) + tryCatch(serve(s), endOfFile=function(c) NULL) } serve <- function(io) { @@ -145,6 +146,11 @@ readPacket <- function(io) { readChunk <- function(io, len) { buffer <- readChar(io, len) + if(length(buffer) == 0) { + condition <- simpleCondition("End of file on io") + class(condition) <- c("endOfFile", class(condition)) + signalCondition(condition) + } if(nchar(buffer) != len) { stop("short read in readChunk") } -- 2.30.2 From 14bc3a0d5910b4c259a985048fe1671b298918c8 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Mon, 23 Apr 2012 11:17:55 +0100 Subject: [PATCH 09/16] log bug #21, regarding inspection of environments Reported by Philipp Marek --- BUGS.org | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/BUGS.org b/BUGS.org index 46fcb4e..7132a71 100644 --- a/BUGS.org +++ b/BUGS.org @@ -74,6 +74,11 @@ I'm not sure what else that does. * RESOLVED #20 closing the connection causes infinite R errors :IMPORTANT: reported by "Philipp Marek" by private mail. +* OPEN #21 inspecting an environment causes error in match() :MINOR: + reported by "Philipp Marek" by private mail. + + To reproduce, C-c I globalenv() RET, or hit RET on environment + presentations in the debugger (if presentations are on). * COMMENT: Local Variables: mode: org; -- 2.30.2 From 24bb738d87a1636b9b86850e14c59b608fe61fb9 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Mon, 23 Apr 2012 11:33:44 +0100 Subject: [PATCH 10/16] fix bug #21 %in% needs a `vector' first argument, so make it so, listifying anything that isn't already a vector. (Note: there seem to be plenty of non-vector first arguments that work, such as as.Date("2012-01-01"), which returns FALSE to is.vector() -- but the new code seems to get that right anyway, based on very limited testing. --- BUGS.org | 2 +- swank.R | 9 ++++++++- 2 files changed, 9 insertions(+), 2 deletions(-) diff --git a/BUGS.org b/BUGS.org index 7132a71..3976058 100644 --- a/BUGS.org +++ b/BUGS.org @@ -74,7 +74,7 @@ I'm not sure what else that does. * RESOLVED #20 closing the connection causes infinite R errors :IMPORTANT: reported by "Philipp Marek" by private mail. -* OPEN #21 inspecting an environment causes error in match() :MINOR: +* RESOLVED #21 inspecting an environment causes error in match() :MINOR: reported by "Philipp Marek" by private mail. To reproduce, C-c I globalenv() RET, or hit RET on environment diff --git a/swank.R b/swank.R index 2031184..d91c35f 100644 --- a/swank.R +++ b/swank.R @@ -601,12 +601,19 @@ resetInspector <- function(slimeConnection) { } inspectObject <- function(slimeConnection, object) { + vectorify <- function(x) { + if(is.vector(x)) { + x + } else { + list(x) + } + } previous <- slimeConnection$istate slimeConnection$istate <- new.env() slimeConnection$istate$object <- object slimeConnection$istate$previous <- previous slimeConnection$istate$content <- emacsInspect(object) - if(!(object %in% slimeConnection$inspectorHistory)) { + if(!(vectorify(object) %in% slimeConnection$inspectorHistory)) { slimeConnection$inspectorHistory <- c(slimeConnection$inspectorHistory, object) } if(!is.null(slimeConnection$istate$previous)) { -- 2.30.2 From f26811f35b41594dbbc6c6c53b0d09fd819c152d Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Tue, 24 Apr 2012 13:38:09 +0100 Subject: [PATCH 11/16] implement `swank:operator-arglist` properly Now that slime-operator-at-point is overrideable, I can even test this from within Emacs -- but thanks to Philipp Marek for implementing this in his SLIMV-based environment first. --- swank.R | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/swank.R b/swank.R index d91c35f..49f73ff 100644 --- a/swank.R +++ b/swank.R @@ -348,7 +348,16 @@ sendReplResultFunction <- sendReplResult } `swank:operator-arglist` <- function(slimeConnection, sldbState, op, package) { - list() + if(!exists(op, envir = globalenv())) { + return(list()) + } + funoid <- get(op, envir = globalenv()) + if(is.function(funoid)) { + args <- formals(funoid) + paste(sprintf("%s=%s", names(args), args), collapse=", ") + } else { + list() + } } `swank:throw-to-toplevel` <- function(slimeConnection, sldbState) { -- 2.30.2 From 2b90642449296fbb529321bb67ec50595e004b07 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Tue, 24 Apr 2012 13:39:47 +0100 Subject: [PATCH 12/16] declare a version in `swank:connection-info` Useful both for me, to track what slime version is most likely to be maximally compatible, and for SLIMV users, which dispatch on the version to know whether the protocol is byte-count-based or character-count-based. --- swank.R | 1 + 1 file changed, 1 insertion(+) diff --git a/swank.R b/swank.R index 49f73ff..979bd84 100644 --- a/swank.R +++ b/swank.R @@ -293,6 +293,7 @@ printToString <- function(val) { `swank:connection-info` <- function (slimeConnection, sldbState) { list(quote(`:pid`), Sys.getpid(), quote(`:package`), list(quote(`:name`), "R", quote(`:prompt`), "R> "), + quote(`:version`), "2012-04-23", quote(`:encoding`), list(quote(`:coding-systems`), list("utf-8-unix")), quote(`:lisp-implementation`), list(quote(`:type`), "R", quote(`:name`), "R", -- 2.30.2 From 62734d710ea398ec55611c61f9a28cd8f0638522 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Sun, 29 Apr 2012 14:11:48 +0100 Subject: [PATCH 13/16] log wishlist completion bug Also note some other bugs as fixed. --- BUGS.org | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/BUGS.org b/BUGS.org index 3976058..31743fd 100644 --- a/BUGS.org +++ b/BUGS.org @@ -72,13 +72,17 @@ * OPEN #19 base graphics don't work automatically :NORMAL: They can be made to by passing --interactive to R on startup, but I'm not sure what else that does. -* RESOLVED #20 closing the connection causes infinite R errors :IMPORTANT: +* RESOLVED #20 closing the connection causes infinite R errors :IMPORTANT:FIXED: reported by "Philipp Marek" by private mail. -* RESOLVED #21 inspecting an environment causes error in match() :MINOR: +* RESOLVED #21 inspecting an environment causes error in match() :MINOR:FIXED: reported by "Philipp Marek" by private mail. To reproduce, C-c I globalenv() RET, or hit RET on environment presentations in the debugger (if presentations are on). +* OPEN #22 completion of named list fields :WISHLIST: + It is very nice in ESS to be able to type df$ TAB and get a + completion list of the data frame's columns. Supporting it in + swankr should be really easy. * COMMENT: Local Variables: mode: org; -- 2.30.2 From f198b5e4bf8b550c1401ea248f28a515eb3182e1 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Sun, 29 Apr 2012 14:15:22 +0100 Subject: [PATCH 14/16] rework `swank:simple-completions` In the process, implement looking up foo$bar$baz, and passing those completions back. It's not completely robust to somewhat exotic syntax, as it assumes that the text being completed can be used directly as character vectors naming objects or fields; it is good enough to get started, and now a lot less annoying to use (particularly when lots of fields have underscores in them...) --- BUGS.org | 2 +- swank.R | 38 +++++++++++++++++++++++++++++++------- 2 files changed, 32 insertions(+), 8 deletions(-) diff --git a/BUGS.org b/BUGS.org index 31743fd..3e65f0a 100644 --- a/BUGS.org +++ b/BUGS.org @@ -79,7 +79,7 @@ To reproduce, C-c I globalenv() RET, or hit RET on environment presentations in the debugger (if presentations are on). -* OPEN #22 completion of named list fields :WISHLIST: +* RESOLVED #22 completion of named list fields :WISHLIST:FIXED: It is very nice in ESS to be able to type df$ TAB and get a completion list of the data frame's columns. Supporting it in swankr should be really easy. diff --git a/swank.R b/swank.R index 979bd84..3b1f3d7 100644 --- a/swank.R +++ b/swank.R @@ -455,20 +455,44 @@ computeRestartsForEmacs <- function (sldbState) { } `swank:simple-completions` <- function(slimeConnection, sldbState, prefix, package) { + symbolFieldsCompletion <- function(object, rest) { + ## FIXME: this is hacky, ignoring several syntax issues (use of + ## and/or necessity for backquoting identifiers: e.g. fields + ## containing hyphens) + if((dollar <- regexpr("$", rest, fixed=TRUE)) == -1) { + matches <- grep(sprintf("^%s", literal2rx(rest)), names(object), value=TRUE) + matches <- sprintf("%s$%s", gsub("\\$[^$]*$", "", prefix), matches) + returnMatches(matches) + } else { + if(exists(substr(rest, 1, dollar-1), object)) { + symbolFieldsCompletion(get(substr(rest, 1, dollar-1), object), substr(rest, dollar+1, nchar(rest))) + } else { + returnMatches(character(0)) + } + } + } + returnMatches <- function(matches) { + nmatches <- length(matches) + if(nmatches == 0) { + list(list(), "") + } else { + longest <- matches[order(nchar(matches))][1] + while(length(grep(sprintf("^%s", literal2rx(longest)), matches)) < nmatches) { + longest <- substr(longest, 1, nchar(longest)-1) + } + list(as.list(matches), longest) + } + } literal2rx <- function(string) { ## list of ERE metacharacters from ?regexp gsub("([.\\|()[{^$*+?])", "\\\\\\1", string) } matches <- apropos(sprintf("^%s", literal2rx(prefix)), ignore.case=FALSE) nmatches <- length(matches) - if(nmatches == 0) { - list(list(), "") + if((nmatches == 0) && ((dollar <- regexpr("$", prefix, fixed=TRUE)) > -1)) { + symbolFieldsCompletion(globalenv(), prefix) } else { - longest <- matches[order(nchar(matches))][1] - while(length(grep(sprintf("^%s", literal2rx(longest)), matches)) < nmatches) { - longest <- substr(longest, 1, nchar(longest)-1) - } - list(as.list(matches), longest) + returnMatches(matches) } } -- 2.30.2 From 3bf571b71b14d5d953c84b0158e5d25a60663083 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Tue, 1 May 2012 15:20:25 +0100 Subject: [PATCH 15/16] make inspector printing more reasonable I don't yet know what's right, but it's fairly nonsensical to have "[1] " prepending every label and value, so use prin1ToString --- swank.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/swank.R b/swank.R index 3b1f3d7..5968629 100644 --- a/swank.R +++ b/swank.R @@ -658,7 +658,7 @@ inspectObject <- function(slimeConnection, object) { valuePart <- function(istate, object, string) { list(quote(`:value`), - if(is.null(string)) printToString(object) else string, + if(is.null(string)) prin1ToString(object) else string, assignIndexInParts(object, istate)) } @@ -669,7 +669,7 @@ preparePart <- function(istate, part) { switch(as.character(part[[1]]), `:newline` = list("\n"), `:value` = valuePart(istate, part[[2]], part[[3]]), - `:line` = list(printToString(part[[2]]), ": ", + `:line` = list(prin1ToString(part[[2]]), ": ", valuePart(istate, part[[3]], NULL), "\n")) } } -- 2.30.2 From cfbfd5bbd369242017802df89fb51afa97744b48 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Tue, 1 May 2012 15:20:55 +0100 Subject: [PATCH 16/16] some elisp code that slime/swankr users probably want Should try to find out how to have it loaded automatically --- swankr.el | 13 +++++++++++++ 1 file changed, 13 insertions(+) create mode 100644 swankr.el diff --git a/swankr.el b/swankr.el new file mode 100644 index 0000000..9ddeeab --- /dev/null +++ b/swankr.el @@ -0,0 +1,13 @@ +(require 'ess-help) + +(defun swankr-operator-before-point () + (ignore-errors + (save-excursion + (backward-up-list 1) + (slime-symbol-at-point)))) + +(add-hook 'R-mode-hook + (defun swankr/R-mode-hook () + (slime-mode 1) + (set (make-local-variable 'slime-operator-before-point-function) 'swankr-operator-before-point) + (local-set-key (kbd "(") 'slime-space))) -- 2.30.2