Changeset 12825

Timestamp:

Sep 12, 2009, 12:10:55 PM (15 years ago)

Author:

Gary Byers

Message:

Do most of the work of EXEC-WITH-IO-REDIRECTION in CREATE-WINDOWS-PROCESS
on Windows; the former requires an EXTERNAL-PROCESS object and the latter
does not.

Note that the call to CreateProcessW uses some unusual options; this
may have been based on the code in Gnu Emacs.

File:

• trunk/source/level-1/linux-files.lisp (modified) (3 diffs)

trunk/source/level-1/linux-files.lisp

@@ -1663 +1663 @@
     (reduce (lambda (left right) (concatenate 'string left " " right)) strings))
 
-  (defun exec-with-io-redirection (new-in new-out new-err args proc &optional env)
+  (defun create-windows-process (new-in new-out new-err cmdstring env)
     (declare (ignore env))              ; until we can do better.
-    (with-filename-cstrs ((command (join-strings args)))
+    (with-filename-cstrs ((command cmdstring))
       (rletz ((proc-info #>PROCESS_INFORMATION)
               (si #>STARTUPINFO))
@@ -1694 +1694 @@
                                      si
                                      proc-info))
-          (progn
-            (setf (external-process-%status proc) :error
-                  (external-process-%exit-code proc) (#_GetLastError))
-            (signal-semaphore (external-process-signal proc))
-            (signal-semaphore (external-process-completed proc))
-            nil)
+          (values nil (#_GetLastError))
           (progn
             (#_CloseHandle (pref proc-info #>PROCESS_INFORMATION.hThread))
-            (pref proc-info #>PROCESS_INFORMATION.hProcess))))))
+            (values t (pref proc-info #>PROCESS_INFORMATION.hProcess)))))))
+
+  (defun exec-with-io-redirection (new-in new-out new-err args proc &optional env)
+    (multiple-value-bind (win handle-to-process-or-error)
+        (create-windows-process new-in new-out new-err (join-strings args) env)
+      (if win
+        handle-to-process-or-error
+        (progn
+          (setf (external-process-%status proc) :error
+                (external-process-%exit-code proc) handle-to-process-or-error)
+          (signal-semaphore (external-process-signal proc))
+          (signal-semaphore (external-process-completed proc))
+          nil))))
 
   (defun fd-uninheritable (fd &key direction)
@@ -1802 +1809 @@
 
 
-)
+  )
                                         ;#+windows-target (progn