- ;; Prepend the program to the argument list.
- (push (namestring program) args)
- (labels (;; It's friendly to allow the caller to pass any string
- ;; designator, but internally we'd like SIMPLE-STRINGs.
- ;;
- ;; Huh? We let users pass in symbols and characters for
- ;; the arguments, but call NAMESTRING on the program
- ;; name... -- RMK
- (simplify-args (args)
- (loop for arg in args
- as escaped-arg = (escape-arg arg)
- collect (coerce escaped-arg 'simple-string)))
- (escape-arg (arg)
- #-win32 arg
- ;; Apparently any spaces or double quotes in the arguments
- ;; need to be escaped on win32.
- #+win32 (if (position-if
- (lambda (c) (find c '(#\" #\Space))) arg)
- (write-to-string arg)
- arg)))
- (let (;; Clear various specials used by GET-DESCRIPTOR-FOR to
- ;; communicate cleanup info.
- *close-on-error*
- *close-in-parent*
- ;; Some other binding used only on non-Win32. FIXME:
- ;; nothing seems to set this.
- #-win32 *handlers-installed*
- ;; Establish PROC at this level so that we can return it.
- proc
- (simple-args (simplify-args args))
- (progname (native-namestring program))
- ;; Gag.
- (cookie (list 0)))
- (unwind-protect
- ;; Note: despite the WITH-* names, these macros don't
- ;; expand into UNWIND-PROTECT forms. They're just
- ;; syntactic sugar to make the rest of the routine slightly
- ;; easier to read.
- (macrolet ((with-no-with
- ((&optional no)
- (&whole form with-something parameters &body body))
- (declare (ignore with-something parameters))
- (typecase no
- (keyword `(progn ,@body))
- (null form)
- (t `(let ,no (declare (ignorable ,@no)) ,@body))))
- (with-fd-and-stream-for (((fd stream) which &rest args)
- &body body)
- `(multiple-value-bind (,fd ,stream)
- ,(ecase which
- ((:input :output)
- `(get-descriptor-for ,@args))
- (:error
- `(if (eq ,(first args) :output)
- ;; kludge: we expand into
- ;; hard-coded symbols here.
- (values stdout output-stream)
- (get-descriptor-for ,@args))))
- (unless ,fd
- (return-from run-program))
- ,@body))
- (with-open-pty (((pty-name pty-stream) (pty cookie))
- &body body)
- `(multiple-value-bind (,pty-name ,pty-stream)
- (open-pty ,pty ,cookie :external-format external-format)
- ,@body))
- (with-args-vec ((vec args) &body body)
- `(with-c-strvec (,vec ,args)
- ,@body))
- (with-environment-vec ((vec) &body body)
- `(with-environment
- (,vec environment
- :null (not (or environment environment-p)))
- ,@body)))
- (with-fd-and-stream-for ((stdin input-stream) :input
- input cookie
- :direction :input
- :if-does-not-exist if-input-does-not-exist
- :external-format external-format
- :wait wait)
- (with-fd-and-stream-for ((stdout output-stream) :output
- output cookie
+ (let* (;; Clear various specials used by GET-DESCRIPTOR-FOR to
+ ;; communicate cleanup info.
+ *close-on-error*
+ *close-in-parent*
+ ;; Some other binding used only on non-Win32. FIXME:
+ ;; nothing seems to set this.
+ #-win32 *handlers-installed*
+ ;; Establish PROC at this level so that we can return it.
+ proc
+ (progname (native-namestring program))
+ (args (prepare-args (cons progname args)))
+ (directory (and directory-p (native-namestring directory)))
+ ;; Gag.
+ (cookie (list 0)))
+ (unwind-protect
+ ;; Note: despite the WITH-* names, these macros don't
+ ;; expand into UNWIND-PROTECT forms. They're just
+ ;; syntactic sugar to make the rest of the routine slightly
+ ;; easier to read.
+ (macrolet ((with-fd-and-stream-for (((fd stream) which &rest args)
+ &body body)
+ `(multiple-value-bind (,fd ,stream)
+ ,(ecase which
+ ((:input :output)
+ `(get-descriptor-for ,@args))
+ (:error
+ `(if (eq ,(first args) :output)
+ ;; kludge: we expand into
+ ;; hard-coded symbols here.
+ (values stdout output-stream)
+ (get-descriptor-for ,@args))))
+ (unless ,fd
+ (return-from run-program))
+ ,@body))
+ (with-open-pty (((pty-name pty-stream) (pty cookie))
+ &body body)
+ (declare (ignorable pty-name pty-stream pty cookie))
+ #+win32
+ `(progn ,@body)
+ #-win32
+ `(multiple-value-bind (,pty-name ,pty-stream)
+ (open-pty ,pty ,cookie :external-format external-format)
+ ,@body)))
+ (with-fd-and-stream-for ((stdin input-stream) :input
+ input cookie
+ :direction :input
+ :if-does-not-exist if-input-does-not-exist
+ :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 external-format)
+ (with-fd-and-stream-for ((stderr error-stream) :error
+ error cookie