X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;ds=sidebyside;f=8sync%2Fagenda.scm;h=7a76ebf5837359951d964726380aac86fe1c3df7;hb=381c180279b47d0536f12da170c3911475af0755;hp=3aa43da1eeec85dee0f6d9f9d58abe1d6084b558;hpb=b631d525422b859d5720c5216eb40216eb9b15e9;p=8sync.git

diff --git a/8sync/agenda.scm b/8sync/agenda.scm
index 3aa43da..7a76ebf 100644
--- a/8sync/agenda.scm
+++ b/8sync/agenda.scm
@@ -1,5 +1,5 @@
 ;;; 8sync --- Asynchronous programming for Guile
-;;; Copyright (C) 2015, 2016 Christopher Allan Webber <cwebber@dustycloud.org>
+;;; Copyright © 2015, 2016, 2017 Christopher Allan Webber <cwebber@dustycloud.org>
 ;;;
 ;;; This file is part of 8sync.
 ;;;
@@ -62,7 +62,7 @@
             stop-on-nothing-to-do
 
             %current-agenda-prompt
-            start-agenda agenda-run-once!))
+            run-agenda agenda-run-once!))
 
 
 ;;; Agenda definition
@@ -411,7 +411,8 @@ forge ahead in our current function!"
     ;; convert into sec / usec pair
     (receive (secs usecs)
         (floor/ next-time-in-usecs 1000000)
-      (cons secs (floor usecs))))
+      (cons (inexact->exact secs)
+            (inexact->exact (floor usecs)))))
   (define (convert-integer)
     (cons (+ in-secs cur-secs) cur-usecs))
   (if (integer? in-secs)
@@ -466,13 +467,19 @@ Also handles sleeping when all we have to do is wait on the schedule."
     ;; TODO: support usecond wait time too
     (match (get-wait-time)
       ((sec . usec)
-       (catch 'system-error
+       (catch #t           ; expect: wrong-type-arg (open port), system-error
          (lambda ()
            (select (hash-keys (agenda-read-port-map agenda))
                    (hash-keys (agenda-write-port-map agenda))
                    '()
                    sec usec))
          (lambda (key . rest-args)
+           (unless (and (memq key '(system-error wrong-type-arg))
+                        (match rest-args
+                          (((or "select" "get-u8" "get-bytevector-n" "lookahead-u8"
+                                "put-u8" "put-bytevector") arg ...) #t)
+                          (_ #f)))
+             (apply throw key rest-args))
            (match rest-args
              ((_ _ _ (EINTR))
               '(() () ()))
@@ -553,16 +560,14 @@ on suspendable ports."
        (= 0 (hash-count (const #t) (agenda-write-port-map agenda)))))
 
 
-(define* (start-agenda agenda
-                       #:key (stop-condition stop-on-nothing-to-do)
-                       ;; For live hacking madness, etc
-                       (post-run-hook #f))
+(define* (run-agenda agenda
+                     #:key (stop-condition stop-on-nothing-to-do)
+                     ;; For live hacking madness, etc
+                     (post-run-hook #f))
   ;; TODO: Document fields
   "Start up the AGENDA"
   (install-suspendable-ports!)
   (parameterize ((%current-agenda-prompt (agenda-prompt-tag agenda))
-                 ;; @@: Couldn't we just parameterize this at the start of
-                 ;;   the agenda...?
                  (current-read-waiter wait-for-readable)
                  (current-write-waiter wait-for-writable))
     (while (not (stop-condition agenda))