mirror of
https://git.savannah.gnu.org/git/emacs/org-mode.git
synced 2024-11-21 06:55:35 +00:00
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
parent
cab233fb96
commit
3ff21c7138
12
etc/ORG-NEWS
12
etc/ORG-NEWS
@ -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.
|
||||
|
||||
38
lisp/ob-R.el
38
lisp/ob-R.el
@ -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.
|
||||
|
||||
@ -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)))
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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 ()
|
||||
|
||||
Loading…
Reference in New Issue
Block a user