1 ;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CL-USER; -*-
2 ;;; ---------------------------------------------------------------------------
3 ;;; Title: [Originally CMUCL dependent stuff + fixups], probably for SCL
4 ;;; Created: 1999-05-25 22:32
5 ;;; Author: Gilbert Baumann <gilbert@base-engineering.com>
6 ;;; License: MIT style (see below)
7 ;;; ---------------------------------------------------------------------------
8 ;;; (c) copyright 1999 by Gilbert Baumann
10 ;;; Permission is hereby granted, free of charge, to any person obtaining
11 ;;; a copy of this software and associated documentation files (the
12 ;;; "Software"), to deal in the Software without restriction, including
13 ;;; without limitation the rights to use, copy, modify, merge, publish,
14 ;;; distribute, sublicense, and/or sell copies of the Software, and to
15 ;;; permit persons to whom the Software is furnished to do so, subject to
16 ;;; the following conditions:
18 ;;; The above copyright notice and this permission notice shall be
19 ;;; included in all copies or substantial portions of the Software.
21 ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
22 ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
23 ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
24 ;;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
25 ;;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
26 ;;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
27 ;;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
29 (export 'glisp
::read-byte-sequence
:glisp
)
30 (export 'glisp
::read-char-sequence
:glisp
)
31 (export 'glisp
::run-unix-shell-command
:glisp
)
33 (export 'glisp
::getenv
:glisp
)
35 (defun glisp::read-byte-sequence
(&rest ap
)
36 (apply #'read-sequence ap
))
38 (defun glisp::read-char-sequence
(&rest ap
)
39 (apply #'read-sequence ap
))
41 (defun glisp::read-byte-sequence
(sequence input
&key
(start 0) (end (length sequence
)))
44 (cond ((= i end
) (return i
)))
45 (setq c
(read-byte input nil
:eof
))
46 (cond ((eql c
:eof
) (return i
)))
47 (setf (aref sequence i
) c
)
50 (defun glisp::read-byte-sequence
(sequence input
&key
(start 0) (end (length sequence
)))
51 (let ((r (read-sequence sequence input
:start start
:end end
)))
52 (cond ((and (= r start
) (> end start
))
53 (let ((byte (read-byte input nil
:eof
)))
57 (setf (aref sequence start
) byte
)
60 (glisp::read-byte-sequence sequence input
:start start
:end end
)
66 (defun glisp::read-char-sequence
(sequence input
&key
(start 0) (end (length sequence
)))
69 (cond ((= i end
) (return i
)))
70 (setq c
(read-byte input nil
:eof
))
71 (cond ((eql c
:eof
) (return i
)))
72 (setf (aref sequence i
) c
)
76 (defmacro glisp
::with-timeout
((&rest ignore
) &body body
)
77 (declare (ignore ignore
))
81 (defun glisp::open-inet-socket
(hostname port
)
82 (let ((fd (extensions:connect-to-inet-socket hostname port
)))
84 (sys:make-fd-stream fd
87 :element-type
'(unsigned-byte 8)
88 :name
(format nil
"Network connection to ~A:~D" hostname port
))
91 (defun glisp::g
/make-string
(length &rest options
)
92 (apply #'make-array length
:element-type
'base-char options
))
96 RUN-PROGRAM is an external symbol in the EXTENSIONS package.
97 Function
: #<Function RUN-PROGRAM
{12E7B79
}>
99 (program args
&key
(env *environment-list
*) (wait t
) pty input
100 if-input-does-not-exist output
(if-output-exists :error
) (error :output
)
101 (if-error-exists :error
) status-hook
)
102 Function documentation
:
103 Run-program creates a new process and runs the unix progam in the
104 file specified by the simple-string program. Args are the standard
105 arguments that can be passed to a Unix program
, for no arguments
106 use NIL
(which means just the name of the program is passed as arg
0).
108 Run program will either return NIL or a PROCESS structure. See the CMU
109 Common Lisp Users Manual for details about the PROCESS structure.
111 The keyword arguments have the following meanings
:
113 An A-LIST mapping keyword environment variables to simple-string
116 If non-NIL
(default), wait until the created process finishes. If
117 NIL
, continue running Lisp until the program finishes.
119 Either T
, NIL
, or a stream. Unless NIL
, the subprocess is established
120 under a PTY. If
:pty is a stream
, all output to this pty is sent to
121 this stream
, otherwise the PROCESS-PTY slot is filled in with a stream
122 connected to pty that can read output and write input.
124 Either T
, NIL
, a pathname
, a stream
, or
:STREAM. If T
, the standard
125 input for the current process is inherited. If NIL
, /dev
/null
126 is used. If a pathname
, the file so specified is used. If a stream
,
127 all the input is read from that stream and send to the subprocess. If
128 :STREAM
, the PROCESS-INPUT slot is filled in with a stream that sends
129 its output to the process. Defaults to NIL.
130 :if-input-does-not-exist
(when :input is the name of a file
) -
132 :error - generate an error.
133 :create - create an empty file.
134 nil
(default) - return nil from run-program.
136 Either T
, NIL
, a pathname
, a stream
, or
:STREAM. If T
, the standard
137 output for the current process is inherited. If NIL
, /dev
/null
138 is used. If a pathname
, the file so specified is used. If a stream
,
139 all the output from the process is written to this stream. If
140 :STREAM
, the PROCESS-OUTPUT slot is filled in with a stream that can
141 be read to get the output. Defaults to NIL.
142 :if-output-exists
(when :input is the name of a file
) -
144 :error
(default) - generates an error if the file already exists.
145 :supersede - output from the program supersedes the file.
146 :append - output from the program is appended to the file.
147 nil - run-program returns nil without doing anything.
148 :error and
:if-error-exists -
149 Same as
:output and
:if-output-exists
, except that
:error can also be
150 specified as
:output in which case all error output is routed to the
151 same place as normal output.
153 This is a function the system calls whenever the status of the
154 process changes. The function takes the process as an argument.
155 Its defined argument types are
:
156 (T T
&KEY
(:ENV T
) (:WAIT T
) (:PTY T
) (:INPUT T
) (:IF-INPUT-DOES-NOT-EXIST T
)
157 (:OUTPUT T
) (:IF-OUTPUT-EXISTS T
) (:ERROR T
) (:IF-ERROR-EXISTS T
)
160 (OR EXTENSIONS
::PROCESS NULL
)
161 On Wednesday
, 7/1/98 12:48:51 pm
[-
1] it was compiled from
:
162 target
:code
/run-program.lisp
163 Created
: Saturday
, 6/20/98 07:13:08 pm
[-
1]
164 Comment
: $Header
: /home
/david
/closure-cvs
/cvsroot
/closure
/src
/glisp
/dep-scl.lisp
,v
1.2 2006-
12-
31 15:42:40 dlichteblau Exp $
167 ;; (process-exit-code (run-program "/bin/sh" (list "-c" "ls") :wait t :input nil :output nil))
169 (defun glisp:run-unix-shell-command
(command)
170 (ext:process-exit-code
(ext:run-program
"/bin/sh" (list "-c" command
) :wait t
:input nil
:output nil
)))
175 (defun glisp::getenv
(string)
176 (cdr (assoc string ext
:*environment-list
* :test
#'string-equal
)))