fix dealing with prompt printout

svn: r16203
This commit is contained in:
Eli Barzilay 2009-10-01 21:10:44 +00:00
parent 2fbb31c6ad
commit 5a186c7e08

View File

@ -41,17 +41,18 @@
(let ([pfx (prefix)])
(for ([p (in-list outps)]) (display pfx p)))
(set! prompt? #f))
(let* ([nl (if nl (cdar nl) end)]
(let* ([nl (and nl (cdar nl))]
[end (or nl end)]
[ls (for/list ([p (in-list outps)])
(write-bytes-avail* buf p start nl))]
(write-bytes-avail* buf p start end))]
[l (car ls)])
(when (and (pair? (cdr ls))
(not (equal? (car ls) (cadr ls))))
(display "WARNING: incomplete write to log file\n"
(car outps)))
(when (and nl (= l (- nl start)))
;; pre-newline part written
(map flush-output outps) (set! prompt? #t))
(when (= l (- end start))
(map flush-output outps)
(when nl (set! prompt? #t)))
l))))
(lambda () (semaphore-post sema))))
(lambda () (map close-output-port outps))))))