Skip to content
Snippets Groups Projects
Commit c51d4b5b authored by wlott's avatar wlott
Browse files

Changed CREATE-SLAVE to check the status of the process while waiting for

it to connect.  If the process exits of is killed, report that instead of
waiting for an arbitrary about of time.
parent 8bc0a7f8
Branches
Tags
No related merge requests found
...@@ -325,23 +325,30 @@ ...@@ -325,23 +325,30 @@
(when (getstring background *buffer-names*) (when (getstring background *buffer-names*)
(editor-error "Buffer ~A is already in use." background))) (editor-error "Buffer ~A is already in use." background)))
(message "Spawning slave ... ") (message "Spawning slave ... ")
(unless (ext:run-program (namestring (truename (value slave-utility))) (let ((proc
`("-slave" ,(get-editor-name) (ext:run-program (namestring (truename (value slave-utility)))
,@(if slave (list "-slave-buffer" slave)) `("-slave" ,(get-editor-name)
,@(if background ,@(if slave (list "-slave-buffer" slave))
(list "-background-buffer" background)) ,@(if background
,@(value slave-utility-switches)) (list "-background-buffer" background))
:wait nil ,@(value slave-utility-switches))
:output "/dev/null" :wait nil
:if-output-exists :append) :output "/dev/null"
(editor-error "Could not start slave.")) :if-output-exists :append))
(let ((*accept-connections* t) (*accept-connections* t)
(*newly-created-slave* nil)) (*newly-created-slave* nil))
(unless proc
(editor-error "Could not start slave."))
(dotimes (i *slave-connect-wait* (dotimes (i *slave-connect-wait*
(editor-error "Client Lisp is still unconnected. ~ (editor-error "Client Lisp is still unconnected. ~
You must use \"Accept Slave Connections\" to ~ You must use \"Accept Slave Connections\" to ~
allow the slave to connect at this point.")) allow the slave to connect at this point."))
(system:serve-event 1) (system:serve-event 1)
(case (ext:process-status proc)
(:exited
(editor-error "The slave lisp exited before connecting."))
(:signaled
(editor-error "The slave lisp was kill before connecting.")))
(when *newly-created-slave* (when *newly-created-slave*
(message "DONE") (message "DONE")
(return *newly-created-slave*)))))) (return *newly-created-slave*))))))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment