lisp/ob-R: Async evaluation in R

* lisp/ob-R.el (ob-session-async-R-indicator): Add constant
representing a prefix R to identity session.
(ob-session-async-org-babel-R-evaluate-session): New function to
evaluate R src block asynchrously.
(ob-session-async-R-value-callback): New function that calls back
the result of the asynchronous evaluation.
(org-babel-R-evaluate): Add `async' parameter and call
`ob-session-async-org-babel-R-evaluate-session' if `async'
parameter is present.
(org-babel-execute:R): Call `org-babel-comint-use-async' to check
if async is among `params' and add async parameter to
`org-babel-R-evaluate'.

* testing/lisp/test-ob-R.el: Add 7 more tests for async
evaluations, also taken from the `ob-session-async' package.

This is almost a carbon copy of Jack Kamm's `ob-session-async'.
The original source code can be found
https://github.com/jackkamm/ob-session-async.

Please refer to the following thread to trace back the discussion
on async evaluation in R:

https://list.orgmode.org/87eed9g9p6.fsf@gmail.com/

lisp/ob-R.el

@@ -158,6 +158,7 @@ This function is called by `org-babel-execute-src-block'."
   (save-excursion
     (let* ((result-params (cdr (assq :result-params params)))
 	   (result-type (cdr (assq :result-type params)))
+           (async (org-babel-comint-use-async params))
            (session (org-babel-R-initiate-session
 		     (cdr (assq :session params)) params))
 	   (graphics-file (and (member "graphics" (assq :result-params params))
@@ -184,7 +185,8 @@ This function is called by `org-babel-execute-src-block'."
 		  (cdr (assq :colname-names params)) colnames-p))
 	     (or (equal "yes" rownames-p)
 		 (org-babel-pick-name
-		  (cdr (assq :rowname-names params)) rownames-p)))))
+		  (cdr (assq :rowname-names params)) rownames-p))
+             async)))
       (if graphics-file nil result))))
 
 (defun org-babel-prep-session:R (session params)
@@ -371,11 +373,14 @@ Has four %s escapes to be filled in:
 4. The name of the file to write to")
 
 (defun org-babel-R-evaluate
-  (session body result-type result-params column-names-p row-names-p)
+  (session body result-type result-params column-names-p row-names-p async)
   "Evaluate R code in BODY."
   (if session
+      (if async
+          (ob-session-async-org-babel-R-evaluate-session
+           session body result-type result-params column-names-p row-names-p)
       (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))
     (org-babel-R-evaluate-external-process
      body result-type result-params column-names-p row-names-p)))
 
@@ -468,6 +473,85 @@ Insert hline if column names in output have been requested."
 	(error "Could not parse R result"))
     result))
 
+
+;;; async evaluation
+
+(defconst ob-session-async-R-indicator "'ob_comint_async_R_%s_%s'")
+
+(defun ob-session-async-org-babel-R-evaluate-session
+    (session body result-type result-params column-names-p row-names-p)
+  "Asynchronously evaluate BODY in SESSION.
+Returns a placeholder string for insertion, to later be replaced
+by `org-babel-comint-async-filter'."
+  (org-babel-comint-async-register
+   session (current-buffer)
+   "^\\(?:[>.+] \\)*\\[1\\] \"ob_comint_async_R_\\(.+?\\)_\\(.+\\)\"$"
+   'org-babel-chomp
+   'ob-session-async-R-value-callback)
+  (cl-case result-type
+    (value
+     (let ((tmp-file (org-babel-temp-file "R-")))
+       (with-temp-buffer
+         (insert
+          (org-babel-chomp body))
+         (let ((ess-local-process-name
+                (process-name (get-buffer-process session))))
+           (ess-eval-buffer nil)))
+       (with-temp-buffer
+	 (insert
+	  (mapconcat
+           'org-babel-chomp
+           (list (format org-babel-R-write-object-command
+                         (if row-names-p "TRUE" "FALSE")
+                         (if column-names-p
+                             (if row-names-p "NA" "TRUE")
+                           "FALSE")
+                         ".Last.value"
+                         (org-babel-process-file-name tmp-file 'noquote))
+                 (format ob-session-async-R-indicator
+                         "file" tmp-file))
+           "\n"))
+	 (let ((ess-local-process-name
+		(process-name (get-buffer-process session))))
+	   (ess-eval-buffer nil)))
+       tmp-file))
+    (output
+     (let ((uuid (md5 (number-to-string (random 100000000))))
+           (ess-local-process-name
+            (process-name (get-buffer-process session))))
+       (with-temp-buffer
+         (insert (format ob-session-async-R-indicator
+					  "start" uuid))
+         (insert "\n")
+         (insert body)
+         (insert "\n")
+         (insert (format ob-session-async-R-indicator
+					  "end" uuid))
+         (ess-eval-buffer nil))
+       uuid))))
+
+(defun ob-session-async-R-value-callback (params tmp-file)
+  "Callback for async value results.
+Assigned locally to `ob-session-async-file-callback' in R
+comint buffers used for asynchronous Babel evaluation."
+  (let* ((graphics-file (and (member "graphics" (assq :result-params params))
+			     (org-babel-graphical-output-file params)))
+	 (colnames-p (unless graphics-file (cdr (assq :colnames params)))))
+    (org-babel-R-process-value-result
+     (org-babel-result-cond (assq :result-params params)
+       (with-temp-buffer
+         (insert-file-contents tmp-file)
+         (org-babel-chomp (buffer-string) "\n"))
+       (org-babel-import-elisp-from-file tmp-file '(16)))
+     (or (equal "yes" colnames-p)
+	 (org-babel-pick-name
+	  (cdr (assq :colname-names params)) colnames-p)))))
+
+
+
+;;; ob-session-async-R.el ends here
+
+
 (provide 'ob-R)
 
 ;;; ob-R.el ends here

testing/lisp/test-ob-R.el

@@ -117,6 +117,8 @@ x
 ))))
 
 
+
+
 ;; (ert-deftest test-ob-r/output-with-error ()
 ;;   "make sure angle brackets are well formatted"
 ;;     (let (ess-ask-for-ess-directory ess-history-file)
@@ -151,6 +153,98 @@ log10(10)
 #+end_src"     
   (org-babel-execute-src-block))))))
 
+
+(ert-deftest ob-session-async-R-simple-session-async-value ()
+  (let (ess-ask-for-ess-directory
+        ess-history-file
+        (org-babel-temporary-directory "/tmp")
+        (org-confirm-babel-evaluate nil))
+    (org-test-with-temp-text
+     "#+begin_src R :session R :async yes\n  Sys.sleep(.1)\n  paste(\"Yep!\")\n#+end_src\n"
+     (should (let ((expected "Yep!"))
+	       (and (not (string= expected (org-babel-execute-src-block)))
+		    (string= expected
+			     (progn
+			       (sleep-for 0 200)
+			       (goto-char (org-babel-where-is-src-block-result))
+			       (org-babel-read-result)))))))))
+
+(ert-deftest ob-session-async-R-simple-session-async-output ()
+  (let (ess-ask-for-ess-directory
+        ess-history-file
+        (org-babel-temporary-directory "/tmp")
+        (org-confirm-babel-evaluate nil))
+    (org-test-with-temp-text
+     "#+begin_src R :session R :results output :async yes\n  Sys.sleep(.1)\n  1:5\n#+end_src\n"
+     (should (let ((expected "[1] 1 2 3 4 5"))
+	       (and (not (string= expected (org-babel-execute-src-block)))
+		    (string= expected
+			     (progn
+			       (sleep-for 0 200)
+			       (goto-char (org-babel-where-is-src-block-result))
+			       (org-babel-read-result)))))))))
+
+(ert-deftest ob-session-async-R-named-output ()
+  (let (ess-ask-for-ess-directory
+        ess-history-file
+        (org-babel-temporary-directory "/tmp")
+        org-confirm-babel-evaluate
+        (src-block "#+begin_src R :async :session R :results output\n  1:5\n#+end_src")
+        (results-before "\n\n#+NAME: foobar\n#+RESULTS:\n: [1] 1")
+        (results-after "\n\n#+NAME: foobar\n#+RESULTS:\n: [1] 1 2 3 4 5\n"))
+    (org-test-with-temp-text
+     (concat src-block results-before)
+     (should (progn (org-babel-execute-src-block)
+                    (sleep-for 0 200)
+                    (string= (concat src-block results-after)
+                             (buffer-string)))))))
+
+(ert-deftest ob-session-async-R-named-value ()
+  (let (ess-ask-for-ess-directory
+        ess-history-file
+        org-confirm-babel-evaluate
+        (org-babel-temporary-directory "/tmp")
+        (src-block "#+begin_src R :async :session R :results value\n  paste(\"Yep!\")\n#+end_src")
+        (results-before "\n\n#+NAME: foobar\n#+RESULTS:\n: [1] 1")
+        (results-after "\n\n#+NAME: foobar\n#+RESULTS:\n: Yep!\n"))
+    (org-test-with-temp-text
+     (concat src-block results-before)
+     (should (progn (org-babel-execute-src-block)
+                    (sleep-for 0 200)
+                    (string= (concat src-block results-after)
+                             (buffer-string)))))))
+
+(ert-deftest ob-session-async-R-output-drawer ()
+  (let (ess-ask-for-ess-directory
+        ess-history-file
+        org-confirm-babel-evaluate
+        (org-babel-temporary-directory "/tmp")
+        (src-block "#+begin_src R :async :session R :results output drawer\n  1:5\n#+end_src")
+        (result "\n\n#+RESULTS:\n:results:\n[1] 1 2 3 4 5\n:end:\n"))
+    (org-test-with-temp-text
+     src-block
+     (should (progn (org-babel-execute-src-block)
+                    (sleep-for 0 200)
+                    (string= (concat src-block result)
+                             (buffer-string)))))))
+
+(ert-deftest ob-session-async-R-value-drawer ()
+  (let (ess-ask-for-ess-directory
+        ess-history-file
+        org-confirm-babel-evaluate
+        (org-babel-temporary-directory "/tmp")
+        (src-block "#+begin_src R :async :session R :results value drawer\n  1:3\n#+end_src")
+        (result "\n\n#+RESULTS:\n:results:\n1\n2\n3\n:end:\n"))
+    (org-test-with-temp-text
+     src-block
+     (should (progn (org-babel-execute-src-block)
+                    (sleep-for 0 200)
+                    (string= (concat src-block result)
+                             (buffer-string)))))))
+
+
+
+
 (provide 'test-ob-R)
 
 ;;; test-ob-R.el ends here