Update of /cvsroot/wisp/wisp/modules
In directory sc8-pr-cvs1:/tmp/cvs-serv20908
Modified Files:
Makefile.am unix.wim
Added Files:
unix.wid
Log Message:
generalized pipe-from to accept explicit file descriptors to be diverted
--- NEW FILE: unix.wid ---
#### unix.wid
#
# Copyleft © 2003 by Andres Soolo (di...@us...)
# This file is licensed under the GNU GPL v2. If you
# don't know what that means, please do read the GPL.
#
#### @(#) $Id: unix.wid,v 1.1 2003/04/14 11:53:53 digg Exp $
pipe-from
(|pipe-from| /prog/ /option/ ...) => /port/
Invokes /prog/ by forking a new process that applies |dedicated| on it.
The new process' standard output will be attached to the current
process via a pipe. Returns a Wisp port wrapper for the pipe.
The following /option/s are known:
* ~divert-stderr~ -- if given, use dup2(2) to divert the new
process' stderr as well as stdout to the
/port/.
* any integer -- all integers used as options will be treated
as file descriptors to be attached to /port/.
If any integer is specified, stdout
(descriptor ~1~) will not attached to /port/
unless it's explicitly specified too.
:Conforms to: Wisp extension.
:See also: |pipe-to|, |dedicated|.
Index: Makefile.am
===================================================================
RCS file: /cvsroot/wisp/wisp/modules/Makefile.am,v
retrieving revision 1.59
retrieving revision 1.60
diff -u -d -r1.59 -r1.60
--- Makefile.am 9 Feb 2003 16:43:01 -0000 1.59
+++ Makefile.am 14 Apr 2003 11:53:51 -0000 1.60
@@ -31,7 +31,7 @@
wid_DATA = builtin.wid help.wid help-et.wid \
files.wid getopt.wid ini.wid lists.wid locale.wid random.wid \
- strings.wid unicode.wid
+ strings.wid unicode.wid unix.wid
wrti_DATA = ia32.wrti io.wrti linux.wrti universal.wrti wisptyp.wrti
Index: unix.wim
===================================================================
RCS file: /cvsroot/wisp/wisp/modules/unix.wim,v
retrieving revision 1.45
retrieving revision 1.46
diff -u -d -r1.45 -r1.46
--- unix.wim 9 Feb 2003 15:41:38 -0000 1.45
+++ unix.wim 14 Apr 2003 11:53:53 -0000 1.46
@@ -74,21 +74,27 @@
(define (pipe-from proc . options)
(let* ((pipe (sys:pipe))
(child (sys:fork))
- (divert-stderr? #f))
- (for-each
- (lambda (option)
- (case option
- ((divert-stderr) (set! divert-stderr? #t))
- (else (raise 'pipe-from-option? option))))
- options)
+ (divert-fds '()))
+ (my divert-stderr? #f
+ (for-each
+ (lambda (option)
+ (case option
+ ((divert-stderr) (set! divert-stderr? #t))
+ (integer? (cons! divert-fds option))
+ (else (raise 'pipe-from-option? option))))
+ options)
+ (if (null? divert-fds)
+ (set! divert-fds '(1))) ; stdout
+ (if divert-stderr?
+ (cons! divert-fds 2)))
(if (zero? child)
; child
(begin
(sys:close (car pipe))
- (sys:dup2 (cdr pipe) 1)
- (if divert-stderr?
- (sys:dup2 (cdr pipe) 2))
- (sys:close (cdr pipe))
+ (for-each (cut sys:dup2 (cdr pipe) <>)
+ divert-fds)
+ (if (not (memv (cdr pipe) divert-fds))
+ (sys:close (cdr pipe)))
(dedicated proc))
; parent
(begin
|
