diff --git a/emacs/flan-dev.el b/emacs/flan-dev.el index 689ab66..0eeb13b 100644 --- a/emacs/flan-dev.el +++ b/emacs/flan-dev.el @@ -137,6 +137,31 @@ program finishes without announcing it, and the commonest way to finish is closing its window with the mouse. Nothing about the session has gone — `flan-rerun' runs `main' again, with the globals as the last run left them.") +;; The daemon this Emacs started, which is not the same thing as the +;; connection and must not be confused with one: `flan-connect' attaches to a +;; program running in a terminal, and from that moment the two name different +;; sessions. Kept up here with the rest of the client's state rather than +;; beside the code that starts a daemon, because `flan-connect' reads them +;; before it replaces anything. +(defvar flan-dev--file nil + "The program the daemon this Emacs started was started on, or nil. +Kept so that it can be started again on the same program and the same +socket, which is what `flan-dev-restart-program' is.") + +(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.") + +(defvar flan-dev--daemon-socket nil + "Path of the socket the daemon this Emacs started is listening on, or nil. + +`flan-dev--socket' is where the *connection* is, and the two part company the +moment `flan-connect' attaches to something else: a second program in another +terminal is an ordinary thing to go and look at, and it does not stop this +Emacs being responsible for the daemon it launched. Keeping both is what lets +`flan-dev-quit' tell one session from two.") + (defvar flan-dev--busy nil "Non-nil while a request is waiting for its reply. `flan-dev--read-reply' runs `accept-process-output', which runs timers, so @@ -569,6 +594,29 @@ With no argument, look for `flan-dev-socket-name' up from this buffer." (list (or (flan-dev--find-socket) (read-file-name "flan dev socket: ")))) (unless socket (user-error "No %s found above this buffer" flan-dev-socket-name)) + (setq socket (expand-file-name socket)) + ;; Attaching to a second program is a thing people do on purpose — a daemon + ;; running in a terminal is exactly what this command is for — but it leaves + ;; two sessions where the client can only name one, and until it was said + ;; out loud the cost fell on `flan-dev-quit': "stop the daemon this Emacs + ;; started" ended up closing whatever the connection happened to be pointing + ;; at *and* killing the daemon, which by then were two different programs. + ;; Naming both is most of the fix, because the situation is fine once it is + ;; known about; the refusal for a Lisp caller matches `flan-dev''s, where a + ;; running program is never discarded without someone saying so. + (when (and (process-live-p flan-dev--daemon) + flan-dev--daemon-socket + (not (equal socket flan-dev--daemon-socket))) + (let ((mine (abbreviate-file-name (or flan-dev--file flan-dev--daemon-socket))) + (theirs (abbreviate-file-name socket))) + (if (called-interactively-p 'interactive) + (unless (y-or-n-p + (format "%s is running here; connect to %s and leave it? " + mine theirs)) + (user-error "flan dev: staying with %s" mine)) + (user-error + "flan dev: %s is running from this Emacs; M-x flan-connect interactively to attach to %s as well" + mine theirs)))) (flan-dev--open socket) (let ((r (flan-dev--request '(:op "describe")))) (flan-dev-refresh-defs) @@ -624,21 +672,18 @@ A name is looked up on `exec-path'; a path is used as given." It builds the program first, which for a cold project is most of this." :type 'number) -(defvar flan-dev--file nil - "The program the daemon this Emacs started was started on, or nil. -Kept so that it can be started again on the same program and the same -socket, which is what `flan-dev-restart-program' is.") - -(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.") +;; The three variables that say what this Emacs started — `flan-dev--file', +;; `flan-dev--daemon' and `flan-dev--daemon-socket' — are declared with the +;; rest of the client's state at the top of the file for the same reason: +;; `flan-connect' reads all three before it replaces a connection, and the +;; byte-compiler reads a file in order. (defun flan-dev--daemon-sentinel (proc event) "Say that the daemon PROC has gone, once, when it does. EVENT says how." (unless (process-live-p proc) (when (eq proc flan-dev--daemon) (setq flan-dev--daemon nil) + (setq flan-dev--daemon-socket 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 @@ -745,6 +790,7 @@ refuses: callers cannot silently discard a running program's state." (unless (file-exists-p file) (user-error "flan dev: no such file: %s" file)) (setq flan-dev--file file) + (setq flan-dev--daemon-socket socket) (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: @@ -760,46 +806,70 @@ refuses: callers cannot silently discard a running program's state." (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." +socket; the process is killed only if it does not take it. + +One session at a time, which is the whole of the guard at the top. The +connection and the daemon are usually the same program and were treated as +though they always were: `close' went down whichever connection was current +and the daemon was killed afterwards, so a `flan-connect' to a second program +in another terminal turned one command into the end of two sessions — one of +them belonging to somebody else's window. When the connection is not the +daemon's, this closes the connection and says what it left running." (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))) + (if (and (process-live-p flan-dev--daemon) + (process-live-p flan-dev--connection) + flan-dev--socket flan-dev--daemon-socket + (not (equal flan-dev--socket flan-dev--daemon-socket))) + (let ((theirs (abbreviate-file-name flan-dev--socket)) + (mine (abbreviate-file-name + (or flan-dev--file flan-dev--daemon-socket)))) + ;; `flan-disconnect' is exactly the right half: it closes, which the + ;; daemon on the other end takes as the end of its session, and it + ;; touches nothing this Emacs started. + (flan-disconnect) + (message + "flan dev: closed %s; %s is still running here — M-x flan-dev-quit again to stop it" + theirs mine)) + (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) - ;; Killed rather than asked, so its own cleanup never runs — and that - ;; cleanup is what signals the program. The program is therefore - ;; probably still running, reparented, holding its agent socket, and - ;; saying "stopped" here would be the one place in this client where - ;; a success message meant "probably". - (delete-process proc) - (setq flan-dev--daemon nil) - (force-mode-line-update t) - (user-error - "flan dev: the daemon would not close and was killed; its program may still be running"))) - (setq flan-dev--daemon nil) - (force-mode-line-update t) - (message "flan dev: stopped"))) + ;; 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) + ;; Killed rather than asked, so its own cleanup never runs — and that + ;; cleanup is what signals the program. The program is therefore + ;; probably still running, reparented, holding its agent socket, and + ;; saying "stopped" here would be the one place in this client where + ;; a success message meant "probably". + (delete-process proc) + (setq flan-dev--daemon nil + flan-dev--daemon-socket nil) + (force-mode-line-update t) + (user-error + "flan dev: the daemon would not close and was killed; its program may still be running"))) + (setq flan-dev--daemon nil + flan-dev--daemon-socket nil) + (force-mode-line-update t) + (message "flan dev: stopped")))) ;;;###autoload (defun flan-dev-restart-program () @@ -822,8 +892,21 @@ running — `flan-dev' then starts it again, on the same program." (interactive) (unless (process-live-p flan-dev--daemon) (user-error "flan dev: no daemon started from Emacs to restart")) + ;; Refused rather than half-done: this ends a program and builds it again, + ;; and with the connection attached to somebody else's daemon there is no + ;; reading of it that leaves one session where there was one. + (when (and (process-live-p flan-dev--connection) + flan-dev--socket flan-dev--daemon-socket + (not (equal flan-dev--socket flan-dev--daemon-socket))) + (user-error + "flan dev: connected to %s, which is not the %s started here; M-x flan-connect to it first" + (abbreviate-file-name flan-dev--socket) + (abbreviate-file-name (or flan-dev--file flan-dev--daemon-socket)))) (let ((file flan-dev--file) - (socket flan-dev--socket)) + ;; The daemon's socket and not the connection's: what is being + ;; restarted is the program this Emacs started, and the connection may + ;; by now be attached to a second one somewhere else. + (socket (or flan-dev--daemon-socket flan-dev--socket))) (flan-dev-quit) ; returns only once it is really gone (flan-dev file socket))) diff --git a/emacs/test-flan-dev.el b/emacs/test-flan-dev.el index feac0de..04f6de9 100644 --- a/emacs/test-flan-dev.el +++ b/emacs/test-flan-dev.el @@ -917,6 +917,62 @@ is written instead — the real `message' call the real command makes." (not (file-exists-p socket2)))) (ignore-errors (delete-file socket2))) + ;; ── One command, one session ────────────────────────────────────────── + ;; + ;; Attaching to a second program while a daemon of this Emacs' own is + ;; running is an ordinary thing to do — the other one is in a terminal, and + ;; `flan-connect' is the command for it — and it used to cost the first + ;; program its life: `flan-dev-quit' sent `close' down whichever connection + ;; was current and then killed the daemon, which by then were two different + ;; programs. Both halves are checked here. + ;; + ;; Stand-ins rather than two real daemons. Nothing about this is a claim + ;; about the wire: what is under test is which process each command reaches + ;; for, and a `cat' is a live process with a buffer, which is all either of + ;; them looks at. `cat' also parrots whatever is written to it, so the + ;; `close' a disconnect sends comes straight back as its own reply and + ;; nothing waits. Every variable touched is bound, so the suite carries on + ;; with the state it had. + (let* ((mine-buf (generate-new-buffer " *flan-mine*")) + (theirs-buf (generate-new-buffer " *flan-theirs*")) + (mine (start-process "flan-mine" mine-buf "cat")) + (theirs (start-process "flan-theirs" theirs-buf "cat"))) + (set-process-query-on-exit-flag mine nil) + (set-process-query-on-exit-flag theirs nil) + (with-current-buffer theirs-buf (set-buffer-multibyte nil)) + (unwind-protect + (let ((flan-dev--daemon mine) + (flan-dev--daemon-socket "/tmp/flan-emacs-mine.sock") + (flan-dev--file "/tmp/flan-emacs-mine.flan") + (flan-dev--connection theirs) + (flan-dev--socket "/tmp/flan-emacs-theirs.sock") + (flan-dev--defs nil)) + (test-flan--check + "flan-connect elsewhere names both programs rather than dropping one" + (let ((raised nil)) + (condition-case err (flan-connect "/tmp/flan-emacs-elsewhere.sock") + (user-error (setq raised (error-message-string err)))) + (and raised + (string-match-p "flan-emacs-mine" raised) + (string-match-p "flan-emacs-elsewhere" raised)))) + (test-flan--check "and the connection it refused to replace is untouched" + (eq flan-dev--connection theirs)) + ;; And the command whose name promises one program. It closes the + ;; connection it is on and leaves the daemon alone, saying so — + ;; where it used to end both. + (let ((said (test-flan--said (flan-dev-quit)))) + (test-flan--check "quit ends the session it is connected to" + (not (process-live-p theirs))) + (test-flan--check "and leaves the daemon this Emacs started running" + (process-live-p mine)) + (test-flan--check "and says which one it left" + (and said (string-match-p "still running" said) + (string-match-p "flan-emacs-mine" said))))) + (ignore-errors (delete-process mine)) + (ignore-errors (delete-process theirs)) + (kill-buffer mine-buf) + (kill-buffer theirs-buf))) + ;; 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.