Hi Chuck,

Attached is a new version of the patch, including a few more tests.  I
have one question:

2014ko abuztuak 28an, Aaron Ecay-ek idatzi zuen:
>> but the patch here uses on.exit(file.create(...)) to ensure that that
>> file is created. One hiccup (not sure if it exists in master,too) is
>> that starting a remote session and then trying to run src blocks from
>> a buffer for a local file will hang (because a local temp file is used
>> for sentinel). So there is still stuff to do.
> 
> Hmm, OK.

Can you give a recipe to reproduce this?  Everything seems to work for
me using the following test code, although there is an unexplained ~10s
delay while babel sits in the ‘(while (not (file-exists-p file)) ...)’
loop at the end of ‘org-babel-comint-eval-invisibly-and-wait-for-file’.
,----
| #+name: foo
| #+begin_src R :session *foo* :dir /ssh:aecay@foo:/home/aecay :results output
|   1+1
| #+end_src
| 
| #+RESULTS: foo
| : [1] 2
`----

Thanks,

-- 
Aaron Ecay
>From 65aa82b71e709250717896ab9bc85bf144a8ee30 Mon Sep 17 00:00:00 2001
From: Aaron Ecay <aarone...@gmail.com>
Date: Sat, 16 Aug 2014 00:49:05 -0400
Subject: [PATCH] ob-R: overhaul handling of :output results type in a session
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* lisp/ob-R.el (org-babel-R-check-evaluate-package): New function.
(org-babel-R-initiate-session): Use it.
(org-babel-R-evaluate-session): Use the evaluate package to capture
session output.

This uses the “evaluate” R package[1] to capture the
output (incl. warnings, errors, and messages) from a babel R session.
This avoids the output showing up in the session buffer, and dodges
some previous issues with removing R prompts (>) when scraping the
output from the session buffer.

Thanks to Charles C. Berry for assistance with this code.

[1] <http://cran.r-project.org/web/packages/evaluate/index.html>
---
 lisp/ob-R.el              | 73 +++++++++++++++++++++++++++++++++++------------
 testing/lisp/test-ob-R.el | 61 +++++++++++++++++++++++++++++++++++++++
 2 files changed, 115 insertions(+), 19 deletions(-)

diff --git a/lisp/ob-R.el b/lisp/ob-R.el
index 41b943c..81b3290 100644
--- a/lisp/ob-R.el
+++ b/lisp/ob-R.el
@@ -245,6 +245,22 @@ This function is called by `org-babel-execute-src-block'."
 	  ((stringp  value) (format "%s <- %S" name (org-no-properties value)))
 	  (t                (format "%s <- %S" name (prin1-to-string value))))))
 
+(defvar ess-execute-in-process-buffer)
+(defun org-babel-R-check-evaluate-package (&optional recursive)
+  (save-window-excursion
+    (let ((ess-execute-in-process-buffer nil)
+	  (r-buff (current-buffer)))
+      (ess-execute "library(evaluate)" nil "org-babel-R-auto")
+      (when (with-current-buffer "*org-babel-R-auto*"
+	      (goto-char (point-min))
+	      (search-forward "Error" nil t))
+	(if (and (not recursive)
+		 (y-or-n-p "Cannot load the evaluate package required for babel session support, would you like to install it from CRAN?"))
+	    (progn
+	      (message "Downloading and installing package (may take some time)")
+	      (ess-execute "install.packages(\"evaluate\")" nil "org-babel-R-auto")
+	      (org-babel-R-check-evaluate-package t))
+	  (user-error "R package evaluate is required, but not available."))))))
 
 (defvar ess-ask-for-ess-directory) ; dynamically scoped
 (defun org-babel-R-initiate-session (session params)
@@ -261,7 +277,9 @@ This function is called by `org-babel-execute-src-block'."
 	  (when (get-buffer session)
 	    ;; Session buffer exists, but with dead process
 	    (set-buffer session))
-	  (require 'ess) (R)
+	  (require 'ess)
+	  (R)
+	  (org-babel-R-check-evaluate-package)
 	  (rename-buffer
 	   (if (bufferp session)
 	       (buffer-name session)
@@ -365,8 +383,27 @@ last statement in BODY, as elisp."
 
 (defvar ess-eval-visibly-p)
 
+(defconst org-babel-R-session-cmd
+  "local({
+      on.exit(file.create(%S))
+      sink(%S)
+      withCallingHandlers(
+          replay(
+              Filter(Negate(is.source),
+                     evaluate(%S, envir=parent.frame(2), new_device = FALSE,
+                              stop_on_error = 0L))),
+          message = function (x) {
+              cat(x$message);
+              invokeRestart(\"muffleMessage\")
+          },
+          error = function (e) {
+              cat(e$message)
+          })
+      sink()})"
+"format string for an `R :session :results output' regime.")
+
 (defun org-babel-R-evaluate-session
-  (session body result-type result-params column-names-p row-names-p)
+    (session body result-type result-params column-names-p row-names-p)
   "Evaluate BODY in SESSION.
 If RESULT-TYPE equals 'output then return standard output as a
 string.  If RESULT-TYPE equals 'value then return the value of the
@@ -396,23 +433,21 @@ last statement in BODY, as elisp."
 	  (org-babel-import-elisp-from-file tmp-file '(16)))
 	column-names-p)))
     (output
-     (mapconcat
-      'org-babel-chomp
-      (butlast
-       (delq nil
-	     (mapcar
-	      (lambda (line) (when (> (length line) 0) line))
-	      (mapcar
-	       (lambda (line) ;; cleanup extra prompts left in output
-		 (if (string-match
-		      "^\\([ ]*[>+\\.][ ]?\\)+\\([[0-9]+\\|[ ]\\)" line)
-		     (substring line (match-end 1))
-		   line))
-	       (org-babel-comint-with-output (session org-babel-R-eoe-output)
-		 (insert (mapconcat 'org-babel-chomp
-				    (list body org-babel-R-eoe-indicator)
-				    "\n"))
-		 (inferior-ess-send-input)))))) "\n"))))
+     (let* ((output-file (org-babel-temp-file "R-"))
+	    (sentinel-file (concat output-file "-sentinel")))
+       (org-babel-comint-eval-invisibly-and-wait-for-file
+	session sentinel-file
+	(format
+	 org-babel-R-session-cmd
+	 (org-babel-local-file-name sentinel-file)
+	 (org-babel-local-file-name output-file)
+	 (org-babel-chomp body)))
+       (with-temp-buffer
+	 (insert-file-contents output-file)
+	 (goto-char (point-min))
+	 (flush-lines "^$")
+	 (delete-trailing-whitespace)
+	 (buffer-string))))))
 
 (defun org-babel-R-process-value-result (result column-names-p)
   "R-specific processing of return value.
diff --git a/testing/lisp/test-ob-R.el b/testing/lisp/test-ob-R.el
index e3f13f1..3d7ebef 100644
--- a/testing/lisp/test-ob-R.el
+++ b/testing/lisp/test-ob-R.el
@@ -79,6 +79,67 @@ x
     (should (equal '(("col") ("a") ("b"))
 		   (org-babel-execute-src-block)))))
 
+(ert-deftest test-ob-R/session-output ()
+  (org-test-with-temp-text "#+begin_src R :results output :session *foo*
+  1
+  message(\"hi\")
+  2
+  warning(\"hi2\")
+  3
+  stop(\"hi3\")
+  4
+#+end_src
+"
+			   (should (string= (org-babel-execute-src-block)
+					    "[1] 1
+hi
+[1] 2
+Warning message:
+hi2
+[1] 3
+Error: hi3
+[1] 4"))))
+
+(ert-deftest test-ob-R/session-output-stray-open-paren ()
+  (org-test-with-temp-text "#+begin_src R :results output :session *foo*
+  (
+#+end_src
+"
+			   (should (string= (org-babel-execute-src-block)
+					    "<text>:2:0: unexpected end of input
+1: (
+   ^"))))
+
+(ert-deftest test-ob-R/session-output-stray-close-paren ()
+  (org-test-with-temp-text "#+begin_src R :results output :session *foo*
+  )
+#+end_src
+"
+			   (should (string= (org-babel-execute-src-block)
+					    "<text>:1:1: unexpected ')'
+1: )
+    ^"))))
+
+(ert-deftest test-ob-R/session-output-stray-single-quote ()
+  (org-test-with-temp-text "#+begin_src R :results output :session *foo*
+  '
+#+end_src
+"
+			   (should (string= (org-babel-execute-src-block)
+					    "<text>:1:1: unexpected INCOMPLETE_STRING
+1: '
+    ^"))))
+
+(ert-deftest test-ob-R/session-output-stray-dbl-quote ()
+  (org-test-with-temp-text "#+begin_src R :results output :session *foo*
+  \"
+#+end_src
+"
+			   (should (string= (org-babel-execute-src-block)
+					    "<text>:1:1: unexpected INCOMPLETE_STRING
+1: \"
+    ^"))))
+
 (provide 'test-ob-R)
 
 ;;; test-ob-R.el ends here
-- 
2.1.0

Reply via email to