Skip to content
Snippets Groups Projects
Commit 4ed0f027 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

launch-program: introduce nest and move bindings

First of refactorings where nest helps keep conditional and nested code clean.
parent a62c3982
No related branches found
No related tags found
No related merge requests found
...@@ -528,20 +528,21 @@ LAUNCH-PROGRAM returns a PROCESS-INFO object." ...@@ -528,20 +528,21 @@ LAUNCH-PROGRAM returns a PROCESS-INFO object."
(list input output error-output)) (list input output error-output))
(parameter-error "~S: Streams passed as I/O parameters need to be (synonymous with) file streams on this lisp" (parameter-error "~S: Streams passed as I/O parameters need to be (synonymous with) file streams on this lisp"
'launch-program)) 'launch-program))
;; see comments for these functions
(%handle-if-does-not-exist input if-input-does-not-exist)
(%handle-if-exists output if-output-exists)
(%handle-if-exists error-output if-error-output-exists)
#+(or abcl allegro clozure cmucl ecl (and lispworks os-unix) mkcl sbcl scl) #+(or abcl allegro clozure cmucl ecl (and lispworks os-unix) mkcl sbcl scl)
(let* ((command (%normalize-command command)) (nest
(progn ;; see comments for these functions
(%handle-if-does-not-exist input if-input-does-not-exist)
(%handle-if-exists output if-output-exists)
(%handle-if-exists error-output if-error-output-exists))
(let ((process-info (make-instance 'process-info))
(input (%normalize-io-specifier input :input)) (input (%normalize-io-specifier input :input))
(output (%normalize-io-specifier output :output)) (output (%normalize-io-specifier output :output))
(error-output (%normalize-io-specifier error-output :error-output)) (error-output (%normalize-io-specifier error-output :error-output))
#+(and allegro os-windows) #+(and allegro os-windows) (interactive (%interactivep input output error-output))
(interactive (%interactivep input output error-output)) (command (%normalize-command command))))
(process* #-(or allegro mkcl sbcl) (with-current-directory (directory))
(multiple-value-bind (process*)
(nest (nest
#-(or allegro mkcl sbcl) (with-current-directory (directory))
#+(or allegro ecl lispworks mkcl) (multiple-value-list) #+(or allegro ecl lispworks mkcl) (multiple-value-list)
(apply (apply
#+abcl #'sys:run-program #+abcl #'sys:run-program
...@@ -571,8 +572,7 @@ LAUNCH-PROGRAM returns a PROCESS-INFO object." ...@@ -571,8 +572,7 @@ LAUNCH-PROGRAM returns a PROCESS-INFO object."
#+sbcl `(:search t) #+sbcl `(:search t)
#-sbcl keys ;; on SBCL, don't pass :directory nil but remove it from the keys #-sbcl keys ;; on SBCL, don't pass :directory nil but remove it from the keys
#+sbcl (if directory keys (remove-plist-key :directory keys)))))) #+sbcl (if directory keys (remove-plist-key :directory keys))))))
(process-info (make-instance 'process-info))) (labels ((prop (key value) (setf (slot-value process-info key) value)))
(labels ((prop (key value) (setf (slot-value process-info key) value)))
#+allegro #+allegro
(cond (cond
(separate-streams (separate-streams
...@@ -634,5 +634,4 @@ LAUNCH-PROGRAM returns a PROCESS-INFO object." ...@@ -634,5 +634,4 @@ LAUNCH-PROGRAM returns a PROCESS-INFO object."
(prop 'error-stream err))) (prop 'error-stream err)))
;; lispworks6 returns (pid), lispworks7 returns (io err pid) of which we keep io ;; lispworks6 returns (pid), lispworks7 returns (io err pid) of which we keep io
(prop 'process (first process*))))) (prop 'process (first process*)))))
process-info))) process-info)))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment