From ea99c10d148f71e5384144728a5714ecc5ae47ca Mon Sep 17 00:00:00 2001
From: Aaron Ecay <aaronecay@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.

[1] <http://cran.r-project.org/web/packages/evaluate/index.html>
---
 lisp/ob-R.el | 68 +++++++++++++++++++++++++++++++++++++++++++-----------------
 1 file changed, 49 insertions(+), 19 deletions(-)

diff --git a/lisp/ob-R.el b/lisp/ob-R.el
index 41b943c..08ef9c2 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)
@@ -366,7 +384,7 @@ last statement in BODY, as elisp."
 (defvar ess-eval-visibly-p)
 
 (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 +414,35 @@ 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
+"
+tryCatch(.org.eval.result <- evaluate(%S, new_device = FALSE, stop_on_error = 0L),
+         finally = {
+             capture.output(
+                 withCallingHandlers(
+                     replay(Filter(function (x) !inherits(x, \"source\"),
+                                   .org.eval.result)),
+                     message = function (x) {
+                         cat(x$message);
+                         invokeRestart(\"muffleMessage\")
+                     }),
+                 file=%S)
+             file.create(%S)
+         })
+"
+		(org-babel-chomp body)
+		output-file
+		sentinel-file))
+       (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.
-- 
2.0.4