From 3f4a0d5370ae6c34afe180df96add3b8522f4af1 Mon Sep 17 00:00:00 2001 From: mattkae Date: Wed, 11 May 2022 09:23:58 -0400 Subject: initial commit --- elpa/irony-20220110.849/irony-iotask.el | 441 ++++++++++++++++++++++++++++++++ 1 file changed, 441 insertions(+) create mode 100644 elpa/irony-20220110.849/irony-iotask.el (limited to 'elpa/irony-20220110.849/irony-iotask.el') diff --git a/elpa/irony-20220110.849/irony-iotask.el b/elpa/irony-20220110.849/irony-iotask.el new file mode 100644 index 0000000..2226a69 --- /dev/null +++ b/elpa/irony-20220110.849/irony-iotask.el @@ -0,0 +1,441 @@ +;;; irony-iotask.el --- Abstraction for I/O-based tasks + +;; Copyright (C) 2015 Guillaume Papin + +;; Author: Guillaume Papin +;; Keywords: processes, convenience + +;; 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 3 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, see . + +;;; Commentary: + +;; Purpose is to work with both processes and network streams. +;; +;; Unlike tq.el we want tasks to be composed of 0, 1-1, or n-n communications. +;; tq.el only supports 1-1. +;; +;; 0 is useful if a server command has been cached, it means there is no need +;; for communication. We may only know if a task is still cached when the +;; callback is called (maybe after some other asynchronous tasks, so the context +;; may have changed since the task was initially posted) +;; +;; n-n is useful if the number of request depends on the answer to a previous +;; request but we still want to be able to push new tasks. + +;;; Code: + +(eval-when-compile + (require 'cl)) ;for lexical-let macro + +(require 'cl-lib) + + +;; +;; Error conditions +;; + +;; `define-error' breaks backward compatibility with Emacs < 24.4 +(defun irony-iotask--define-error (name message &optional parent) + "Define NAME as a new error signal. +MESSAGE is a string that will be output to the echo area if such an error +is signaled without being caught by a `condition-case'. +PARENT is either a signal or a list of signals from which it inherits. +Defaults to `error'." + (unless parent (setq parent 'error)) + (let ((conditions + (if (consp parent) + (apply #'nconc + (mapcar (lambda (parent) + (cons parent + (or (get parent 'error-conditions) + (error "Unknown signal `%s'" parent)))) + parent)) + (cons parent (get parent 'error-conditions))))) + (put name 'error-conditions + (delete-dups (copy-sequence (cons name conditions)))) + (when message (put name 'error-message message)))) + +(irony-iotask--define-error 'irony-iotask-error "I/O task error") +(irony-iotask--define-error 'irony-iotask-filter-error "I/O task filter error") +(irony-iotask--define-error 'irony-iotask-bad-task "Bad I/O task") +(irony-iotask--define-error 'irony-iotask-bad-data "Bad I/O task data") + + +;; +;; Structures +;; + +(cl-defstruct (irony-iotask-result (:constructor irony-iotask-result-create)) + -tag ;; 'value or 'error, or nil when unset + -value + -error -error-data + ) + +(defun irony-iotask-result-valid-p (result) + (and (irony-iotask-result--tag result) t)) + +(defun irony-iotask-result-value-p (result) + (eq (irony-iotask-result--tag result) 'value)) + +(defun irony-iotask-result-error-p (result) + (eq (irony-iotask-result--tag result) 'error)) + +(defun irony-iotask-result-set-value (result value) + (setf (irony-iotask-result--tag result) 'value) + (setf (irony-iotask-result--value result) value)) + +(defun irony-iotask-result-set-error (result error &rest error-data) + (setf (irony-iotask-result--tag result) 'error) + (setf (irony-iotask-result--error result) error) + (setf (irony-iotask-result--error-data result) error-data)) + +(irony-iotask--define-error 'irony-iotask-result-get-error + "Result not set before call to get") + +(defun irony-iotask-result-get (result) + (cl-case (irony-iotask-result--tag result) + ('value (irony-iotask-result--value result)) + ('error (signal (irony-iotask-result--error result) + (irony-iotask-result--error-data result))) + (t + (signal 'irony-iotask-result-get-error (list result))))) + +;; FIXME: quoting issues? I cannot write "#'(lambda ()...)" as property value +(defmacro irony-iotask-define-task (var docstring &rest properties) + "A task is simply a property list. + +Each of these function are called in the buffer they were +originally created (at schedule time). + +The functions `irony-iotask-put', `irony-iotask-get', +`irony-iotask-set-result' and `irony-iotask-set-error' are +available to the task's functions to set the task's result. + +Properties: + +`:start' (mandatory) + Function to call to launch the task. + + Usually the function sends a string/command/message to the + execution context. If the task do some caching it's possible + that nothing is send, instead the execution context result + should be set to indicate that the task is ready. + + The following additional functions are available to call + inside the `:start' function to communicate with the + underlying process: + + - `irony-iotask-send-string' + - `irony-iotask-send-region' + - `irony-iotask-send-eof' + +`:update' (mandatory) + Function to call when some process output is available. + + The function should determine whether a message is complete + and set the result when it is. It should also detect if the + message is invalid and throw the 'invalid-msg tag with a + value of t in this case. If the message is incomplete, the + function should do nothing. + + The process output is the current buffer. + +`:finish' (optional) + + Function to call after the result has been set but before + the callback is called. + + Usually performs some kind of cleanup operation. + + Note: it makes no sense to set a result or error in this + function as it is necessarily been set beforehand. + +`:on-success' (optional) + + Same as `:finish' but called only if the result IS NOT an error. + +`:on-error' (optional) + + Same as `:finish' but called only if the result IS an error." + (declare (indent 1) + (doc-string 2)) + `(progn + (defvar ,var nil ,docstring) + ;; Use `setq' to reset the var every time the macro is called. + ;; This is useful, for example when evaluating using C-M-x (`eval-defun'). + ;; Trick stolen from auto-complete's `ac-define-source' + (setq ,var '(,@properties)))) + +(cl-defstruct (irony-iotask-packaged-task + (:constructor irony-iotask-packaged-task--create)) + task + args + result + plist + continuation) + +(defun irony-iotask-package-task (task &rest args) + (irony-iotask-packaged-task--create :task task + :result (irony-iotask-result-create) + :args args)) + +(defvar irony-iotask--current-packaged-task) ;dynamically bound +(defun irony-iotask-package-task-invoke (packaged-task prop-fn + &optional ignore-missing + &rest leading-args) + (let* ((task (irony-iotask-packaged-task-task packaged-task)) + (args (irony-iotask-packaged-task-args packaged-task)) + (fn (plist-get task prop-fn))) + (condition-case err + (if fn + ;; let binding for irony-iotask-{get,put} + ;; and irony-iotask-set-{result,error} + (let ((irony-iotask--current-packaged-task packaged-task)) + (apply fn (append leading-args args))) + (unless ignore-missing + (signal 'irony-iotask-bad-task + (list task (format "no %s function" prop-fn))))) + (error + (apply #'irony-iotask-result-set-error + (irony-iotask-packaged-task-result packaged-task) + (car err) (cdr err)))))) + +(defun irony-iotask--chain-1 (packaged-task-1 packaged-task-2) + (while (irony-iotask-packaged-task-continuation packaged-task-1) + (setq packaged-task-1 + (irony-iotask-packaged-task-continuation packaged-task-1))) + (setf (irony-iotask-packaged-task-continuation packaged-task-1) + packaged-task-2)) + +(defun irony-iotask-chain (packaged-task-1 packaged-task-2 &rest others) + (setq others (cons packaged-task-2 others)) + (while others + (irony-iotask--chain-1 packaged-task-1 (car others)) + (setq others (cdr others))) + packaged-task-1) + +(cl-defstruct (irony-iotask-ectx + (:constructor irony-iotask-ectx--create)) + started + packaged-task + callback + schedule-buffer) + +(defun irony-iotask-ectx-call-callback (ectx result) + (let ((cb-buffer (irony-iotask-ectx-schedule-buffer ectx))) + (when (buffer-live-p cb-buffer) ;[GH-427] + (with-demoted-errors "Irony I/O task: error in callback: %S" + (with-current-buffer cb-buffer + (funcall (irony-iotask-ectx-callback ectx) result)))))) + +(defvar irony-iotask--process) + +(defun irony-iotask--start-next (process) + (let* ((ectx (car (process-get process :ectx-q))) + (packaged-task (irony-iotask-ectx-packaged-task ectx))) + (setf (irony-iotask-ectx-started ectx) t) + ;; erase the buffer before we call :start so the next :update starts anew + (erase-buffer) + ;; for `irony-iotask-send-string', `irony-iotask-send-region' and + ;; `irony-iotask-send-eof' + (let ((irony-iotask--process process)) + (save-current-buffer + (irony-iotask-package-task-invoke packaged-task :start))) + (irony-iotask--check-result process))) + +(defun irony-iotask--start-next-safe (process) + "Run the next task, if any." + (let ((ectx-q (process-get process :ectx-q))) + (when (and ectx-q (not (irony-iotask-ectx-started (car ectx-q)))) + (irony-iotask--start-next process)))) + +(defun irony-iotask--check-result (process) + (let* ((ectx (car (process-get process :ectx-q))) + (packaged-task (irony-iotask-ectx-packaged-task ectx)) + (result (irony-iotask-packaged-task-result packaged-task))) + (when (irony-iotask-result-valid-p result) + (save-current-buffer + (if (irony-iotask-result-value-p result) + (irony-iotask-package-task-invoke packaged-task :on-success t) + (irony-iotask-package-task-invoke packaged-task :on-error t))) + (save-current-buffer + (irony-iotask-package-task-invoke packaged-task :finish t)) + (if (and (irony-iotask-packaged-task-continuation packaged-task) + (irony-iotask-result-value-p result)) + ;; we got a non-error, we can chain to the next continuation + (progn + (setf (irony-iotask-ectx-packaged-task ectx) + (irony-iotask-packaged-task-continuation packaged-task)) + (irony-iotask--start-next process)) + ;; no continuation or an error, call the callback + ;; and skip any potential continuation + (setq ectx (pop (process-get process :ectx-q))) + (irony-iotask-ectx-call-callback ectx result) + (irony-iotask--start-next-safe process))))) + +(irony-iotask--define-error 'irony-iotask-aborted "I/O task aborted") + +(defun irony-iotask--abort-all (process &rest reasons) + (let ((result (irony-iotask-result-create)) + ectx) + (apply #'irony-iotask-result-set-error result 'irony-iotask-aborted reasons) + (while (setq ectx (pop (process-get process :ectx-q))) + (irony-iotask-ectx-call-callback ectx result)))) + + +;; +;; Implementation details, internal mechanic +;; + +(defun irony-iotask-process-filter (process output) + (when (buffer-live-p (process-buffer process)) + (with-current-buffer (process-buffer process) + (let ((ectx (car (process-get process :ectx-q))) + packaged-task + result) + ;; if no task this is an error, a spurious message is an error + (unless ectx + (signal 'irony-iotask-filter-error (list "spurious output" output))) + (setq packaged-task (irony-iotask-ectx-packaged-task ectx)) + (setq result (irony-iotask-packaged-task-result packaged-task)) + (goto-char (process-mark process)) + (insert output) + (set-marker (process-mark process) (point)) + ;; go to the first char, so the `:update' function is called at the + ;; beginning of the buffer, it is more convenient + (goto-char (point-min)) + (when (catch 'invalid-msg + (save-current-buffer + (irony-iotask-package-task-invoke packaged-task :update)) + nil) + (irony-iotask-result-set-error result + 'irony-iotask-bad-data + packaged-task + (buffer-string))) + (irony-iotask--check-result process))))) + +(defun irony-iotask-process-sentinel (process event) + ;; events usually ends with a newline, we don't want it + (setq event (replace-regexp-in-string "\n\\'" "" event)) + (unless (process-live-p process) + (irony-iotask--abort-all process "process stopped running" event) + (message "%s process stopped!" (process-name process)))) + +(defun irony-iotask-check-process (process) + (let ((pfilter (process-filter process)) + (psentinel (process-sentinel process))) + (unless (eq pfilter 'irony-iotask-process-filter) + (signal 'irony-iotask-error + (list "invalid process filter" pfilter + "did you call `irony-iotask-setup-process'?"))) + (unless (eq psentinel 'irony-iotask-process-sentinel) + (signal 'irony-iotask-error + (list "invalid process sentinel" psentinel + "did you call `irony-iotask-setup-process'?")))) + (unless (process-live-p process) + (signal 'irony-iotask-error (list "Process ain't running!"))) + (unless (buffer-live-p (process-buffer process)) + (signal 'irony-iotask-error (list "Process' buffer dead!")))) + + +;; +;; Public API +;; + +(defun irony-iotask-setup-process (process) + "Call after creating the asynchronous process to let +irony-iotask setup the PROCESS filter and anything else that may +be needed." + (with-current-buffer (process-buffer process) + (set-process-filter process #'irony-iotask-process-filter) + (set-process-sentinel process #'irony-iotask-process-sentinel) + (buffer-disable-undo))) + +(defun irony-iotask-schedule (process packaged-task callback) + (let ((ectx (irony-iotask-ectx--create :packaged-task packaged-task + :callback callback + :schedule-buffer (current-buffer)))) + (irony-iotask-check-process process) + (with-current-buffer (process-buffer process) + ;; append the new task to the queue + (process-put process :ectx-q (append (process-get process :ectx-q) + (list ectx))) + ;; run task if none were running + (unless (cdr (process-get process :ectx-q)) + (irony-iotask--start-next process))))) + +(defun irony-iotask-run (process packaged-task) + "Blocking/waiting counterpart of `irony-iotask-schedule'. + +Return the result (or signal the stored error) instead of passing +it to a callback. + +Returns nil when quitting. + +This function isn't reentrant, do not call it from another task." + (lexical-let (run-result) + ;; schedule an asynchronous task that set result when done + (irony-iotask-schedule process + packaged-task + (lambda (result) + (setq run-result result))) + + ;; wait for the task to complete + ;; quitting is allowed, in this case the task will still run but + ;; asynchronously, it won't block the user interface but the result will be + ;; lost + (if (with-local-quit + (while (not run-result) + (accept-process-output process 0.05)) + t) + ;; didn't quit, task was completed + (irony-iotask-result-get run-result) + ;; C-g was used + ;; TODO: We cannot abort the task because that may break the other tasks, + ;; the process will be in an unpredictable state. Howewer we can cancel + ;; the continuations. + ))) + +(defun irony-iotask-get (propname) + (plist-get (irony-iotask-packaged-task-plist + irony-iotask--current-packaged-task) + propname)) + +(defun irony-iotask-put (propname value) + (setf (irony-iotask-packaged-task-plist irony-iotask--current-packaged-task) + (plist-put (irony-iotask-packaged-task-plist + irony-iotask--current-packaged-task) + propname + value))) + +(defun irony-iotask--result () + (irony-iotask-packaged-task-result irony-iotask--current-packaged-task)) + +(defun irony-iotask-set-result (value) + (irony-iotask-result-set-value (irony-iotask--result) value)) + +(defun irony-iotask-set-error (err &rest error-data) + (apply #'irony-iotask-result-set-error (irony-iotask--result) err error-data)) + +(defun irony-iotask-send-string (string) + (process-send-string irony-iotask--process string)) + +(defun irony-iotask-send-region (start end) + (process-send-region irony-iotask--process start end)) + +(defun irony-iotask-send-eof (string) + (process-send-eof irony-iotask--process)) + +(provide 'irony-iotask) +;;; irony-iotask.el ends here -- cgit v1.2.1