code.delx.au - gnu-emacs/blob - lisp/url/url-future.el

   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
  39 ;; See the ERT tests and the code for further details.
  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 ()
  99   (let* (saver
 100          (text "running future")
 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)
 108                                                  (set 'saver d)))))
 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