--- /dev/null
+;;; promise-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*-
+;; Generated by the `loaddefs-generate' function.
+
+;; This file is part of GNU Emacs.
+
+;;; Code:
+
+(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path)))
+
+
+\f
+;;; Generated autoloads from promise.el
+
+(autoload 'promise-chain "promise" "\
+Extract PROMISE, BODY include then, catch, done and finally.
+
+Extract the following code...
+
+ (promise-chain (promise-new ...)
+ (then
+ (lambda (value)
+ ...))
+
+ (catch
+ (lambda (reason)
+ ...))
+
+ (done
+ (lambda (value)
+ ...))
+
+ (finally
+ (lambda () ...))
+
+ ;; Anaphoric versions of `then' and `catch'.
+
+ (thena (message \"result -> %s\" result)
+ ...)
+
+ (catcha (message \"error: reason -> %s\" reason)
+ ...))
+
+as below.
+
+ (let ((promise (promise-new ...)))
+ (setf promise (promise-then promise
+ (lambda (value)
+ ...)))
+
+ (setf promise (promise-catch promise
+ (lambda (value)
+ ...)))
+
+ (setf promise (promise-done promise
+ (lambda (reason)
+ ...)))
+
+ (setf promise (promise-finally promise
+ (lambda ()
+ ...)))
+
+ (setf promise (promise-then promise
+ (lambda (result)
+ (message \"result -> %s\" result)
+ ...)))
+
+ (setf promise (promise-catch promise
+ (lambda (reason)
+ (message \"error: reason -> %s\" reason)
+ ...)))
+ promise)
+
+(fn PROMISE &rest BODY)" nil t)
+(function-put 'promise-chain 'lisp-indent-function 1)
+(register-definition-prefixes "promise" '("promise"))
+
+\f
+;;; Generated autoloads from promise-core.el
+
+(register-definition-prefixes "promise-core" '("promise-"))
+
+\f
+;;; Generated autoloads from promise-es6-extensions.el
+
+(register-definition-prefixes "promise-es6-extensions" '("promise-"))
+
+\f
+;;; Generated autoloads from promise-rejection-tracking.el
+
+(register-definition-prefixes "promise-rejection-tracking" '("promise-"))
+\f
+;;; End of scraped data
+
+(provide 'promise-autoloads)
+
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; no-native-compile: t
+;; coding: utf-8-emacs-unix
+;; End:
+
+;;; promise-autoloads.el ends here
--- /dev/null
+;;; promise-core.el --- This is a simple implementation of Promises/A+. -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2016-2017 chuntaro
+
+;; Author: chuntaro <chuntaroNOSPAMsakura-games.jp>
+;; URL: https://github.com/chuntaro/emacs-promise
+;; Keywords: async promise 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/>.
+
+;; The original JavaScript code is:
+;;
+;; Copyright (c) 2014 Forbes Lindesay
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a copy
+;; of this software and associated documentation files (the "Software"), to deal
+;; in the Software without restriction, including without limitation the rights
+;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+;; copies of the Software, and to permit persons to whom the Software is
+;; furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+;; THE SOFTWARE.
+
+;;; Commentary:
+
+;; This implementation ported the following Promises/A+ implementation faithfully.
+;; https://github.com/then/promise/blob/master/src/core.js
+;;
+;; This file contains the core Promises/A+ API.
+;; (promise-new fn) or (make-instance 'promise-class :fn fn)
+;; (promise-then ((this promise-class) &optional on-fulfilled on-rejected))
+
+;;; Code:
+
+(require 'eieio)
+(require 'cl-lib)
+(eval-when-compile (require 'subr-x))
+
+(defun promise--asap (task)
+ (run-at-time 0.001 nil task))
+
+(defun promise--type-of (obj)
+ (cond
+ ((not (vectorp obj))
+ (type-of obj))
+ ((cl-struct-p obj)
+ ;; Code copied from `cl--describe-class'.
+ (cl--class-name (symbol-value (aref obj 0))))
+ ((eieio-object-p obj)
+ (eieio-object-class obj))
+ (t
+ 'vector)))
+
+(defun promise--is-object (obj)
+ (or (cl-struct-p obj)
+ (eieio-object-p obj)))
+
+(defsubst promise--find-then-method (obj)
+ (cl-find-method #'promise-then '() (list (promise--type-of obj))))
+
+(defun promise--find-then-function (obj)
+ (when-let (method (promise--find-then-method obj))
+ (cl--generic-method-function method)))
+
+;; States:
+;;
+;; 0 - pending
+;; 1 - fulfilled with _value
+;; 2 - rejected with _value
+;; 3 - adopted the state of another promise, _value
+;;
+;; once the state is no longer pending (0) it is immutable
+
+;; to avoid using condition-case inside critical functions, we
+;; extract them to here.
+(defvar promise--last-error nil)
+(defconst promise--is-error (cl-gensym "promise-error"))
+(defun promise--get-then (obj)
+ (condition-case ex
+ (promise--find-then-function obj)
+ (error (setf promise--last-error ex)
+ promise--is-error)))
+
+(defun promise--try-call-one (fn a)
+ (condition-case ex
+ (funcall fn a)
+ (error (setf promise--last-error ex)
+ promise--is-error)))
+
+(defun promise--try-call-two (fn a b)
+ (condition-case ex
+ (funcall fn a b)
+ (error (setf promise--last-error ex)
+ promise--is-error)))
+
+(defclass promise-class ()
+ ((_deferred-state :accessor promise-_deferred-state :initform 0)
+ (_state :accessor promise-_state :initform 0)
+ (_value :accessor promise-_value :initform nil)
+ (_deferreds :accessor promise-_deferreds :initform nil)
+ ;; for rejection-tracking
+ (_rejection-id :accessor promise-_rejection-id :initform nil)))
+(defvar promise--on-handle nil)
+(defvar promise--on-reject nil)
+
+(cl-defmethod initialize-instance ((this promise-class) &optional args)
+ (cl-call-next-method this)
+ (let ((fn (plist-get args :fn)))
+ (unless (eq fn #'ignore)
+ (promise--do-resolve fn this))))
+
+(defun promise-new (fn)
+ (make-instance 'promise-class :fn fn))
+
+(cl-defmethod promise-then ((this promise-class) &optional on-fulfilled on-rejected)
+ (if (not (eq (promise--type-of this) 'promise-class))
+ (promise--safe-then this on-fulfilled on-rejected)
+ (let ((res (promise-new #'ignore)))
+ (promise--handle this
+ (promise--handler-new on-fulfilled
+ on-rejected
+ res))
+ res)))
+
+(defun promise--safe-then (self on-fulfilled on-rejected)
+ (make-instance (promise--type-of self)
+ :fn (lambda (resolve reject)
+ (let ((res (promise-new #'ignore)))
+ (promise-then res resolve reject)
+ (promise--handle self
+ (promise--handler-new on-fulfilled
+ on-rejected
+ res))))))
+
+(defun promise--handle (self deferred)
+ (while (= (promise-_state self) 3)
+ (setf self (promise-_value self)))
+ (when promise--on-handle
+ (funcall promise--on-handle self))
+ (if (= (promise-_state self) 0)
+ (cond
+ ((= (promise-_deferred-state self) 0)
+ (setf (promise-_deferred-state self) 1
+ (promise-_deferreds self) deferred))
+ ((= (promise-_deferred-state self) 1)
+ (setf (promise-_deferred-state self) 2
+ (promise-_deferreds self) (list (promise-_deferreds self)
+ deferred)))
+ (t
+ (setf (promise-_deferreds self) (nconc (promise-_deferreds self)
+ (list deferred)))))
+ (promise--handle-resolved self deferred)))
+
+(defun promise--handle-resolved (self deferred)
+ (promise--asap
+ (lambda ()
+ (let-alist deferred
+ (let ((cb (if (= (promise-_state self) 1) .on-fulfilled .on-rejected)))
+ (if (not cb)
+ (if (= (promise-_state self) 1)
+ (promise--resolve .promise (promise-_value self))
+ (promise--reject .promise (promise-_value self)))
+ (let ((ret (promise--try-call-one cb (promise-_value self))))
+ (if (eq ret promise--is-error)
+ (promise--reject .promise promise--last-error)
+ (promise--resolve .promise ret)))))))))
+
+(defun promise--resolve (self new-value)
+ "Promise Resolution Procedure.
+See: https://github.com/promises-aplus/promises-spec#the-promise-resolution-procedure"
+ (cl-block nil
+ (when (eq new-value self)
+ (cl-return (promise--reject
+ self
+ '(wrong-type-argument
+ "A promise cannot be resolved with itself."))))
+ (when (and new-value
+ (promise--is-object new-value))
+ (let ((then (promise--get-then new-value)))
+ (when (eq then promise--is-error)
+ (cl-return (promise--reject self promise--last-error)))
+ (cond
+ ((and (eq then (ignore-errors (promise--find-then-function self)))
+ (promise-class-p new-value))
+ (setf (promise-_state self) 3
+ (promise-_value self) new-value)
+ (promise--finale self)
+ (cl-return))
+ ((functionp then)
+ (promise--do-resolve (lambda (resolve reject)
+ (promise-then new-value resolve reject))
+ self)
+ (cl-return)))))
+ (setf (promise-_state self) 1
+ (promise-_value self) new-value)
+ (promise--finale self)))
+
+(defun promise--reject (self new-value)
+ (setf (promise-_state self) 2
+ (promise-_value self) new-value)
+ (when promise--on-reject
+ (funcall promise--on-reject self new-value))
+ (promise--finale self))
+
+(defun promise--finale (self)
+ (when (= (promise-_deferred-state self) 1)
+ (promise--handle self (promise-_deferreds self))
+ (setf (promise-_deferreds self) nil))
+ (when (= (promise-_deferred-state self) 2)
+ (dolist (deferred (promise-_deferreds self))
+ (promise--handle self deferred))
+ (setf (promise-_deferreds self) nil))
+ nil)
+
+(defun promise--handler-new (on-fulfilled on-rejected promise)
+ `((on-fulfilled . ,(and (functionp on-fulfilled) on-fulfilled))
+ (on-rejected . ,(and (functionp on-rejected) on-rejected))
+ (promise . ,promise)))
+
+;; Take a potentially misbehaving resolver function and make sure
+;; onFulfilled and onRejected are only called once.
+;;
+;; Makes no guarantees about asynchrony.
+(defun promise--do-resolve (fn promise)
+ (let* ((done nil)
+ (res (promise--try-call-two
+ fn
+ (lambda (&optional value)
+ (unless done
+ (setf done t)
+ (promise--resolve promise value)))
+ (lambda (&optional reason)
+ (unless done
+ (setf done t)
+ (promise--reject promise reason))))))
+ (when (and (not done)
+ (eq res promise--is-error))
+ (setf done t)
+ (promise--reject promise promise--last-error))))
+
+(provide 'promise-core)
+;;; promise-core.el ends here
--- /dev/null
+;;; promise-done.el --- Porting done.js -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2016-2017 chuntaro
+
+;; Author: chuntaro <chuntaroNOSPAMsakura-games.jp>
+;; URL: https://github.com/chuntaro/emacs-promise
+;; Keywords: async promise 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/>.
+
+;; The original JavaScript code is:
+;;
+;; Copyright (c) 2014 Forbes Lindesay
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a copy
+;; of this software and associated documentation files (the "Software"), to deal
+;; in the Software without restriction, including without limitation the rights
+;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+;; copies of the Software, and to permit persons to whom the Software is
+;; furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+;; THE SOFTWARE.
+
+;;; Commentary:
+
+;; This implementation ported the following implementation faithfully.
+;; https://github.com/then/promise/blob/master/src/done.js
+
+;;; Code:
+
+(require 'promise-core)
+
+(cl-defmethod promise-done ((this promise-class) &optional on-fulfilled on-rejected)
+ (let ((self (if (or on-fulfilled on-rejected)
+ (promise-then this on-fulfilled on-rejected)
+ this)))
+ (promise-then self nil (lambda (err)
+ (run-at-time 0 nil
+ (lambda ()
+ (signal 'error (list err)))))))
+ nil)
+
+(provide 'promise-done)
+;;; promise-done.el ends here
--- /dev/null
+;;; promise-es6-extensions.el --- Porting es6-extensions.js -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2016-2017 chuntaro
+
+;; Author: chuntaro <chuntaroNOSPAMsakura-games.jp>
+;; URL: https://github.com/chuntaro/emacs-promise
+;; Keywords: async promise 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/>.
+
+;; The original JavaScript code is:
+;;
+;; Copyright (c) 2014 Forbes Lindesay
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a copy
+;; of this software and associated documentation files (the "Software"), to deal
+;; in the Software without restriction, including without limitation the rights
+;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+;; copies of the Software, and to permit persons to whom the Software is
+;; furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+;; THE SOFTWARE.
+
+;;; Commentary:
+
+;; This implementation ported the following implementation faithfully.
+;; https://github.com/then/promise/blob/master/src/es6-extensions.js
+;;
+;; This file contains the ES6 extensions to the core Promises/A+ API.
+;; (promise-resolve value)
+;; (promise-all [values...])
+;; (promise-reject value)
+;; (promise-race [values...])
+;; (promise-catch ((this promise-class) on-rejected))
+
+;;; Code:
+
+(require 'promise-core)
+
+(defsubst promise--then-function ()
+ (ignore-errors
+ (cl--generic-method-function (cl-find-method #'promise-then
+ '()
+ '(promise-class)))))
+
+;; Static Functions
+
+(defun promise--value (value)
+ (let ((p (promise-new #'ignore)))
+ (setf (promise-_state p) 1
+ (promise-_value p) value)
+ p))
+
+(defconst promise-t (promise--value t))
+(defconst promise-nil (promise--value nil))
+(defconst promise-zero (promise--value 0))
+(defconst promise-emptystring (promise--value ""))
+
+(defun promise-resolve (value)
+ (cond
+ ((promise-class-p value) value)
+
+ ((eq value t) promise-t)
+ ((eq value nil) promise-nil)
+ ((eq value 0) promise-zero)
+ ((eq value "") promise-emptystring)
+
+ ((promise--is-object value)
+ (condition-case ex
+ (let ((then (ignore-errors (promise--find-then-function value))))
+ (if (functionp then)
+ (promise-new (lambda (resolve reject)
+ (promise-then value resolve reject)))
+ (promise--value value)))
+ (error (promise-new (lambda (_resolve reject)
+ (funcall reject ex))))))
+ (t
+ (promise--value value))))
+
+(defun promise-all (arr)
+ (let ((args (cl-coerce arr 'vector)))
+
+ (promise-new
+ (lambda (resolve reject)
+ (if (zerop (length args))
+ (funcall resolve [])
+ (let ((remaining (length args)))
+ (cl-labels
+ ((res (i val)
+ (cl-block nil
+ (when (and val (promise--is-object val))
+ (cond
+ ((and (promise-class-p val)
+ (eq (promise--find-then-function val)
+ (promise--then-function)))
+ (while (= (promise-_state val) 3)
+ (setf val (promise-_value val)))
+ (when (= (promise-_state val) 1)
+ (cl-return (res i (promise-_value val))))
+ (when (= (promise-_state val) 2)
+ (funcall reject (promise-_value val)))
+ (promise-then val
+ (lambda (val)
+ (res i val))
+ reject)
+ (cl-return))
+ (t
+ (let ((then (ignore-errors
+ (promise--find-then-function val))))
+ (when (functionp then)
+ (let ((p (promise-new
+ (lambda (resolve reject)
+ (promise-then val
+ resolve
+ reject)))))
+ (promise-then p
+ (lambda (val)
+ (res i val))
+ reject)
+ (cl-return)))))))
+ (setf (aref args i) val)
+ (when (zerop (cl-decf remaining))
+ (funcall resolve args)))))
+ (cl-loop for i from 0
+ for arg across args
+ do (res i arg)))))))))
+
+(defun promise-reject (value)
+ (promise-new (lambda (_resolve reject)
+ (funcall reject value))))
+
+(defun promise-race (values)
+ (promise-new (lambda (resolve reject)
+ (cl-loop for value across (cl-coerce values 'vector)
+ do (promise-then (promise-resolve value)
+ resolve
+ reject)))))
+
+(cl-defmethod promise-catch ((this promise-class) on-rejected)
+ (promise-then this nil on-rejected))
+
+(provide 'promise-es6-extensions)
+;;; promise-es6-extensions.el ends here
--- /dev/null
+;;; promise-finally.el --- Porting finally.js -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2016-2017 chuntaro
+
+;; Author: chuntaro <chuntaroNOSPAMsakura-games.jp>
+;; URL: https://github.com/chuntaro/emacs-promise
+;; Keywords: async promise 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/>.
+
+;; The original JavaScript code is:
+;;
+;; Copyright (c) 2014 Forbes Lindesay
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a copy
+;; of this software and associated documentation files (the "Software"), to deal
+;; in the Software without restriction, including without limitation the rights
+;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+;; copies of the Software, and to permit persons to whom the Software is
+;; furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+;; THE SOFTWARE.
+
+;;; Commentary:
+
+;; This implementation ported the following implementation faithfully.
+;; https://github.com/then/promise/blob/master/src/finally.js
+
+;;; Code:
+
+(require 'promise-es6-extensions)
+
+(cl-defmethod promise-finally ((this promise-class) f)
+ (promise-then this
+ (lambda (value)
+ (promise-then (promise-resolve (funcall f))
+ (lambda (_) value)))
+ (lambda (err)
+ (promise-then (promise-resolve (funcall f))
+ (lambda (_)
+ (promise-reject err))))))
+
+(provide 'promise-finally)
+;;; promise-finally.el ends here
--- /dev/null
+(define-package "promise" "20210307.727" "Promises/A+"
+ '((emacs "25.1"))
+ :commit "cec51feb5f957e8febe6325335cf57dc2db6be30" :authors
+ '(("chuntaro" . "chuntaroNOSPAMsakura-games.jp"))
+ :maintainers
+ '(("chuntaro" . "chuntaroNOSPAMsakura-games.jp"))
+ :maintainer
+ '("chuntaro" . "chuntaroNOSPAMsakura-games.jp")
+ :keywords
+ '("async" "promise" "convenience")
+ :url "https://github.com/chuntaro/emacs-promise")
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
--- /dev/null
+;;; promise-rejection-tracking.el --- Porting rejection-tracking.js -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2016-2017 chuntaro
+
+;; Author: chuntaro <chuntaroNOSPAMsakura-games.jp>
+;; URL: https://github.com/chuntaro/emacs-promise
+;; Keywords: async promise 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/>.
+
+;; The original JavaScript code is:
+;;
+;; Copyright (c) 2014 Forbes Lindesay
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a copy
+;; of this software and associated documentation files (the "Software"), to deal
+;; in the Software without restriction, including without limitation the rights
+;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+;; copies of the Software, and to permit persons to whom the Software is
+;; furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+;; THE SOFTWARE.
+
+;;; Commentary:
+
+;; This implementation ported the following implementation faithfully.
+;; https://github.com/then/promise/blob/master/src/rejection-tracking.js
+
+;; TODO: Display easy-to-read backtrace
+
+;;; Code:
+
+(require 'promise-core)
+
+(defun promise--warn (message &rest args)
+ (display-warning 'promise (apply #'format-message message args)))
+
+(defvar promise--default-whitelist '(void-function
+ void-variable
+ wrong-type-argument
+ args-out-of-range))
+
+(defvar promise--enabled nil)
+
+(defun promise-rejection-tracking-disable ()
+ (setf promise--enabled nil
+ promise--on-handle nil
+ promise--on-reject nil))
+
+(defun promise-rejection-tracking-enable (&optional options)
+ (when promise--enabled (promise-rejection-tracking-disable))
+ (setf promise--enabled t)
+ (let ((id -1)
+ (display-id -1)
+ (rejections (make-hash-table)))
+ (cl-flet*
+ ((rejections (id symbol) (alist-get symbol (gethash id rejections)))
+ (rejections-set (id symbol value)
+ (setf (alist-get symbol (gethash id rejections))
+ value))
+ (options (sym) (alist-get sym options))
+
+ (on-unhandled (id)
+ (when (or (options 'all-rejections)
+ (promise--match-whitelist
+ (rejections id 'error)
+ (or (options 'whitelist)
+ promise--default-whitelist)))
+ (rejections-set id 'display-id (cl-incf display-id))
+ (cond
+ ((options 'on-unhandled)
+ (rejections-set id 'logged t)
+ (funcall (options 'on-unhandled)
+ (rejections id 'display-id)
+ (rejections id 'error)))
+ (t
+ (rejections-set id 'logged t)
+ (promise--log-error (rejections id 'display-id)
+ (rejections id 'error))))))
+ (on-handled (id)
+ (when (rejections id 'logged)
+ (cond
+ ((options 'on-handled)
+ (funcall (options 'on-handled)
+ (rejections id 'display-id)
+ (rejections id 'error)))
+ ((not (rejections id 'on-unhandled))
+ (promise--warn "Promise Rejection Handled (id:%d):"
+ (rejections id 'display-id))
+ (promise--warn " This means you can ignore any previous messages of the form \"Possible Unhandled Promise Rejection\" with id %d."
+ (rejections id 'display-id)))))))
+ (setf promise--on-handle
+ (lambda (promise)
+ (when (and (= (promise-_state promise) 2) ; IS REJECTED
+ (gethash (promise-_rejection-id promise) rejections))
+ (if (rejections (promise-_rejection-id promise) 'logged)
+ (on-handled (promise-_rejection-id promise))
+ (cancel-timer (rejections (promise-_rejection-id promise) 'timeout)))
+ (remhash (promise-_rejection-id promise) rejections)))
+ promise--on-reject
+ (lambda (promise err)
+ (when (zerop (promise-_deferred-state promise)) ; not yet handled
+ (setf (promise-_rejection-id promise) (cl-incf id))
+ (puthash (promise-_rejection-id promise)
+ `((display-id . nil)
+ (error . ,err)
+ (timeout . ,(run-at-time
+ (if (promise--match-whitelist
+ err promise--default-whitelist)
+ 0.1
+ 2)
+ nil
+ (lambda ()
+ (on-unhandled (promise-_rejection-id promise)))))
+ (logged . nil))
+ rejections)))))))
+
+(defun promise--log-error (id error)
+ (promise--warn "Possible Unhandled Promise Rejection (id:%d):" id)
+ (display-warning 'promise (prin1-to-string error)))
+
+(defun promise--match-whitelist (error list)
+ (cl-some (lambda (cls)
+ (eq (or (and (consp error)
+ (car error))
+ error)
+ cls))
+ list))
+
+(provide 'promise-rejection-tracking)
+;;; promise-rejection-tracking.el ends here
--- /dev/null
+;;; promise.el --- Promises/A+ -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2016-2017 chuntaro
+
+;; Author: chuntaro <chuntaroNOSPAMsakura-games.jp>
+;; URL: https://github.com/chuntaro/emacs-promise
+;; Package-Requires: ((emacs "25.1"))
+;; Version: 1.1
+;; Keywords: async promise 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/>.
+
+;; The original JavaScript code is:
+;;
+;; Copyright (c) 2014 Forbes Lindesay
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a copy
+;; of this software and associated documentation files (the "Software"), to deal
+;; in the Software without restriction, including without limitation the rights
+;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+;; copies of the Software, and to permit persons to whom the Software is
+;; furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+;; THE SOFTWARE.
+
+;;; Commentary:
+
+;; This is a simple implementation of Promises/A+.
+;;
+;; This implementation ported the following Promises/A+ implementation faithfully.
+;; https://github.com/then/promise
+;;
+;; * The same API as JavaScript version Promise can be used.
+;; * then, catch, resolve, reject, all, race, etc...
+;; * supports "thenable"
+;; * supports "Inheritance of Promise"
+;; * supports "rejection-tracking"
+;;
+;; Usage:
+;; See `promise-examples.el' for details.
+;; https://raw.githubusercontent.com/chuntaro/emacs-promise/master/examples/promise-examples.el
+;; You can check the operation while downloading and running it interactively.
+;;
+;; (require 'promise)
+;;
+;; ;; Please be sure to enable it when developing.
+;; (promise-rejection-tracking-enable '((all-rejections . t)))
+;;
+;; (defun do-something-async (delay-sec value)
+;; "Return `Promise' to resolve the value asynchronously."
+;; (promise-new (lambda (resolve _reject)
+;; (run-at-time delay-sec
+;; nil
+;; (lambda ()
+;; (funcall resolve value))))))
+;;
+;; (defun example4 ()
+;; "All processes are asynchronous Promise chain."
+;; (promise-chain (do-something-async 1 33)
+;; (then (lambda (result)
+;; (message "first result: %s" result)
+;; (do-something-async 1 (* result 2))))
+;;
+;; (then (lambda (second-result)
+;; (message "second result: %s" second-result)
+;; (do-something-async 1 (* second-result 2))))
+;;
+;; (then (lambda (third-result)
+;; (message "third result: %s" third-result)))))
+
+;;; Code:
+
+(require 'promise-es6-extensions)
+(require 'promise-done)
+(require 'promise-finally)
+(require 'promise-rejection-tracking)
+
+;;;###autoload
+(defmacro promise-chain (promise &rest body)
+ "Extract PROMISE, BODY include then, catch, done and finally.
+
+Extract the following code...
+
+ (promise-chain (promise-new ...)
+ (then
+ (lambda (value)
+ ...))
+
+ (catch
+ (lambda (reason)
+ ...))
+
+ (done
+ (lambda (value)
+ ...))
+
+ (finally
+ (lambda () ...))
+
+ ;; Anaphoric versions of `then' and `catch'.
+
+ (thena (message \"result -> %s\" result)
+ ...)
+
+ (catcha (message \"error: reason -> %s\" reason)
+ ...))
+
+as below.
+
+ (let ((promise (promise-new ...)))
+ (setf promise (promise-then promise
+ (lambda (value)
+ ...)))
+
+ (setf promise (promise-catch promise
+ (lambda (value)
+ ...)))
+
+ (setf promise (promise-done promise
+ (lambda (reason)
+ ...)))
+
+ (setf promise (promise-finally promise
+ (lambda ()
+ ...)))
+
+ (setf promise (promise-then promise
+ (lambda (result)
+ (message \"result -> %s\" result)
+ ...)))
+
+ (setf promise (promise-catch promise
+ (lambda (reason)
+ (message \"error: reason -> %s\" reason)
+ ...)))
+ promise)"
+ (declare (indent 1) (debug t))
+ `(let ((promise ,promise))
+ ,@(mapcar (lambda (sexp)
+ (let ((fn (car-safe sexp))
+ (args (cdr-safe sexp)))
+ (cl-case fn
+ (promise-new
+ `(setf promise ,sexp))
+ ((promise-then
+ promise-catch
+ promise-done
+ promise-finally)
+ `(setf promise (,fn promise ,@args)))
+ (catch
+ `(setf promise (promise-catch promise ,@args)))
+ (then
+ `(setf promise (promise-then promise ,@args)))
+ (done
+ `(setf promise (promise-done promise ,@args)))
+ (finally
+ `(setf promise (promise-finally promise ,@args)))
+ (thena
+ `(setf promise (promise-then promise (lambda (result) ,@args))))
+ (catcha
+ `(setf promise (promise-catch promise (lambda (reason) ,@args))))
+ (otherwise
+ sexp))))
+ body)
+ promise))
+
+;;
+;; Promise version of various utility functions
+;;
+
+(require 'url-http)
+
+(defun promise:run-at-time (time function &rest args)
+ "Return promise to funcall FUNCTION with ARGS at specified TIME.
+
+Arguments:
+ - TIME can accept the various formats. See `run-at-time'.
+ - FUNCTION is funcalled with ARGS.
+
+Resolve:
+ - The return value from funcalled FUNCTION.
+
+Reject:
+ - <Never rejected>"
+ (declare (indent 1))
+ (promise-new
+ (lambda (resolve _reject)
+ (run-at-time time nil
+ (lambda ()
+ (funcall resolve (apply function args)))))))
+
+(defun promise:delay (time &optional value)
+ "Return promise to delay specified TIME.
+
+Arguments:
+ - TIME can accept the various formats. See `run-at-time'.
+ - VALUE is return value when resolved this function.
+
+Resolve:
+ - VALUE
+
+Reject:
+ - <Never rejected>"
+ (declare (indent 1))
+ (promise-new
+ (lambda (resolve _reject)
+ (run-at-time time
+ nil
+ (lambda ()
+ (funcall resolve value))))))
+
+(defun promise:time-out (time &optional reason)
+ "Return promise to reject after specified TIME with REASON.
+
+Arguments:
+ - TIME an accept various format. See `run-at-time'.
+ - REASON is return value when rejected this function.
+
+Resolve:
+ - <Never resolved>
+
+Reject:
+ - REASON"
+ (declare (indent 1))
+ (promise-new
+ (lambda (_resolve reject)
+ (run-at-time time nil
+ (lambda ()
+ (funcall reject reason))))))
+
+(defun promise:make-process (command)
+ "Return promise to make new asynchronous COMMAND.
+
+Arguments:
+ - COMMAND is program and shell arguments list of string.
+
+See `promise:make-process-with-handler' for Resolve and Reject sections."
+ (funcall #'promise:make-process-with-handler command))
+
+(defun promise:make-process-send-buffer (command buf)
+ "Return promise to make new asynchronous COMMAND.
+
+Arguments:
+ - COMMAND is program and shell arguments list of string.
+ - BUF is buffer, a format that can be accepted by `with-current-buffer'.
+ `buffer-string' of BUF is sent with EOF after process has been invoked.
+
+See `promise:make-process-with-handler' for Resolve and Reject sections."
+ (funcall #'promise:make-process-with-handler
+ command
+ (lambda (proc)
+ (with-current-buffer buf
+ (process-send-region proc (point-min) (point-max))
+ (process-send-eof proc)))))
+
+(defun promise:make-process-send-string (command string)
+ "Return promise to make new asynchronous COMMAND.
+
+Arguments:
+ - COMMAND is program and shell arguments list of string.
+ - STRING is sent with EOF after process has been invoked.
+
+See `promise:make-process-with-handler' for Resolve and Reject sections."
+ (funcall #'promise:make-process-with-handler
+ command
+ (lambda (proc)
+ (process-send-string proc string)
+ (process-send-eof proc))))
+
+(defun promise:make-process-with-handler (command &optional handler merge-stderr)
+ "Return promise to make new asynchronous COMMAND.
+
+Arguments:
+ - COMMAND is program and shell arguments list of string.
+ - HANDLER is function, called with process object after program is invoked.
+ - MERGE-STDERR is boolean, whether merge stdout and stderr or not.
+
+Resolve:
+ - A list like as (stdout stderr) when process finish with exitcode 0.
+ stdout and stderr are string.
+
+Reject:
+ - A list like as (event stdout stderr) when process doesn't finish exitcode 0.
+ event, stdout and stderr are string.
+ The event is documented at https://www.gnu.org/software/emacs/manual/html_node/elisp/Sentinels.html"
+ (promise-new
+ (lambda (resolve reject)
+ (let* ((program (car command))
+ (stdout (generate-new-buffer (concat "*" program "-stdout*")))
+ (stderr (unless merge-stderr
+ (generate-new-buffer (concat "*" program "-stderr*"))))
+ (stderr-pipe (unless merge-stderr
+ (make-pipe-process
+ :name (concat "*" program "-stderr-pipe*")
+ :noquery t
+ ;; use :filter instead of :buffer, to get rid of "Process Finished" lines
+ :filter (lambda (_ output)
+ (with-current-buffer stderr
+ (insert output))))))
+ (cleanup (lambda ()
+ (kill-buffer stdout)
+ (unless merge-stderr
+ (delete-process stderr-pipe)
+ (kill-buffer stderr)))))
+ (condition-case err
+ (let ((proc (if merge-stderr
+ (make-process :name program :buffer stdout :command command)
+ (make-process :name program :buffer stdout :command command :stderr stderr-pipe))))
+ (set-process-sentinel
+ proc
+ (lambda (_process event)
+ (unwind-protect
+ (let ((stdout-str (with-current-buffer stdout
+ (buffer-string)))
+ (stderr-str (unless merge-stderr
+ (with-current-buffer stderr
+ (buffer-string)))))
+ (if (string= event "finished\n")
+ (funcall resolve (list stdout-str stderr-str))
+ (funcall reject (list event stdout-str stderr-str))))
+ (funcall cleanup))))
+ (when handler
+ (funcall handler proc)))
+ (error (funcall cleanup)
+ (signal (car err) (cdr err))))))))
+
+(require 'subr-x)
+(defun promise:maybe-message (msg)
+ "Display MSG if non-blank."
+ (let ((m (string-trim-right msg)))
+ (when (not (string-empty-p m))
+ (message "%s" m))))
+
+(require 'seq)
+(defun promise:make-process-string (command)
+ "Return promise to make new asynchronous COMMAND.
+
+Arguments:
+ - COMMAND is program and shell arguments list of string.
+
+Resolve:
+ - Process stdout as string when process finish with exitcode 0.
+
+Reject:
+ - Event as string represented process exit state.
+ The event is documented at https://www.gnu.org/software/emacs/manual/html_node/elisp/Sentinels.html"
+ (promise-then
+ (funcall #'promise:make-process command)
+ (lambda (res)
+ (seq-let (stdout stderr) res
+ (promise:maybe-message (propertize stderr 'face '(:foreground "yellow")))
+ stdout))
+ (lambda (err)
+ (seq-let (event stdout stderr) err
+ (promise:maybe-message (propertize stdout 'face '(:foreground "black" :background "white")))
+ (promise:maybe-message (propertize stderr 'face '(:foreground "red")))
+ (promise-reject event)))))
+
+(defun promise:make-shell-command (script &optional dir)
+ "Return promise to make new asynchronous shell SCRIPT.
+
+Arguments:
+ - SCRIPT is string, will be passed sh -c.
+ - DIR is directory path in which SCRIPT will be executed.
+
+See `promise:make-process-string' for Resolve and Reject sections."
+ (let ((default-directory (or dir default-directory)))
+ (promise:make-process-string (list shell-file-name shell-command-switch script))))
+
+(defun promise:make-thread (function &rest args)
+ "Return promise to make new thread via `make-thread'.
+
+Arguments:
+ - FUNCTION is funcalled with ARGS in new thread.
+
+Resolve:
+ - Return value from funcalled FUNCTION in the thread.
+
+Reject:
+ - Error object while running in the thread."
+ (promise-new
+ (lambda (resolve reject)
+ (if (not (fboundp 'make-thread))
+ (error "`promise:make-thread' needs `make-thread' attached to Emacs-26.1 or above")
+ (make-thread
+ (lambda ()
+ (condition-case err
+ (funcall resolve (apply function args))
+ (error (funcall reject err)))))))))
+
+(defun promise:wrap-message (promise)
+ "Return promise to show debug message after PROMISE resolved.
+
+Arguments:
+ - PROMISE is any promise object.
+
+Resolve:
+ - Return original return value when PROMISE resolved.
+
+Reject:
+ - Return original return value when PROMISE rejected."
+ (promise-new
+ (lambda (resolve reject)
+ (promise-then
+ promise
+ (lambda (res)
+ (message "%s: %s"
+ (propertize "Result" 'face '(:foreground "green"))
+ (string-trim-right res))
+ (funcall resolve res))
+ (lambda (err)
+ (message "%s: %s"
+ (propertize "Error" 'face '(:foreground "red"))
+ (string-trim-right err))
+ (funcall reject err))))))
+
+(defun promise:url-retrieve (url)
+ "Return promise to retrieve response body from URL.
+
+Arguments:
+ - URL is either a string or a parsed URL. See `url-retrieve'.
+
+Resolve:
+ - Response body as a string retrieved from the URL.
+
+Reject:
+ - Error object while retrieving URL."
+ (promise-new
+ (lambda (resolve reject)
+ (url-retrieve url
+ (lambda (status)
+ ;; All errors are reliably captured and rejected with appropriate values.
+ (if (plist-get status :error)
+ (funcall reject (plist-get status :error))
+ (condition-case err
+ (if (not (url-http-parse-headers))
+ (funcall reject (buffer-string))
+ (search-forward-regexp "\n\\s-*\n" nil t)
+ (funcall resolve (buffer-substring (point) (point-max))))
+ (error (funcall reject err)))))))))
+
+(require 'xml) ; for `xml-parse-region'
+
+(defun promise:xml-retrieve (url)
+ "Return promise to retrieve XML object parsed from contents from URL.
+
+Arguments:
+ - URL is either a string or a parsed URL. See `url-retrieve'.
+
+Resolve:
+ - XML object parsed by `xml-parse-region'.
+
+Reject:
+ - Error object while retrieving URL and parsing contents."
+ (promise-new
+ (lambda (resolve reject)
+ (url-retrieve url
+ (lambda (status)
+ ;; All errors are reliably captured and rejected with appropriate values.
+ (if (plist-get status :error)
+ (funcall reject (plist-get status :error))
+ (condition-case err
+ (if (not (url-http-parse-headers))
+ (funcall reject (buffer-string))
+ (search-forward-regexp "\n\\s-*\n" nil t)
+ (funcall resolve (xml-parse-region)))
+ (error (funcall reject err)))))))))
+
+(defun promise:request (url)
+ "Return promise to request URL via `request'.
+
+Arguments:
+ - URL is a target url as string.
+
+Resolve:
+ - Response body as string.
+
+Reject:
+ - A string list like as (status-code response-header response-body)"
+ (promise:request-with-args url nil))
+
+(defun promise:request-post (url data)
+ "Return promise to POST DATA to URL via `request'.
+
+Arguments:
+ - URL is a target url as string.
+ - DATA is post data alist.
+
+Resolve:
+ - Response body as string.
+
+Reject:
+ - A string list like as (status-code response-header response-body)"
+ (declare (indent 1))
+ (promise:request-with-args url `(:type "POST" :data ',data)))
+
+(declare-function request "request.el" (url &rest settings))
+(declare-function request-response-status-code "request.el" (response))
+(declare-function request-response--raw-header "request.el" (response))
+(declare-function request-response-data "request.el" (response))
+
+(defun promise:request-with-args (url arglist)
+ "Return promise to request URL via `request' with ARGLIST.
+
+Arguments:
+ - URL is a target url as string.
+
+Resolve:
+ - Response body as string.
+
+Reject:
+ - A string list like as (status-code response-header response-body)"
+ (declare (indent 1))
+
+ (require 'request)
+ (promise-new
+ (lambda (resolve reject)
+ (when (plist-get arglist :success)
+ (funcall reject "Success callback function is not customizable"))
+ (when (plist-get arglist :error)
+ (funcall reject "Error callback function is not customizable"))
+ (apply #'request url
+ :success (cl-function
+ (lambda (&key data &allow-other-keys)
+ (funcall resolve data)))
+ :error (cl-function
+ (lambda (&key response &allow-other-keys)
+ (funcall reject
+ (list (request-response-status-code response)
+ (request-response--raw-header response)
+ (request-response-data response)))))
+ arglist))))
+
+(declare-function async-start "async.el" (start-func &optional finish-func))
+(declare-function async-when-done "async.el" (proc &optional _change))
+
+(defun promise:async-start (start-func &optional finish-func)
+ "Return promise to eval function in a new Emacs process via `async-start'.
+
+Arguments:
+ - START-FUNC is function that will be evaled in new Emacs.
+ - FINISH-FUNC is function that will be evaled after START-FUNC evaled.
+
+Resolve:
+ - Return value from START-FUNC in the Emacs.
+
+Reject:
+ - Error object while evaluating START-FUNC and FINISH-FUNC."
+ (require 'async)
+ (promise-new
+ (lambda (resolve reject)
+ (set-process-sentinel (async-start start-func
+ (lambda (result)
+ (when finish-func
+ (funcall finish-func result))
+ (funcall resolve result)))
+ (lambda (process event)
+ (condition-case reason
+ (async-when-done process event)
+ (error (funcall reject reason))))))))
+
+(defun promise-wait (timeout promise)
+ "Return promise to wait synchronously until PROMISE is resolved or rejected or TIMEOUT.
+
+Arguments:
+ - TIMEOUT can accept the various formats. See `run-at-time'.
+ - PROMISE is any promise object.
+
+Resolve:
+ - Return (:fullfilled value), value is PROMISE resolved value.
+
+Reject:
+ - Return (:rejected reason), reason is PROMISE rejected reason.
+
+Timeout:
+ - Return (:timeouted)."
+ (declare (indent 1))
+ (catch 'done
+ (let* (handled
+ (timer (run-at-time timeout nil
+ (lambda ()
+ (unless handled
+ (setq handled t)
+ (throw 'done (promise-reject '(:timeouted))))))))
+ (promise-then promise
+ (lambda (value)
+ (unless handled
+ (setq handled t)
+ (cancel-timer timer)
+ (throw 'done (promise-resolve `(:fullfilled ,value)))))
+ (lambda (reason)
+ (unless handled
+ (setq handled t)
+ (cancel-timer timer)
+ (throw 'done (promise-reject `(:rejected ,reason))))))
+ (while t (accept-process-output)))))
+
+(defun promise-wait-value (promise)
+ "Return orignal value form PROMISE return value of `promise-wait'."
+ (seq-let (state value) (promise-_value promise)
+ (cond
+ ((eq :fullfilled state) value)
+ ((eq :rejected state) (error "Rejected: %s" (prin1-to-string value)))
+ ((eq :timeouted state) (error "Timeouted: %s" (prin1-to-string value))))))
+
+(defun promise-concurrent--internal (concurrent limit promisefn &optional no-reject-immediately-p)
+ "Internal function of `promise-concurrent'.
+
+Arguments:
+ - CONCURRENT is limited number of concurrent promises.
+ - LIMIT is number of PROMISEFN executions.
+ - PROMISEFN is function should return any promise object.
+ - If NO-REJECT-IMMEDIATELY-P is non-nil, returned promise is not reject immidiately."
+ (declare (indent 2))
+ (let ((pipeline (make-vector concurrent nil))
+ (results (make-vector limit nil))
+ (count -1)
+ reasons)
+ (dotimes (i concurrent)
+ (aset pipeline i
+ (promise-new
+ (lambda (resolve reject)
+ (cl-labels
+ ((worker (inx)
+ (if (not (< inx limit))
+ (funcall resolve)
+ (promise-chain (funcall promisefn inx)
+ (then (lambda (res)
+ (aset results inx res)
+ (worker (cl-incf count))))
+ (catch (lambda (reason)
+ (if (not no-reject-immediately-p)
+ (funcall reject reason)
+ (push `(,inx ,reason) reasons)
+ (worker (cl-incf count)))))))))
+ (worker (cl-incf count)))))))
+ (promise-chain (promise-all pipeline)
+ (then (lambda (_)
+ (if (not reasons)
+ results
+ (promise-reject `(,results ,reasons))))))))
+
+(defun promise-concurrent (concurrent limit promisefn)
+ "Return promise to run a limited number of concurrent promises.
+
+This function returns promise which immediately rejected if one
+of promises fails. This behavior corresponds to `promise-all'.
+See `promise-concurrent-no-reject-immidiately' with no reject immidiately.
+
+Arguments:
+ - CONCURRENT is limited number of concurrent promises.
+ - LIMIT is number of PROMISEFN executions.
+ - PROMISEFN is function should return any promise object.
+
+Resolve:
+ - Return vector includes values resolved for promise with respect to order.
+
+Reject:
+ - Return reason for the first rejection."
+ (declare (indent 2))
+ (funcall #'promise-concurrent--internal concurrent limit promisefn))
+
+(defun promise-concurrent-no-reject-immidiately (concurrent limit promisefn)
+ "Return promise to run a limited number of concurrent promises.
+
+This function returns promise which execute the whole promises if
+a promise fails. If all promises are fulfilled, only vectors
+with resolved values are returned. If one of promise is
+rejected, the whole promises are executed and the index and
+reason rejected as the second return value is returned after the
+whole state has been determined. In this case, the index location
+of the first return value is nil.
+See `promise-concurrent' with reject immidiately.
+
+Arguments:
+ - CONCURRENT is limited number of concurrent promises.
+ - LIMIT is number of PROMISEFN executions.
+ - PROMISEFN is function should return any promise object.
+
+Resolve:
+ - Return vector includes values resolved for promise with respect to order.
+
+Reject:
+ - Return (<vector> <list>)
+ <vector> includes values resolved for promise with respect to order.
+ <list> is list of (index reason)."
+ (declare (indent 2))
+ (funcall #'promise-concurrent--internal concurrent limit promisefn :no-reject-immediately))
+
+(provide 'promise)
+;;; promise.el ends here
projects / emacsconfig.git / commitdiff