run-program.lisp - clic - Clic is an command line interactive client for gopher… | |
git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65… | |
Log | |
Files | |
Refs | |
Tags | |
README | |
LICENSE | |
--- | |
run-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 |