;;; 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: ;;;; 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 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)))) 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 filter call detected: 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))))) (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