X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;f=loopy.scm;h=cc1ee7889bcfdcb1a253b0ec0049c84a3a730890;hb=bbbf61a9bb88a9a97f987a67f7e06e0febbf0d53;hp=c78197a5c1c090f9132636b71ce5c69f3f9d4258;hpb=a92d497f62a50199799da48b9653903060f6d9be;p=8sync.git

diff --git a/loopy.scm b/loopy.scm
index c78197a..cc1ee78 100644
--- a/loopy.scm
+++ b/loopy.scm
@@ -37,7 +37,7 @@
             make-run-request run-request?
             run-request-proc run-request-when
 
-            run wrap run-wrap run-wrap-at
+            run-it wrap run run-at delay
 
             %current-agenda
             start-agenda agenda-run-once))
@@ -110,6 +110,11 @@
   (queue time-segment-queue))
 
 (define (time-segment-right-format time)
+  "Ensure TIME is in the right format.
+
+The right format means (second . microsecond).
+If an integer, will convert appropriately."
+  ;; TODO: add floating point / rational number support.
   (match time
     ;; time is already a cons of second and microsecnd
     (((? integer? s) . (? integer? u)) time)
@@ -118,9 +123,14 @@
     (_ (throw 'invalid-time "Invalid time" time))))
 
 (define* (make-time-segment time #:optional (queue (make-q)))
+  "Make a time segment of TIME and QUEUE
+
+No automatic conversion is done, so you might have to
+run (time-segment-right-format) first."
   (make-time-segment-intern time queue))
 
 (define (time< time1 time2)
+  "Check if TIME1 is less than TIME2"
   (cond ((< (car time1)
             (car time2))
          #t)
@@ -132,10 +142,12 @@
         (else #f)))
 
 (define (time= time1 time2)
+  "Check whether TIME1 and TIME2 are equivalent"
   (and (= (car time1) (car time2))
        (= (cdr time1) (cdr time2))))
 
 (define (time<= time1 time2)
+  "Check if TIME1 is less than or equal to TIME2"
   (or (time< time1 time2)
       (time= time1 time2)))
 
@@ -147,6 +159,10 @@
   (usec time-delta-usec))
 
 (define* (make-time-delta sec #:optional usec)
+  "Make a <time-delta> of SEC seconds and USEC microseconds.
+
+This is used primarily so the agenda can recognize RUN-REQUEST objects
+which are meant "
   (make-time-delta-intern sec (or usec 0)))
 
 (define tdelta make-time-delta)
@@ -319,24 +335,38 @@ Will produce (0 . 0) instead of a negative number, if needed."
 ;;; Request to run stuff
 ;;; ====================
 
-(define-record-type <run-request>
+(define-immutable-record-type <run-request>
   (make-run-request proc when)
   run-request?
   (proc run-request-proc)
   (when run-request-when))
 
-(define* (run proc #:optional when)
+(define* (run-it proc #:optional when)
+  "Make a request to run PROC (possibly at WHEN)"
   (make-run-request proc when))
 
 (define-syntax-rule (wrap body ...)
+  "Wrap contents in a procedure"
   (lambda ()
     body ...))
 
-(define-syntax-rule (run-wrap body ...)
-  (run (wrap 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))
+
+(define-syntax-rule (run-delay body ... delay-time)
+  "Run BODY at DELAY-TIME time from now"
+  (make-run-request (wrap body ...) (tdelta delay-time)))
 
-(define-syntax-rule (run-wrap-at body ... when)
-  (run (wrap body ...) when))
+(define (delay run-request delay-time)
+  "Delay a RUN-REQUEST by DELAY-TIME"
+  (set-field run-request
+             (run-request-when)
+             (tdelta delay-time)))
 
 
 ;;; Execution of agenda, and current agenda