suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix dealing with prompt printout

Browse Source 
svn: r16203
This commit is contained in:
Eli Barzilay 2009-10-01 21:10:44 +00:00
parent 2fbb31c6ad
commit 5a186c7e08
1 changed files with 6 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
collects/handin-server/private/logger.ss
View File

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