- (dolist (handler *handlers-installed*)
- (sb-sys:remove-fd-handler handler))))
- (when (and wait proc)
- (process-wait proc))
- proc))
-
-#+win32 (defun run-program (program args
- &key
- (wait t)
- search
- input
- if-input-does-not-exist
- output
- (if-output-exists :error)
- (error :output)
- (if-error-exists :error)
- status-hook)
- "RUN-PROGRAM creates a new process specified by the PROGRAM argument.
- ARGS are the standard arguments that can be passed to a program. For no
- arguments, use NIL (which means that just the name of the program is
- passed as arg 0).
-
- RUN-PROGRAM will either return NIL or a PROCESS structure. See the CMU
- Common Lisp Users Manual for details about the PROCESS structure.
-
- The &KEY arguments have the following meanings:
- :SEARCH
- Look for PROGRAM in each of the directories along the $PATH
- environment variable. Otherwise an absolute pathname is required.
- (See also FIND-EXECUTABLE-IN-SEARCH-PATH)
- :WAIT
- If non-NIL (default), wait until the created process finishes. If
- NIL, continue running Lisp until the program finishes.
- :INPUT
- Either T, NIL, a pathname, a stream, or :STREAM. If T, the standard
- input for the current process is inherited. If NIL, /dev/null
- is used. If a pathname, the file so specified is used. If a stream,
- all the input is read from that stream and send to the subprocess. If
- :STREAM, the PROCESS-INPUT slot is filled in with a stream that sends
- its output to the process. Defaults to NIL.
- :IF-INPUT-DOES-NOT-EXIST (when :INPUT is the name of a file)
- can be one of:
- :ERROR to generate an error
- :CREATE to create an empty file
- NIL (the default) to return NIL from RUN-PROGRAM
- :OUTPUT
- Either T, NIL, a pathname, a stream, or :STREAM. If T, the standard
- output for the current process is inherited. If NIL, /dev/null
- is used. If a pathname, the file so specified is used. If a stream,
- all the output from the process is written to this stream. If
- :STREAM, the PROCESS-OUTPUT slot is filled in with a stream that can
- be read to get the output. Defaults to NIL.
- :IF-OUTPUT-EXISTS (when :OUTPUT is the name of a file)
- can be one of:
- :ERROR (the default) to generate an error
- :SUPERSEDE to supersede the file with output from the program
- :APPEND to append output from the program to the file
- NIL to return NIL from RUN-PROGRAM, without doing anything
- :ERROR and :IF-ERROR-EXISTS
- Same as :OUTPUT and :IF-OUTPUT-EXISTS, except that :ERROR can also be
- specified as :OUTPUT in which case all error output is routed to the
- 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."
-
- ;; Prepend the program to the argument list.
- (push (namestring program) args)
- (let (;; Clear various specials used by GET-DESCRIPTOR-FOR to
- ;; communicate cleanup info.
- *close-on-error*
- *close-in-parent*
- ;; Establish PROC at this level so that we can return it.
- proc
- ;; It's friendly to allow the caller to pass any string
- ;; designator, but internally we'd like SIMPLE-STRINGs.
- (simple-args (mapcar (lambda (x) (coerce x 'simple-string)) args)))
- (unwind-protect
- (let ((pfile
- (if search
- (namestring (find-executable-in-search-path program))
- (namestring program)))
- (cookie (list 0)))
- (unless pfile
- (error "no such program: ~S" program))
- (multiple-value-bind (stdin input-stream)
- (get-descriptor-for input cookie
- :direction :input
- :if-does-not-exist if-input-does-not-exist)
- (multiple-value-bind (stdout output-stream)
- (get-descriptor-for output cookie
- :direction :output
- :if-exists if-output-exists)
- (multiple-value-bind (stderr error-stream)
- (if (eq error :output)
- (values stdout output-stream)
- (get-descriptor-for error cookie
- :direction :output
- :if-exists if-error-exists))
- (with-c-strvec (args-vec simple-args)
- (let ((iwait (if wait 1 0)))
- (declare (type fixnum iwait))
- (let ((child-pid
- (without-gcing
- (spawn pfile args-vec
- stdin stdout stderr
- iwait))))
- (when (< child-pid 0)
- (error "couldn't spawn program: ~A"
- (strerror)))
- (setf proc
- (if wait
- nil
- (make-process :pid child-pid
- :%status :running
- :input input-stream
- :output output-stream
- :error error-stream
- :status-hook status-hook
- :cookie cookie)))))))))))
- proc))