X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;f=loopy.scm;h=b93a1debbfab0bc6701c3b536394f3442c353c30;hb=e0499fb27f966a6c81679e9d83260164197e5ff7;hp=261e14db704d9323f2ceab82b3a989359e12da7d;hpb=ec22b5b3398c107215b6303ec63dbadb8f77ac76;p=8sync.git diff --git a/loopy.scm b/loopy.scm index 261e14d..b93a1de 100644 --- a/loopy.scm +++ b/loopy.scm @@ -4,20 +4,21 @@ #:use-module (ice-9 q) #:use-module (ice-9 match) #:use-module (ice-9 receive) - #:export (make-agenda - agenda? + #:export ( + make-agenda agenda? agenda-queue agenda-prompt-tag agenda-port-pmapping agenda-schedule make-async-prompt-tag - make-time-segment - time-segment? + + make-time-segment time-segment? time-segment-time time-segment-queue time-< time-= time-<= - make-schedule + + make-schedule schedule? schedule-add! schedule-empty? schedule-segments @@ -28,6 +29,12 @@ port-mapping-set! port-mapping-remove! port-mapping-empty? port-mapping-non-empty? + + make-run-request run-request? + run-request-proc run-request-when + + run wrap run-wrap run-wrap-at + %current-agenda start-agenda agenda-run-once)) @@ -244,6 +251,29 @@ (not (port-mapping-empty? port-mapping))) + +;;; Request to run stuff +;;; ==================== + +(define-record-type + (make-run-request proc when) + run-request? + (proc run-request-proc) + (when run-request-when)) + +(define* (run proc #:optional when) + (make-run-request proc when)) + +(define-syntax-rule (wrap body ...) + (lambda () + body ...)) + +(define-syntax-rule (run-wrap body ...) + (run (wrap body ...))) + +(define-syntax-rule (run-wrap-at body ... when) + (run (wrap body ...) when)) + ;;; Execution of agenda, and current agenda ;;; =======================================