A dev loop should not need a terminal window
The daemon owns the program's lifetime, so the terminal it was started in was also the only place that program could be stopped from. M-x flan-dev builds, launches and connects; M-x flan-dev-quit ends it. It waits for a connection rather than for the socket file to appear: the daemon unlinks a stale socket before binding, so waiting on the file either succeeds instantly against nothing or races the unlink. And when the daemon dies before binding — which for a program that does not compile is the ordinary failure — the refusal names its buffer, because that is where the compiler's reason is and nothing this end sees says it.
This commit is contained in:
parent
da38a3db5f
commit
ab2a31d002
@ -252,7 +252,7 @@ Set to nil to leave the program's state to whatever replies happen to say."
|
||||
(unless (process-live-p flan-dev--connection)
|
||||
(cond
|
||||
((null flan-dev--socket)
|
||||
(error "Not connected: M-x flan-connect, or start `flan dev program.flan'"))
|
||||
(error "Not connected: M-x flan-dev to start a program, or M-x flan-connect"))
|
||||
((not (file-exists-p flan-dev--socket))
|
||||
(setq flan-dev--connection nil)
|
||||
(force-mode-line-update t)
|
||||
@ -312,6 +312,173 @@ With no argument, look for `flan-dev-socket-name' up from this buffer."
|
||||
(force-mode-line-update t)
|
||||
(message "flan dev: disconnected"))
|
||||
|
||||
;;; Starting the daemon
|
||||
|
||||
;; Before this, a dev loop began in a terminal: `flan dev program.flan' in one
|
||||
;; window and Emacs in another, with the socket found by walking up from the
|
||||
;; buffer. That is one window too many for something an editor can own — and
|
||||
;; it is the daemon that owns the program's lifetime, so the terminal was also
|
||||
;; the only place a program could be stopped from.
|
||||
;;
|
||||
;; Waiting for the socket *file* is what this deliberately does not do. The
|
||||
;; daemon unlinks a stale socket before binding, so a file left behind by a
|
||||
;; crashed run exists before the new daemon has bound anything: waiting for it
|
||||
;; to appear either succeeds instantly against nothing or races the unlink.
|
||||
;; Connecting is the only test that means what it says, so it is retried until
|
||||
;; it works, until the timeout, or until the daemon exits — whichever comes
|
||||
;; first.
|
||||
|
||||
(defcustom flan-dev-command "flan"
|
||||
"The Flan compiler, as `flan dev' is started from Emacs.
|
||||
A name is looked up on `exec-path'; a path is used as given."
|
||||
:type 'string)
|
||||
|
||||
(defcustom flan-dev-daemon-buffer "*flan-dev*"
|
||||
"Buffer the daemon's own output goes to.
|
||||
This is where a build that failed says so: the daemon compiles the program
|
||||
before it binds its socket, so a program that does not compile produces no
|
||||
socket at all and this buffer is the only account of why."
|
||||
:type 'string)
|
||||
|
||||
(defcustom flan-dev-start-timeout 60
|
||||
"Seconds to wait for a daemon started from Emacs to accept a connection.
|
||||
It builds the program first, which for a cold project is most of this."
|
||||
:type 'number)
|
||||
|
||||
(defvar flan-dev--daemon nil
|
||||
"The `flan dev' process this Emacs started, or nil.
|
||||
A daemon started in a terminal is not here, and `flan-connect' still works
|
||||
for it — this is only what Emacs is responsible for killing.")
|
||||
|
||||
(defun flan-dev--daemon-sentinel (proc _event)
|
||||
"Say that the daemon PROC has gone, once, when it does."
|
||||
(unless (process-live-p proc)
|
||||
(when (eq proc flan-dev--daemon)
|
||||
(setq flan-dev--daemon nil)
|
||||
(force-mode-line-update t)
|
||||
;; Named, because the daemon exits for two very different reasons — the
|
||||
;; program finished, or it never built — and the buffer is where the
|
||||
;; difference is written.
|
||||
(message "flan dev: the daemon exited (%s); see %s"
|
||||
(string-trim (or _event "")) flan-dev-daemon-buffer))))
|
||||
|
||||
(defun flan-dev--start-daemon (file socket)
|
||||
"Start `flan dev' on FILE listening on SOCKET, and return the process."
|
||||
(let ((buf (get-buffer-create flan-dev-daemon-buffer))
|
||||
;; Expanded before `default-directory' moves, so that a command given
|
||||
;; as a path is the path the user meant and not one relative to the
|
||||
;; program's directory. A bare name is left alone for `exec-path'.
|
||||
(cmd (if (file-name-directory flan-dev-command)
|
||||
(expand-file-name flan-dev-command)
|
||||
flan-dev-command))
|
||||
;; The daemon runs where the program is, and so does the program it
|
||||
;; launches — it inherits this. A game opening "assets/tiles.png"
|
||||
;; means the project's directory, not whichever buffer Emacs happened
|
||||
;; to be in when the command was typed. (Imports do not depend on
|
||||
;; this: lib/load.ml resolves those from the importing file.)
|
||||
(default-directory (file-name-directory (expand-file-name file))))
|
||||
(with-current-buffer buf
|
||||
(let ((inhibit-read-only t))
|
||||
(erase-buffer)
|
||||
(insert (format "%s dev %s -s %s\n\n" cmd file socket)))
|
||||
(setq default-directory (file-name-directory (expand-file-name file))))
|
||||
(make-process
|
||||
:name "flan-dev-daemon" :buffer buf
|
||||
:command (list cmd "dev" file "-s" socket)
|
||||
;; The daemon writes its ready line and the program's stderr to stderr,
|
||||
;; and both belong in the same buffer in the order they happened.
|
||||
:connection-type 'pipe :noquery t
|
||||
:sentinel #'flan-dev--daemon-sentinel)))
|
||||
|
||||
(defun flan-dev--connect-when-ready (socket proc)
|
||||
"Connect to SOCKET once PROC is serving it, or say why that never happened."
|
||||
(let ((deadline (+ (float-time) flan-dev-start-timeout))
|
||||
(done nil))
|
||||
(while (not done)
|
||||
(cond
|
||||
((condition-case nil (progn (flan-dev--open socket) t) (error nil))
|
||||
(setq done t))
|
||||
((not (process-live-p proc))
|
||||
;; The likeliest failure by far: the program did not compile, so the
|
||||
;; daemon died before binding. The reason is in its buffer and not in
|
||||
;; anything this end can see, so point at it rather than paraphrase.
|
||||
(user-error "flan dev: the daemon exited before it was ready; see %s"
|
||||
flan-dev-daemon-buffer))
|
||||
((> (float-time) deadline)
|
||||
(user-error "flan dev: no socket on %s after %ss; see %s"
|
||||
(abbreviate-file-name socket) flan-dev-start-timeout
|
||||
flan-dev-daemon-buffer))
|
||||
(t (accept-process-output proc 0.05))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun flan-dev (file &optional socket)
|
||||
"Start `flan dev' on FILE and connect to it when it is ready.
|
||||
SOCKET defaults to `flan-dev-socket-name' beside FILE, which is where the
|
||||
daemon puts it when it is not told otherwise.
|
||||
|
||||
Refuses while a daemon this Emacs started is still alive, by name: killing it
|
||||
would take its program — and everything that program has in memory — with it,
|
||||
which is the one thing a dev loop exists to avoid doing by accident."
|
||||
(interactive
|
||||
(list (read-file-name "flan dev: " nil nil t
|
||||
(and buffer-file-name
|
||||
(file-name-nondirectory buffer-file-name)))))
|
||||
(when (process-live-p flan-dev--daemon)
|
||||
(user-error "flan dev: already running on %s; M-x flan-dev-quit first"
|
||||
(abbreviate-file-name (or flan-dev--socket "a socket"))))
|
||||
(let* ((file (expand-file-name file))
|
||||
(socket (or socket
|
||||
(expand-file-name flan-dev-socket-name
|
||||
(file-name-directory file)))))
|
||||
(unless (file-exists-p file)
|
||||
(user-error "flan dev: no such file: %s" file))
|
||||
(setq flan-dev--daemon (flan-dev--start-daemon file socket))
|
||||
(flan-dev--connect-when-ready socket flan-dev--daemon)
|
||||
;; Connected by now, so the rest is what `flan-connect' does after opening:
|
||||
;; learn what the program defines, and say what is on the other end.
|
||||
(let ((r (flan-dev--request '(:op "describe"))))
|
||||
(flan-dev-refresh-defs)
|
||||
(message "flan dev: %s running (%d functions, %d globals)"
|
||||
(file-name-nondirectory file)
|
||||
(length (plist-get r :fns)) (length (plist-get r :globals))))
|
||||
flan-dev--daemon))
|
||||
|
||||
;;;###autoload
|
||||
(defun flan-dev-quit ()
|
||||
"Stop the daemon this Emacs started, and the program with it.
|
||||
`close' first, which is the daemon's own way out and lets it unlink its
|
||||
socket; the process is killed only if it does not take it."
|
||||
(interactive)
|
||||
(unless (process-live-p flan-dev--daemon)
|
||||
;; A daemon started in a terminal is not this Emacs' to kill, and
|
||||
;; `flan-disconnect' is the thing that ends one of those — it closes, which
|
||||
;; the daemon takes as the end of the session. Saying so is better than
|
||||
;; doing the same thing under a name that claims more than it did.
|
||||
(user-error "flan dev: no daemon started from Emacs%s"
|
||||
(if (process-live-p flan-dev--connection)
|
||||
"; M-x flan-disconnect ends the one you are connected to"
|
||||
"")))
|
||||
(let ((proc flan-dev--daemon))
|
||||
(when (process-live-p flan-dev--connection)
|
||||
(ignore-errors (flan-dev--request '(:op "close")))
|
||||
(delete-process flan-dev--connection))
|
||||
(setq flan-dev--connection nil
|
||||
flan-dev--socket nil
|
||||
flan-dev--stopped nil)
|
||||
(flan-dev--stop-polling)
|
||||
(flan-dev--forget-defs)
|
||||
(when (process-live-p proc)
|
||||
;; It has been told; give it a moment to go on its own before killing
|
||||
;; it, so that it unlinks its socket and reaps its child itself.
|
||||
(let ((deadline (+ (float-time) 2)))
|
||||
(while (and (process-live-p proc) (< (float-time) deadline))
|
||||
(accept-process-output proc 0.05)))
|
||||
(when (process-live-p proc)
|
||||
(delete-process proc)))
|
||||
(setq flan-dev--daemon nil)
|
||||
(force-mode-line-update t)
|
||||
(message "flan dev: stopped")))
|
||||
|
||||
;;; The modeline
|
||||
|
||||
;; Whether there is a program on the other end is the one thing worth a
|
||||
|
||||
@ -35,7 +35,13 @@ is written instead — the real `message' call the real command makes."
|
||||
|
||||
(let* ((args (cdr (member "--" command-line-args)))
|
||||
(socket (nth 0 args))
|
||||
(file (nth 1 args)))
|
||||
(file (nth 1 args))
|
||||
(flan (nth 2 args))
|
||||
;; The buffer above is a copy in a temporary directory; this is the
|
||||
;; program where it actually lives, which is the one a second daemon
|
||||
;; can be started on — an `import' is resolved from the importing
|
||||
;; file's own directory, and a copy in /tmp has no packages above it.
|
||||
(program (nth 3 args)))
|
||||
(find-file file)
|
||||
;; The copy comes out of a build directory, so it may arrive read-only.
|
||||
;; Set the flag directly: `read-only-mode' asks about the file on disk, and
|
||||
@ -462,6 +468,62 @@ is written instead — the real `message' call the real command makes."
|
||||
(test-flan--check "and the poll timer is cancelled with it"
|
||||
(null flan-dev--timer))
|
||||
|
||||
;; ── Starting the daemon from Emacs ────────────────────────────────────
|
||||
;;
|
||||
;; Last, and after the disconnect above, because it runs a *second* daemon:
|
||||
;; nothing before this should have to reason about which of two programs a
|
||||
;; request went to. Its own socket for the same reason — and because
|
||||
;; `flan dev' with no -s puts one beside the program, which for a test
|
||||
;; program in /tmp is a path shared with every other thing running there.
|
||||
(setq flan-dev-command flan)
|
||||
(let ((socket2 (concat socket "-started-from-emacs")))
|
||||
(ignore-errors (delete-file socket2))
|
||||
(test-flan--check "nothing to quit before anything was started"
|
||||
(let ((raised nil))
|
||||
(condition-case err (flan-dev-quit)
|
||||
(user-error (setq raised (error-message-string err))))
|
||||
(and raised (string-match-p "no daemon started" raised))))
|
||||
(flan-dev program socket2)
|
||||
(test-flan--check "M-x flan-dev builds, launches and connects"
|
||||
(and (process-live-p flan-dev--daemon)
|
||||
(eq (flan-dev-state) 'live)))
|
||||
(test-flan--check "and it is the program that was asked for"
|
||||
(member "step" (plist-get (flan-dev--request '(:op "describe"))
|
||||
:fns)))
|
||||
;; Refused rather than silently restarted: a second daemon would take the
|
||||
;; first one's program and everything in its memory with it.
|
||||
(test-flan--check "a second one is refused while the first is alive"
|
||||
(let ((raised nil))
|
||||
(condition-case err (flan-dev program socket2)
|
||||
(user-error (setq raised (error-message-string err))))
|
||||
(and raised (string-match-p "already running" raised))))
|
||||
;; The daemon owns the program's lifetime, so quitting has to actually end
|
||||
;; the process — not just drop the socket and leave it running.
|
||||
(let ((proc flan-dev--daemon))
|
||||
(flan-dev-quit)
|
||||
;; The process, not the variable: forgetting a daemon is not stopping
|
||||
;; one, and a program left running with nothing attached to it is
|
||||
;; exactly what the terminal loop used to leave behind.
|
||||
(test-flan--check "quitting ends the daemon"
|
||||
(and (not (process-live-p proc))
|
||||
(null flan-dev--daemon)
|
||||
(not (process-live-p flan-dev--connection))
|
||||
(eq (flan-dev-state) 'off)))
|
||||
;; The daemon unlinks its socket on the way out, so this is the same
|
||||
;; claim seen from the other side.
|
||||
(test-flan--check "and takes its socket with it"
|
||||
(not (file-exists-p socket2))))
|
||||
(ignore-errors (delete-file socket2)))
|
||||
|
||||
;; A program that does not exist is refused here rather than by a daemon
|
||||
;; that starts, fails to build and exits — which looks the same from a
|
||||
;; distance and takes a compile to find out.
|
||||
(test-flan--check "a file that is not there is refused before anything starts"
|
||||
(let ((raised nil))
|
||||
(condition-case err (flan-dev "/nonexistent/nope.flan")
|
||||
(user-error (setq raised (error-message-string err))))
|
||||
(and raised (string-match-p "no such file" raised))))
|
||||
|
||||
(if (zerop test-flan--failures)
|
||||
(message "flan-dev.el: all tests passed")
|
||||
(message "\n%d failure(s)" test-flan--failures)
|
||||
|
||||
@ -27,6 +27,16 @@ let () =
|
||||
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ sock; out ];
|
||||
let fd = Unix.openfile out [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
|
||||
let flan = "../bin/main.exe" in
|
||||
(* Absolute, because the client starts its own daemon at the end of the run
|
||||
and does it from the program's directory rather than from this one. *)
|
||||
let flan_abs = try Unix.realpath flan with Unix.Unix_error _ -> flan in
|
||||
(* And the program itself, for the same reason: the client starts a daemon
|
||||
of its own at the end of the run, and the copy it edits is in a
|
||||
temporary directory with no package collections above it. *)
|
||||
let program =
|
||||
let p = "programs/dev-repl.flan" in
|
||||
try Unix.realpath p with Unix.Unix_error _ -> p
|
||||
in
|
||||
let pid =
|
||||
Unix.create_process flan
|
||||
[| flan; "dev"; "programs/dev-repl.flan"; "-s"; sock |]
|
||||
@ -52,8 +62,10 @@ let () =
|
||||
let code =
|
||||
Sys.command
|
||||
(Printf.sprintf
|
||||
"emacs -Q --batch -L ../../../emacs -l ../../../emacs/test-flan-dev.el -- %s %s 2>&1"
|
||||
(Filename.quote sock) (Filename.quote buf))
|
||||
"emacs -Q --batch -L ../../../emacs -l ../../../emacs/test-flan-dev.el \
|
||||
-- %s %s %s %s 2>&1"
|
||||
(Filename.quote sock) (Filename.quote buf) (Filename.quote flan_abs)
|
||||
(Filename.quote program))
|
||||
in
|
||||
(* The client disconnects at the end, which is what ends the daemon. If it
|
||||
did not get that far — because it failed — nothing else will, so it is
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user