From: Christopher Allan Webber Date: Thu, 19 Nov 2015 18:46:10 +0000 (-0600) Subject: run, wrap, and run-wrap stuff X-Git-Tag: v0.1.0~158 X-Git-Url: https://jxself.org/git/?a=commitdiff_plain;h=dd292af59253bf25fd762405ed54611facf01ead;p=8sync.git run, wrap, and run-wrap stuff --- 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 ;;; =======================================