[Wisp-cvs] wisp/modules unix.wid,NONE,1.1 Makefile.am,1.59,1.60 unix.wim,1.45,1.46

[<di...@us...>]

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