+;; @@: Do we really want `body ...' here?
+;; what about just `body'?
+(define-syntax-rule (run body ...)
+ "Run everything in BODY but wrap in a convenient procedure"
+ (make-run-request (wrap body ...) #f))
+
+(define-syntax-rule (run-at body ... when)
+ "Run BODY at WHEN"
+ (make-run-request (wrap body ...) when))
+
+;; @@: Is it okay to overload the term "delay" like this?
+;; Would `run-in' be better?
+(define-syntax-rule (run-delay body ... delay-time)
+ "Run BODY at DELAY-TIME time from now"
+ (make-run-request (wrap body ...) (tdelta delay-time)))
+
+
+;; A request to set up a port with at least one of read, write, except
+;; handling processes
+
+(define-record-type <port-request>
+ (make-port-request-intern port read write except)
+ port-request?
+ (port port-request-port)
+ (read port-request-read)
+ (write port-request-write)
+ (except port-request-except))
+
+(define* (make-port-request port #:key read write except)
+ (if (not (or read write except))
+ (throw 'no-port-handler-given "No port handler given.\n"))
+ (make-port-request-intern port read write except))
+
+(define port-request make-port-request)
+
+
+\f
+;;; Asynchronous escape to run things
+;;; =================================
+
+;; The future's in futures
+
+(define (make-future call-first on-success on-fail on-error)
+ ;; TODO: add error stuff here
+ (lambda ()
+ (let ((call-result (call-first)))
+ ;; queue up calling the
+ (run (on-success call-result)))))
+
+(define (agenda-on-error agenda)
+ (const #f))
+
+(define (agenda-on-fail agenda)
+ (const #f))
+
+(define* (request-future call-first on-success
+ #:key
+ (agenda (%current-agenda))
+ (on-fail (agenda-on-fail agenda))
+ (on-error (agenda-on-error agenda))
+ (when #f))
+ ;; TODO: error handling
+ ;; do we need some distinction between expected, catchable errors,
+ ;; and unexpected, uncatchable ones? Probably...?
+ (make-run-request
+ (make-future call-first on-success on-fail on-error)
+ when))
+
+(define-syntax-rule (%sync body args ...)
+ "Run BODY asynchronously at a prompt, passing args to make-future.
+
+Pronounced `async' despite the spelling.
+
+%sync was chosen because (async) was already taken and could lead to
+errors, and this version of asynchronous code uses a prompt, so the `a'
+character becomes a `%' prompt! :)
+
+The % and 8 characters kind of look similar... hence this library's
+name! (There are 8sync aliases if you prefer that name.)"
+ (abort-to-prompt (current-agenda-prompt)
+ (wrap body)
+ args ...))
+
+(define-syntax-rule (%sync-at body when args ...)
+ (abort-to-prompt (current-agenda-prompt)
+ (wrap body)
+ #:when when
+ args ...))
+
+(define-syntax-rule (%sync-delay body delay-time args ...)
+ (abort-to-prompt (current-agenda-prompt)
+ (wrap body)
+ #:when (tdelta delay-time)
+ args ...))
+
+(define-syntax-rule (8sync args ...)
+ "Alias for %sync"
+ (%sync args ...))
+
+(define-syntax-rule (8sync-at args ...)
+ "Alias for %sync-at"
+ (%sync-at args ...))
+
+(define-syntax-rule (8sync-delay args ...)
+ "Alias for %sync-delay"
+ (8sync-delay args ...))