From 65aa82b71e709250717896ab9bc85bf144a8ee30 Mon Sep 17 00:00:00 2001 From: Aaron Ecay 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] --- 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) + ":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) + ":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) + ":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) + ":1:1: unexpected INCOMPLETE_STRING +1: \" + ^")))) + (provide 'test-ob-R) ;;; test-ob-R.el ends here -- 2.1.0