1 ;;; handle subprocesses and threads
5 (defclass base-process
()
6 ((input-stream :initarg
:error-stream
:accessor process-input-stream
)
7 (output-stream :initarg
:output-stream
:accessor process-output-stream
)
8 (error-stream :initarg
:error-stream
:accessor process-error-stream
)
9 (name :initarg
:name
:accessor process-name
)
10 (filter :initarg
:filter
:initform nil
:accessor process-filter
)
11 (sentinel :initarg
:sentinel
:initform nil
:accessor process-sentinel
)))
13 (defclass subprocess
(base-process)
14 ((process :initarg
:internal-process
:accessor subprocess-internal-process
)))
16 (defclass thread-process
(base-process)
17 ((thread :initarg
:thread
:accessor thread-process-thread
)))
19 (defclass stream-process
(base-process)
21 (:documentation
"No process or thread is attached to this
22 process. It's just a stream whose filter function gets called
23 when input exists. An eof would presumably call the sentinel and
24 clean this process up.
26 This is how network streams can be handled like gnu emacs does."))
28 (defclass user-process
(base-process)
30 (:documentation
"When we call the filter and sentinel functions
31 is decided by calling a function. I'm gonna try implementing an irc mode with this."))
33 (defclass base-buffer-process-mixin
()
34 ((buffer :initarg
:buffer
:accessor process-buffer
)
35 (mark :initarg
:mark
:accessor process-mark
)))
37 (defclass buffer-subprocess
(base-buffer-process-mixin subprocess
)
40 (defclass buffer-thread-process
(base-buffer-process-mixin thread-process
)
43 (defclass buffer-stream-process
(base-buffer-process-mixin stream-process
)
46 (defvar *process-list
* nil
49 (defmethod initialize-instance :after
((instance base-process
) &rest initargs
&key
&allow-other-keys
)
50 "Keep track of the instances in our list."
51 (declare (ignore initargs
))
52 (push instance
*process-list
*))
54 (defun subprocess-alive-p (subproc)
55 (internal-process-alive-p (subprocess-internal-process subproc
)))
57 (defun process-activity-p (process)
58 (or (and (process-output-stream process
)
59 (listen (process-output-stream process
)))
60 (and (process-error-stream process
)
61 (listen (process-error-stream process
)))
62 ;; if the process quit, we need to clean things up
63 (and (typep process
'subprocess
)
64 (not (subprocess-alive-p process
)))))
66 (defun poll-processes (&aux
(process-list *process-list
*))
67 "Return the list of processes that need processing."
68 (loop for p in process-list
69 when
(process-activity-p p
)
72 (defun process-ready-streams (process)
74 (and (process-output-stream process
)
75 (listen (process-output-stream process
))
76 (push (process-output-stream process
) streams
))
77 (and (process-error-stream process
)
78 (listen (process-error-stream process
))
79 (push (process-error-stream process
) streams
))
82 (defgeneric dispatch-process
(process)
83 (:documentation
"Call the filter and sentinel functions on process, if needed."))
85 (defmethod dispatch-process :around
((process base-process
))
86 "Handle calling the filter functions."
87 (let ((streams (process-ready-streams process
)))
89 (if (process-filter process
)
90 (if (process-buffer process
)
91 (with-current-buffer (process-buffer process
)
92 ;; TODO: set the point to the process mark
93 (funcall (process-filter process
) process
))
94 ;; FIXME: which buffer should be current if the process has no buffer?
95 (funcall (process-filter process
) process
))
96 ;; or discard the data
97 (mapc 'clear-input streams
))))
100 (defmethod dispatch-process ((process subprocess
))
101 "call the sentinel. FIXME: this isn't quite right. we wanna call
102 the sentinel when its status has changed which includes other
104 (unless (subprocess-alive-p process
)
106 (and (process-sentinel process
)
107 (funcall (process-sentinel process
) process
))
108 ;; its dead. clean it up.
109 (setf *process-list
* (remove process
*process-list
*)))))
111 (defmethod dispatch-process ((process thread-process
))
112 (unless (thread-alive-p (thread-process-thread process
))
114 (and (process-sentinel process
)
115 (funcall (process-sentinel process
) process
))
116 ;; its dead. clean it up.
117 (setf *process-list
* (remove process
*process-list
*)))))
119 (defmethod dispatch-process ((process stream-process
))
120 ;; FIXME: We maybe want something more flexible than just checking
121 ;; the state of the stream.
122 (unless (open-stream-p (process-output-stream process
))
124 (and (process-sentinel process
)
125 (funcall (process-sentinel process
) process
))
126 ;; its dead. clean it up.
127 (setf *process-list
* (remove process
*process-list
*)))))
129 (defun dispatch-processes (process-list)
130 "Call whatever handler function is hooked up to the process"
131 (mapc 'dispatch-process process-list
))
133 (defun default-buffer-process-filter (process)
134 "The default process filter function. Read input from streams
135 and insert it into the process' buffer. Or discard it if buffer
137 (when (process-buffer process
)
138 ;; TODO: If the other process is spitting stuff out as fast as
139 ;; possible is this gonna spin til the program calms down? We
140 ;; don't want that I don't think. -sabetts
141 (while (listen (process-output-stream process
))
142 (insert (read-line (process-output-stream process
)) #\Newline
))
143 ;; handle error output too
144 (while (listen (process-error-stream process
))
145 (insert (read-line (process-error-stream process
)) #\Newline
))))
147 (defun handle-subprocess-state-change (internal-proc)
148 (let ((process (find internal-proc
*process-list
*
149 :key
'subprocess-internal-process
)))
151 (when (process-sentinel process
)
152 (funcall (process-sentinel process
)))
153 ;; assume the process is killed for now
154 (setf *process-list
* (remove process
*process-list
*)))))
156 (defun default-buffer-process-sentinel (process)
157 (declare (ignore process
))
158 ;; uh wuddo we do here?
161 (defun start-process (name buffer program
&rest program-args
)
162 "Start a program in a subprocess. Return the process object for it.
163 name is name for process. It is modified if necessary to make it unique.
164 buffer is the buffer (or buffer name) to associate with the process.
165 Process output goes at end of that buffer, unless you specify
166 an output stream or filter function to handle the output.
167 buffer may be also nil, meaning that this process is not associated
169 program is the program file name. It is searched for in PATH.
170 Remaining arguments are strings to give program as arguments."
171 (let* ((buf (and buffer
(get-buffer-create buffer
)))
172 (mark (and buf
(make-marker (point buf
) buf
))))
173 (multiple-value-bind (proc input output error
) (run-program program program-args
)
174 (make-instance 'buffer-subprocess
175 :internal-process proc
177 :output-stream output
179 :filter
'default-buffer-process-filter
180 :sentinel
'default-buffer-process-sentinel
185 (defun open-network-stream (name buffer host service
)
186 "Open a TCP connection for a service to a host.
187 Returns a subprocess-object to represent the connection.
188 Input and output work as for subprocesses; `delete-process' closes it.
190 Args are name buffer host service.
191 name is name for process. It is modified if necessary to make it unique.
192 buffer is the buffer (or buffer name) to associate with the process.
193 Process output goes at end of that buffer, unless you specify
194 an output stream or filter function to handle the output.
195 buffer may be also nil, meaning that this process is not associated
197 host is name of the host to connect to, or its IP address.
198 service is name of the service desired, or an integer specifying
199 a port number to connect to."
203 (defvar *shell-file-name
* (getenv "SHELL")
204 "File name to load inferior shells from.
205 Initialized from the SHELL environment variable.")
207 (defvar *shell-command-switch
* "-c"
208 "Switch used to have the shell execute its command line argument.")
210 (defcommand shell-command
((command)
211 (:string
"Shell Command: "))
212 (let ((buf (get-buffer-create "*Async Shell Command*")))
215 (start-process "Shell Command" "*Async Shell Command*"
217 *shell-command-switch
*
220 (defgeneric kill-process
(process)
221 (:documentation
"Kill process process. May be process or name of one.
222 See function `interrupt-process' for more details on usage."))
224 (defmethod kill-process ((process subprocess
))
225 ;; send the QUIT signal
226 (internal-process-kill (subprocess-internal-process process
)))
228 (defmethod kill-process ((obj thread-process
))
229 (kill-thread (thread-process-thread obj
)))
231 (defgeneric delete-process
(process)
232 (:documentation
"Delete process: kill it and forget about it immediately.
233 process may be a process, a buffer, the name of a process or buffer, or
234 nil, indicating the current buffer's process."))
236 ;; (defmethod delete-process ((proces subprocess))
240 ;; (defmethod delete-process ((obj buffer))
244 ;; (defmethod delete-process ((obj string))
248 ;; (defmethod delete-process ((process thread-process))
252 ;; (defmethod delete-process ((process null))