From ab2a31d00290474575c7a94d7d148aeae9efa7b0 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 11 Sep 2026 20:17:08 +0700 Subject: [PATCH] A dev loop should not need a terminal window MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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. --- emacs/flan-dev.el | 169 ++++++++++++++++++++++++++++++++++++++++- emacs/test-flan-dev.el | 64 +++++++++++++++- test/test_emacs.ml | 16 +++- 3 files changed, 245 insertions(+), 4 deletions(-) diff --git a/emacs/flan-dev.el b/emacs/flan-dev.el index ed957d1..4c26f56 100644 --- a/emacs/flan-dev.el +++ b/emacs/flan-dev.el @@ -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 diff --git a/emacs/test-flan-dev.el b/emacs/test-flan-dev.el index e579b42..d936ee0 100644 --- a/emacs/test-flan-dev.el +++ b/emacs/test-flan-dev.el @@ -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) diff --git a/test/test_emacs.ml b/test/test_emacs.ml index 79119a6..4bafa59 100644 --- a/test/test_emacs.ml +++ b/test/test_emacs.ml @@ -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