X-Git-Url: https://jxself.org/git/?p=8sync.git;a=blobdiff_plain;f=8sync%2Fagenda.scm;h=ae9ddd6059556fc781d69bae7bcc3cd902db6681;hp=8847dc931185a5424b2dd0e71f7d6f14c4875e7c;hb=cef48f426e254f8c05566a50669bf195560e0d96;hpb=4118e3306b85390d0564960b92c9f56e202898d0 diff --git a/8sync/agenda.scm b/8sync/agenda.scm index 8847dc9..ae9ddd6 100644 --- a/8sync/agenda.scm +++ b/8sync/agenda.scm @@ -27,7 +27,7 @@ #:export ( make-agenda agenda? agenda-queue agenda-prompt-tag - agenda-read-port-map agenda-write-port-map agenda-except-port-map + agenda-read-port-map agenda-write-port-map agenda-schedule make-async-prompt-tag @@ -60,13 +60,11 @@ run-it wrap wrap-apply run run-at run-delay - 8sync 8sync-delay + 8sync-delay 8sync-run 8sync-run-at 8sync-run-delay 8sync-nowait 8sleep - catch-8sync - ;; used for introspecting the error, but a method for making ;; is not exposed wrapped-exception? @@ -477,16 +475,6 @@ return the wrong thing via (8sync) and trip themselves up." (wrapped-exception-stacks body-result)) body-result))) -(define-syntax 8sync - (syntax-rules () - "Run BODY asynchronously (8synchronously?) at a prompt, then return. - -Possibly specify WHEN as the second argument." - ((8sync body) - (8sync-run body)) - ((8sync body when) - (8sync-run-at body when)))) - (define-syntax-rule (8sync-run body ...) (8sync-run-at body ... #f)) @@ -552,18 +540,6 @@ forge ahead in our current function!" (wrap (kont #f)) #f) (make-run-request (lambda () body) #f)))))) -(define-syntax-rule (catch-8sync exp (handler-key handler) ...) - (catch '8sync-caught-error - (lambda () - exp) - (lambda (_ orig-key orig-args orig-stacks) - (cond - ((or (eq? handler-key #t) - (eq? orig-key handler-key)) - (apply handler orig-stacks orig-args)) ... - (else (raise '8sync-caught-error - orig-key orig-args orig-stacks)))))) - ;; This is sugar... and could probably be considerably ;; simplified and optimized. But whatever. (define-syntax-rule (8sleep time) @@ -650,8 +626,7 @@ Also handles sleeping when all we have to do is wait on the schedule." (selector agenda)) 0))) (or (has-items? agenda-read-port-map) - (has-items? agenda-write-port-map) - (has-items? agenda-except-port-map))) + (has-items? agenda-write-port-map))) (if (or (ports-to-select?) ;; select doubles as sleep... @@ -830,7 +805,10 @@ based on the results" ((? write-request? write-request) (agenda-handle-write-request! agenda write-request)) ;; do nothing - ;; @@: Why not throw an error? + ;; Remember, we don't throw an error here because procedures can + ;; return a run request, eg with run-it, at the end of their + ;; evaluation to keep looping. + ;; @@: Though is this really a useful feature? (_ #f))) ;; @@: We might support delay-wrapped procedures here (match proc-result