Changeset 13271 for trunk/abcl/src/org/armedbear/lisp/run-program.lisp
- Timestamp:
- 04/18/11 20:33:58 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/run-program.lisp
r13270 r13271 37 37 (defun run-program (program args &key environment (wait t)) 38 38 ;;For documentation, see below. 39 (let ((pb (java:jnew "java.lang.ProcessBuilder" 40 (java:jnew-array-from-list "java.lang.String" (cons program args))))) 39 (let ((pb (%make-process-builder program args))) 41 40 (when environment 42 (let ((env-map ( java:jcall "environment"pb)))41 (let ((env-map (%process-builder-environment pb))) 43 42 (dolist (entry environment) 44 ( java:jcall "put"env-map45 (princ-to-string (car entry))46 (princ-to-string (cdr entry))))))47 (let ((process (make-process ( java:jcall "start"pb))))43 (%process-builder-env-put env-map 44 (princ-to-string (car entry)) 45 (princ-to-string (cdr entry)))))) 46 (let ((process (make-process (%process-builder-start pb)))) 48 47 (when wait (process-wait process)) 49 48 process))) 50 51 ;;The process structure.52 53 (defstruct (process (:constructor %make-process (jprocess)))54 jprocess input output error)55 56 (defun make-process (proc)57 (let ((process (%make-process proc)))58 (setf (process-input process)59 (java:jnew "org.armedbear.lisp.Stream" 'system-stream60 (java:jcall "getOutputStream" proc)61 'character)) ;;not a typo!62 (setf (process-output process)63 (java:jnew "org.armedbear.lisp.Stream" 'system-stream64 (java:jcall "getInputStream" proc) ;;not a typo|65 'character))66 (setf (process-error process)67 (java:jnew "org.armedbear.lisp.Stream" 'system-stream68 (java:jcall "getErrorStream" proc)69 'character))70 process))71 72 (defun process-alive-p (process)73 "Return t if process is still alive, nil otherwise."74 (not (ignore-errors (java:jcall "exitValue" (process-jprocess process)))))75 76 (defun process-wait (process)77 "Wait for process to quit running for some reason."78 (java:jcall "waitFor" (process-jprocess process)))79 80 (defun process-exit-code (instance)81 "The exit code of a process."82 (ignore-errors (java:jcall "exitValue" (process-jprocess instance))))83 84 (defun process-kill (process)85 "Kills the process."86 (java:jcall "destroy" (process-jprocess process)))87 49 88 50 (setf (documentation 'run-program 'function) … … 102 64 :wait 103 65 If non-NIL (default), wait until the created process finishes. If nil, continue running Lisp until the program finishes.") 66 67 ;;The process structure. 68 69 (defstruct (process (:constructor %make-process (jprocess))) 70 jprocess input output error) 71 72 (defun make-process (proc) 73 (let ((process (%make-process proc))) 74 (setf (process-input process) (%make-process-input-stream proc)) 75 (setf (process-output process) (%make-process-output-stream proc)) 76 (setf (process-error process) (%make-process-error-stream proc)) 77 process)) 78 79 (defun process-alive-p (process) 80 "Return t if process is still alive, nil otherwise." 81 (%process-alive-p (process-jprocess process))) 82 83 (defun process-wait (process) 84 "Wait for process to quit running for some reason." 85 (%process-wait (process-jprocess process))) 86 87 (defun process-exit-code (instance) 88 "The exit code of a process." 89 (%process-exit-code (process-jprocess instance))) 90 91 (defun process-kill (process) 92 "Kills the process." 93 (%process-kill (process-jprocess process))) 94 95 ;;Low-level functions. For now they're just a refactoring of the initial implementation with direct 96 ;;jnew & jcall forms in the code. As per Ville's suggestion, these should really be implemented as 97 ;;primitives. 98 99 (defun %make-process-builder (program args) 100 (java:jnew "java.lang.ProcessBuilder" 101 (java:jnew-array-from-list "java.lang.String" (cons program args)))) 102 103 (defun %process-builder-environment (pb) 104 (java:jcall "environment" pb)) 105 106 (defun %process-builder-env-put (env-map key value) 107 (java:jcall "put" env-map key value)) 108 109 (defun %process-builder-start (pb) 110 (java:jcall "start" pb)) 111 112 (defun %make-process-input-stream (proc) 113 (java:jnew "org.armedbear.lisp.Stream" 'system-stream 114 (java:jcall "getOutputStream" proc) ;;not a typo! 115 'character)) 116 117 (defun %make-process-output-stream (proc) 118 (java:jnew "org.armedbear.lisp.Stream" 'system-stream 119 (java:jcall "getInputStream" proc) ;;not a typo| 120 'character)) 121 122 (defun %make-process-error-stream (proc) 123 (java:jnew "org.armedbear.lisp.Stream" 'system-stream 124 (java:jcall "getErrorStream" proc) 125 'character)) 126 127 (defun %process-alive-p (jprocess) 128 (not (ignore-errors (java:jcall "exitValue" jprocess)))) 129 130 (defun %process-wait (jprocess) 131 (java:jcall "waitFor" jprocess)) 132 133 (defun %process-exit-code (jprocess) 134 (ignore-errors (java:jcall "exitValue" jprocess))) 135 136 (defun %process-kill (jprocess) 137 (java:jcall "destroy" jprocess))
Note: See TracChangeset
for help on using the changeset viewer.