summaryrefslogtreecommitdiff
path: root/scsh-process.scm
diff options
context:
space:
mode:
authorPeter Bex <peter@more-magic.net>2012-09-30 20:34:16 +0100
committerPeter Bex <peter@more-magic.net>2012-09-30 20:34:16 +0100
commit5b84da15a22d21fcf023cef5e88dc384f77168af (patch)
tree5cfc0e7cd80b0a82dbff1c55c69b53816a95f6c3 /scsh-process.scm
parentb496bba407a6d57beced6a6598b9032095993d85 (diff)
downloadscsh-process-5b84da15a22d21fcf023cef5e88dc384f77168af.tar.gz
Implement scheme begin forms, filedescriptor dup()ing and use print-error-message to print the error message, then exit
Diffstat (limited to 'scsh-process.scm')
-rw-r--r--scsh-process.scm16
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) ...