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.
2024-11-21 06:55:35 +00:00 · 2024-10-17 17:33:47 -07:00 · 2024-10-17 17:33:47 -07:00 · 3ff21c7138
commit 3ff21c7138
parent cab233fb96
5 changed files with 87 additions and 71 deletions
--- a/etc/ORG-NEWS
+++ b/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.
--- a/lisp/ob-R.el
+++ b/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.
--- a/lisp/ob-comint.el
+++ b/lisp/ob-comint.el
@ -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)))
--- a/lisp/ob-python.el
+++ b/lisp/ob-python.el
@ -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)
--- a/testing/lisp/test-ob-R.el
+++ b/testing/lisp/test-ob-R.el
@ -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 ()