[elpa] externals/org f7aa8c19f5 4/4: ob-shell.el: Add async evaluation

[ELPA Syncer]

branch: externals/org
commit f7aa8c19f5170dbf09538686fb569f9b60acbd6c
Author: Matthew Trzcinski <matt@excalamus.com>
Commit: Matthew Trzcinski <matt@excalamus.com>

    ob-shell.el: Add async evaluation
    
    * ob-shell.el (org-babel-sh-evaluate): Add condition for async within
    session.  Allow :async header argument to be either t or blank.
    
    * test-ob-shell.el:
    (test-ob-shell/session-async-valid-header-arg-values): Check that
    :async header works for both t and blank values.
    (test-ob-shell/session-async-inserts-uuid-before-results-are-returned):
    Check that UUID is used as placeholder until results return.
    (test-ob-shell/session-async-evaluation): Check that asynchronously
    evaluated results are eventually placed in the buffer.
    
    Link: 
https://list.orgmode.org/186283d230a.129f5feb61660123.3289004102603503414@excalamus.com/
---
 lisp/ob-shell.el              | 54 ++++++++++++++++++++++++++++++++-----------
 testing/lisp/test-ob-shell.el | 54 +++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 95 insertions(+), 13 deletions(-)

diff --git a/lisp/ob-shell.el b/lisp/ob-shell.el
index 9e7b45a891..340c79abe0 100644
--- a/lisp/ob-shell.el
+++ b/lisp/ob-shell.el
@@ -269,12 +269,22 @@ var of the same value."
            (set-marker comint-last-output-start (point))
            (get-buffer (current-buffer)))))))
 
+(defconst ob-shell-async-indicator "echo 'ob_comint_async_shell_%s_%s'"
+  "Session output delimiter template.
+See `org-babel-comint-async-indicator'.")
+
+(defun ob-shell-async-chunk-callback (string)
+  "Filter applied to results before insertion.
+See `org-babel-comint-async-chunk-callback'."
+  (replace-regexp-in-string comint-prompt-regexp "" string))
+
 (defun org-babel-sh-evaluate (session body &optional params stdin cmdline)
   "Pass BODY to the Shell process in BUFFER.
 If RESULT-TYPE equals `output' then return a list of the outputs
 of the statements in BODY, if RESULT-TYPE equals `value' then
 return the value of the last statement in BODY."
   (let* ((shebang (cdr (assq :shebang params)))
+         (async (org-babel-comint-use-async params))
         (results-params (cdr (assq :result-params params)))
         (value-is-exit-status
          (or (and
@@ -306,19 +316,37 @@ return the value of the last statement in BODY."
                                 (concat (file-local-name script-file)  " " 
cmdline)))))
                (buffer-string))))
           (session                     ; session evaluation
-           (mapconcat
-            #'org-babel-sh-strip-weird-long-prompt
-            (mapcar
-             #'org-trim
-             (butlast ; Remove eoe indicator
-              (org-babel-comint-with-output
-                  (session org-babel-sh-eoe-output t body)
-                 (insert (org-trim body) "\n"
-                         org-babel-sh-eoe-indicator)
-                (comint-send-input nil t))
-               ;; Remove `org-babel-sh-eoe-indicator' output line.
-              1))
-            "\n"))
+            (if async
+                (progn
+                  (let ((uuid (org-id-uuid)))
+                    (org-babel-comint-async-register
+                     session
+                     (current-buffer)
+                     "ob_comint_async_shell_\\(.+\\)_\\(.+\\)"
+                     'ob-shell-async-chunk-callback
+                     nil)
+                    (org-babel-comint-async-delete-dangling-and-eval
+                        session
+                      (insert (format ob-shell-async-indicator "start" uuid))
+                      (comint-send-input nil t)
+                      (insert (org-trim body))
+                      (comint-send-input nil t)
+                      (insert (format ob-shell-async-indicator "end" uuid))
+                      (comint-send-input nil t))
+                    uuid))
+             (mapconcat
+              #'org-babel-sh-strip-weird-long-prompt
+              (mapcar
+               #'org-trim
+               (butlast ; Remove eoe indicator
+                (org-babel-comint-with-output
+                    (session org-babel-sh-eoe-output t body)
+                   (insert (org-trim body) "\n"
+                           org-babel-sh-eoe-indicator)
+                  (comint-send-input nil t))
+                 ;; Remove `org-babel-sh-eoe-indicator' output line.
+                1))
+              "\n")))
           ;; External shell script, with or without a predefined
           ;; shebang.
           ((org-string-nw-p shebang)
diff --git a/testing/lisp/test-ob-shell.el b/testing/lisp/test-ob-shell.el
index 8366f9dbee..879555af0a 100644
--- a/testing/lisp/test-ob-shell.el
+++ b/testing/lisp/test-ob-shell.el
@@ -27,6 +27,7 @@
 ;;; Requirements:
 
 (require 'ob-core)
+(require 'org-macs)
 
 (unless (featurep 'ob-shell)
   (signal 'missing-test-dependency "Support for Shell code blocks"))
@@ -75,6 +76,59 @@ the body of the tangled block does."
     (if (should (equal '((1) (2)) result))
         (kill-buffer session-name))))
 
+(ert-deftest test-ob-shell/session-async-valid-header-arg-values ()
+  "Test that session runs asynchronously for certain :async values."
+  (let ((session-name "test-ob-shell/session-async-valid-header-arg-values")
+        (kill-buffer-query-functions nil))
+    (dolist (arg-val '("t" ""))
+     (org-test-with-temp-text
+         (concat "#+begin_src sh :session " session-name " :async " arg-val "
+echo 1<point>
+#+end_src")
+       (if (should
+            (string-match
+             org-uuid-regexp
+             (org-trim (org-babel-execute-src-block))))
+           (kill-buffer session-name))))))
+
+(ert-deftest 
test-ob-shell/session-async-inserts-uuid-before-results-are-returned ()
+  "Test that a uuid placeholder is inserted before results are inserted."
+  (let ((session-name 
"test-ob-shell/session-async-inserts-uuid-before-results-are-returned")
+        (kill-buffer-query-functions nil))
+    (org-test-with-temp-text
+        (concat "#+begin_src sh :session " session-name " :async t
+echo 1<point>
+#+end_src")
+      (if (should
+           (string-match
+            org-uuid-regexp
+            (org-trim (org-babel-execute-src-block))))
+          (kill-buffer session-name)))))
+
+(ert-deftest test-ob-shell/session-async-evaluation ()
+  "Test the async evaluation process."
+  (let* ((session-name "test-ob-shell/session-async-evaluation")
+         (kill-buffer-query-functions nil)
+         (start-time (current-time))
+         (wait-time (time-add start-time 3))
+         uuid-placeholder)
+    (org-test-with-temp-text
+        (concat "#+begin_src sh :session " session-name " :async t
+echo 1
+echo 2<point>
+#+end_src")
+      (setq uuid-placeholder (org-trim (org-babel-execute-src-block)))
+      (catch 'too-long
+        (while (string-match uuid-placeholder (buffer-string))
+          (progn
+            (sleep-for 0.01)
+            (when (time-less-p wait-time (current-time))
+              (throw 'too-long (ert-fail "Took too long to get result from 
callback"))))))
+    (search-forward "#+results")
+    (beginning-of-line 2)
+    (if (should (string= ": 1\n: 2\n" (buffer-substring-no-properties (point) 
(point-max))))
+          (kill-buffer session-name)))))
+
 (ert-deftest test-ob-shell/generic-uses-no-arrays ()
   "Test generic serialization of array into a single string."
   (org-test-with-temp-text