X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;f=loopy.scm;h=99741c4727b6ef9c1d76942e4b9c90fcd5c4629c;hb=95f268c3d55e83ab4a1b1bbf66b9de6f6eae070d;hp=2f733c01d4fe32afa21641bc456c37efc4f0f171;hpb=c02ea81e55c9ce946b0d3c132cc7d0a9f2f3e45f;p=8sync.git

diff --git a/loopy.scm b/loopy.scm
index 2f733c0..99741c4 100644
--- a/loopy.scm
+++ b/loopy.scm
@@ -18,7 +18,7 @@
             time-< time-= time-<= time-+
 
             <time-delta>
-            make-time-delta time-delta?
+            make-time-delta tdelta time-delta?
             time-delta-sec time-delta-usec
 
             <schedule>
@@ -141,6 +141,8 @@
 (define* (make-time-delta sec #:optional usec)
   (make-time-delta-intern sec (or usec 0)))
 
+(define tdelta make-time-delta)
+
 (define (time-+ time time-delta)
   (cons (+ (car time) (time-delta-sec time-delta))
         (+ (cdr time) (time-delta-usec time-delta))))
@@ -301,9 +303,9 @@
 
 (define %current-agenda (make-parameter #f))
 
-(define* (start-agenda agenda #:optional stop-condition)
+(define* (start-agenda agenda #:key stop-condition)
   (let loop ((agenda agenda))
-    (let ((new-agenda   
+    (let ((agenda   
            ;; @@: Hm, maybe here would be a great place to handle
            ;;   select'ing on ports.
            ;;   We could compose over agenda-run-once and agenda-read-ports
@@ -311,12 +313,18 @@
              (agenda-run-once agenda))))
       (if (and stop-condition (stop-condition agenda))
           'done
-          (let ((updated-agenda
-                 ;; Adjust the agenda's time just in time
-                 ;; We do this here rather than in agenda-run-once to make
-                 ;; agenda-run-once's behavior fairly predictable
-                 (set-field new-agenda (agenda-time) (gettimeofday))))
-            (loop updated-agenda))))))
+          (let* ((new-time (gettimeofday))
+                 (agenda
+                  ;; Adjust the agenda's time just in time
+                  ;; We do this here rather than in agenda-run-once to make
+                  ;; agenda-run-once's behavior fairly predictable
+                  (set-field agenda (agenda-time) new-time)))
+            ;; Update the agenda's current queue based on
+            ;; currently applicable time segments
+            (add-segments-contents-to-queue!
+             (schedule-extract-until! (agenda-schedule agenda) new-time)
+             (agenda-queue agenda))
+            (loop agenda))))))
 
 (define (agenda-run-once agenda)
   "Run once through the agenda, and produce a new agenda
@@ -343,12 +351,12 @@ based on the results"
                     ((? time-delta? time-delta)
                      (let ((time (time-+ (agenda-time agenda)
                                          time-delta)))
-                       (schedule-at! time (run-request-proc proc))))
+                       (schedule-at! time (run-request-proc run-request))))
                     ((? integer? sec)
                      (let ((time (cons sec 0)))
-                       (schedule-at! time (run-request-proc proc))))
+                       (schedule-at! time (run-request-proc run-request))))
                     (((? integer? sec) . (? integer? usec))
-                     (schedule-at! request-time (run-request-proc proc)))
+                     (schedule-at! request-time (run-request-proc run-request)))
                     (#f
                      (enq! next-queue (run-request-proc run-request))))))))
         ;; @@: We might support delay-wrapped procedures here