1 files changed, 441 insertions, 0 deletions
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 <guillaume.papin@epitech.eu>
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; 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