GopherProxy

	trun-program.lisp - clic - Clic is an command line interactive client for gophe…
	git clone git://bitreich.org/clic/ git://hg6vgqziawt5s4dj.onion/clic/
	Log
	Files
	Refs
	Tags
	LICENSE
	---
	trun-program.lisp (30529B)
	---
	1 ;;;; -------------------------------------------------------------------…
	2 ;;;; run-program initially from xcvb-driver.
	3
	4 (uiop/package:define-package :uiop/run-program
	5 (:nicknames :asdf/run-program) ; OBSOLETE. Used by cl-sane, printv.
	6 (:use :uiop/common-lisp :uiop/package :uiop/utility :uiop/version
	7 :uiop/pathname :uiop/os :uiop/filesystem :uiop/stream :uiop/launch-pr…
	8 (:export
	9 #:run-program
	10 #:slurp-input-stream #:vomit-output-stream
	11 #:subprocess-error
	12 #:subprocess-error-code #:subprocess-error-command #:subprocess-error…
	13 (:import-from :uiop/launch-program
	14 #:%handle-if-does-not-exist #:%handle-if-exists #:%interactivep
	15 #:input-stream #:output-stream #:error-output-stream))
	16 (in-package :uiop/run-program)
	17
	18 ;;;; Slurping a stream, typically the output of another program
	19 (with-upgradability ()
	20 (defun call-stream-processor (fun processor stream)
	21 "Given FUN (typically SLURP-INPUT-STREAM or VOMIT-OUTPUT-STREAM,
	22 a PROCESSOR specification which is either an atom or a list specifying
	23 a processor an keyword arguments, call the specified processor with
	24 the given STREAM as input"
	25 (if (consp processor)
	26 (apply fun (first processor) stream (rest processor))
	27 (funcall fun processor stream)))
	28
	29 (defgeneric slurp-input-stream (processor input-stream &key)
	30 (:documentation
	31 "SLURP-INPUT-STREAM is a generic function with two positional argum…
	32 PROCESSOR and INPUT-STREAM and additional keyword arguments, that consum…
	33 the contents of the INPUT-STREAM and processes them according to a method
	34 specified by PROCESSOR.
	35
	36 Built-in methods include the following:
	37 * if PROCESSOR is a function, it is called with the INPUT-STREAM as its …
	38 * if PROCESSOR is a list, its first element should be a function. It wi…
	39 INPUT-STREAM and the rest of the list. That is (x . y) will be treate…
	40 \(APPLY x <stream> y\)
	41 * if PROCESSOR is an output-stream, the contents of INPUT-STREAM is copi…
	42 per copy-stream-to-stream, with appropriate keyword arguments.
	43 * if PROCESSOR is the symbol CL:STRING or the keyword :STRING, then the …
	44 are returned as a string, as per SLURP-STREAM-STRING.
	45 * if PROCESSOR is the keyword :LINES then the INPUT-STREAM will be handl…
	46 * if PROCESSOR is the keyword :LINE then the INPUT-STREAM will be handle…
	47 * if PROCESSOR is the keyword :FORMS then the INPUT-STREAM will be handl…
	48 * if PROCESSOR is the keyword :FORM then the INPUT-STREAM will be handle…
	49 * if PROCESSOR is T, it is treated the same as standard-output. If it …
	50
	51 Programmers are encouraged to define their own methods for this generic …
	52
	53 #-genera
	54 (defmethod slurp-input-stream ((function function) input-stream &key)
	55 (funcall function input-stream))
	56
	57 (defmethod slurp-input-stream ((list cons) input-stream &key)
	58 (apply (first list) input-stream (rest list)))
	59
	60 #-genera
	61 (defmethod slurp-input-stream ((output-stream stream) input-stream
	62 &key linewise prefix (element-type 'cha…
	63 (copy-stream-to-stream
	64 input-stream output-stream
	65 :linewise linewise :prefix prefix :element-type element-type :buffe…
	66
	67 (defmethod slurp-input-stream ((x (eql 'string)) stream &key stripped)
	68 (slurp-stream-string stream :stripped stripped))
	69
	70 (defmethod slurp-input-stream ((x (eql :string)) stream &key stripped)
	71 (slurp-stream-string stream :stripped stripped))
	72
	73 (defmethod slurp-input-stream ((x (eql :lines)) stream &key count)
	74 (slurp-stream-lines stream :count count))
	75
	76 (defmethod slurp-input-stream ((x (eql :line)) stream &key (at 0))
	77 (slurp-stream-line stream :at at))
	78
	79 (defmethod slurp-input-stream ((x (eql :forms)) stream &key count)
	80 (slurp-stream-forms stream :count count))
	81
	82 (defmethod slurp-input-stream ((x (eql :form)) stream &key (at 0))
	83 (slurp-stream-form stream :at at))
	84
	85 (defmethod slurp-input-stream ((x (eql t)) stream &rest keys &key &all…
	86 (apply 'slurp-input-stream standard-output stream keys))
	87
	88 (defmethod slurp-input-stream ((x null) (stream t) &key)
	89 nil)
	90
	91 (defmethod slurp-input-stream ((pathname pathname) input
	92 &key
	93 (element-type *default-stream-element…
	94 (external-format *utf-8-external-form…
	95 (if-exists :rename-and-delete)
	96 (if-does-not-exist :create)
	97 buffer-size
	98 linewise)
	99 (with-output-file (output pathname
	100 :element-type element-type
	101 :external-format external-format
	102 :if-exists if-exists
	103 :if-does-not-exist if-does-not-exist)
	104 (copy-stream-to-stream
	105 input output
	106 :element-type element-type :buffer-size buffer-size :linewise lin…
	107
	108 (defmethod slurp-input-stream (x stream
	109 &key linewise prefix (element-type 'cha…
	110 (declare (ignorable stream linewise prefix element-type buffer-size))
	111 (cond
	112 #+genera
	113 ((functionp x) (funcall x stream))
	114 #+genera
	115 ((output-stream-p x)
	116 (copy-stream-to-stream
	117 stream x
	118 :linewise linewise :prefix prefix :element-type element-type :bu…
	119 (t
	120 (parameter-error "Invalid ~S destination ~S" 'slurp-input-stream …
	121
	122 ;;;; Vomiting a stream, typically into the input of another program.
	123 (with-upgradability ()
	124 (defgeneric vomit-output-stream (processor output-stream &key)
	125 (:documentation
	126 "VOMIT-OUTPUT-STREAM is a generic function with two positional argu…
	127 PROCESSOR and OUTPUT-STREAM and additional keyword arguments, that produ…
	128 some content onto the OUTPUT-STREAM, according to a method specified by …
	129
	130 Built-in methods include the following:
	131 * if PROCESSOR is a function, it is called with the OUTPUT-STREAM as its…
	132 * if PROCESSOR is a list, its first element should be a function.
	133 It will be applied to a cons of the OUTPUT-STREAM and the rest of the …
	134 That is (x . y) will be treated as \(APPLY x <stream> y\)
	135 * if PROCESSOR is an input-stream, its contents will be copied the OUTPU…
	136 per copy-stream-to-stream, with appropriate keyword arguments.
	137 * if PROCESSOR is a string, its contents will be printed to the OUTPUT-S…
	138 * if PROCESSOR is T, it is treated the same as standard-input. If it i…
	139
	140 Programmers are encouraged to define their own methods for this generic …
	141
	142 #-genera
	143 (defmethod vomit-output-stream ((function function) output-stream &key)
	144 (funcall function output-stream))
	145
	146 (defmethod vomit-output-stream ((list cons) output-stream &key)
	147 (apply (first list) output-stream (rest list)))
	148
	149 #-genera
	150 (defmethod vomit-output-stream ((input-stream stream) output-stream
	151 &key linewise prefix (element-type 'cha…
	152 (copy-stream-to-stream
	153 input-stream output-stream
	154 :linewise linewise :prefix prefix :element-type element-type :buffe…
	155
	156 (defmethod vomit-output-stream ((x string) stream &key fresh-line terp…
	157 (princ x stream)
	158 (when fresh-line (fresh-line stream))
	159 (when terpri (terpri stream))
	160 (values))
	161
	162 (defmethod vomit-output-stream ((x (eql t)) stream &rest keys &key &al…
	163 (apply 'vomit-output-stream standard-input stream keys))
	164
	165 (defmethod vomit-output-stream ((x null) (stream t) &key)
	166 (values))
	167
	168 (defmethod vomit-output-stream ((pathname pathname) input
	169 &key
	170 (element-type *default-stream-element…
	171 (external-format *utf-8-external-form…
	172 (if-exists :rename-and-delete)
	173 (if-does-not-exist :create)
	174 buffer-size
	175 linewise)
	176 (with-output-file (output pathname
	177 :element-type element-type
	178 :external-format external-format
	179 :if-exists if-exists
	180 :if-does-not-exist if-does-not-exist)
	181 (copy-stream-to-stream
	182 input output
	183 :element-type element-type :buffer-size buffer-size :linewise lin…
	184
	185 (defmethod vomit-output-stream (x stream
	186 &key linewise prefix (element-type 'cha…
	187 (declare (ignorable stream linewise prefix element-type buffer-size))
	188 (cond
	189 #+genera
	190 ((functionp x) (funcall x stream))
	191 #+genera
	192 ((input-stream-p x)
	193 (copy-stream-to-stream
	194 x stream
	195 :linewise linewise :prefix prefix :element-type element-type :bu…
	196 (t
	197 (parameter-error "Invalid ~S source ~S" 'vomit-output-stream x)))…
	198
	199
	200 ;;;; Run-program: synchronously run a program in a subprocess, handling …
	201 (with-upgradability ()
	202 (define-condition subprocess-error (error)
	203 ((code :initform nil :initarg :code :reader subprocess-error-code)
	204 (command :initform nil :initarg :command :reader subprocess-error-c…
	205 (process :initform nil :initarg :process :reader subprocess-error-p…
	206 (:report (lambda (condition stream)
	207 (format stream "Subprocess ~@[~S~% ~]~@[with command ~S~%…
	208 (subprocess-error-process condition)
	209 (subprocess-error-command condition)
	210 (subprocess-error-code condition)))))
	211
	212 (defun %check-result (exit-code &key command process ignore-error-stat…
	213 (unless ignore-error-status
	214 (unless (eql exit-code 0)
	215 (cerror "IGNORE-ERROR-STATUS"
	216 'subprocess-error :command command :code exit-code :proc…
	217 exit-code)
	218
	219 (defun %active-io-specifier-p (specifier)
	220 "Determines whether a run-program I/O specifier requires Lisp-side p…
	221 via SLURP-INPUT-STREAM or VOMIT-OUTPUT-STREAM (return T),
	222 or whether it's already taken care of by the implementation's underlying…
	223 (not (typep specifier '(or null string pathname (member :interactive…
	224 #+(or cmucl (and sbcl os-unix) scl) (or stre…
	225 #+lispworks file-stream))))
	226
	227 (defun %run-program (command &rest keys &key &allow-other-keys)
	228 "DEPRECATED. Use LAUNCH-PROGRAM instead."
	229 (apply 'launch-program command keys))
	230
	231 (defun %call-with-program-io (gf tval stream-easy-p fun direction spec…
	232 &key
	233 (element-type #-clozure *default-strea…
	234 (external-format *utf-8-external-forma…
	235 ;; handle redirection for run-program and system
	236 ;; SPEC is the specification for the subprocess's input or output or…
	237 ;; TVAL is the value used if the spec is T
	238 ;; GF is the generic function to call to handle arbitrary values of …
	239 ;; STREAM-EASY-P is T if we're going to use a RUN-PROGRAM that copie…
	240 ;; (it's only meaningful on CMUCL, SBCL, SCL that actually do it)
	241 ;; DIRECTION is :INPUT, :OUTPUT or :ERROR-OUTPUT for the direction o…
	242 ;; FUN is a function of the new reduced spec and an activity functio…
	243 ;; when the subprocess is active and communicating through that stre…
	244 ;; ACTIVEP is a boolean true if we will get to run code while the pr…
	245 ;; ELEMENT-TYPE and EXTERNAL-FORMAT control what kind of temporary f…
	246 ;; RETURNER is a function called with the value of the activity.
	247 ;; --- TODO ([email protected]): handle if-output-exists and such when …
	248 (declare (ignorable stream-easy-p))
	249 (let* ((actual-spec (if (eq spec t) tval spec))
	250 (activity-spec (if (eq actual-spec :output)
	251 (ecase direction
	252 ((:input :output)
	253 (parameter-error "~S does not allow ~S …
	254 'run-program :output d…
	255 ((:error-output)
	256 nil))
	257 actual-spec)))
	258 (labels ((activity (stream)
	259 (call-function returner (call-stream-processor gf activ…
	260 (easy-case ()
	261 (funcall fun actual-spec nil))
	262 (hard-case ()
	263 (if activep
	264 (funcall fun :stream #'activity)
	265 (with-temporary-file (:pathname tmp)
	266 (ecase direction
	267 (:input
	268 (with-output-file (s tmp :if-exists :overwrite
	269 :external-format external…
	270 :element-type element-typ…
	271 (activity s))
	272 (funcall fun tmp nil))
	273 ((:output :error-output)
	274 (multiple-value-prog1 (funcall fun tmp nil)
	275 (with-input-file (s tmp
	276 :external-format external…
	277 :element-type element-typ…
	278 (activity s)))))))))
	279 (typecase activity-spec
	280 ((or null string pathname (eql :interactive))
	281 (easy-case))
	282 #+(or cmucl (and sbcl os-unix) scl) ;; streams are only easy o…
	283 (stream
	284 (if stream-easy-p (easy-case) (hard-case)))
	285 (t
	286 (hard-case))))))
	287
	288 (defmacro place-setter (place)
	289 (when place
	290 (let ((value (gensym)))
	291 `#'(lambda (,value) (setf ,place ,value)))))
	292
	293 (defmacro with-program-input (((reduced-input-var
	294 &optional (input-activity-var (gensym)…
	295 input-form &key setf stream-easy-p acti…
	296 `(apply '%call-with-program-io 'vomit-output-stream standard-input…
	297 #'(lambda (,reduced-input-var ,input-activity-var)
	298 ,@(unless iavp `((declare (ignore ,input-activity-var))))
	299 ,@body)
	300 :input ,input-form ,active (place-setter ,setf) ,keys))
	301
	302 (defmacro with-program-output (((reduced-output-var
	303 &optional (output-activity-var (gensym…
	304 output-form &key setf stream-easy-p ac…
	305 `(apply '%call-with-program-io 'slurp-input-stream standard-output…
	306 #'(lambda (,reduced-output-var ,output-activity-var)
	307 ,@(unless oavp `((declare (ignore ,output-activity-var))…
	308 ,@body)
	309 :output ,output-form ,active (place-setter ,setf) ,keys))
	310
	311 (defmacro with-program-error-output (((reduced-error-output-var
	312 &optional (error-output-activit…
	313 error-output-form &key setf stre…
	314 &body body)
	315 `(apply '%call-with-program-io 'slurp-input-stream error-output ,s…
	316 #'(lambda (,reduced-error-output-var ,error-output-activity-…
	317 ,@(unless eoavp `((declare (ignore ,error-output-activit…
	318 ,@body)
	319 :error-output ,error-output-form ,active (place-setter ,setf…
	320
	321 (defun %use-launch-program (command &rest keys
	322 &key input output error-output ignore-error-s…
	323 ;; helper for RUN-PROGRAM when using LAUNCH-PROGRAM
	324 #+(or cormanlisp gcl (and lispworks os-windows) mcl xcl)
	325 (progn
	326 command keys input output error-output ignore-error-status ;; igno…
	327 (not-implemented-error '%use-launch-program))
	328 (when (member :stream (list input output error-output))
	329 (parameter-error "~S: ~S is not allowed as synchronous I/O redirec…
	330 'run-program :stream))
	331 (let* ((active-input-p (%active-io-specifier-p input))
	332 (active-output-p (%active-io-specifier-p output))
	333 (active-error-output-p (%active-io-specifier-p error-output))
	334 (activity
	335 (cond
	336 (active-output-p :output)
	337 (active-input-p :input)
	338 (active-error-output-p :error-output)
	339 (t nil)))
	340 output-result error-output-result exit-code process-info)
	341 (with-program-output ((reduced-output output-activity)
	342 output :keys keys :setf output-result
	343 :stream-easy-p t :active (eq activity :outpu…
	344 (with-program-error-output ((reduced-error-output error-output-a…
	345 error-output :keys keys :setf error-…
	346 :stream-easy-p t :active (eq activit…
	347 (with-program-input ((reduced-input input-activity)
	348 input :keys keys
	349 :stream-easy-p t :active (eq activity :in…
	350 (setf process-info
	351 (apply 'launch-program command
	352 :input reduced-input :output reduced-output
	353 :error-output (if (eq error-output :output) :ou…
	354 keys))
	355 (labels ((get-stream (stream-name &optional fallbackp)
	356 (or (slot-value process-info stream-name)
	357 (when fallbackp
	358 (slot-value process-info 'bidir-stream))))
	359 (run-activity (activity stream-name &optional fallb…
	360 (if-let (stream (get-stream stream-name fallbackp…
	361 (funcall activity stream)
	362 (error 'subprocess-error
	363 :code `(:missing ,stream-name)
	364 :command command :process process-info))…
	365 (unwind-protect
	366 (ecase activity
	367 ((nil))
	368 (:input (run-activity input-activity 'input-stream …
	369 (:output (run-activity output-activity 'output-stre…
	370 (:error-output (run-activity error-output-activity …
	371 (close-streams process-info)
	372 (setf exit-code (wait-process process-info)))))))
	373 (%check-result exit-code
	374 :command command :process process-info
	375 :ignore-error-status ignore-error-status)
	376 (values output-result error-output-result exit-code)))
	377
	378 (defun %normalize-system-command (command) ;; helper for %USE-SYSTEM
	379 (etypecase command
	380 (string command)
	381 (list (escape-shell-command
	382 (os-cond
	383 ((os-unix-p) (cons "exec" command))
	384 (t command))))))
	385
	386 (defun %redirected-system-command (command in out err directory) ;; he…
	387 (flet ((redirect (spec operator)
	388 (let ((pathname
	389 (typecase spec
	390 (null (null-device-pathname))
	391 (string (parse-native-namestring spec))
	392 (pathname spec)
	393 ((eql :output)
	394 (unless (equal operator " 2>>")
	395 (parameter-error "~S: only the ~S argument can…
	396 'run-program :error-output :o…
	397 (return-from redirect '(" 2>&1"))))))
	398 (when pathname
	399 (list operator " "
	400 (escape-shell-token (native-namestring pathname))…
	401 (let* ((redirections (append (redirect in " <") (redirect out " >>…
	402 (normalized (%normalize-system-command command))
	403 (directory (or directory #+(or abcl xcl) (getcwd)))
	404 (chdir (when directory
	405 (let ((dir-arg (escape-shell-token (native-namestr…
	406 (os-cond
	407 ((os-unix-p) `("cd " ,dir-arg " ; "))
	408 ((os-windows-p) `("cd /d " ,dir-arg " & ")))))))
	409 (reduce/strcat
	410 (os-cond
	411 ((os-unix-p) `(,@(when redirections `("exec " ,@redirections "…
	412 ((os-windows-p) `(,@redirections " (" ,@chdir ,normalized ")")…
	413
	414 (defun %system (command &rest keys &key directory
	415 input (if-input-does-not-exist :e…
	416 output (if-output-exists :superse…
	417 error-output (if-error-output-exi…
	418 &allow-other-keys)
	419 "A portable abstraction of a low-level call to libc's system()."
	420 (declare (ignorable keys directory input if-input-does-not-exist out…
	421 if-output-exists error-output if-error-output-ex…
	422 (when (member :stream (list input output error-output))
	423 (parameter-error "~S: ~S is not allowed as synchronous I/O redirec…
	424 'run-program :stream))
	425 #+(or abcl allegro clozure cmucl ecl (and lispworks os-unix) mkcl sb…
	426 (let (#+(or abcl ecl mkcl)
	427 (version (parse-version
	428 #-abcl
	429 (lisp-implementation-version)
	430 #+abcl
	431 (second (split-string (implementation-identifier) …
	432 (nest
	433 #+abcl (unless (lexicographic< '< version '(1 4 0)))
	434 #+ecl (unless (lexicographic<= '< version '(16 0 0)))
	435 #+mkcl (unless (lexicographic<= '< version '(1 1 9)))
	436 (return-from %system
	437 (wait-process
	438 (apply 'launch-program (%normalize-system-command command) key…
	439 #+(or abcl clasp clisp cormanlisp ecl gcl genera (and lispworks os-w…
	440 (let ((%command (%redirected-system-command command input output err…
	441 ;; see comments for these functions
	442 (%handle-if-does-not-exist input if-input-does-not-exist)
	443 (%handle-if-exists output if-output-exists)
	444 (%handle-if-exists error-output if-error-output-exists)
	445 #+abcl (ext:run-shell-command %command)
	446 #+(or clasp ecl) (let ((standard-input stdin)
	447 (standard-output stdout)
	448 (error-output stderr))
	449 (ext:system %command))
	450 #+clisp
	451 (let ((raw-exit-code
	452 (or
	453 #.`(#+os-windows ,@'(ext:run-shell-command %command)
	454 #+os-unix ,@'(ext:run-program "/bin/sh" :arguments `("…
	455 :wait t :input :terminal :output :terminal)
	456 0)))
	457 (if (minusp raw-exit-code)
	458 (- 128 raw-exit-code)
	459 raw-exit-code))
	460 #+cormanlisp (win32:system %command)
	461 #+gcl (system:system %command)
	462 #+genera (not-implemented-error '%system)
	463 #+(and lispworks os-windows)
	464 (system:call-system %command :current-directory directory :wait t)
	465 #+mcl (ccl::with-cstrs ((%%command %command)) (_system %%command))
	466 #+mkcl (mkcl:system %command)
	467 #+xcl (system:%run-shell-command %command)))
	468
	469 (defun %use-system (command &rest keys
	470 &key input output error-output ignore-error-status…
	471 ;; helper for RUN-PROGRAM when using %system
	472 (let (output-result error-output-result exit-code)
	473 (with-program-output ((reduced-output)
	474 output :keys keys :setf output-result)
	475 (with-program-error-output ((reduced-error-output)
	476 error-output :keys keys :setf error-…
	477 (with-program-input ((reduced-input) input :keys keys)
	478 (setf exit-code (apply '%system command
	479 :input reduced-input :output reduced-…
	480 :error-output reduced-error-output ke…
	481 (%check-result exit-code
	482 :command command
	483 :ignore-error-status ignore-error-status)
	484 (values output-result error-output-result exit-code)))
	485
	486 (defun run-program (command &rest keys
	487 &key ignore-error-status (force-shell nil force-s…
	488 input (if-input-does-not-exist :error)
	489 output (if-output-exists :supersede)
	490 error-output (if-error-output-exists :supersede)
	491 (element-type #-clozure *default-stream-element…
	492 (external-format utf-8-external-format)
	493 &allow-other-keys)
	494 "Run program specified by COMMAND,
	495 either a list of strings specifying a program and list of arguments,
	496 or a string specifying a shell command (/bin/sh on Unix, CMD.EXE on Wind…
	497 _synchronously_ process its output as specified and return the processin…
	498 when the program and its output processing are complete.
	499
	500 Always call a shell (rather than directly execute the command when possi…
	501 if FORCE-SHELL is specified. Similarly, never call a shell if FORCE-SHE…
	502 specified to be NIL.
	503
	504 Signal a continuable SUBPROCESS-ERROR if the process wasn't successful (…
	505 unless IGNORE-ERROR-STATUS is specified.
	506
	507 If OUTPUT is a pathname, a string designating a pathname, or NIL (the de…
	508 designating the null device, the file at that path is used as output.
	509 If it's :INTERACTIVE, output is inherited from the current process;
	510 beware that this may be different from your STANDARD-OUTPUT,
	511 and under SLIME will be on your inferior-lisp buffer.
	512 If it's T, output goes to your current STANDARD-OUTPUT stream.
	513 Otherwise, OUTPUT should be a value that is a suitable first argument to
	514 SLURP-INPUT-STREAM (qv.), or a list of such a value and keyword argument…
	515 In this case, RUN-PROGRAM will create a temporary stream for the program…
	516 the program output, in that stream, will be processed by a call to SLURP…
	517 using OUTPUT as the first argument (or the first element of OUTPUT, and …
	518 The primary value resulting from that call (or NIL if no call was needed)
	519 will be the first value returned by RUN-PROGRAM.
	520 E.g., using :OUTPUT :STRING will have it return the entire output stream…
	521 And using :OUTPUT '(:STRING :STRIPPED T) will have it return the same st…
	522 stripped of any ending newline.
	523
	524 IF-OUTPUT-EXISTS, which is only meaningful if OUTPUT is a string or a
	525 pathname, can take the values :ERROR, :APPEND, and :SUPERSEDE (the
	526 default). The meaning of these values and their effect on the case
	527 where OUTPUT does not exist, is analogous to the IF-EXISTS parameter
	528 to OPEN with :DIRECTION :OUTPUT.
	529
	530 ERROR-OUTPUT is similar to OUTPUT, except that the resulting value is re…
	531 as the second value of RUN-PROGRAM. T designates the ERROR-OUTPUT.
	532 Also :OUTPUT means redirecting the error output to the output stream,
	533 in which case NIL is returned.
	534
	535 IF-ERROR-OUTPUT-EXISTS is similar to IF-OUTPUT-EXIST, except that it
	536 affects ERROR-OUTPUT rather than OUTPUT.
	537
	538 INPUT is similar to OUTPUT, except that VOMIT-OUTPUT-STREAM is used,
	539 no value is returned, and T designates the STANDARD-INPUT.
	540
	541 IF-INPUT-DOES-NOT-EXIST, which is only meaningful if INPUT is a string
	542 or a pathname, can take the values :CREATE and :ERROR (the
	543 default). The meaning of these values is analogous to the
	544 IF-DOES-NOT-EXIST parameter to OPEN with :DIRECTION :INPUT.
	545
	546 ELEMENT-TYPE and EXTERNAL-FORMAT are passed on
	547 to your Lisp implementation, when applicable, for creation of the output…
	548
	549 One and only one of the stream slurping or vomiting may or may not happen
	550 in parallel in parallel with the subprocess,
	551 depending on options and implementation,
	552 and with priority being given to output processing.
	553 Other streams are completely produced or consumed
	554 before or after the subprocess is spawned, using temporary files.
	555
	556 RUN-PROGRAM returns 3 values:
	557 0- the result of the OUTPUT slurping if any, or NIL
	558 1- the result of the ERROR-OUTPUT slurping if any, or NIL
	559 2- either 0 if the subprocess exited with success status,
	560 or an indication of failure via the EXIT-CODE of the process"
	561 (declare (ignorable input output error-output if-input-does-not-exis…
	562 if-error-output-exists element-type external-for…
	563 #-(or abcl allegro clasp clisp clozure cmucl cormanlisp ecl gcl lisp…
	564 (not-implemented-error 'run-program)
	565 (apply (if (or force-shell
	566 ;; Per doc string, set FORCE-SHELL to T if we get com…
	567 ;; But don't override user's specified preference. [2…
	568 (and (stringp command)
	569 (or (not force-shell-suppliedp)
	570 #-(or allegro clisp clozure sbcl) (os-cond (…
	571 #+(or clasp clisp cormanlisp gcl (and lispworks os-wi…
	572 ;; A race condition in ECL <= 16.0.0 prevents using e…
	573 #+ecl #.(if-let (ver (parse-version (lisp-implementat…
	574 (lexicographic<= '< ver '(16 0 0)))
	575 #+(and lispworks os-unix) (%interactivep input output…
	576 '%use-system '%use-launch-program)
	577 command keys)))
	578