[PATCH] Async sessions: Fix prompt removal regression in ob-R

[Jack Kamm <jackkamm@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 1520 bytes --]

Consider the following R block, which prints the occurrences of each
element in a list, including NAs:

#+begin_src R :session :results output :async
  table(c("ab","ab","c",NA,NA), useNA='always')
#+end_src

#+RESULTS:
:   ab    c <NA> 
:    2    1    2

Since Org 9.7, it instead prints:

#+RESULTS:
: ab    c <
: 2    1    2

The regression happens in commit:

e9c288dfaccc2960e5b6889e6aabea700ad4e05a

which made the prompt filtering more consistent between
`org-babel-comint-with-output' and `org-babel-comint-async-filter'.
However, it causes ob-R async session blocks to be over-aggressive in
removing the prompt.

Note that non-async ob-R blocks don't suffer from this problem,
because ob-R let-binds `comint-prompt-regexp' around
`org-babel-comint-with-output' (specifically, it adds a
beginning-of-line at the front of the regexp). However, I don't see a
good way to let-bind this around `org-babel-comint-async-filter'.

The best solution I could think of was to define a new buffer-local
variable, `org-babel-comint-prompt-regexp-override', which could be used
to override `comint-prompt-regexp' for the purpose of filtering. I
attach a patch with this solution.

Additionally, the regression causes causes misalignment of the output
due to removal of indentation. The fix for this is simpler, and
involves replacing a call of `org-trim' with `org-babel-chomp'.

I'm not sure if my patch is the best solution. But whatever solution
we arrive at, I would like to request that it be applied to bugfix
branch.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-ob-R-Fix-over-aggressive-async-prompt-removal.patch --]
[-- Type: text/x-patch, Size: 6494 bytes --]

From 11177e57f8a0c77b6c6541b852c5d105d70afec0 Mon Sep 17 00:00:00 2001
From: Jack Kamm <jackkamm@gmail.com>
Date: Sun, 22 Sep 2024 13:48:45 -0700
Subject: [PATCH] ob-R: Fix over-aggressive async prompt removal

* lisp/ob-comint.el (org-babel-comint-prompt-regexp-override): New
variable to override `comint-prompt-regexp' in
`org-babel-comint--prompt-filter'.
(org-babel-comint-async-filter):  Replace `org-trim' with
`org-babel-chomp' to avoid removing leading indentation.
* lisp/ob-R.el (org-babel-R-evaluate): Set
`org-babel-comint-regexp-override' in session evaluation.
(org-babel-R-evaluate-session): Remove let binding of
`comint-prompt-regexp', since `org-babel-comint-regexp-override' is
now set.
* testing/lisp/test-ob-R.el (test-ob-R/async-prompt-filter): Test for
over-aggressive prompt removal.
---
 lisp/ob-R.el              | 25 ++++++++++++++-----------
 lisp/ob-comint.el         | 18 +++++++++++++++---
 testing/lisp/test-ob-R.el | 28 ++++++++++++++++++++++++++++
 3 files changed, 57 insertions(+), 14 deletions(-)

diff --git a/lisp/ob-R.el b/lisp/ob-R.el
index de2d27a9a..a9a58d0e4 100644
--- a/lisp/ob-R.el
+++ b/lisp/ob-R.el
@@ -375,11 +375,15 @@ (defun org-babel-R-evaluate
     (session body result-type result-params column-names-p row-names-p async)
   "Evaluate R code in BODY."
   (if session
-      (if async
-          (ob-session-async-org-babel-R-evaluate-session
-           session body result-type column-names-p row-names-p)
-        (org-babel-R-evaluate-session
-         session body result-type result-params column-names-p row-names-p))
+      (progn
+        (with-current-buffer session
+          (setq org-babel-comint-prompt-regexp-override
+                (concat "^" comint-prompt-regexp)))
+        (if async
+            (ob-session-async-org-babel-R-evaluate-session
+             session body result-type column-names-p row-names-p)
+          (org-babel-R-evaluate-session
+           session body result-type result-params column-names-p row-names-p)))
     (org-babel-R-evaluate-external-process
      body result-type result-params column-names-p row-names-p)))
 
@@ -456,12 +460,11 @@ (defun org-babel-R-evaluate-session
 		     (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"))))
+		 (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"))))
 
 (defun org-babel-R-process-value-result (result column-names-p)
   "R-specific processing of return value.
diff --git a/lisp/ob-comint.el b/lisp/ob-comint.el
index 764927af7..7f1686035 100644
--- a/lisp/ob-comint.el
+++ b/lisp/ob-comint.el
@@ -75,11 +75,17 @@ (defun org-babel-comint--set-fallback-prompt ()
       (setq comint-prompt-regexp org-babel-comint-prompt-regexp-old
             org-babel-comint-prompt-regexp-old tmp))))
 
+(defvar-local org-babel-comint-prompt-regexp-override nil
+  "Overrides `comint-prompt-regexp' in `org-babel-comint--prompt-filter.'")
+
 (defun org-babel-comint--prompt-filter (string &optional prompt-regexp)
   "Remove PROMPT-REGEXP from STRING.
 
-PROMPT-REGEXP defaults to `comint-prompt-regexp'."
-  (let* ((prompt-regexp (or prompt-regexp comint-prompt-regexp))
+PROMPT-REGEXP defaults to `comint-prompt-regexp', which can be
+overridden with `org-babel-comint-prompt-regexp-override'."
+  (let* ((prompt-regexp (or prompt-regexp
+                            org-babel-comint-prompt-regexp-override
+                            comint-prompt-regexp))
          ;; We need newline in case if we do progressive replacement
          ;; of agglomerated comint prompts with `comint-prompt-regexp'
          ;; containing ^.
@@ -327,7 +333,13 @@ (defun org-babel-comint-async-filter (string)
 				 (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"))
+                   (res-promptless
+                    (org-trim (string-join
+                               (mapcar #'org-babel-chomp
+                                       (org-babel-comint--prompt-filter
+                                        res-str-raw))
+                               "\n")
+                              t))
 		   ;; Apply user callback
 		   (res-str (funcall org-babel-comint-async-chunk-callback res-promptless)))
 	      ;; Search for uuid in associated org-buffers to insert results
diff --git a/testing/lisp/test-ob-R.el b/testing/lisp/test-ob-R.el
index 9ffbf3afd..05b91afd6 100644
--- a/testing/lisp/test-ob-R.el
+++ b/testing/lisp/test-ob-R.el
@@ -316,6 +316,34 @@ (org-test-with-temp-text-in-file
             (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)
 
-- 
2.46.0