1
0
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2024-11-21 06:55:35 +00:00

Disable async prompt removal in ob-R,python

* lisp/ob-comint.el (org-babel-comint-async-remove-prompts-p): New
variable to disable prompt removal in async output.
(org-babel-comint-async-filter): Check
`org-babel-comint-async-remove-prompts-p' before calling
`org-babel-comint--prompt-filter'.
(org-babel-comint-async-register): Added argument for whether prompts
should be removed from async output.
* lisp/ob-python.el (org-babel-python-async-evaluate-session): Set
option to inhibit prompt removal when registering async evaluators.
* lisp/ob-R.el (ob-session-async-org-babel-R-evaluate-session): Set
option to inhibit prompt removal when registering async evaluators.
* testing/lisp/test-ob-R.el (test-ob-R/async-prompt-filter): Test for
over-aggressive prompt removal.
This commit is contained in:
Jack Kamm 2024-09-22 13:48:45 -07:00
parent a1df10f679
commit 23a3c82532
4 changed files with 60 additions and 8 deletions

View File

@ -486,7 +486,8 @@ by `org-babel-comint-async-filter'."
session (current-buffer)
"^\\(?:[>.+] \\)*\\[1\\] \"ob_comint_async_R_\\(start\\|end\\|file\\)_\\(.+\\)\"$"
'org-babel-chomp
'ob-session-async-R-value-callback)
'ob-session-async-R-value-callback
'disable-prompt-filtering)
(cl-case result-type
(value
(let ((tmp-file (org-babel-temp-file "R-")))

View File

@ -239,6 +239,9 @@ Its single argument is a string consisting of output from the
comint process. It should return a string that will be passed
to `org-babel-insert-result'.")
(defvar-local org-babel-comint-async-remove-prompts-p t
"Whether prompts should be detected and removed from async output.")
(defvar-local org-babel-comint-async-dangling nil
"Dangling piece of the last process output, as a string.
Used when `org-babel-comint-async-indicator' is spread across multiple
@ -326,10 +329,16 @@ STRING contains the output originally inserted into the comint buffer."
until (and (equal (match-string 1) "start")
(equal (match-string 2) uuid))
finally return (+ 1 (match-end 0)))))
;; Remove prompt
(res-promptless (org-trim (string-join (mapcar #'org-trim (org-babel-comint--prompt-filter res-str-raw)) "\n") "\n"))
;; Apply user callback
(res-str (funcall org-babel-comint-async-chunk-callback res-promptless)))
(res-str (funcall org-babel-comint-async-chunk-callback
(if org-babel-comint-async-remove-prompts-p
(org-trim (string-join
(mapcar #'org-trim
(org-babel-comint--prompt-filter
res-str-raw))
"\n")
t)
res-str-raw))))
;; Search for uuid in associated org-buffers to insert results
(cl-loop for buf in org-buffers
until (with-current-buffer buf
@ -350,18 +359,31 @@ STRING contains the output originally inserted into the comint buffer."
(defun org-babel-comint-async-register
(session-buffer org-buffer indicator-regexp
chunk-callback file-callback)
chunk-callback file-callback
&optional prompt-handling)
"Set local org-babel-comint-async variables in SESSION-BUFFER.
ORG-BUFFER is added to `org-babel-comint-async-buffers' if not
present. `org-babel-comint-async-indicator',
`org-babel-comint-async-chunk-callback', and
`org-babel-comint-async-file-callback' are set to
INDICATOR-REGEXP, CHUNK-CALLBACK, and FILE-CALLBACK
respectively."
INDICATOR-REGEXP, CHUNK-CALLBACK, and FILE-CALLBACK respectively.
PROMPT-HANDLING may be either of the symbols `filter-prompts', in
which case prompts matching `comint-prompt-regexp' are filtered
from output before it is passed to CHUNK-CALLBACK, or
`disable-prompt-filtering', in which case this behavior is
disabled. For backward-compatibility, the default value of `nil'
is equivalent to `filter-prompts'."
(org-babel-comint-in-buffer session-buffer
(setq org-babel-comint-async-indicator indicator-regexp
org-babel-comint-async-chunk-callback chunk-callback
org-babel-comint-async-file-callback file-callback)
(setq org-babel-comint-async-remove-prompts-p
(cond
((eq prompt-handling 'disable-prompt-filtering) nil)
((eq prompt-handling 'filter-prompts) t)
((eq prompt-handling nil) t)
(t (error (format "Unrecognized prompt handling behavior %s"
prompt-handling)))))
(unless (memq org-buffer org-babel-comint-async-buffers)
(setq org-babel-comint-async-buffers
(cons org-buffer org-babel-comint-async-buffers)))

View File

@ -538,7 +538,8 @@ by `org-babel-comint-async-filter'."
(org-babel-comint-async-register
session (current-buffer)
"ob_comint_async_python_\\(start\\|end\\|file\\)_\\(.+\\)"
'org-babel-chomp 'org-babel-python-async-value-callback)
'org-babel-chomp 'org-babel-python-async-value-callback
'disable-prompt-filtering)
(pcase result-type
(`output
(let ((uuid (org-id-uuid)))

View File

@ -316,6 +316,34 @@ x
(string= (concat text result)
(buffer-string)))))))
(ert-deftest test-ob-R/async-prompt-filter ()
"Test that async evaluation doesn't remove spurious prompts and leading indentation."
(let* (ess-ask-for-ess-directory
ess-history-file
org-confirm-babel-evaluate
(session-name "*R:test-ob-R/session-async-results*")
(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 R :session " session-name " :async t :results output
table(c('ab','ab','c',NA,NA), useNA='always')
#+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)
(when (should (re-search-forward "\
:\\([ ]+ab\\)[ ]+c[ ]+<NA>[ ]*
:\\([ ]+2\\)[ ]+1[ ]+2"))
(should (equal (length (match-string 1)) (length (match-string 2))))
(kill-buffer session-name)))))
(provide 'test-ob-R)