s c h e m a t i c s : c o o k b o o k

(require (lib "process.ss"))

;; system/output : string -> (U string #f)
;;
;; Synchronously run the given command through the shell and
;; capture standard output.
;;
;; Returns the standard output or #f if the command failed
;;
;; If the command blocks for any reason (e.g. waiting for
;; input) this function will as well.
(define (system/output command-string)
  (let ([p (open-output-string)])
    (parameterize ([current-output-port p])
      (if (system command-string)
          (get-output-string p)
          #f))))

> (display (system/output "ls"))
fsm-1.eps
fsm-1.fig
fsm-1.fig.bak
fsm-2.fig
fsm-2.fig.bak
...

(require (lib "port.ss"))

;; lookup-exe: path -> path
;; Resolves relative exe lookups using PATH.
(define (lookup-exe a-path)
  (cond
    [(complete-path? a-path)
     a-path]
    [(find-executable-path a-path #f)
     => (lambda (path) path)]
    [else
     (error 'lookup-exe "Can't find executable ~s" a-path)]))


;; system/output: path [string]* -> string
;; Executes command with the given arguments.  If stderr has anything
;; written to it, its output will be interleaved in the string in some
;; unpredictable way.
;; If th executable can't be found, returns an error.
(define (system/output command . args)
  (let*-values ([(cmd-path) (lookup-exe command)]
                [(subp stdout stdin stderr)
                 (apply subprocess #f #f #f cmd-path args)]
                [(outp) (open-output-string)]
                [(threads)
                 (list (thread (lambda () (copy-port stdout outp)))
                       (thread (lambda () (copy-port stderr outp))))])
    (close-output-port stdin)
    (subprocess-wait subp)
    (for-each sync threads)
    (get-output-string outp)))

(require scheme/system)
(define (system/input->output command-string input-port)
  (let ([out (open-output-string)]
        [err (open-output-string)])
    (let ([code (parameterize ([current-output-port out]
                               [current-error-port err]
                               [current-input-port input-port])
                  (system/exit-code command-string))])
      (if (= 0 code)
          (get-output-string out)
          (raise (format "Subprocess failed with exit code ~a" code))))))