better variable names for the run procedures
authorChristopher Allan Webber <cwebber@dustycloud.org>
Fri, 20 Nov 2015 16:43:26 +0000 (10:43 -0600)
committerChristopher Allan Webber <cwebber@dustycloud.org>
Fri, 20 Nov 2015 16:43:26 +0000 (10:43 -0600)
loopy.scm
tests.scm

index c78197a5c1c090f9132636b71ce5c69f3f9d4258..7b43ba6d6dbe6274786779d7b7fd9f7cb7bc0ef0 100644 (file)
--- 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))
@@ -319,24 +319,37 @@ 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-wrap-at body ... when)
-  (run (wrap body ...) when))
+(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)
+  (make-run-request (wrap body ...) (tdelta delay-time)))
+
+(define (delay run-request delay-time)
+  "Delay a RUN-REQUEST by DELAY-TIME"
+  (set-field run-request
+             (run-request-when)
+             (tdelta delay-time)))
 
 \f
 ;;; Execution of agenda, and current agenda
index 0843fb4b8ab484d475b33cf9f3895fa71b7bfea5..085387612568bf77b41d77ba8a95788f32334889 100644 (file)
--- a/tests.scm
+++ b/tests.scm
   (test-assert (procedure? wrapped))
   (test-equal (wrapped) 3))
 
-(let ((run-two-squared (run (lambda () (* 2 2)))))
+(let ((run-two-squared (run-it (lambda () (* 2 2)))))
   (test-assert (run-request? run-two-squared))
   (test-assert (procedure? (run-request-proc run-two-squared)))
   (test-equal ((run-request-proc run-two-squared)) 4)
   (test-eq (run-request-when run-two-squared) #f))
 
-(let ((run-two-squared (run (lambda () (* 2 2)) '(88 . 0))))
+(let ((run-two-squared (run-it (lambda () (* 2 2)) '(88 . 0))))
   (test-assert (run-request? run-two-squared))
   (test-assert (procedure? (run-request-proc run-two-squared)))
   (test-equal ((run-request-proc run-two-squared)) 4)
   (test-equal (run-request-when run-two-squared) '(88 . 0)))
 
-(let ((run-two-squared (run-wrap (* 2 2))))
+(let ((run-two-squared (run (* 2 2))))
   (test-assert (run-request? run-two-squared))
   (test-assert (procedure? (run-request-proc run-two-squared)))
   (test-equal ((run-request-proc run-two-squared)) 4)
   (test-eq (run-request-when run-two-squared) #f))
 
-(let ((run-two-squared (run-wrap-at (* 2 2) '(88 . 0))))
+(let ((run-two-squared (run-at (* 2 2) '(88 . 0))))
   (test-assert (run-request? run-two-squared))
   (test-assert (procedure? (run-request-proc run-two-squared)))
   (test-equal ((run-request-proc run-two-squared)) 4)
 
 (define (run-dummy)
   (speaker "I bet I can make you say you're a dummy!\n")
-  (run dummy-func))
+  (run-it dummy-func))
 
 (let ((q (make-q)))
   (set! speaker (speak-it))  ; reset the speaker