-
Notifications
You must be signed in to change notification settings - Fork 1
/
compat.ikarus.sls
32 lines (30 loc) · 1.2 KB
/
compat.ikarus.sls
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
(library (spon compat)
(export implementation-name
command
current-directory
)
(import (rnrs)
(spon config)
(only (ikarus) current-directory)
(ikarus ipc))
(define (implementation-name) "ikarus")
(define (command cmd . args)
(let-values (([pid p-stdin p-stdout p-stderr] (apply process cmd args)))
(zero? ; for now
(wstatus-exit-status
(cond ((quiet?)
(waitpid pid))
(else
(let ((p-message (transcoded-port p-stdout (native-transcoder)))
(p-error (transcoded-port p-stderr (native-transcoder))))
(let loop ((status #f))
(when (verbose?)
(let ((message (get-string-all p-message)))
(unless (eof-object? message)
(display message)
(put-string (current-output-port) message))))
(let ((err (get-string-all p-error)))
(unless (eof-object? err)
(put-string (current-error-port) err)))
(or status (loop (waitpid pid #f)))))))))))
)