From 11177e57f8a0c77b6c6541b852c5d105d70afec0 Mon Sep 17 00:00:00 2001 From: Jack Kamm 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[ ]+[ ]* +:\\([ ]+2\\)[ ]+1[ ]+2")) + (should (equal (length (match-string 1)) (length (match-string 2)))) + (kill-buffer session-name))))) (provide 'test-ob-R) -- 2.46.0