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

(define-module (system-utils)
  #:use-module (ice-9 popen)
  #:use-module (ice-9 rdelim)
  #:export (shell-command-to-string*
            in-directory
            with-error-to-string*))

(define* (shell-command-to-string* cmd #:optional . args)
  "run system program CMD with ARGS and return stdout as string"
  (with-output-to-string
    (lambda ()
      (let ((in-port (apply open-pipe* (cons OPEN_READ (cons cmd args)))))
        (let loop ((line (read-line in-port 'concat)))
          (or (eof-object? line)
              (begin
                (display line)
                (loop (read-line in-port 'concat)))))))))

(define (with-error-to-string* thunk)
  (let ((old-port (current-error-port))
        (str-port (open-output-string)))
    (set-current-error-port str-port)
    (let ((result (thunk)))
      (set-current-error-port old-port)
      (cons str-port result))))

(define-syntax-rule (in-directory directory body ...)
  (let ((old-path (getcwd)))
    (chdir directory)
    (let ((result (begin body ...)))
      (chdir old-path)
      result)))