diff options
-rw-r--r-- | scsh-process.scm | 16 |
1 files changed, 14 insertions, 2 deletions
diff --git a/scsh-process.scm b/scsh-process.scm index ca747e2..74727ce 100644 --- a/scsh-process.scm +++ b/scsh-process.scm @@ -24,7 +24,8 @@ (handle-exceptions exn ;; TODO: Figure out how SCSH does this. It shows the error ;; on stderr in the REPL, but then still quits it. - (begin ((##sys#error-handler) exn) (exit 1)) + ;; If we just invoke current-handler, it'll get a second REPL + (begin (print-error-message exn) (exit 1)) (exec-epf ?epf ...))))))) (define-syntax run @@ -57,6 +58,12 @@ `?fd)) ((_ (<< ?fd ?object)) (error "<< currently not implemented")) ((_ (>> ?fd ?object)) (error ">> currently not implemented")) + ((_ (= ?fd-from ?fd/port-to)) + (let* ((fd/port-to ?fd/port-to) ; Evaluate once + (fd-to (if (port? fd/port-to) + (port->fileno fd/port-to) + fd/port-to))) + (duplicate-fileno ?fd-from fd-to))) ((_ (- ?fd/port)) (let ((o `?fd/port)) (cond @@ -73,7 +80,12 @@ ;; The most "core" syntax form (define-syntax exec-epf - (syntax-rules () + (syntax-rules (begin) + ((_ (begin ?expr0 ...)) + (begin (setup-redirection (= 0 (current-input-port))) + (setup-redirection (= 1 (current-output-port))) + (setup-redirection (= 2 (current-error-port))) + ?expr0 ...)) ((_ (?prog ?arg0 ...) ?redir0 ...) (begin (setup-redirection ?redir0) ... |