X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Frun-program.lisp;h=8dd754ab4c88bb7ccee85c201d59753aa685a7fe;hb=6d36f2d6954cb79e3c88fef33fe0c3ad63deaea8;hp=04b5d6a5b0cac638fd7d3ae2fd3e44e997869903;hpb=1e7fc4730aa0cafb0aba5278e8cdbdba566b8725;p=sbcl.git

diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp
index 04b5d6a..8dd754a 100644
--- a/src/code/run-program.lisp
+++ b/src/code/run-program.lisp
@@ -440,7 +440,7 @@ status slot."
             (error "could not find a pty"))))))
 
 #-win32
-(defun open-pty (pty cookie)
+(defun open-pty (pty cookie &key (external-format :default))
   (when pty
     (multiple-value-bind
           (master slave name)
@@ -452,7 +452,7 @@ status slot."
           (unless new-fd
             (error "couldn't SB-UNIX:UNIX-DUP ~W: ~A" master (strerror errno)))
           (push new-fd *close-on-error*)
-          (copy-descriptor-to-stream new-fd pty cookie)))
+          (copy-descriptor-to-stream new-fd pty cookie external-format)))
       (values name
               (sb-sys:make-fd-stream master :input t :output t
                                      :element-type :default
@@ -578,7 +578,8 @@ status slot."
                     (if-output-exists :error)
                     (error :output)
                     (if-error-exists :error)
-                    status-hook)
+                    status-hook
+                    (external-format :default))
   #+sb-doc
   #.(concatenate
      'string
@@ -661,7 +662,9 @@ Users Manual for details about the PROCESS structure."#-win32"
       same place as normal output.
    :STATUS-HOOK
       This is a function the system calls whenever the status of the
-      process changes.  The function takes the process as an argument.")
+      process changes.  The function takes the process as an argument.
+   :EXTERNAL-FORMAT
+      The external-format to use for :INPUT, :OUTPUT, and :ERROR :STREAMs.")
   #-win32
   (when (and env-p environment-p)
     (error "can't specify :ENV and :ENVIRONMENT simultaneously"))
@@ -733,18 +736,18 @@ Users Manual for details about the PROCESS structure."#-win32"
                                       input cookie
                                       :direction :input
                                       :if-does-not-exist if-input-does-not-exist
-                                      :external-format :default
+                                      :external-format external-format
                                       :wait wait)
                (with-fd-and-stream-for ((stdout output-stream) :output
                                         output cookie
                                         :direction :output
                                         :if-exists if-output-exists
-                                        :external-format :default)
+                                        :external-format external-format)
                  (with-fd-and-stream-for ((stderr error-stream)  :error
                                           error cookie
                                           :direction :output
                                           :if-exists if-error-exists
-                                          :external-format :default)
+                                          :external-format external-format)
                    (with-open-pty ((pty-name pty-stream) (pty cookie))
                      ;; Make sure we are not notified about the child
                      ;; death before we have installed the PROCESS
@@ -759,7 +762,7 @@ Users Manual for details about the PROCESS structure."#-win32"
                                                   (if search 1 0)
                                                   environment-vec pty-name
                                                   (if wait 1 0))))
-                             (when (plusp child)
+                             (unless (= child -1)
                                (setf proc
                                      (apply
                                       #'make-process