ndwarshuis
/
org-mode
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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/
This commit is contained in:
Matthew Trzcinski 2023-03-22 14:55:11 -04:00
parent 180c1c37a9
commit f7aa8c19f5
2 changed files with 95 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
lisp/ob-shell.el
View File

@ -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)

54
testing/lisp/test-ob-shell.el
View File

@ -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