Add options to skip extra processing in org-babel-comint-with-output

This patch adds options to org-babel-comint-with-output to skip prompt
removal.  Allowing individual languages to handle this cleanup can be
more robust than relying on the generic ob-comint implementation.
This allows ob-python to switch back to using
`org-babel-comint-with-output' rather than its own bespoke
reimplementation, reducing code duplication.  Furthermore, this adds a
new implementation of ob-R non-async session output evaluation, that
is similar to the ob-python approach in that it avoids leaking
prompts, rather than relying on the cleanup from
`org-babel-comint-with-output'.  A test is added to test-ob-R.el to
demonstrate the improved robustness of the new approach; previously,
this test would fail due to a false positive prompt, but now passes.

* lisp/ob-comint.el (org-babel-comint--remove-prompts-p): New helper
function to parse the prompt-handling argument in
`org-babel-comint-with-output' and `org-babel-comint-async-register'.
(org-babel-comint-with-output): Add a new argument
to prevent extra processing for prompt cleanup.  Also, search for the
end-of-execution sentinel within the collected output rather than the
comint buffer, which doesn't depend on the position of point during
evaluation.
(org-babel-comint-async-register): Move parsing of prompt-handling
argument to `org-babel-comint--remove-prompts-p'.
* lisp/ob-python.el: Require subr-x for Emacs 27 compatibility.
(org-babel-python-send-string): Switch to using
`org-babel-comint-with-output', rather than bespoke reimplementation.
* lisp/ob-R.el: Require subr-x for Emacs 27 compatibility.
(ess-send-string): Declare external function.
(org-babel-R-evaluate-session): New implementation of output
evaluation that avoids leaking prompts, by writing the code block to a
tmp file and then sourcing it.
* testing/lisp/test-ob-R.el (test-ob-r/session-output-with->-bol): New
test for robustness against false positive prompts at the beginning of
a line.
This commit is contained in:
Jack Kamm 2024-10-17 17:33:47 -07:00
parent cab233fb96
commit 3ff21c7138
5 changed files with 87 additions and 71 deletions

View File

@ -186,13 +186,13 @@ accept the INFO channel and return a string. This makes it possible
to dynamically generate the content of the resulting ~<head>~ tag in
the resulting HTML document.
*** ~org-babel-comint-async-register~: New optional argument controlling prompt handling
*** ob-comint: New optional arguments controlling prompt handling
The new argument ~prompt-handling~ allows Babel languages to specify
how prompts should be handled when passing output to
~org-babel-comint-async-chunk-callback~. If equal to
~filter-prompts~, prompts are removed beforehand, same as the
default behavior of ~org-babel-comint-with-output~. If equal to
The new argument ~prompt-handling~ in ~org-babel-comint-with-output~
and ~org-babel-comint-async-register~ allows Babel languages to
specify how prompts should be handled in comint output. If equal to
~filter-prompts~, prompts are removed from output before it is passed
on to language-specific processing. If equal to
~disable-prompt-filtering~, then the prompt filtering is skipped. If
unset, then the default behavior is the same as ~filter-prompts~ for
backwards compatibility.

View File

@ -35,6 +35,8 @@
(require 'cl-lib)
(require 'ob)
(require 'subr-x) ; For `string-trim-right', Emacs < 28
(declare-function orgtbl-to-tsv "org-table" (table params))
(declare-function run-ess-r "ext:ess-r-mode" (&optional start-args))
(declare-function inferior-ess-send-input "ext:ess-inf" ())
@ -42,6 +44,8 @@
(declare-function ess-eval-buffer "ext:ess-inf" (vis))
(declare-function ess-wait-for-process "ext:ess-inf"
(&optional proc sec-prompt wait force-redisplay))
(declare-function ess-send-string "ext:ess-inf"
(process string &optional visibly message type))
(defvar ess-current-process-name) ; ess-custom.el
(defvar ess-local-process-name) ; ess-custom.el
@ -448,26 +452,20 @@ last statement in BODY, as elisp."
(org-babel-import-elisp-from-file tmp-file '(16)))
column-names-p)))
(output
(mapconcat
'org-babel-chomp
(butlast
(delq nil
(mapcar
(lambda (line) (when (> (length line) 0) line))
(mapcar
(lambda (line) ;; cleanup extra prompts left in output
(if (string-match
"^\\([>+.]\\([ ][>.+]\\)*[ ]\\)"
(car (split-string line "\n")))
(substring line (match-end 1))
line))
(with-current-buffer session
(let ((comint-prompt-regexp (concat "^" comint-prompt-regexp)))
(org-babel-comint-with-output (session org-babel-R-eoe-output)
(insert (mapconcat 'org-babel-chomp
(list body org-babel-R-eoe-indicator)
"\n"))
(inferior-ess-send-input)))))))) "\n"))))
(let ((tmp-src-file (org-babel-temp-file "R-")))
(with-temp-file tmp-src-file
(insert (concat
(org-babel-chomp body) "\n" org-babel-R-eoe-indicator)))
(with-current-buffer session
(org-babel-chomp
(string-trim-right
(org-babel-comint-with-output
(session org-babel-R-eoe-output nil nil 'disable-prompt-filtering)
(ess-send-string (get-buffer-process (current-buffer))
(format "source('%s', echo=F, print.eval=T)"
(org-babel-process-file-name
tmp-src-file 'noquote))))
(rx (literal org-babel-R-eoe-output) (zero-or-more anychar)))))))))
(defun org-babel-R-process-value-result (result column-names-p)
"R-specific processing of return value.

View File

@ -101,15 +101,33 @@ PROMPT-REGEXP defaults to `comint-prompt-regexp'."
(setq string (substring string (match-end 0))))
string)
(defun org-babel-comint--remove-prompts-p (prompt-handling)
"Helper to decide whether to remove prompts from comint output.
Parses the symbol in PROMPT-HANDLING, which can be
`filter-prompts', in which case prompts should be removed; or
`disable-prompt-filtering', in which case prompt filtering is
skipped. For backward-compatibility, the default value of `nil'
is equivalent to `filter-prompts'."
(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)))))
(defmacro org-babel-comint-with-output (meta &rest body)
"Evaluate BODY in BUFFER and return process output.
Will wait until EOE-INDICATOR appears in the output, then return
all process output. If REMOVE-ECHO and FULL-BODY are present and
non-nil, then strip echo'd body from the returned output. META
should be a list containing the following where the last two
elements are optional.
non-nil, then strip echo'd body from the returned output.
PROMPT-HANDLING may be either of the symbols `filter-prompts', in
which case the output is split by `comint-prompt-regexp' and
returned as a list; or, `disable-prompt-filtering', which
suppresses this behavior and returns the full output as a string.
META should be a list containing the following where the last
three elements are optional.
(BUFFER EOE-INDICATOR REMOVE-ECHO FULL-BODY)
(BUFFER EOE-INDICATOR REMOVE-ECHO FULL-BODY PROMPT-HANDLING)
This macro ensures that the filter is removed in case of an error
or user `keyboard-quit' during execution of body."
@ -117,7 +135,8 @@ or user `keyboard-quit' during execution of body."
(let ((buffer (nth 0 meta))
(eoe-indicator (nth 1 meta))
(remove-echo (nth 2 meta))
(full-body (nth 3 meta)))
(full-body (nth 3 meta))
(prompt-handling (nth 4 meta)))
`(org-babel-comint-in-buffer ,buffer
(let* ((string-buffer "")
(comint-output-filter-functions
@ -125,7 +144,7 @@ or user `keyboard-quit' during execution of body."
(setq string-buffer (concat string-buffer text)))
comint-output-filter-functions))
dangling-text)
;; got located, and save dangling text
;; got located, and save dangling text
(goto-char (process-mark (get-buffer-process (current-buffer))))
(let ((start (point))
(end (point-max)))
@ -135,13 +154,11 @@ or user `keyboard-quit' during execution of body."
,@body
;; wait for end-of-evaluation indicator
(let ((start-time (current-time)))
(while (progn
(goto-char comint-last-input-end)
(not (save-excursion
(and (re-search-forward
(regexp-quote ,eoe-indicator) nil t)
(re-search-forward
comint-prompt-regexp nil t)))))
(while (not (save-excursion
(and (string-match
(regexp-quote ,eoe-indicator) string-buffer)
(string-match
comint-prompt-regexp string-buffer))))
(accept-process-output
(get-buffer-process (current-buffer))
org-babel-comint-fallback-regexp-threshold)
@ -152,21 +169,22 @@ or user `keyboard-quit' during execution of body."
(goto-char comint-last-input-end)
(save-excursion
(and
(re-search-forward
(regexp-quote ,eoe-indicator) nil t)
(re-search-forward
org-babel-comint-prompt-regexp-fallback nil t)))))
(string-match
(regexp-quote ,eoe-indicator) string-buffer)
(string-match
org-babel-comint-prompt-regexp-fallback string-buffer)))))
(org-babel-comint--set-fallback-prompt))))
;; replace cut dangling text
(goto-char (process-mark (get-buffer-process (current-buffer))))
(goto-char (process-mark (get-buffer-process (current-buffer))))
(insert dangling-text)
;; remove echo'd FULL-BODY from input
(and ,remove-echo ,full-body
(setq string-buffer (org-babel-comint--echo-filter string-buffer ,full-body)))
;; Filter out prompts.
(org-babel-comint--prompt-filter string-buffer)))))
(if (org-babel-comint--remove-prompts-p ,prompt-handling)
(org-babel-comint--prompt-filter string-buffer)
string-buffer)))))
(defun org-babel-comint-input-command (buffer cmd)
"Pass CMD to BUFFER.
@ -379,12 +397,7 @@ is equivalent to `filter-prompts'."
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)))))
(org-babel-comint--remove-prompts-p 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

@ -36,6 +36,8 @@
(require 'org-macs)
(require 'python)
(require 'subr-x) ; For `string-trim-right', Emacs < 28
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("python" . "py"))
@ -451,31 +453,22 @@ __org_babel_python_format_value(main(), '%s', %s)")
(defun org-babel-python-send-string (session body)
"Pass BODY to the Python process in SESSION.
Return output."
(with-current-buffer session
(let* ((string-buffer "")
(comint-output-filter-functions
(cons (lambda (text) (setq string-buffer
(concat string-buffer text)))
comint-output-filter-functions))
(body (format "\
(org-babel-chomp
(string-trim-right
(org-babel-comint-with-output
((org-babel-session-buffer:python session)
org-babel-python-eoe-indicator
nil nil 'disable-prompt-filtering)
(python-shell-send-string (format "\
try:
%s
except:
raise
finally:
print('%s')"
(org-babel-python--shift-right body 4)
org-babel-python-eoe-indicator)))
(let ((python-shell-buffer-name
(org-babel-python-without-earmuffs session)))
(python-shell-send-string body))
;; same as `python-shell-comint-end-of-output-p' in emacs-25.1+
(while (not (and (python-shell-comint-end-of-output-p string-buffer)
(string-match
org-babel-python-eoe-indicator
string-buffer)))
(accept-process-output (get-buffer-process (current-buffer))))
(org-babel-chomp (substring string-buffer 0 (match-beginning 0))))))
(org-babel-python--shift-right body 4)
org-babel-python-eoe-indicator)))
(rx (literal org-babel-python-eoe-indicator) (zero-or-more anychar)))))
(defun org-babel-python-evaluate-session
(session body &optional result-type result-params graphics-file)

View File

@ -126,6 +126,18 @@ x
))))
(ert-deftest test-ob-r/session-output-with->-bol ()
"make sure prompt-like strings are well formatted, even when at beginning of line."
(let (ess-ask-for-ess-directory ess-history-file)
(should (string="abc
def> <ghi"
(org-test-with-temp-text "#+begin_src R :results output :session R
cat(\"abc
def> <ghi\")
#+end_src
"
(org-babel-execute-src-block))
))))
;; (ert-deftest test-ob-r/output-with-error ()