Commit | Line | Data |
---|---|---|
e300a61b TZ |
1 | ;;; url-future.el --- general futures facility for url.el |
2 | ||
3 | ;; Copyright (C) 2011 Free Software Foundation, Inc. | |
4 | ||
5 | ;; Author: Teodor Zlatanov <tzz@lifelogs.com> | |
6 | ;; Keywords: data | |
7 | ||
8 | ;; This file is part of GNU Emacs. | |
9 | ;; | |
10 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
11 | ;; it under the terms of the GNU General Public License as published by | |
12 | ;; the Free Software Foundation, either version 3 of the License, or | |
13 | ;; (at your option) any later version. | |
14 | ||
15 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
22 | ||
23 | ;;; Commentary: | |
24 | ||
25 | ;; Make a url-future (basically a defstruct): | |
26 | ;; (make-url-future :value (lambda () (calculation goes here)) | |
27 | ;; :callback (lambda (future) (use future on success)) | |
28 | ;; :errorback (lambda (future &rest error) (error handler))) | |
29 | ||
30 | ;; Then either call it with `url-future-call' or cancel it with | |
31 | ;; `url-future-cancel'. Generally the functions will return the | |
32 | ;; future itself, not the value it holds. Also the functions will | |
33 | ;; throw a url-future-already-done error if you try to call or cancel | |
34 | ;; a future more than once. | |
35 | ||
36 | ;; So, to get the value: | |
37 | ;; (when (url-future-completed-p future) (url-future-value future)) | |
38 | ||
c5e87d10 | 39 | ;; See the ERT tests and the code for further details. |
e300a61b TZ |
40 | |
41 | ;;; Code: | |
42 | ||
43 | (eval-when-compile (require 'cl)) | |
44 | (eval-when-compile (require 'ert)) | |
45 | ||
46 | (defstruct url-future callback errorback status value) | |
47 | ||
48 | (defmacro url-future-done-p (url-future) | |
49 | `(url-future-status ,url-future)) | |
50 | ||
51 | (defmacro url-future-completed-p (url-future) | |
52 | `(eq (url-future-status ,url-future) t)) | |
53 | ||
54 | (defmacro url-future-errored-p (url-future) | |
55 | `(eq (url-future-status ,url-future) 'error)) | |
56 | ||
57 | (defmacro url-future-cancelled-p (url-future) | |
58 | `(eq (url-future-status ,url-future) 'cancel)) | |
59 | ||
60 | (defun url-future-finish (url-future &optional status) | |
61 | (if (url-future-done-p url-future) | |
62 | (signal 'error 'url-future-already-done) | |
63 | (setf (url-future-status url-future) (or status t)) | |
64 | ;; the status must be such that the future was completed | |
65 | ;; to run the callback | |
66 | (when (url-future-completed-p url-future) | |
67 | (funcall (or (url-future-callback url-future) 'ignore) | |
68 | url-future)) | |
69 | url-future)) | |
70 | ||
71 | (defun url-future-errored (url-future errorcons) | |
72 | (if (url-future-done-p url-future) | |
73 | (signal 'error 'url-future-already-done) | |
74 | (setf (url-future-status url-future) 'error) | |
75 | (setf (url-future-value url-future) errorcons) | |
76 | (funcall (or (url-future-errorback url-future) 'ignore) | |
77 | url-future errorcons))) | |
78 | ||
79 | (defun url-future-call (url-future) | |
80 | (if (url-future-done-p url-future) | |
81 | (signal 'error 'url-future-already-done) | |
82 | (let ((ff (url-future-value url-future))) | |
83 | (when (functionp ff) | |
84 | (condition-case catcher | |
85 | (setf (url-future-value url-future) | |
86 | (funcall ff)) | |
87 | (error (url-future-errored url-future catcher))) | |
88 | (url-future-value url-future))) | |
89 | (if (url-future-errored-p url-future) | |
90 | url-future | |
91 | (url-future-finish url-future)))) | |
92 | ||
93 | (defun url-future-cancel (url-future) | |
94 | (if (url-future-done-p url-future) | |
95 | (signal 'error 'url-future-already-done) | |
96 | (url-future-finish url-future 'cancel))) | |
97 | ||
98 | (ert-deftest url-future-test () | |
5993c059 AS |
99 | (let* (saver |
100 | (text "running future") | |
e300a61b TZ |
101 | (good (make-url-future :value (lambda () (format text)) |
102 | :callback (lambda (f) (set 'saver f)))) | |
103 | (bad (make-url-future :value (lambda () (/ 1 0)) | |
104 | :errorback (lambda (&rest d) (set 'saver d)))) | |
105 | (tocancel (make-url-future :value (lambda () (/ 1 0)) | |
106 | :callback (lambda (f) (set 'saver f)) | |
107 | :errorback (lambda (&rest d) | |
5993c059 | 108 | (set 'saver d))))) |
e300a61b TZ |
109 | (should (equal good (url-future-call good))) |
110 | (should (equal good saver)) | |
111 | (should (equal text (url-future-value good))) | |
112 | (should (url-future-completed-p good)) | |
113 | (should-error (url-future-call good)) | |
114 | (setq saver nil) | |
115 | (should (equal bad (url-future-call bad))) | |
116 | (should-error (url-future-call bad)) | |
117 | (should (equal saver (list bad '(arith-error)))) | |
118 | (should (url-future-errored-p bad)) | |
119 | (setq saver nil) | |
120 | (should (equal (url-future-cancel tocancel) tocancel)) | |
121 | (should-error (url-future-call tocancel)) | |
122 | (should (null saver)) | |
123 | (should (url-future-cancelled-p tocancel)))) | |
124 | ||
125 | (provide 'url-future) | |
126 | ;;; url-future.el ends here |