subprocesses.lisp

   1 ;;; handle subprocesses and threads
   2
   3 (in-package "LICE")
   4
   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)))
  12
  13 (defclass subprocess (base-process)
  14   ((process :initarg :internal-process :accessor subprocess-internal-process)))
  15
  16 (defclass thread-process (base-process)
  17   ((thread :initarg :thread :accessor thread-process-thread)))
  18
  19 (defclass stream-process (base-process)
  20   ()
  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.
  25
  26 This is how network streams can be handled like gnu emacs does."))
  27
  28 (defclass user-process (base-process)
  29   ()
  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."))
  32
  33 (defclass base-buffer-process-mixin ()
  34   ((buffer :initarg :buffer :accessor process-buffer)
  35    (mark :initarg :mark :accessor process-mark)))
  36
  37 (defclass buffer-subprocess (base-buffer-process-mixin subprocess)
  38   ())
  39
  40 (defclass buffer-thread-process (base-buffer-process-mixin thread-process)
  41   ())
  42
  43 (defclass buffer-stream-process (base-buffer-process-mixin stream-process)
  44   ())
  45
  46 (defvar *process-list* nil
  47   "")
  48
  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*))
  53
  54 (defun subprocess-alive-p (subproc)
  55   (internal-process-alive-p (subprocess-internal-process subproc)))
  56
  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)))))
  65
  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)
  70        collect p))
  71
  72 (defun process-ready-streams (process)
  73   (let (streams)
  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))
  80     streams))
  81
  82 (defgeneric dispatch-process (process)
  83   (:documentation "Call the filter and sentinel functions on process, if needed."))
  84
  85 (defmethod dispatch-process :around ((process base-process))
  86   "Handle calling the filter functions."
  87   (let ((streams (process-ready-streams process)))
  88     (when streams
  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))))
  98   (call-next-method))
  99
 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
 103 states."
 104   (unless (subprocess-alive-p process)
 105     (unwind-protect
 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*)))))
 110
 111 (defmethod dispatch-process ((process thread-process))
 112   (unless (thread-alive-p (thread-process-thread process))
 113     (unwind-protect
 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*)))))
 118
 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))
 123     (unwind-protect
 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*)))))
 128
 129 (defun dispatch-processes (process-list)
 130   "Call whatever handler function is hooked up to the process"
 131   (mapc 'dispatch-process process-list))
 132
 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
 136 is nil."
 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))))
 146
 147 (defun handle-subprocess-state-change (internal-proc)
 148   (let ((process (find internal-proc *process-list*
 149                        :key 'subprocess-internal-process)))
 150     (when 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*)))))
 155
 156 (defun default-buffer-process-sentinel (process)
 157   (declare (ignore process))
 158   ;; uh wuddo we do here?
 159   )
 160
 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
 168  with any buffer.
 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 (copy-marker (point-marker buf)))))
 173     (multiple-value-bind (proc input output error) (run-program program program-args)
 174       (make-instance 'buffer-subprocess
 175                      :internal-process proc
 176                      :input-stream input
 177                      :output-stream output
 178                      :error-stream error
 179                      :filter 'default-buffer-process-filter
 180                      :sentinel 'default-buffer-process-sentinel
 181                      :name name
 182                      :buffer buf
 183                      :mark mark))))
 184
 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.
 189
 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
 196  with any buffer.
 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."
 200   (declare (ignore name buffer host service))
 201   ;; TODO: implement
 202   (error "unimplemented")
 203   )
 204
 205 (defvar *shell-file-name* (getenv "SHELL")
 206   "File name to load inferior shells from.
 207 Initialized from the SHELL environment variable.")
 208
 209 (defvar *shell-command-switch* "-c"
 210   "Switch used to have the shell execute its command line argument.")
 211
 212 (defcommand shell-command ((command)
 213                            (:string "Shell Command: "))
 214   (let ((buf (get-buffer-create "*Async Shell Command*")))
 215     (erase-buffer buf)
 216     (display-buffer buf)
 217     (start-process "Shell Command" "*Async Shell Command*"
 218                    *shell-file-name*
 219                    *shell-command-switch*
 220                    command)))
 221
 222 (defgeneric kill-process (process)
 223   (:documentation "Kill process process.  May be process or name of one.
 224 See function `interrupt-process' for more details on usage."))
 225
 226 (defmethod kill-process ((process subprocess))
 227   ;; send the QUIT signal
 228   (internal-process-kill (subprocess-internal-process process)))
 229
 230 (defmethod kill-process ((obj thread-process))
 231   (kill-thread (thread-process-thread obj)))
 232
 233 (defgeneric delete-process (process)
 234   (:documentation "Delete process: kill it and forget about it immediately.
 235 process may be a process, a buffer, the name of a process or buffer, or
 236 nil, indicating the current buffer's process."))
 237
 238 ;; (defmethod delete-process ((proces subprocess))
 239 ;;   ;; TODO
 240 ;;   )
 241
 242 ;; (defmethod delete-process ((obj buffer))
 243 ;;   ;; TODO
 244 ;;   )
 245
 246 ;; (defmethod delete-process ((obj string))
 247 ;;   ;; TODO
 248 ;;   )
 249
 250 ;; (defmethod delete-process ((process thread-process))
 251 ;;   ;; TODO
 252 ;;   )
 253
 254 ;; (defmethod delete-process ((process null))
 255 ;;   ;; TODO
 256 ;;   )