From 4d6a0700a6f38f8ca26fa47cfa2e68015bfbd9cc Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Mon, 1 Oct 2012 20:38:00 +0100 Subject: Implement appending to files --- scsh-process.scm | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) (limited to 'scsh-process.scm') diff --git a/scsh-process.scm b/scsh-process.scm index 6102c4d..57a773e 100644 --- a/scsh-process.scm +++ b/scsh-process.scm @@ -214,19 +214,22 @@ (define-syntax setup-redirection (syntax-rules (< > << >> = - stdports) ((_ (< ?file-name)) (setup-redirection (< 0 ?file-name))) - ((_ (> ?file-name)) (setup-redirection (> 1 ?file-name))) ((_ (<< ?object)) (setup-redirection (<< 0 ?object))) - ((_ (>> ?object)) (setup-redirection (>> 1 ?object))) - ((_ (< ?fd ?file-name)) - (duplicate-fileno (file-open (maybe-symbol->string `?file-name) - open/rdonly) - `?fd)) + ((_ (> ?file-name)) (setup-redirection (> 1 ?file-name))) + ((_ (>> ?file-name)) (setup-redirection (>> 1 ?file-name))) ((_ (> ?fd ?file-name)) (duplicate-fileno (file-open (maybe-symbol->string `?file-name) (fx+ open/wronly open/creat)) `?fd)) + ((_ (>> ?fd ?file-name)) + (duplicate-fileno (file-open (maybe-symbol->string `?file-name) + (fx+ open/wronly (fx+ open/append open/creat))) + `?fd)) + ((_ (< ?fd ?file-name)) + (duplicate-fileno (file-open (maybe-symbol->string `?file-name) + open/rdonly) + `?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) -- cgit v1.2.3