projects
/
8sync.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Added add-segments-contents-to-queue!
[8sync.git]
/
loopy.scm
diff --git
a/loopy.scm
b/loopy.scm
index 7172e9b57b3a6d7cefcaad6fe29c00248f3c6bd1..d878601659e583d63a791a7c1a970ff1c31fa984 100644
(file)
--- a/
loopy.scm
+++ b/
loopy.scm
@@
-21,7
+21,8
@@
schedule-add! schedule-empty?
schedule-segments
schedule-add! schedule-empty?
schedule-segments
- schedule-segments-until schedule-extract-until!
+ schedule-segments-split schedule-extract-until!
+ add-segments-contents-to-queue!
make-port-mapping
port-mapping-set! port-mapping-remove!
make-port-mapping
port-mapping-set! port-mapping-remove!
@@
-169,7
+170,7
@@
(define (schedule-empty? schedule)
(eq? (schedule-segments schedule) '()))
(define (schedule-empty? schedule)
(eq? (schedule-segments schedule) '()))
-(define (schedule-segments-
until
schedule time)
+(define (schedule-segments-
split
schedule time)
"Does a multiple value return of time segments before/at and after TIME"
(let ((time (time-segment-right-format time)))
(define (segment-is-now? segment)
"Does a multiple value return of time segments before/at and after TIME"
(let ((time (time-segment-right-format time)))
(define (segment-is-now? segment)
@@
-200,10
+201,18
@@
(define (schedule-extract-until! schedule time)
"Extract all segments until TIME from SCHEDULE, and pop old segments off"
(receive (segments-before segments-after)
(define (schedule-extract-until! schedule time)
"Extract all segments until TIME from SCHEDULE, and pop old segments off"
(receive (segments-before segments-after)
- (schedule-s
plit-segments-until
schedule time)
+ (schedule-s
egments-split
schedule time)
(set-schedule-segments! schedule segments-after)
segments-before))
(set-schedule-segments! schedule segments-after)
segments-before))
+(define (add-segments-contents-to-queue! segments queue)
+ (for-each
+ (lambda (segment)
+ (let ((seg-queue (time-segment-queue segment)))
+ (while (not (q-empty? seg-queue))
+ (enq! queue (deq! seg-queue)))))
+ segments))
+
\f
;;; Port handling
\f
;;; Port handling