From 000b7ea1025a7f076c0af0b69d6a2a653c415b40 Mon Sep 17 00:00:00 2001 From: Jack Kamm Date: Sun, 22 Sep 2024 13:48:45 -0700 Subject: [PATCH] Disable async prompt removal in ob-R,python * lisp/ob-comint.el (org-babel-comint-async-remove-prompts-p): New variable to disable prompt removal in async output. (org-babel-comint-async-filter): Check `org-babel-comint-async-remove-prompts-p' before calling `org-babel-comint--prompt-filter'. (org-babel-comint-async-register): Added argument for whether prompts should be removed from async output. * lisp/ob-python.el (org-babel-python-async-evaluate-session): Set option to inhibit prompt removal when registering async evaluators. * lisp/ob-R.el (ob-session-async-org-babel-R-evaluate-session): Set option to inhibit prompt removal when registering async evaluators. * testing/lisp/test-ob-R.el (test-ob-R/async-prompt-filter): Test for over-aggressive prompt removal. --- lisp/ob-R.el | 3 ++- lisp/ob-comint.el | 34 ++++++++++++++++++++++++++++------ lisp/ob-python.el | 3 ++- testing/lisp/test-ob-R.el | 28 ++++++++++++++++++++++++++++ 4 files changed, 60 insertions(+), 8 deletions(-) diff --git a/lisp/ob-R.el b/lisp/ob-R.el index de2d27a9a..5a8dfe22c 100644 --- a/lisp/ob-R.el +++ b/lisp/ob-R.el @@ -486,7 +486,8 @@ (defun ob-session-async-org-babel-R-evaluate-session session (current-buffer) "^\\(?:[>.+] \\)*\\[1\\] \"ob_comint_async_R_\\(start\\|end\\|file\\)_\\(.+\\)\"$" 'org-babel-chomp - 'ob-session-async-R-value-callback) + 'ob-session-async-R-value-callback + 'disable-prompt-filtering) (cl-case result-type (value (let ((tmp-file (org-babel-temp-file "R-"))) diff --git a/lisp/ob-comint.el b/lisp/ob-comint.el index 764927af7..efec7badc 100644 --- a/lisp/ob-comint.el +++ b/lisp/ob-comint.el @@ -239,6 +239,9 @@ (defvar-local org-babel-comint-async-chunk-callback nil comint process. It should return a string that will be passed to `org-babel-insert-result'.") +(defvar-local org-babel-comint-async-remove-prompts-p t + "Whether prompts should be detected and removed from async output.") + (defvar-local org-babel-comint-async-dangling nil "Dangling piece of the last process output, as a string. Used when `org-babel-comint-async-indicator' is spread across multiple @@ -326,10 +329,16 @@ (defun org-babel-comint-async-filter (string) until (and (equal (match-string 1) "start") (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")) ;; Apply user callback - (res-str (funcall org-babel-comint-async-chunk-callback res-promptless))) + (res-str (funcall org-babel-comint-async-chunk-callback + (if org-babel-comint-async-remove-prompts-p + (org-trim (string-join + (mapcar #'org-trim + (org-babel-comint--prompt-filter + res-str-raw)) + "\n") + t) + res-str-raw)))) ;; Search for uuid in associated org-buffers to insert results (cl-loop for buf in org-buffers until (with-current-buffer buf @@ -350,18 +359,31 @@ (defun org-babel-comint-async-filter (string) (defun org-babel-comint-async-register (session-buffer org-buffer indicator-regexp - chunk-callback file-callback) + chunk-callback file-callback + &optional prompt-handling) "Set local org-babel-comint-async variables in SESSION-BUFFER. ORG-BUFFER is added to `org-babel-comint-async-buffers' if not present. `org-babel-comint-async-indicator', `org-babel-comint-async-chunk-callback', and `org-babel-comint-async-file-callback' are set to -INDICATOR-REGEXP, CHUNK-CALLBACK, and FILE-CALLBACK -respectively." +INDICATOR-REGEXP, CHUNK-CALLBACK, and FILE-CALLBACK respectively. +PROMPT-HANDLING may be either of the symbols `filter-prompts', in +which case prompts matching `comint-prompt-regexp' are filtered +from output before it is passed to CHUNK-CALLBACK, or +`disable-prompt-filtering', in which case this behavior is +disabled. For backward-compatibility, the default value of `nil' +is equivalent to `filter-prompts'." (org-babel-comint-in-buffer session-buffer (setq org-babel-comint-async-indicator indicator-regexp 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" + (symbol-name 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))) diff --git a/lisp/ob-python.el b/lisp/ob-python.el index 8a3c24f70..f41f44dbd 100644 --- a/lisp/ob-python.el +++ b/lisp/ob-python.el @@ -538,7 +538,8 @@ (defun org-babel-python-async-evaluate-session (org-babel-comint-async-register session (current-buffer) "ob_comint_async_python_\\(start\\|end\\|file\\)_\\(.+\\)" - 'org-babel-chomp 'org-babel-python-async-value-callback) + 'org-babel-chomp 'org-babel-python-async-value-callback + 'disable-prompt-filtering) (pcase result-type (`output (let ((uuid (org-id-uuid))) 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.2