From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 12 Feb 1992 02:23:32 +0000 (+0000)
Subject: Use new MAKE-SUBPROCESS primitive argument to set working directory of
X-Git-Tag: 20090517-FFI~9797
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=78b8491c78ac421af708926a6b629c1a086bcd31;p=mit-scheme.git

Use new MAKE-SUBPROCESS primitive argument to set working directory of
subprocess.
---

diff --git a/v7/src/edwin/process.scm b/v7/src/edwin/process.scm
index 60ac0c444..20dc7884d 100644
--- a/v7/src/edwin/process.scm
+++ b/v7/src/edwin/process.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/process.scm,v 1.20 1992/02/11 20:52:30 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/process.scm,v 1.21 1992/02/12 02:23:32 cph Exp $
 ;;;
 ;;;	Copyright (c) 1991-92 Massachusetts Institute of Technology
 ;;;
@@ -140,40 +140,37 @@ False means don't delete them until \\[list-processes] is run."
 	  (mark-right-inserting-copy (buffer-end buffer))))))
 
 (define (start-process name buffer environment program . arguments)
-  (let ((directory (buffer-default-directory buffer)))
-    (let ((make-subprocess
+  (let ((make-subprocess
+	 (let ((directory (buffer-default-directory buffer)))
 	   (let ((filename (find-program program directory))
 		 (arguments (list->vector (cons program arguments)))
 		 (pty? (ref-variable process-connection-type buffer)))
 	     (lambda ()
-	       (start-subprocess filename arguments environment pty?)))))
-      ;; Calling WITH-WORKING-DIRECTORY-PATHNAME is a kludge --
-      ;; there's no other way to specify the working directory of the
-      ;; subprocess.  The subprocess abstraction should be fixed to
-      ;; allow this.
-      (with-working-directory-pathname directory
-	(lambda ()
-	  (without-interrupts
-	   (lambda ()
-	     (let ((subprocess (make-subprocess)))
-	       (let ((channel (subprocess-input-channel subprocess)))
-		 (if channel
-		     (begin
-		       (channel-nonblocking channel)
-		       (channel-register channel))))
-	       (let ((process
-		      (%make-process
-		       subprocess
-		       (do ((n 2 (+ n 1))
-			    (name* name
-				   (string-append name
-						  "<" (number->string n) ">")))
-			   ((not (get-process-by-name name*)) name*))
-		       buffer)))
-		 (update-process-mark! process)
-		 (subprocess-put! subprocess 'EDWIN-PROCESS process)
-		 (set! edwin-processes (cons process edwin-processes))
-		 process)))))))))
+	       (start-subprocess filename
+				 arguments
+				 (cons environment (->namestring directory))
+				 pty?))))))
+    (without-interrupts
+     (lambda ()
+       (let ((subprocess (make-subprocess)))
+	 (let ((channel (subprocess-input-channel subprocess)))
+	   (if channel
+	       (begin
+		 (channel-nonblocking channel)
+		 (channel-register channel))))
+	 (let ((process
+		(%make-process
+		 subprocess
+		 (do ((n 2 (+ n 1))
+		      (name* name
+			     (string-append name
+					    "<" (number->string n) ">")))
+		     ((not (get-process-by-name name*)) name*))
+		 buffer)))
+	   (update-process-mark! process)
+	   (subprocess-put! subprocess 'EDWIN-PROCESS process)
+	   (set! edwin-processes (cons process edwin-processes))
+	   process))))))
 
 (define (start-subprocess filename arguments environment pty?)
   (if (and pty? ((ucode-primitive have-ptys? 0)))