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:
parent
a1df10f679
commit
23a3c82532
@ -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-")))
|
||||
|
@ -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)))
|
||||
|
@ -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)))
|
||||
|
@ -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)
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user