Hi Jack,
Jack Kamm <jackk...@gmail.com> writes:
> Bruno Barbier <brubar...@gmail.com> writes:
>
>> I'm not using it with official org backends (yet). I'm using it with
>> several custom backends that I'm working on. One of the backend
>> delegate the block executions to emacs subprocesses: so I have a kind of
>> asynchronous executions for free for any language, including elisp
>> itself.
>
> For sessions, wouldn't running in a subprocess prevent the user from
> directly interacting with the REPL outside of Org?
Good point. The REPL should be created in the same subprocess; the
REPL display and interaction must happen in the user main emacs. If
the REPL is based on comint, it should be relatively easy to
implement.
> If so, that's a problem. Org-babel sessions need to play nicely with
> inferior Python, inferior ESS, and other interactive comint modes.
With this solution, the user and the REPL/execution will be in
separate processes; so there will be disavantages. For basic
interactions, mostly based on text input/output, it should work well.
>> So, here we go. You'll find attach a set of patchs. It works for me with
>> Emacsc 30.50 and 9.7-pre (from today).
>
> I suggest to keep these patches on a public branch somewhere, see:
> https://orgmode.org/worg/org-contribute.html#patches
>
> "When discussing important changes, it is sometimes not so useful to
> send long and/or numerous patches.
>
> In this case, you can maintain your changes on a public branch of a
> public clone of Org and send a link to the diff between your changes
> and the latest Org commit that sits in your clone."
Good point. I'll switch to such a solution as soon as possible.
> I tried running your example on emacs29 using
>
> emacs -q -L /path/to/org-mode/lisp my-async-tests.org
>
> but it fails with the error below. Also "make" gives a bunch of
> compilation warnings (which I've put at the bottom).
> ...
My bad: I should have compiled the demo code in a standalone emacs.
I forgot to require some libraries: cl-lib and org-id.
I've now tested with your command line (thanks). It should now
work. Sorry about that.
> Finally here are the warnings when running "make":
I should have fixed everything; no more (new) warnings.
Thanks!
Please find attached the new set of patchs. I'll switch to using a
clone and a branch soon, in case if you prefer to wait.
Thanks again!
Bruno
>From f67829454ac0d3cd142da1bd0006efa37acce588 Mon Sep 17 00:00:00 2001
From: Bruno BARBIER <brubar...@gmail.com>
Date: Fri, 16 Feb 2024 14:31:36 +0100
Subject: [PATCH 1/8] ob-core async: Add faces [1/5]
lisp/org-faces.el (org-async-scheduled, org-async-pending,
org-async-failure): new faces
---
lisp/org-faces.el | 18 ++++++++++++++++++
1 file changed, 18 insertions(+)
diff --git a/lisp/org-faces.el b/lisp/org-faces.el
index 0e20de51a..5a8a8fd51 100644
--- a/lisp/org-faces.el
+++ b/lisp/org-faces.el
@@ -736,6 +736,24 @@ (defface org-mode-line-clock-overrun
"Face used for clock display for overrun tasks in mode line."
:group 'org-faces)
+(defface org-async-scheduled '((t :inherit org-tag :background "gray"))
+ "Face for babel results for code blocks that are scheduled for execution."
+ :group 'org-faces
+ :version "27.2"
+ :package-version '(Org . "9.5"))
+
+(defface org-async-pending '((t :inherit org-checkbox :background "dark orange"))
+ "Face for babel results for code blocks that are running."
+ :group 'org-faces
+ :version "27.2"
+ :package-version '(Org . "9.5"))
+
+(defface org-async-failure '((t :inherit org-warning))
+ "Face for babel results for code blocks that have failed."
+ :group 'org-faces
+ :version "27.2"
+ :package-version '(Org . "9.5"))
+
(provide 'org-faces)
;;; org-faces.el ends here
--
2.43.0
>From 9f135bd5e8e153323bed5a3274851fa78f246b83 Mon Sep 17 00:00:00 2001
From: Bruno BARBIER <brubar...@gmail.com>
Date: Fri, 16 Feb 2024 14:32:00 +0100
Subject: [PATCH 2/8] ob-core async: Add org-babel--async tools [2/5]
---
lisp/ob-core.el | 213 ++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 213 insertions(+)
diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index bfeac257b..d98626fe8 100644
--- a/lisp/ob-core.el
+++ b/lisp/ob-core.el
@@ -792,6 +792,219 @@ (defun org-babel-session-buffer (&optional info)
(when (org-babel-comint-buffer-livep buffer-name)
buffer-name)))
+(defun org-babel--async-status-face (status)
+ (pcase status
+ (:scheduled 'org-async-scheduled)
+ (:pending 'org-async-pending)
+ (:failure 'org-async-failure)
+ (:success nil)
+ (_ (error "Not a status"))
+ ))
+
+(defun org-babel--async-make-overlay (beg end)
+ "Create an overlay between positions BEG and END and return it."
+ (let ((overlay (make-overlay beg end))
+ (read-only
+ (list
+ (lambda (&rest _)
+ (user-error
+ "Cannot modify an area being updated"))))
+ )
+ (cl-flet ((make-read-only
+ (ovl)
+ (overlay-put ovl 'modification-hooks read-only)
+ (overlay-put ovl 'insert-in-front-hooks read-only)
+ (overlay-put ovl 'insert-behind-hooks read-only))
+ )
+ (overlay-put overlay 'org-babel--async-type 'org-babel--async-note)
+ (overlay-put overlay 'face 'secondary-selection)
+ (overlay-put overlay 'help-echo "Pending src block result...")
+ (make-read-only overlay)
+ overlay)))
+
+(defun org-babel--async-result-region (inline-elem &optional info)
+ "Return the region of the results, for the source block at point."
+ (unless info (setq info (org-babel-get-src-block-info)))
+ (save-excursion
+ (when-let ((res-begin (org-babel-where-is-src-block-result nil info)))
+ (cons res-begin
+ (save-excursion
+ (goto-char res-begin)
+ (if inline-elem
+ ;; Logic copy/pasted from org-babel-where-is-src-block-result.
+ (let ((result (org-element-context)))
+ (and (org-element-type-p result 'macro)
+ (string= (org-element-property :key result)
+ "results")
+ (progn
+ (goto-char (org-element-end result))
+ (skip-chars-backward " \t")
+ (point))))
+ ;; Logic copy/pasted from hide-result
+ (beginning-of-line)
+ (let ((case-fold-search t))
+ (unless (re-search-forward org-babel-result-regexp nil t)
+ (error "Not looking at a result line")))
+ (org-babel-result-end)
+ ))))))
+
+(defun org-babel--async-feedbacks (info handle-result
+ result-params exec-start-time)
+ "Flag the result as \='scheduled\=' and return how to handle feedbacks.
+
+Use overlays to report progress and status to the user. Do not delete
+the existing result unless a new one is available. When the result is
+available, remove the async overlays and insert the result as usual,
+like for a synchronous result. In case of failure, use an overlay to
+report the error.
+
+The returned function handles 3 types of feedbacks:
+ - (:success R): Evaluation is successful; result is R.
+ - (:failure ERR): Evaluation failed; error is ERR.
+ - (:pending P): Outcome still pending; current progress is P."
+ ;; FIXME: INFO CMD ... Nothing is used but handle-result here !!
+ (let (;; copy/pasted from org-babel-insert-result
+ (inline-elem (let ((context (org-element-context)))
+ (and (memq (org-element-type context)
+ '(inline-babel-call inline-src-block))
+ context))))
+ (cl-labels
+ ((eot-point (start)
+ "Move to End Of Title after START"
+ (if inline-elem
+ (org-element-end inline-elem)
+ (save-excursion (goto-char start)
+ (forward-line 1) (point))))
+ (after-indent (pt)
+ "Move after indentation, starting at PT."
+ (save-excursion (goto-char pt) (re-search-forward "[[:blank:]]*")))
+ (mk-result-overlays ()
+ ;; Make 2 overlays to handle the pending result: one title
+ ;; (first line) and one for the body.
+ (pcase-let ((`(,start . ,end) (org-babel--async-result-region
+ inline-elem info)))
+ (let ((anchor-end (eot-point start)))
+ (cons (org-babel--async-make-overlay
+ (after-indent start)
+ (1- anchor-end))
+ (org-babel--async-make-overlay
+ anchor-end end)))))
+ (add-style (status txt)
+ ;; Add the style matching STATUS over the text TXT.
+ (propertize txt 'face (org-babel--async-status-face status)))
+
+ (short-version-of (msg)
+ ;; Compute the short version of MSG, to display in the header.
+ ;; Must return a string.
+ (if msg
+ (car (split-string (format "%s" msg) "\n" :omit-nulls))
+ ""))
+ (update (ovl-title status msg)
+ ;; Update the title overlay to match STATUS and MSG.
+ (overlay-put ovl-title
+ 'face
+ (org-babel--async-status-face status))
+ (overlay-put ovl-title
+ 'before-string (pcase status
+ (:scheduled "⏱")
+ (:pending "⏳")
+ (:failure "❌")
+ (:success "✔️")))
+ (overlay-put ovl-title
+ 'after-string
+ (propertize (format " |%s|"
+ (if (eq :failure status)
+ (if (consp msg) (car msg)
+ (format "%s" msg))
+ (short-version-of msg)))
+ 'face (org-babel--async-status-face status))))
+ (remove-previous-overlays ()
+ ;; Remove previous title and body overlays.
+ (mapc (lambda (ovl)
+ (when (eq 'org-babel--async-note
+ (overlay-get ovl 'org-babel--async-type))
+ (delete-overlay ovl)))
+ (when-let ((region (org-babel--async-result-region
+ inline-elem info)))
+ ;; Not sure why, but we do need to start before
+ ;; point min, else, in some cases, some overlays
+ ;; are not found.
+ (overlays-in (max (1- (car region)) (point-min))
+ (cdr region))))))
+
+ (remove-previous-overlays)
+
+ ;; Ensure there is a non-empty region for the result.
+ (save-excursion
+ (unless (org-babel-where-is-src-block-result (not inline-elem) nil nil)
+ (org-babel-insert-result
+ ;; Use " " for the empty result. That cannot be nil, else it's interpreted
+ ;; as a list. We need at least one char, to separate markers if any.
+ " \n"
+ result-params
+ info nil
+ (nth 0 info) ; lang
+ exec-start-time
+ )))
+
+ ;; Create the overlays that span the result title and its body.
+ (pcase-let ((`(,title-ovl . ,body-ovl) (mk-result-overlays)))
+ ;; Flag the result as ":scheduled".
+ (update title-ovl :scheduled nil)
+
+ ;; The callback, that runs in the org buffer at point.
+ (let ((buf (current-buffer))
+ (pt (point-marker)))
+ (lambda (feedback)
+ (message "ob-core: Handling outcome at %s@%s: %s" pt buf feedback)
+ (with-current-buffer buf
+ (save-excursion
+ (goto-char pt)
+ (pcase feedback
+ (`(:success ,r)
+ ;; Visual beep that the result is available.
+ (update title-ovl :success r)
+ (sit-for 0.2)
+ ;; We remove all overlays and let org insert the result
+ ;; as it would in the synchronous case.
+ (delete-overlay title-ovl)
+ (delete-overlay body-ovl)
+ (funcall handle-result r))
+
+ (`(:pending ,r)
+ ;; Still waiting for the outcome. Update our
+ ;; overlays with the progress info R.
+ (message "Updating block at %s@%s" pt buf)
+ (update title-ovl :pending r))
+
+ (`(:failure ,err)
+ ;; We didn't get a result. We update our overlays
+ ;; to report that failure. And unlock the old
+ ;; result.
+ (overlay-put title-ovl 'face nil)
+ (update title-ovl :failure err)
+ (delete-overlay body-ovl))
+
+ (_ (error "Invalid outcome"))
+ )
+ ))
+ nil))))))
+
+
+(cl-defun org-babel--async-p (params &key default)
+ "Return a non-nil value when the execution is asynchronous.
+Get the value of the :nasync argument and convert it."
+ (if-let ((binding (assq :nasync params)))
+ (pcase (cdr binding)
+ ((pred (not stringp))
+ (error "Invalid value for :nasync argument"))
+ ((or "no" "n") nil)
+ ((or "yes" "y") t)
+ (_ (error "Invalid value for :nasync argument")))
+ default))
+
+
+
;;;###autoload
(defun org-babel-execute-src-block (&optional arg info params executor-type)
"Execute the current source code block and return the result.
--
2.43.0
>From b0cdd3f5a9bd6e4e72adeac91f968741da95f98f Mon Sep 17 00:00:00 2001
From: Bruno BARBIER <brubar...@gmail.com>
Date: Fri, 16 Feb 2024 14:32:22 +0100
Subject: [PATCH 3/8] ob-core async: Refactor handle-result [3/5]
lisp/ob-core.el (org-babel-execute-src-block): Refactor the code to
prepare for the next change: move the part handling the result in its
own function `handle-result'.
---
lisp/ob-core.el | 105 ++++++++++++++++++++++++------------------------
1 file changed, 53 insertions(+), 52 deletions(-)
diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index d98626fe8..d1adba61c 100644
--- a/lisp/ob-core.el
+++ b/lisp/ob-core.el
@@ -1086,7 +1086,58 @@ (defun org-babel-execute-src-block (&optional arg info params executor-type)
(make-directory d 'parents)
d))))
(cmd (intern (concat "org-babel-execute:" lang)))
- result exec-start-time)
+ (exec-start-time (current-time))
+ (handle-result
+ (lambda (result)
+ (setq result
+ (if (and (eq (cdr (assq :result-type params)) 'value)
+ (or (member "vector" result-params)
+ (member "table" result-params))
+ (not (listp result)))
+ (list (list result))
+ result))
+ (let ((file (and (member "file" result-params)
+ (cdr (assq :file params)))))
+ ;; If non-empty result and :file then write to :file.
+ (when file
+ ;; If `:results' are special types like `link' or
+ ;; `graphics', don't write result to `:file'. Only
+ ;; insert a link to `:file'.
+ (when (and result
+ (not (or (member "link" result-params)
+ (member "graphics" result-params))))
+ (with-temp-file file
+ (insert (org-babel-format-result
+ result
+ (cdr (assq :sep params)))))
+ ;; Set file permissions if header argument
+ ;; `:file-mode' is provided.
+ (when (assq :file-mode params)
+ (set-file-modes file (cdr (assq :file-mode params)))))
+ (setq result file))
+ ;; Possibly perform post process provided its
+ ;; appropriate. Dynamically bind "*this*" to the
+ ;; actual results of the block.
+ (let ((post (cdr (assq :post params))))
+ (when post
+ (let ((*this* (if (not file) result
+ (org-babel-result-to-file
+ file
+ (org-babel--file-desc params result)
+ 'attachment))))
+ (setq result (org-babel-ref-resolve post))
+ (when file
+ (setq result-params (remove "file" result-params))))))
+ (unless (member "none" result-params)
+ (org-babel-insert-result
+ result result-params info
+ ;; append/prepend cannot handle hash as we accumulate
+ ;; multiple outputs together.
+ (when (member "replace" result-params) new-hash)
+ lang
+ (time-subtract (current-time) exec-start-time)))
+ (run-hooks 'org-babel-after-execute-hook)
+ result))))
(unless (fboundp cmd)
(error "No org-babel-execute function for %s!" lang))
(message "Executing %s %s %s..."
@@ -1101,57 +1152,7 @@ (defun org-babel-execute-src-block (&optional arg info params executor-type)
(if name
(format "(%s)" name)
(format "at position %S" (nth 5 info)))))
- (setq exec-start-time (current-time)
- result
- (let ((r (save-current-buffer (funcall cmd body params))))
- (if (and (eq (cdr (assq :result-type params)) 'value)
- (or (member "vector" result-params)
- (member "table" result-params))
- (not (listp r)))
- (list (list r))
- r)))
- (let ((file (and (member "file" result-params)
- (cdr (assq :file params)))))
- ;; If non-empty result and :file then write to :file.
- (when file
- ;; If `:results' are special types like `link' or
- ;; `graphics', don't write result to `:file'. Only
- ;; insert a link to `:file'.
- (when (and result
- (not (or (member "link" result-params)
- (member "graphics" result-params))))
- (with-temp-file file
- (insert (org-babel-format-result
- result
- (cdr (assq :sep params)))))
- ;; Set file permissions if header argument
- ;; `:file-mode' is provided.
- (when (assq :file-mode params)
- (set-file-modes file (cdr (assq :file-mode params)))))
- (setq result file))
- ;; Possibly perform post process provided its
- ;; appropriate. Dynamically bind "*this*" to the
- ;; actual results of the block.
- (let ((post (cdr (assq :post params))))
- (when post
- (let ((*this* (if (not file) result
- (org-babel-result-to-file
- file
- (org-babel--file-desc params result)
- 'attachment))))
- (setq result (org-babel-ref-resolve post))
- (when file
- (setq result-params (remove "file" result-params))))))
- (unless (member "none" result-params)
- (org-babel-insert-result
- result result-params info
- ;; append/prepend cannot handle hash as we accumulate
- ;; multiple outputs together.
- (when (member "replace" result-params) new-hash)
- lang
- (time-subtract (current-time) exec-start-time))))
- (run-hooks 'org-babel-after-execute-hook)
- result)))))))
+ (funcall handle-result (save-current-buffer (funcall cmd body params))))))))))
(defun org-babel-expand-body:generic (body params &optional var-lines)
"Expand BODY with PARAMS.
--
2.43.0
>From 019a0d2d8ba042606632e13976f8dfaeb37a8e74 Mon Sep 17 00:00:00 2001
From: Bruno BARBIER <brubar...@gmail.com>
Date: Fri, 16 Feb 2024 14:32:45 +0100
Subject: [PATCH 4/8] ob-core async: Handle :nasync param [4/5]
---
lisp/ob-core.el | 17 +++++++++++++----
1 file changed, 13 insertions(+), 4 deletions(-)
diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index d1adba61c..262218923 100644
--- a/lisp/ob-core.el
+++ b/lisp/ob-core.el
@@ -1085,7 +1085,10 @@ (defun org-babel-execute-src-block (&optional arg info params executor-type)
(let ((d (file-name-as-directory (expand-file-name dir))))
(make-directory d 'parents)
d))))
- (cmd (intern (concat "org-babel-execute:" lang)))
+ (async (org-babel--async-p params))
+ (cmd (intern (concat "org-babel-"
+ (if async "schedule" "execute")
+ ":" lang)))
(exec-start-time (current-time))
(handle-result
(lambda (result)
@@ -1139,8 +1142,8 @@ (defun org-babel-execute-src-block (&optional arg info params executor-type)
(run-hooks 'org-babel-after-execute-hook)
result))))
(unless (fboundp cmd)
- (error "No org-babel-execute function for %s!" lang))
- (message "Executing %s %s %s..."
+ (error "No org-babel-execute function for %s: %s!" lang (symbol-name cmd)))
+ (message "Executing %s %s %s %s..."
(capitalize lang)
(pcase executor-type
('src-block "code block")
@@ -1148,11 +1151,17 @@ (defun org-babel-execute-src-block (&optional arg info params executor-type)
('babel-call "call")
('inline-babel-call "inline call")
(e (symbol-name e)))
+ (if async "async" "")
(let ((name (nth 4 info)))
(if name
(format "(%s)" name)
(format "at position %S" (nth 5 info)))))
- (funcall handle-result (save-current-buffer (funcall cmd body params))))))))))
+ (if (not async)
+ (funcall handle-result (save-current-buffer (funcall cmd body params)))
+ (let ((handle-feedback
+ (org-babel--async-feedbacks info handle-result result-params exec-start-time)))
+ (funcall cmd body params handle-feedback))))))))))
+
(defun org-babel-expand-body:generic (body params &optional var-lines)
"Expand BODY with PARAMS.
--
2.43.0
>From c17aaea885e3aa6087563d55045e74ce71557dbf Mon Sep 17 00:00:00 2001
From: Bruno BARBIER <brubar...@gmail.com>
Date: Fri, 16 Feb 2024 14:33:09 +0100
Subject: [PATCH 5/8] ob-core async: Add :execute-with [5/5]
---
lisp/ob-core.el | 19 ++++++++++++++-----
1 file changed, 14 insertions(+), 5 deletions(-)
diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index 262218923..64f434f71 100644
--- a/lisp/ob-core.el
+++ b/lisp/ob-core.el
@@ -1086,9 +1086,18 @@ (defun org-babel-execute-src-block (&optional arg info params executor-type)
(make-directory d 'parents)
d))))
(async (org-babel--async-p params))
- (cmd (intern (concat "org-babel-"
- (if async "schedule" "execute")
- ":" lang)))
+ (execute-with (let ((be (cdr (assq :execute-with params))))
+ (when (equal be "none") (setq be nil))
+ be))
+ (cmd (intern (or (and execute-with
+ (concat execute-with "-" (if async "schedule" "execute")))
+ (concat "org-babel-"
+ (if async "schedule" "execute")
+ ":" lang))))
+ (cmd-args (let ((ps (list body params)))
+ (when execute-with
+ (setq ps (cons lang ps)))
+ ps))
(exec-start-time (current-time))
(handle-result
(lambda (result)
@@ -1157,10 +1166,10 @@ (defun org-babel-execute-src-block (&optional arg info params executor-type)
(format "(%s)" name)
(format "at position %S" (nth 5 info)))))
(if (not async)
- (funcall handle-result (save-current-buffer (funcall cmd body params)))
+ (funcall handle-result (save-current-buffer (apply cmd cmd-args)))
(let ((handle-feedback
(org-babel--async-feedbacks info handle-result result-params exec-start-time)))
- (funcall cmd body params handle-feedback))))))))))
+ (apply cmd (nconc cmd-args (list handle-feedback))))))))))))
(defun org-babel-expand-body:generic (body params &optional var-lines)
--
2.43.0
>From d5766eada2c31d0886f514f5ac6b38ad342e158f Mon Sep 17 00:00:00 2001
From: Bruno BARBIER <brubar...@gmail.com>
Date: Fri, 16 Feb 2024 14:33:23 +0100
Subject: [PATCH 6/8] lisp/org-elib-async.el: New package about async helpers
---
lisp/org-elib-async.el | 327 +++++++++++++++++++++++++++++++++++++++++
1 file changed, 327 insertions(+)
create mode 100644 lisp/org-elib-async.el
diff --git a/lisp/org-elib-async.el b/lisp/org-elib-async.el
new file mode 100644
index 000000000..f0a1e4432
--- /dev/null
+++ b/lisp/org-elib-async.el
@@ -0,0 +1,327 @@
+;;; org-elib-async.el --- Helper to write asynchronous functions -*- lexical-binding: t -*-
+
+;; Copyright (C) 2024 Bruno BARBIER
+
+;; Author: Bruno BARBIER
+;; Version: 0.0.0
+;; Maintainer: Bruno BARBIER
+;; Keywords:
+;; Status: WORK IN PROGRESS. DO NOT USE.
+;; URL:
+;; Compatibility: GNU Emacs 30.0.50
+;;
+;; This file is NOT (yet) part of GNU Emacs.
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2 of
+;; the License, or (at your option) any later version.
+
+;; This program is distributed in the hope that it will be
+;; useful, but WITHOUT ANY WARRANTY; without even the implied
+;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+;; PURPOSE. See the GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public
+;; License along with this program; if not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
+;; MA 02111-1307 USA
+
+
+;;; Commentary:
+;; Names with "--" are for functions and variables that are meant to be for
+;; internal use only.
+
+;;;; Description
+;; Some functions to help dealing with asynchronous tasks.
+
+;; The prefix 'org-elib' means that this package should evenutally be
+;; moved into core Emacs. The functions defined here do NOT depend
+;; nor rely on org itself.
+
+;;; TODOs
+;;
+;; - Keywords
+;;
+
+
+;;; Code:
+;;
+(require 'cl-lib)
+(require 'org-id)
+
+;;;; Process
+;;
+(cl-defun org-elib-async-process (command &key input callback)
+ "Execute COMMAND.
+
+A quick naive featureless boggus wrapper around `make-process' to
+receive the result when the process is done.
+
+When INPUT is non-nil, use it as the COMMAND standard input. Let DATA
+be the COMMAND output, if COMMAND succeeds, call CALLBACK with
+(:success DATA), else, call CALLBACK with (:failure DATA)."
+ (let* ((stdout-buffer (generate-new-buffer "*org-elib-async-process*"))
+ (get-outcome
+ (lambda (process)
+ (with-current-buffer stdout-buffer
+ (let* ((exit-code (process-exit-status process))
+ (real-end ;; Getting rid of the user message.
+ (progn (goto-char (point-max))
+ (forward-line -1)
+ (point)))
+ (txt (string-trim (buffer-substring-no-properties
+ (point-min) real-end))))
+ (list (if (eq 0 exit-code) :success :failure)
+ (if (not (string-empty-p txt)) txt
+ (and (not (eq 0 exit-code)) exit-code)))))))
+ (process (make-process
+ :name "*org-elib-async-process*"
+ :buffer stdout-buffer
+ :command command
+ :connection-type 'pipe))
+ (sentinel
+ (lambda (&rest _whatever)
+ (pcase (process-status process)
+ ('run )
+ ('stop)
+ ((or 'exit 'signal)
+ (funcall callback (funcall get-outcome process)))
+ (_ (error "Not a real process"))))))
+ (add-function :after (process-sentinel process) sentinel)
+ (when input
+ (process-send-string process input)
+ (process-send-eof process))
+ process))
+;; (org-elib-async-process (list "date") :callback (lambda (o) (message "outcome: %S" o)))
+;; (org-elib-async-process (list "false") :callback (lambda (o) (message "outcome: %S" o)))
+;; (org-elib-async-process (list "true") :callback (lambda (o) (message "outcome: %S" o)))
+;; (org-elib-async-process (list "bash" "-c" "bash") :input "date" :callback (lambda (o) (message "outcome: %S" o)))
+;; (org-elib-async-process (list "bash") :input "date" :callback (lambda (o) (message "outcome: %S" o)))
+;; (org-elib-async-process (list "bash") :input "false" :callback (lambda (o) (message "outcome: %S" o)))
+;; (org-elib-async-process (list "bash") :input "true" :callback (lambda (o) (message "outcome: %S" o)))
+;; (org-elib-async-process (list "bash") :input "sleep 2; date" :callback (lambda (o) (message "outcome: %S" o)))
+
+
+;;;; Wait for a process until some condition becomes true.
+
+(define-error 'org-elib-async-timeout-error
+ "Timeout waiting for a process.")
+
+(cl-defun org-elib-async-wait-condition ( cond-p
+ &key
+ (tick .3) (message "Waiting")
+ (nb_secs_between_messages 5)
+ timeout)
+ "Wait until the condition COND-P returns non-nil.
+Repeatedly call COND-P with no arguments, about every TICK seconds,
+until it returns a non-nil value. Return that non-nil value. When
+TIMEOUT (seconds) is non-nil, raise an `org-elib-async-timeout-error' if
+the COND-P is still nil after TIMEOUT seconds. Assume COND-P calls cost
+0s. Do NOT block display updates. Do not block process outputs. Do
+not block idle timers. Do block the user, letting him/her know why, but
+do not display more messages than one every NB_SECS_BETWEEN_MESSAGES.
+Default MESSAGE is \"Waiting\". Use 0.3s as the default for TICK."
+ ;; FIXME: Still not sure if it's possible to write such a function.
+ (let ((keep-waiting t)
+ (result nil)
+ (start (float-time))
+ elapsed
+ last-elapsed)
+ (while keep-waiting
+ (setq result (funcall cond-p))
+ (if result
+ (setq keep-waiting nil)
+ (sleep-for 0.01)
+ (redisplay :force)
+ (setq elapsed (- (float-time) start))
+ (when (and timeout (> elapsed timeout))
+ (signal 'org-timeout-error (list message elapsed)))
+ ;; Let the user know, without flooding the message area.
+ (if (and last-elapsed (> (- elapsed last-elapsed) nb_secs_between_messages))
+ (message (format "%s ...(%.1fs)" message elapsed)))
+ (unless (sit-for tick :redisplay)
+ ;; Emacs has something to do; let it process new
+ ;; sub-processes outputs in case there are some.
+ (accept-process-output nil 0.01))
+ (setq last-elapsed elapsed)))
+ result))
+
+
+
+;;;; Comint: a FIFO queue of tasks with callbacks
+;; org-elib-async-comint-queue executes tasks in a FIFO order. For each
+;; task, it identifies the text output for that
+;; task. org-elib-async-comint-queue does NOT remove prompts, or other
+;; useless texts; this is the responsibility of the user. Currently,
+;; org-elib-async-comint-queue assume it has the full control of the
+;; session: no user interaction, no other direct modifications.
+
+(defvar-local org-elib-async-comint-queue--todo :NOT-SET
+ "A FIFO queue of pending executions.")
+
+
+(defvar-local org-elib-async-comint-queue--unused-output ""
+ "Process output that has not been used yet.")
+
+(defvar-local org-elib-async-comint-queue--incoming-text ""
+ "Newly incoming text, added by the process filter, not yet handled.")
+
+(defvar-local org-elib-async-comint-queue--current-task nil
+ "The task that is currently running.")
+
+(defvar-local org-elib-async-comint-queue--process-filter-running nil
+ "non-nil when filter is running.")
+
+(defvar-local org-elib-async-comint-queue--incoming-timer nil
+ "A timer, when handling incoming text is scheduled or running.")
+
+
+(defvar-local org-elib-async-comint-queue--handle-incoming-running
+ nil
+ "True when the incoming text handler is running.")
+
+(defun org-elib-async-comint-queue--handle-incoming ()
+ (when org-elib-async-comint-queue--handle-incoming-running
+ (error "Bad call to handle-incoming: kill buffer %s!" (current-buffer)))
+ (setq org-elib-async-comint-queue--handle-incoming-running t)
+
+ ;; Take the incoming text.
+ (setq org-elib-async-comint-queue--unused-output
+ (concat org-elib-async-comint-queue--unused-output
+ org-elib-async-comint-queue--incoming-text))
+ (setq org-elib-async-comint-queue--incoming-text "")
+
+ ;; Process the unused text with the queued tasks
+ (unless org-elib-async-comint-queue--current-task
+ (when org-elib-async-comint-queue--todo
+ (setq org-elib-async-comint-queue--current-task (pop org-elib-async-comint-queue--todo))))
+ (when-let ((task org-elib-async-comint-queue--current-task))
+ (let ((unused org-elib-async-comint-queue--unused-output)
+ (session-buffer (current-buffer))
+ task-start)
+ (setq org-elib-async-comint-queue--unused-output
+ (with-temp-buffer
+ (insert unused)
+ (goto-char (point-min))
+ (while (and task
+ (setq task-start (point))
+ (search-forward (car task) nil t))
+ (when (cdr task)
+ (let ((txt (buffer-substring-no-properties task-start
+ (- (point) (length (car task))))))
+ (save-excursion (funcall (cdr task) txt))))
+ (setq task (and (buffer-live-p session-buffer)
+ (with-current-buffer session-buffer (pop org-elib-async-comint-queue--todo)))))
+ (buffer-substring (point) (point-max))))
+ (setq org-elib-async-comint-queue--current-task task)))
+
+ ;; Signal that we are done. If we already have some new incoming text,
+ ;; reschedule to run.
+ (setq org-elib-async-comint-queue--incoming-timer
+ (if (string-empty-p org-elib-async-comint-queue--incoming-text)
+ nil
+ (org-elib-async-comint-queue--wake-up-handle-incoming)))
+
+ ;; We reset it only on success. If it failed for some reason, the
+ ;; comint buffer is in an unknown state: you'll need to kill that
+ ;; buffer.
+ (setq org-elib-async-comint-queue--handle-incoming-running nil))
+
+
+(defun org-elib-async-comint-queue--wake-up-handle-incoming ()
+ "Wake up the handling of incoming chunks of text.
+Assume we are called from the comint buffer."
+ (setq org-elib-async-comint-queue--incoming-timer
+ (run-with-timer
+ 0.01 nil
+ (let ((comint-buffer (current-buffer)))
+ (lambda ()
+ (with-local-quit
+ (with-current-buffer comint-buffer
+ (org-elib-async-comint-queue--handle-incoming))))))))
+
+
+(defun org-elib-async-comint-queue--process-filter (chunk)
+ "Accept the arbitrary CHUNK of text."
+ (setq org-elib-async-comint-queue--incoming-text
+ (concat org-elib-async-comint-queue--incoming-text
+ chunk))
+ :; We delegate the real work outside the process filter, as it is
+ ; not reliable to do anything here.
+ (unless org-elib-async-comint-queue--incoming-timer
+ (org-elib-async-comint-queue--wake-up-handle-incoming)))
+
+
+
+(define-error 'org-elib-async-comint-queue-task-error
+ "Task failure.")
+
+(cl-defun org-elib-async-comint-queue--push (exec &key handle-feedback)
+ "Push the execution of EXEC into the FIFO queue.
+When the task completed, call HANDLE-FEEDBACK with its outcome. Return
+a function that waits for and return the result on succes, raise on
+failure."
+ (let* ((tid (org-id-uuid))
+ (start-tag (format "ORG-ELIB-ASYNC_START_%s" tid))
+ (end-tag (format "ORG-ELIB-ASYNC_END___%s" tid))
+ (result-sb (make-symbol "result"))
+ (on-start
+ (lambda (_)
+ ;; TODO: Use (point) in session to link back to it.
+ (when handle-feedback
+ (funcall handle-feedback '(:pending "running")))))
+ (on-result
+ (lambda (result)
+ ;; Get the result, and report success using HANDLE-FEEDBACK.
+ ;; If something fails, report failure using HANDLE-FEEDBACK.
+ (unwind-protect
+ (let ((outcome
+ (condition-case-unless-debug exc
+ (list :success (funcall exec :post-process result))
+ (error (list :failure exc)))))
+ (when handle-feedback (save-excursion (funcall handle-feedback outcome)))
+ (set result-sb outcome))
+ (funcall exec :finally)))))
+
+ ;; TODO: Add detect-properties => alist of properties that can be used: PS1 and PS2
+ (let ((comint-buffer (funcall exec :get-comint-buffer)))
+ (with-current-buffer comint-buffer
+ (setq org-elib-async-comint-queue--todo
+ (nconc org-elib-async-comint-queue--todo
+ (list (cons start-tag on-start)
+ (cons end-tag on-result))))
+ (funcall exec :send-instrs-to-session
+ (funcall exec :instrs-to-enter))
+ (funcall exec :send-instrs-to-session
+ (funcall exec :instr-to-emit-tag start-tag))
+ (funcall exec :send-instrs-to-session
+ (funcall exec :get-code))
+ (funcall exec :send-instrs-to-session
+ (funcall exec :instr-to-emit-tag end-tag))
+ (funcall exec :send-instrs-to-session
+ (funcall exec :instrs-to-exit))
+
+ (lambda ()
+ (org-elib-async-wait-condition (lambda ()
+ (boundp result-sb)))
+ (pcase (symbol-value result-sb)
+ (`(:success ,r) r)
+ (`(:failure ,err) (signal (car err) (cdr err)))))
+ ))))
+
+
+
+(defun org-elib-async-comint-queue-init-if-needed (buffer)
+ "Initialize the FIFO queue in BUFFER if needed."
+ (with-current-buffer buffer
+ (unless (local-variable-p 'org-elib-async-comint-queue--todo)
+ (setq-local org-elib-async-comint-queue--todo nil)
+ (add-hook 'comint-output-filter-functions
+ #'org-elib-async-comint-queue--process-filter nil :local))))
+
+
+
+;;;; Provide
+(provide 'org-elib-async)
+;;; org-elib-async.el ends here
--
2.43.0
>From 1129770cc62b0580c71ba2a3f6a94f6fd18574b3 Mon Sep 17 00:00:00 2001
From: Bruno BARBIER <brubar...@gmail.com>
Date: Fri, 16 Feb 2024 14:33:40 +0100
Subject: [PATCH 7/8] lisp/ob-core.el: Notify when execution fails
lisp/ob-core.el (org-babel-popup-failure-details): New function.
(org-babel-execute-src-block): For synchronous execution, use
`org-babel-popup-failure-details' on failure.
(org-babel--async-feedbacks): Add call to
`org-babel-popup-failure-details' on user request.
---
lisp/ob-core.el | 29 +++++++++++++++++++++++++++--
1 file changed, 27 insertions(+), 2 deletions(-)
diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index 64f434f71..e8f9e9ad9 100644
--- a/lisp/ob-core.el
+++ b/lisp/ob-core.el
@@ -917,7 +917,17 @@ (defun org-babel--async-feedbacks (info handle-result
(if (consp msg) (car msg)
(format "%s" msg))
(short-version-of msg)))
- 'face (org-babel--async-status-face status))))
+ 'face (org-babel--async-status-face status)))
+ (when (eq :failure status)
+ (overlay-put ovl-title
+ 'keymap
+ (let ((km (make-sparse-keymap)))
+ (define-key km (kbd "<mouse-1>")
+ (lambda ()
+ "Display failure details."
+ (interactive)
+ (org-babel-popup-failure-details msg)))
+ km))))
(remove-previous-overlays ()
;; Remove previous title and body overlays.
(mapc (lambda (ovl)
@@ -1166,11 +1176,26 @@ (defun org-babel-execute-src-block (&optional arg info params executor-type)
(format "(%s)" name)
(format "at position %S" (nth 5 info)))))
(if (not async)
- (funcall handle-result (save-current-buffer (apply cmd cmd-args)))
+ (let ((res-sb (make-symbol "result")))
+ (condition-case exc
+ (set res-sb (save-current-buffer (apply cmd cmd-args)))
+ (error (org-babel-popup-failure-details exc)))
+ (when (boundp res-sb)
+ (funcall handle-result (symbol-value res-sb))))
(let ((handle-feedback
(org-babel--async-feedbacks info handle-result result-params exec-start-time)))
(apply cmd (nconc cmd-args (list handle-feedback))))))))))))
+(defun org-babel-popup-failure-details (exc)
+ "Notify/display"
+ (when-let ((buf (get-buffer org-babel-error-buffer-name)))
+ (with-current-buffer buf (erase-buffer)))
+ (org-babel-eval-error-notify
+ 127 ; Don't have exit-code
+ (if (consp exc)
+ (format "%s\n%s\n" (car exc) (cdr exc))
+ (format "%s\n" exc))))
+
(defun org-babel-expand-body:generic (body params &optional var-lines)
"Expand BODY with PARAMS.
--
2.43.0
>From 2078be0ebd741127c383a386f672dbc3d741206d Mon Sep 17 00:00:00 2001
From: Bruno BARBIER <brubar...@gmail.com>
Date: Wed, 21 Feb 2024 15:54:05 +0100
Subject: [PATCH 8/8] scratch/bba-ob-core-async: Some temporary test files
---
scratch/bba-ob-core-async/my-async-tests.el | 339 ++++++++
scratch/bba-ob-core-async/my-async-tests.org | 820 +++++++++++++++++++
2 files changed, 1159 insertions(+)
create mode 100644 scratch/bba-ob-core-async/my-async-tests.el
create mode 100644 scratch/bba-ob-core-async/my-async-tests.org
diff --git a/scratch/bba-ob-core-async/my-async-tests.el b/scratch/bba-ob-core-async/my-async-tests.el
new file mode 100644
index 000000000..918a4b142
--- /dev/null
+++ b/scratch/bba-ob-core-async/my-async-tests.el
@@ -0,0 +1,339 @@
+;;; my-async-tests.el --- Scratch/temporary file: some tests about async -*- lexical-binding: t -*-
+
+;; Copyright (C) 2024 Bruno BARBIER
+
+;; Author: Bruno BARBIER
+;; Status: Temporary tests.
+;; Compatibility: GNU Emacs 30.0.50
+;;
+;; This file is NOT part of GNU Emacs.
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2 of
+;; the License, or (at your option) any later version.
+
+;; This program is distributed in the hope that it will be
+;; useful, but WITHOUT ANY WARRANTY; without even the implied
+;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+;; PURPOSE. See the GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public
+;; License along with this program; if not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
+;; MA 02111-1307 USA
+
+(require 'cl-lib)
+(require 'org)
+(require 'org-elib-async)
+
+(require 'ob-shell)
+(require 'ob-python)
+
+;;; Shells
+;;
+
+;;;; One shell script
+
+;; Standalone direct asynchronous execution.
+
+(defun my-shell-babel-schedule (lang body _params handle-feedback)
+ "Execute the bash script BODY.
+Execute the shell script BODY using bash. Use HANDLE-FEEDBACK to report
+the outcome (success or failure)."
+ (unless (equal "bash" lang)
+ (error "Only for bash"))
+ (funcall handle-feedback (list :pending "started"))
+ (org-elib-async-process (list "bash") :input body :callback handle-feedback))
+
+
+;;;; Asynchronous using ob-shell
+
+(defun my-org-babel-shell-how-to-execute (body params)
+ "Return how to execute BODY using a POSIX shell.
+Return how to execute, as expected by
+`org-elib-async-comint-queue--execution'."
+ ;; Code mostly extracted from ob-shell, following
+ ;; `org-babel-execute:shell' and `org-babel-sh-evaluate'.
+ ;; Results are expected to differ from ob-shell as we follow the
+ ;; same process for all execution paths: asynchronous or not, with
+ ;; session or without.
+ (let* ((session (org-babel-sh-initiate-session
+ (cdr (assq :session params))))
+ (stdin (let ((stdin (cdr (assq :stdin params))))
+ (when stdin (org-babel-sh-var-to-string
+ (org-babel-ref-resolve stdin)))))
+ (result-params (cdr (assq :result-params params)))
+ (value-is-exit-status
+ (or (and
+ (equal '("replace") result-params)
+ (not org-babel-shell-results-defaults-to-output))
+ (member "value" result-params)))
+ (cmdline (cdr (assq :cmdline params)))
+ (shebang (cdr (assq :shebang params)))
+ (full-body (concat
+ (org-babel-expand-body:generic
+ body params (org-babel-variable-assignments:shell params))
+ (when value-is-exit-status "\necho $?")))
+ (post-process
+ (lambda (r)
+ (setq r (org-trim r))
+ (org-babel-reassemble-table
+ (org-babel-result-cond result-params
+ r
+ (let ((tmp-file (org-babel-temp-file "sh-")))
+ (with-temp-file tmp-file (insert r))
+ (org-babel-import-elisp-from-file tmp-file)))
+ (org-babel-pick-name
+ (cdr (assq :colname-names params)) (cdr (assq :colnames params)))
+ (org-babel-pick-name
+ (cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))
+ comint-buffer
+ finally
+ to-run)
+
+ (setq comint-buffer
+ (if session session
+ ;; No session. We create a temporary one and use 'finally' to
+ ;; destroy it once we are done.
+ ;;
+ ;; FIXME: This session code should be refactored and moved into
+ ;; ob-core.
+ (let ((s-buf (org-babel-sh-initiate-session
+ (generate-new-buffer-name (format "*ob-shell-no-session*")))))
+ (setq finally (lambda ()
+ ;; We cannot delete it immediately as we are called from it.
+ (run-with-idle-timer
+ 0.1 nil
+ (lambda ()
+ (when (buffer-live-p s-buf)
+ (let ((kill-buffer-query-functions nil)
+ (kill-buffer-hook nil))
+ (kill-buffer s-buf)))))))
+ s-buf)))
+
+ (org-elib-async-comint-queue-init-if-needed comint-buffer)
+
+ (setq to-run
+ (cond
+ ((or stdin cmdline) ; external shell script w/STDIN
+ (let ((script-file (org-babel-temp-file "sh-script-"))
+ (stdin-file (org-babel-temp-file "sh-stdin-"))
+ (padline (not (string= "no" (cdr (assq :padline params))))))
+ (with-temp-file script-file
+ (when shebang (insert shebang "\n"))
+ (when padline (insert "\n"))
+ (insert full-body))
+ (set-file-modes script-file #o755)
+ (with-temp-file stdin-file (insert (or stdin "")))
+ (with-temp-buffer
+ (with-connection-local-variables
+ (concat
+ (mapconcat #'shell-quote-argument
+ (cons (if shebang (file-local-name script-file)
+ shell-file-name)
+ (if shebang (when cmdline (list cmdline))
+ (list shell-command-switch
+ (concat (file-local-name script-file) " " cmdline))))
+ " ")
+ "<" (shell-quote-argument stdin-file))))))
+ (session ; session evaluation
+ full-body)
+ ;; External shell script, with or without a predefined
+ ;; shebang.
+ ((org-string-nw-p shebang)
+ (let ((script-file (org-babel-temp-file "sh-script-"))
+ (padline (not (equal "no" (cdr (assq :padline params))))))
+ (with-temp-file script-file
+ (insert shebang "\n")
+ (when padline (insert "\n"))
+ (insert full-body))
+ (set-file-modes script-file #o755)
+ (if (file-remote-p script-file)
+ ;; Run remote script using its local path as COMMAND.
+ ;; The remote execution is ensured by setting
+ ;; correct `default-directory'.
+ (let ((default-directory (file-name-directory script-file)))
+ (file-local-name script-file)
+ script-file ""))))
+ (t
+ (let ((script-file (org-babel-temp-file "sh-script-")))
+ (with-temp-file script-file
+ (insert full-body))
+ (set-file-modes script-file #o755)
+ (mapconcat #'shell-quote-argument
+ (list shell-file-name
+ shell-command-switch
+ (if (file-remote-p script-file)
+ (file-local-name script-file)
+ script-file))
+ " ")))))
+ ;; TODO: How to handle `value-is-exit-status'?
+ (lambda (&rest q)
+ (pcase q
+ (`(:instrs-to-enter)
+ ;; FIXME: This is wrong.
+ "export PS1=''; export PS2='';")
+ (`(:instrs-to-exit))
+ (`(:finally) (when finally (funcall finally)))
+ (`(:instr-to-emit-tag ,tag) (format "printf '%s\\n'" tag))
+ (`(:post-process ,r) (when post-process (funcall post-process r)))
+ (`(:send-instrs-to-session ,code)
+ (with-current-buffer comint-buffer
+ (when code
+ (goto-char (point-max))
+ (insert code) (insert "\n")
+ (comint-send-input nil t))))
+ (`(:get-code) to-run)
+ (`(:get-comint-buffer) comint-buffer)
+ (_ (error "Unknown query"))))))
+
+
+
+
+
+;;; Python
+;;
+
+;;;; Asynchronous using ob-python
+
+(defun my-org-babel-python-how-to-execute (body params)
+ "Return how to execute BODY using python.
+Return how to execute, as expected by
+`org-elib-async-comint-queue--execution'."
+ ;; Code mostly extracted from ob-python, following
+ ;; `org-babel-python-evaluate-session'.
+ ;; Results are expected to differ from ob-python as we follow the
+ ;; same process for all execution paths: asynchronous or not, with
+ ;; session or without.
+ (let* ((org-babel-python-command
+ (or (cdr (assq :python params))
+ org-babel-python-command))
+ (session-key (org-babel-python-initiate-session
+ (cdr (assq :session params))))
+ (graphics-file (and (member "graphics" (assq :result-params params))
+ (org-babel-graphical-output-file params)))
+ (result-params (cdr (assq :result-params params)))
+ (result-type (cdr (assq :result-type params)))
+ (results-file (when (eq 'value result-type)
+ (or graphics-file
+ (org-babel-temp-file "python-"))))
+ (return-val (when (eq result-type 'value)
+ (cdr (assq :return params))))
+ (full-body
+ (concat
+ (org-babel-expand-body:generic
+ body params
+ (org-babel-variable-assignments:python params))
+ (when return-val
+ (format "\n%s" return-val))))
+ (post-process
+ (lambda (r)
+ (setq r (string-trim r))
+ (when (string-prefix-p "Traceback (most recent call last):" r)
+ (signal 'user-error (list r)))
+ (when (eq 'value result-type)
+ (setq r (org-babel-eval-read-file results-file)))
+ (org-babel-reassemble-table
+ (org-babel-result-cond result-params
+ r
+ (org-babel-python-table-or-string r))
+ (org-babel-pick-name (cdr (assq :colname-names params))
+ (cdr (assq :colnames params)))
+ (org-babel-pick-name (cdr (assq :rowname-names params))
+ (cdr (assq :rownames params))))))
+ (tmp-src-file (org-babel-temp-file "python-"))
+ (session-body
+ ;; The real code we evaluate in the session.
+ (pcase result-type
+ (`output
+ (format (string-join
+ (list "with open('%s') as f:\n"
+ " exec(compile(f.read(), f.name, 'exec'))\n"))
+ (org-babel-process-file-name
+ tmp-src-file 'noquote)))
+ (`value
+ ;; FIXME: In this case, any output is an error.
+ (org-babel-python-format-session-value
+ tmp-src-file results-file result-params))))
+ comint-buffer
+ finally)
+
+
+ (unless session-key
+ ;; No session. We create a temporary one and use 'finally' to
+ ;; destroy it once we are done.
+ ;;
+ ;; FIXME: This session code should be refactored and moved into
+ ;; ob-core.
+ (setq session-key (org-babel-python-initiate-session
+ ;; We can't use a simple `generate-new-buffer'
+ ;; due to the earmuffs game.
+ (org-babel-python-without-earmuffs
+ (format "*ob-python-no-session-%s*" (org-id-uuid)))))
+ (setq finally (lambda ()
+ (when-let ((s-buf
+ (get-buffer (org-babel-python-with-earmuffs session-key))))
+ ;; We cannot delete it immediately as we are called from it.
+ (run-with-idle-timer
+ 0.1 nil
+ (lambda ()
+ (when (buffer-live-p s-buf)
+ (let ((kill-buffer-query-functions nil)
+ (kill-buffer-hook nil))
+ (kill-buffer s-buf)))))))))
+
+ (setq comint-buffer
+ (get-buffer (org-babel-python-with-earmuffs session-key)))
+ (org-elib-async-comint-queue-init-if-needed comint-buffer)
+ (with-temp-file tmp-src-file
+ (insert (if (and graphics-file (eq result-type 'output))
+ (format org-babel-python--output-graphics-wrapper
+ full-body graphics-file)
+ full-body)))
+
+ (lambda (&rest q)
+ (pcase q
+ (`(:instrs-to-enter)
+ ;; FIXME: This is wrong.
+ "import sys; sys.ps1=''; sys.ps2=''")
+ (`(:instrs-to-exit))
+ (`(:finally) (when finally (funcall finally)))
+ (`(:instr-to-emit-tag ,tag) (format "print ('%s')" tag))
+ (`(:post-process ,r) (when post-process (funcall post-process r)))
+ (`(:send-instrs-to-session ,code)
+ ;; See org-babel-python-send-string
+ (with-current-buffer comint-buffer
+ (let ((python-shell-buffer-name
+ (org-babel-python-without-earmuffs session-key)))
+ (python-shell-send-string (concat code "\n")))))
+ (`(:get-code) session-body)
+ (`(:get-comint-buffer) comint-buffer)
+ (_ (error "Unknown query"))))))
+
+
+;;; Org babel 'execute-with'.
+
+
+;;;; Asynchronous
+;;
+(defun my-org-babel-schedule (lang body params handle-feedback)
+ "Schedule the execution of BODY according to PARAMS.
+This function is called by `org-babel-execute-src-block'. Return a
+function that waits and returns the result on success, raise on failure."
+ (let ((exec (pcase lang
+ ("python" (my-org-babel-python-how-to-execute body params))
+ ("bash" (my-org-babel-shell-how-to-execute body params))
+ (_ (error "Not handled (yet): %s" lang)))))
+ (org-elib-async-comint-queue--push exec :handle-feedback handle-feedback)))
+
+
+;;;; Synchronous
+;;
+(defun my-org-babel-execute (lang body params)
+ "Execute Python BODY according to PARAMS.
+This function is called by `org-babel-execute-src-block'."
+ ;; We just start the asynchronous execution, wait for it, and return
+ ;; the result (or raise the exception). No custom code, and,
+ ;; synchronous and asynchronous should just mix nicely together.
+ (funcall (my-org-babel-schedule lang body params nil)))
diff --git a/scratch/bba-ob-core-async/my-async-tests.org b/scratch/bba-ob-core-async/my-async-tests.org
new file mode 100644
index 000000000..08284c470
--- /dev/null
+++ b/scratch/bba-ob-core-async/my-async-tests.org
@@ -0,0 +1,820 @@
+#+PROPERTY: HEADER-ARGS+ :eval no-export :exports both
+* Intro
+
+An org document with code blocks to help test the proposed patchs.
+
+See [[*On top of ob-shell][On top of ob-shell]] for asynchronous shell scripts using ob-shell.
+
+See [[*On top of ob-python][On top of ob-python]] for asynchronous python scripts using ob-python.
+
+You need to load:
+ #+begin_src elisp :results silent
+ (setq-local org-confirm-babel-evaluate nil)
+ (load-file "my-async-tests.el")
+ #+end_src
+
+
+Emacs and org versions:
+ #+begin_src elisp
+ (mapcar (lambda (sb) (list sb (symbol-value sb)))
+ '(emacs-version org-version))
+ #+end_src
+
+ #+RESULTS:
+ | emacs-version | 30.0.50 |
+ | org-version | 9.7-pre |
+
+Note that we've disabled eval on export: export doesn't know it needs
+to wait for asynchronous results.
+
+* POSIX shells
+** A simple bash example
+ :PROPERTIES:
+ :header-args:bash: :execute-with my-shell-babel :nasync yes
+ :END:
+
+The package `my-async-tests.el' contains the function
+`my-shell-babel-schedule' to evaluate shell script asynchronously.
+
+The header-args properties above request asynchronous execution for
+bash (:nasync yes), and, tells ob-core to use the prefix
+`my-shell-babel' when looking for functions to evaluate a source
+block. Thus, org will delegate execution to `my-shell-babel-schedule'.
+We don't have `my-shell-babel-execute', so, in this case, :nasync must
+be yes.
+
+Examples taken from the org mailing list and from worg.
+
+A simple execution:
+ #+begin_src bash
+ date
+ #+end_src
+
+ #+RESULTS:
+ : Wed Feb 21 15:56:23 CET 2024
+
+A tricky computation takes some time:
+ #+begin_src bash
+ sleep 1; date
+ #+end_src
+
+ #+RESULTS:
+ : Wed Feb 21 15:56:25 CET 2024
+
+An example of a failure:
+ #+begin_src bash
+ sleepdd 1; false
+ #+end_src
+
+ #+RESULTS:
+
+** On top of ob-shell
+ :PROPERTIES:
+ :header-args:bash: :execute-with my-org-babel :nasync yes
+ :header-args:bash+: :session sh-async
+ :END:
+
+ #+begin_src bash
+ sleep 1; date
+ #+end_src
+
+ #+RESULTS:
+ : Wed Feb 21 15:56:42 CET 2024
+
+
+ #+begin_src bash :results output :session *test* :nasync yes
+ cd /tmp
+ echo "hello world"
+ #+end_src
+
+ #+RESULTS:
+ : hello world
+
+ #+begin_src bash :results output
+ # comment
+ # comment
+ #+end_src
+
+ #+RESULTS:
+
+ #+begin_src bash :results output
+ # print message
+ echo \"hello world\"
+ #+end_src
+
+ #+RESULTS:
+ : "hello world"
+
+ #+begin_src bash :results output
+ echo "hello"
+ echo "world"
+ #+end_src
+
+ #+RESULTS:
+ : hello
+ : world
+
+
+ #+begin_src bash :results output
+ echo PID: "$$"
+ #+end_src
+
+ #+RESULTS:
+ : PID: 22212
+
+ #+begin_src bash :results output
+ echo PID: "$$"
+ #+end_src
+
+ #+RESULTS:
+ : PID: 22212
+
+
+ #+begin_src bash :results output :session shared
+ echo PID: "$$"
+ X=5
+ #+end_src
+
+ #+RESULTS:
+ : PID: 22218
+
+ #+begin_src bash :results output :session shared
+ echo PID: "$$"
+ echo X was set to "$X"
+ #+end_src
+
+ #+RESULTS:
+ : PID: 22218
+ : X was set to 5
+
+ #+begin_src bash :nasync yes :results value scalar
+ echo "Execute session blocks in the background"
+ sleep 3
+ echo "Using the :async header"
+ #+end_src
+
+ #+RESULTS:
+ : Execute session blocks in the background
+ : Using the :async header
+ : 0
+
+
+
+ #+name: their-os
+ Linux
+
+
+ #+begin_src bash :results output :shebang #!/usr/bin/env bash :stdin their-os :cmdline RMS :tangle ask_for_os.sh
+
+ # call as ./ask_for_os.sh NAME, where NAME is who to ask
+
+ if [ -z "$1" ]; then
+ asked="$USER"
+ else
+ asked="$1"
+ fi
+
+ echo Hi, "$asked"! What operating system are you using?
+ read my_os
+
+ if [ "$asked" = "RMS" ]; then
+ echo You\'re using GNU/"$my_os"!
+ elif [ "$asked" = "Linus" ]; then
+ echo You\'re using "$my_os"!
+ else
+ echo You\'re using `uname -o`!
+ fi
+ #+end_src
+
+ #+RESULTS:
+ : Hi, RMS! What operating system are you using?
+ : You're using GNU/Linux!
+
+
+
+ #+begin_src bash
+ declare -a array
+
+ m=4
+ n=3
+ for ((i=0; i<m; i++))
+ do
+ for ((j=0; j<n; j++))
+ do
+ a[${i},${j}]=$RANDOM
+ done
+ done
+ for ((i=0; i<m; i++))
+ do
+ for ((j=0; j<n; j++))
+ do
+ echo -ne "${a[${i},${j}]}\t"
+ done
+ echo
+ done
+ #+end_src
+
+ #+RESULTS:
+ | 7592 | 13920 | 4911 |
+ | 7592 | 13920 | 4911 |
+ | 7592 | 13920 | 4911 |
+ | 7592 | 13920 | 4911 |
+
+
+ #+begin_src bash :results list
+ declare -a array
+
+ m=4
+ n=3
+ for ((i=0; i<m; i++))
+ do
+ for ((j=0; j<n; j++))
+ do
+ a[${i},${j}]=$RANDOM
+ done
+ done
+ for ((i=0; i<m; i++))
+ do
+ for ((j=0; j<n; j++))
+ do
+ echo -ne "${a[${i},${j}]}\t"
+ done
+ echo
+ done
+ #+end_src
+
+ #+RESULTS:
+ - 17593
+ 384
+ 1439
+ - 17593
+ 384
+ 1439
+ - 17593
+ 384
+ 1439
+ - 17593
+ 384
+ 1439
+
+ #+begin_src bash :results file :file my_output.txt
+ declare -a array
+
+ m=4
+ n=3
+ for ((i=0; i<m; i++))
+ do
+ for ((j=0; j<n; j++))
+ do
+ a[${i},${j}]=$RANDOM
+ done
+ done
+ for ((i=0; i<m; i++))
+ do
+ for ((j=0; j<n; j++))
+ do
+ echo -ne "${a[${i},${j}]}\t"
+ done
+ echo
+ done
+ #+end_src
+
+ #+RESULTS:
+ [[file:my_output.txt]]
+
+
+ #+begin_src bash :results output
+ cat my_output.txt
+ #+end_src
+
+ #+RESULTS:
+ : 30132 16194 19934
+ : 30132 16194 19934
+ : 30132 16194 19934
+ : 30132 16194 19934
+
+
+ #+begin_src bash :results output :dir /ssh:phone: :session none
+ if [ ! -e "foo_file" ];
+ then
+ echo "foo" > foo_file
+ echo "Created foo_file"
+ else
+ echo "foo_file already exists!"
+ fi
+ #+end_src
+
+ #+RESULTS:
+ : foo_file already exists!
+
+
+ #+begin_src bash :results output :dir /ssh:phone: :session *remote*
+ if [ ! -e "foo_file" ];
+ then
+ echo "foo" > foo_file
+ echo "Created foo_file"
+ else
+ echo "foo_file already exists!"
+ fi
+ #+end_src
+
+ #+RESULTS:
+ : Created foo_file
+
+
+ #+RESULTS:
+
+
+ #+begin_src bash :results none :session *my-session*
+ X=1
+ #+end_src
+
+ #+RESULTS:
+
+ #+begin_src bash :results output :session *my-session*
+ echo X was set to "$X"
+ #+end_src
+
+ #+RESULTS:
+ : X was set to 1
+
+ #+begin_src bash :results output :session *another-session*
+ echo X was set to "$X"
+ #+end_src
+
+ #+RESULTS:
+ : X was set to
+
+ #+RESULTS:
+
+
+ #+begin_src bash :results output
+ echo "Hello, world!"
+ sleep 3
+ echo "Good-bye, cruel World..."
+ #+end_src
+
+ #+RESULTS:
+ : Hello, world!
+ : Good-bye, cruel World...
+
+
+
+ #+begin_src bash :var by_two=0 x=3 :session none
+ if [ "$by_two" = "0" ]; then
+ echo $(($x * 2))
+ else
+ echo $(($x * 3))
+ fi
+ #+end_src
+
+ #+RESULTS:
+ : 6
+
+
+ #+begin_src bash :results output :var arr='("apple" "banana" "cherry")
+ echo The first element is...
+ echo \"${arr[1]}\"
+ #+end_src
+
+ #+RESULTS:
+ : The first element is...
+ : "banana"
+
+*** TODO Doesn't work yet: asynchronous that depends from other blocks
+ #+name: multiply_by_2
+ #+begin_src bash :var data="" :results output
+ echo $(($data * 2))
+ #+end_src
+
+ #+RESULTS: multiply_by_2
+ : bash: * 2: syntax error: operand expected (error token is "* 2")
+
+ #+begin_src bash :post multiply_by_2(data=*this*)
+ echo 3
+ #+end_src
+
+ #+results:
+
+
+* On top of ob-python
+ :PROPERTIES:
+ :header-args:python: :execute-with my-org-babel :nasync yes
+ :header-args:python+: :session py-async
+ :END:
+
+Used =header-args= properties:
+ - =:execute-with my-org-babel=: look for functions with the prefix `my-org-babel' to execute
+ blocks (for the asynchronous case use
+ `my-org-babel-schedule', and, for the synchronous case
+ `my-org-babel-execute'). These functions are defined in [[file:my-async-tests.el]].
+
+ - =:nasync yes=: by default, execute asynchronously (use `my-org-babel-schedule').
+
+ - =:session py-async= by default, use a session named "py-async".
+
+** basic examples
+*** async with a session
+A very simple test:
+ #+begin_src python
+ 2+3
+ #+end_src
+
+ #+RESULTS:
+ : 5
+
+Let's import the module time in our session.
+ #+begin_src python :results silent
+ import time
+ #+end_src
+
+ #+RESULTS:
+
+(Yes, =:results silent= needs some work.)
+
+
+
+A table that requires some time to compute:
+ #+begin_src python
+ start = time.time()
+ time.sleep(1)
+ end = time.time()
+ ["%.1fs" % t for t in [start, end, end-start]]
+ #+end_src
+
+ #+RESULTS:
+ | 1708515666.8s | 1708515667.8s | 1.0s |
+
+
+An error (click on the error , <mouse-1>, to see the details):
+ #+begin_src python
+ 2/0
+ #+end_src
+
+ #+RESULTS:
+
+
+*** async with no session
+ :PROPERTIES:
+ :header-args:python+: :session none
+ :END:
+
+A very simple test:
+ #+begin_src python
+ 2+3
+ #+end_src
+
+ #+RESULTS:
+ : 5
+
+Let's import the module time in our session.
+ #+begin_src python :results silent
+ import time
+ #+end_src
+
+ #+RESULTS:
+
+(Yes, =:results silent= needs some work.)
+
+
+
+A table that requires some time to compute:
+ #+begin_src python
+ start = time.time()
+ time.sleep(1)
+ end = time.time()
+ ["%.1fs" % t for t in [start, end, end-start]]
+ #+end_src
+
+ #+RESULTS:
+ | 1708083470.9s | 1708083471.9s | 1.0s |
+
+Yes, it failed, as expected. "import time" was done in its own
+temporary session. The old result is preserved; the error is display
+as an overlay. Click on it to get more info about the error.
+
+
+Let's fix it, adding the import line:
+ #+begin_src python
+ import time
+ start = time.time()
+ time.sleep(1)
+ end = time.time()
+ ["%.1fs" % t for t in [start, end, end-start]]
+ #+end_src
+
+ #+RESULTS:
+ | 1708515915.0s | 1708515916.0s | 1.0s |
+
+
+An error (click on the error , <mouse-1>, to see the details):
+ #+begin_src python
+ 2/0
+ #+end_src
+
+ #+RESULTS:
+
+
+
+*** sync with a session
+ :PROPERTIES:
+ :header-args:python+: :session py-sync-session :nasync no
+ :END:
+
+A very simple test:
+ #+begin_src python
+ 2+3
+ #+end_src
+
+ #+RESULTS:
+ : 5
+
+Let's import the module time in our session.
+ #+begin_src python :results silent
+ import time
+ #+end_src
+
+(Yes, =:results silent= needs some work.)
+
+
+
+A table that requires some time to compute:
+ #+begin_src python
+ start = time.time()
+ time.sleep(1)
+ end = time.time()
+ ["%.1fs" % t for t in [start, end, end-start]]
+ #+end_src
+
+ #+RESULTS:
+ | 1708102997.5s | 1708102998.5s | 1.0s |
+
+
+
+An error (click on the error , <mouse-1>, to see the details):
+ #+begin_src python
+ 2/0
+ #+end_src
+
+ #+RESULTS:
+
+
+*** sync with no session
+ :PROPERTIES:
+ :header-args:python+: :session none :nasync no
+ :END:
+
+A very simple test:
+ #+begin_src python
+ 2+3
+ #+end_src
+
+ #+RESULTS:
+ : 5
+
+Let's import the module time in our session.
+ #+begin_src python :results silent
+ import time
+ #+end_src
+
+(Yes, =:results silent= needs some work.)
+
+
+
+A table that requires some time to compute:
+ #+begin_src python
+ start = time.time()
+ time.sleep(1)
+ end = time.time()
+ ["%.1fs" % t for t in [start, end, end-start]]
+ #+end_src
+
+ #+RESULTS:
+ | 1708083470.9s | 1708083471.9s | 1.0s |
+
+Yes, that fails (no session), displaying the details in a popup. Let's
+fix it:
+ #+begin_src python
+ import time
+ start = time.time()
+ time.sleep(1)
+ end = time.time()
+ ["%.1fs" % t for t in [start, end, end-start]]
+ #+end_src
+
+ #+RESULTS:
+ | 1708103039.0s | 1708103040.0s | 1.0s |
+
+
+
+An error (click on the error , <mouse-1>, to see the details):
+ #+begin_src python
+ 2/0
+ #+end_src
+
+ #+RESULTS:
+
+
+** worg examples
+
+Let's import matplotlib in our session.
+
+ #+begin_src python
+ import matplotlib
+ import matplotlib.pyplot as plt
+ #+end_src
+
+ #+RESULTS:
+ : None
+
+A figure in a PDF, asynchronous case.
+ #+begin_src python :results file link
+ fig=plt.figure(figsize=(3,2))
+ plt.plot([1,3,2])
+ fig.tight_layout()
+
+ fname = 'myfig-async.pdf'
+ plt.savefig(fname)
+ fname # return this to org-mode
+ #+end_src
+
+ #+RESULTS:
+ [[file:myfig-async.pdf]]
+
+
+A figure in a PDF, synchronous case.
+ #+begin_src python :results file link :nasync no
+ fig=plt.figure(figsize=(3,2))
+ plt.plot([1,3,2])
+ fig.tight_layout()
+
+ fname = 'myfig-sync.pdf'
+ plt.savefig(fname)
+ fname # return this to org-mode
+ #+end_src
+
+ #+RESULTS:
+ [[file:myfig-sync.pdf]]
+
+
+
+A PNG figure, asynchronous case.
+ #+begin_src python :results graphics file output :file boxplot.png
+ fig=plt.figure(figsize=(3,2))
+ plt.plot([1,3,2])
+ fig.tight_layout()
+ fig
+ #+end_src
+
+ #+RESULTS:
+ [[file:boxplot.png]]
+
+Same, but using the =:return= keyword.
+ #+begin_src python :return "plt.gcf()" :results graphics file output :file boxplot.png
+ fig=plt.figure(figsize=(3,2))
+ plt.plot([1,3,2])
+ fig.tight_layout()
+ #+end_src
+
+ #+RESULTS:
+ [[file:boxplot.png]]
+
+Same, asynchronous but without a session this time.
+ #+begin_src python :return "plt.gcf()" :results graphics file output :file boxplot-no-sess-a-y.png :session none
+ import matplotlib
+ import matplotlib.pyplot as plt
+ fig=plt.figure(figsize=(3,2))
+ plt.plot([1,3,2])
+ fig.tight_layout()
+ #+end_src
+
+ #+RESULTS:
+ [[file:boxplot-no-sess-a-y.png]]
+
+
+Lists are table,
+ #+begin_src python
+ [1,2,3]
+ #+end_src
+
+ #+RESULTS:
+ | 1 | 2 | 3 |
+
+unless requested otherwise.
+ #+begin_src python :results verbatim
+ [1,2,3]
+ #+end_src
+
+ #+RESULTS:
+ : [1, 2, 3]
+
+
+Dictionaries are tables too.
+ #+begin_src python :results table
+ {"a": 1, "b": 2}
+ #+end_src
+
+ #+RESULTS:
+ | a | 1 |
+ | b | 2 |
+
+
+Let's try the example with Panda.
+ #+begin_src python :results none
+ import pandas as pd
+ import numpy as np
+ #+end_src
+
+ #+RESULTS:
+ : None
+
+ #+begin_src python :results table
+ pd.DataFrame(np.array([[1,2,3],[4,5,6]]),
+ columns=['a','b','c'])
+ #+end_src
+
+ #+RESULTS:
+ | | a | b | c |
+ |---+---+---+---|
+ | 0 | 1 | 2 | 3 |
+ | 1 | 4 | 5 | 6 |
+
+And the synchronous case?
+
+ #+begin_src python :results table :nasync no
+ pd.DataFrame(np.array([[1,2,3],[4,5,6]]),
+ columns=['a','b','c'])
+ #+end_src
+
+ #+RESULTS:
+ | | a | b | c |
+ |---+---+---+---|
+ | 0 | 1 | 2 | 3 |
+ | 1 | 4 | 5 | 6 |
+
+
+
+Without session ?
+
+ #+begin_src python :results table :session none
+ pd.DataFrame(np.array([[1,2,3],[4,5,6]]),
+ columns=['a','b','c'])
+ #+end_src
+
+ #+RESULTS:
+ | | a | b | c |
+ |---+---+---+---|
+ | 0 | 1 | 2 | 3 |
+ | 1 | 4 | 5 | 6 |
+
+Right, we need to import the libraries (no session).
+
+ #+begin_src python :results table :session none
+ import pandas as pd
+ import numpy as np
+ pd.DataFrame(np.array([[1,2,3],[4,5,6]]),
+ columns=['a','b','c'])
+ #+end_src
+
+ #+RESULTS:
+ | | a | b | c |
+ |---+---+---+---|
+ | 0 | 1 | 2 | 3 |
+ | 1 | 4 | 5 | 6 |
+
+
+** inline examples
+
+ A simple asynchronous inline src_python{3*2} {{{results(=6=)}}}.
+
+ An other one containing a mistake src_python{2/0} {{{results(=6=)}}}
+ (click on the error to see the details).
+
+
+ Some very slow inline asynchronous computations that all run in
+ the same session. You need to execute the 3 of them at once. Here
+ is the first one src_python[:return "\"OK1\""]{import time;
+ time.sleep(5)} {{{results(=OK1=)}}} and a second one
+ src_python[:return "\"OK1 bis\""]{import time; time.sleep(5)}
+ {{{results(=OK1 bis=)}}} and the third one src_python[:return
+ "\"OK2\""]{import time; time.sleep(5)} {{{results(=OK2=)}}}.
+
+ Yes, the previous paragraph is unreadable; it's on purpose, to
+ check that ob-core can figure it out.
+
+ Let's repeat, in a more readable way, and making the last one
+ synchronous.
+
+ Some very slow inline computations that all run in the same
+ session. Here is the first asynchronous one
+ src_python[:return"\"OK1\""]{import time; time.sleep(5)} {{{results(=None=)}}}
+ and a second one, asynchronous too:
+ src_python[:return "\"OK1 bis\""]{import time; time.sleep(5)} {{{results(=OK1 bis=)}}}
+ and finally, a third one, synchronous this one:
+ src_python[:nasync no :return "\"OK2\""]{import time; time.sleep(5)} {{{results(=OK2=)}}}.
+
+ Note that, once the user executes the last synchronous block, the
+ user is blocked until the synchronous execution can start
+ (i.e. all previous asynchronous executions are done) and until
+ it's done. The display is updated though, to see the asynchronous
+ progress.
--
2.43.0
