From d5766eada2c31d0886f514f5ac6b38ad342e158f Mon Sep 17 00:00:00 2001 From: Bruno BARBIER 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