open-input-output-process, open-input-output-pipe

[Mikael Djurfeldt]

Hi,

I'd find something like the patch below useful.  The procedures below
return a pair of an input and output port instead of the input-output
port which is stated in the comment.  How would one go about
implementing it as intended, i.e. with an input-output-port?

Best regards,
/mdj

Index: popen.scm
===================================================================
RCS file: /cvs/guile/guile-core/ice-9/popen.scm,v
retrieving revision 1.8
diff -u -r1.8 popen.scm
--- popen.scm   2001/02/21 20:11:18     1.8
+++ popen.scm   2001/03/08 19:37:00
@@ -121,6 +121,39 @@
     (hashq-set! port/pid-table port (cdr port/pid))
     port))
 
+;; run a process connected to an input-output port.
+;; returns port/pid pair.
+(define (open-input-output-process prog . args)
+  (let ((from (pipe))
+       (to (pipe)))
+    (setvbuf (cdr from) _IONBF)
+    (setvbuf (cdr to) _IONBF)
+    (let ((pid (primitive-fork)))
+      (cond ((= pid 0)
+            ;; child
+            (set-batch-mode?! #t)
+            (close-all-ports-except (cdr from) (car to))
+            (move->fdes (cdr from) 1)
+            (move->fdes (car to) 0)
+            (apply execlp prog prog args))
+           (else
+            ;; parent
+            (close-port (cdr from))
+            (close-port (car to))
+            (cons (cons (car from) (cdr to))
+                  pid))))))
+
+(define-public (open-input-output-pipe command)
+  "Executes the shell command @var{command} (a string) in a subprocess.
+An input-output port to the process is returned."
+  (let* ((port/pid (open-input-output-process "/bin/sh" "-c" command))
+        (port (car port/pid)))
+    (pipe-guardian (car port))
+    (hashq-set! port/pid-table (car port) (cdr port/pid))
+    (pipe-guardian (cdr port))
+    (hashq-set! port/pid-table (cdr port) (cdr port/pid))
+    port))
+
 (define (fetch-pid port)
   (let ((pid (hashq-ref port/pid-table port)))
     (hashq-remove! port/pid-table port)
=== Exit status: 1