X-Git-Url: https://jxself.org/git/?p=8sync.git;a=blobdiff_plain;f=loopy.scm;h=8ffe6f18a489a94520f0a1058f0d9a8e3ca1da8a;hp=22b6ac894aac168b3f6c85258e98f89899e54f70;hb=302b13a687285471ba67d62553639519adfb4da8;hpb=cc3001a104f7e2f75858737eb930343c4a8b7999

diff --git a/loopy.scm b/loopy.scm
index 22b6ac8..8ffe6f1 100644
--- a/loopy.scm
+++ b/loopy.scm
@@ -1,3 +1,20 @@
+;; Copyright (C) 2015 Christopher Allan Webber <cwebber@dustycloud.org>
+
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+;;
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Lesser General Public License for more details.
+;;
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+;; 02110-1301 USA
+
 (define-module (eightsync agenda)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
@@ -33,7 +50,7 @@
             schedule-segments-split schedule-extract-until!
             add-segments-contents-to-queue!
 
-            %sync 8sync %sync-at 8sync-at %sync-delay 8sync-delay
+            %sync 8sync
 
             <run-request>
             make-run-request run-request?
@@ -48,7 +65,7 @@
 
             %port-request %run %run-at %run-delay
             8port-request 8run 8run-at 8run-delay
-
+            
             %current-agenda
             start-agenda agenda-run-once))
 
@@ -418,7 +435,7 @@ Will produce (0 . 0) instead of a negative number, if needed."
    (make-future call-first on-success on-fail on-error)
    when))
 
-(define-syntax-rule (%sync body args ...)
+(define-syntax-rule (%sync async-request)
   "Run BODY asynchronously at a prompt, passing args to make-future.
 
 Pronounced `eight-sync' despite the spelling.
@@ -431,33 +448,12 @@ The % and 8 characters kind of look similar... hence this library's
 name!  (That, and the pun 'eight-synchronous' programming.)
 There are 8sync aliases if you prefer that name."
   (abort-to-prompt (current-agenda-prompt)
-                   (wrap body)
-                   args ...))
-
-(define-syntax-rule (%sync-at body when args ...)
-  (abort-to-prompt (current-agenda-prompt)
-                   (wrap body)
-                   #:when when
-                   args ...))
-
-(define-syntax-rule (%sync-delay body delay-time args ...)
-  (abort-to-prompt (current-agenda-prompt)
-                   (wrap body)
-                   #:when (tdelta delay-time)
-                   args ...))
+                   async-request))
 
 (define-syntax-rule (8sync args ...)
   "Alias for %sync"
   (%sync args ...))
 
-(define-syntax-rule (8sync-at args ...)
-  "Alias for %sync-at"
-  (%sync-at args ...))
-
-(define-syntax-rule (8sync-delay args ...)
-  "Alias for %sync-delay"
-  (8sync-delay args ...))
-
 ;; Async port request and run-request meta-requests
 (define (make-async-request proc)
   "Wrap PROC in an async-request
@@ -617,8 +613,7 @@ return the wrong thing via (8sync) and trip themselves up."
            ;; @@: 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
-           (parameterize ((%current-agenda agenda))
-             (agenda-run-once agenda))))
+           (agenda-run-once agenda)))
       (if (and stop-condition (stop-condition agenda))
           'done
           (let* ((agenda
@@ -644,7 +639,11 @@ based on the results"
   (define (call-proc proc)
     (call-with-prompt
      (agenda-prompt-tag agenda)
-     proc setup-async-request))
+     (lambda ()
+       (parameterize ((%current-agenda agenda))
+         (proc)))
+     (lambda (kont async-request)
+       (setup-async-request kont async-request))))
 
   (let ((queue (agenda-queue agenda))
         (next-queue (make-q)))