diff --git a/emacs/flan-dev.el b/emacs/flan-dev.el index f30d28b..70eec52 100644 --- a/emacs/flan-dev.el +++ b/emacs/flan-dev.el @@ -24,6 +24,7 @@ (require 'subr-x) (require 'seq) +(require 'pcase) (defgroup flan-dev nil "Talking to a running Flan program." @@ -73,7 +74,16 @@ (accept-process-output proc 0.05)) (goto-char (point-min)) (unless (re-search-forward "\\`\\([0-9]+\\)\n" nil t) - (error "flan dev: no reply")) + ;; Deliberately not retried. If the daemon took the request and died + ;; before replying, the evaluation may well have happened — sending it + ;; again would install it twice, or run a side-effecting expression + ;; twice. Reconnecting happens before a send, never after one. + (if (process-live-p proc) + (error "flan dev: no reply in 30s from %s" + (abbreviate-file-name (or flan-dev--socket "the daemon"))) + (error + "flan dev: the daemon on %s closed the connection; not resent, because it may already have run" + (abbreviate-file-name (or flan-dev--socket "?"))))) (let* ((n (string-to-number (match-string 1))) (body-start (point))) (while (and (< (- (position-bytes (point-max)) (position-bytes body-start)) n) @@ -120,11 +130,50 @@ flan-dev-socket-name))) (and dir (expand-file-name flan-dev-socket-name dir)))) +(defun flan-dev--open (socket) + "Open a connection to SOCKET and make it the current one." + (when (process-live-p flan-dev--connection) + (delete-process flan-dev--connection)) + (let ((buf (get-buffer-create " *flan-dev*"))) + ;; Unibyte, because the framing counts bytes and this buffer is where they + ;; are counted. + (with-current-buffer buf (erase-buffer) (set-buffer-multibyte nil)) + (setq flan-dev--connection + (make-network-process + :name "flan-dev" :buffer buf :family 'local :service socket + :coding 'binary :noquery t)) + (setq flan-dev--socket socket)) + (force-mode-line-update t) + flan-dev--connection) + +;; A daemon restarted while Emacs was not looking is the ordinary case, not an +;; exceptional one: `flan dev' ends when its program does, and a program under +;; development exits all the time. So a dead connection is reopened on the +;; socket it was on rather than reported — but only *before* a request goes +;; out. Reconnecting after one has been sent and lost would be a retry, and a +;; retry of `eval-expr' runs the expression a second time. (defun flan-dev--live-connection () - "The open connection, or signal an error saying how to get one." - (unless (and flan-dev--connection - (process-live-p flan-dev--connection)) - (error "Not connected: M-x flan-connect, or start `flan dev program.flan'")) + "The open connection, reconnecting if the daemon has been restarted." + (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'")) + ((not (file-exists-p flan-dev--socket)) + (setq flan-dev--connection nil) + (force-mode-line-update t) + (error "flan dev: nothing is listening on %s; start `flan dev program.flan' again" + (abbreviate-file-name flan-dev--socket))) + (t + (condition-case err + (progn (flan-dev--open flan-dev--socket) + (message "flan dev: reconnected to %s" + (abbreviate-file-name flan-dev--socket))) + (error + (setq flan-dev--connection nil) + (force-mode-line-update t) + (error "flan dev: cannot reconnect to %s: %s" + (abbreviate-file-name flan-dev--socket) + (error-message-string err))))))) flan-dev--connection) ;;;###autoload @@ -135,15 +184,7 @@ 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)) - (when (process-live-p flan-dev--connection) - (delete-process flan-dev--connection)) - (let ((buf (get-buffer-create " *flan-dev*"))) - (with-current-buffer buf (erase-buffer) (set-buffer-multibyte nil)) - (setq flan-dev--connection - (make-network-process - :name "flan-dev" :buffer buf :family 'local :service socket - :coding 'binary :noquery t)) - (setq flan-dev--socket socket)) + (flan-dev--open socket) (let ((r (flan-dev--request '(:op "describe")))) (message "flan dev: connected to %s (%d functions, %d globals)" (abbreviate-file-name socket) @@ -157,8 +198,50 @@ With no argument, look for `flan-dev-socket-name' up from this buffer." (ignore-errors (flan-dev--request '(:op "close"))) (delete-process flan-dev--connection)) (setq flan-dev--connection nil) + ;; Forgotten, not kept: this was a deliberate disconnect, so the next + ;; request should say so rather than quietly reopening what was just closed. + (setq flan-dev--socket nil) + (force-mode-line-update t) (message "flan dev: disconnected")) +;;; The modeline + +;; Whether there is a program on the other end is the one thing worth a +;; permanent place on screen, because every other command in here is a lie +;; without it. Before this it was discovered by a command failing. + +(defface flan-dev-live-face '((t :inherit success)) + "Face for the modeline indicator when a program is connected." + :group 'flan-dev) + +(defface flan-dev-lost-face '((t :inherit warning)) + "Face for the modeline indicator when the daemon has gone away." + :group 'flan-dev) + +(defun flan-dev-state () + "Whether a program is connected: `live', `lost', or `off'. +`lost' means there was one and the daemon is gone — a restart away, not a +mistake, so it is distinguished from never having connected." + (cond ((process-live-p flan-dev--connection) 'live) + (flan-dev--socket 'lost) + (t 'off))) + +(defun flan-dev-mode-line () + "The Flan connection indicator, for `mode-line-misc-info'." + (when (derived-mode-p 'flan-mode 'flan-repl-mode) + (pcase (flan-dev-state) + ('live (propertize " flan:live" 'face 'flan-dev-live-face + 'help-echo (format "Connected to %s" flan-dev--socket))) + ('lost (propertize " flan:lost" 'face 'flan-dev-lost-face + 'help-echo + (format "%s has gone away; the next command reconnects" + flan-dev--socket))) + (_ (propertize " flan:off" 'face 'shadow + 'help-echo "Not connected (C-c C-z)"))))) + +;; Appended rather than prepended: this is the least urgent thing in the line. +(add-to-list 'mode-line-misc-info '(:eval (flan-dev-mode-line)) t) + ;;;###autoload (defun flan-show-output () "Show the running program's output, after collecting anything pending." diff --git a/emacs/test-flan-dev.el b/emacs/test-flan-dev.el index abf3712..6f67a80 100644 --- a/emacs/test-flan-dev.el +++ b/emacs/test-flan-dev.el @@ -31,8 +31,42 @@ (setq buffer-read-only nil) (test-flan--check "flan-mode is on for a .flan file" (eq major-mode 'flan-mode)) + (test-flan--check "the modeline says so before connecting" + (and (eq (flan-dev-state) 'off) + (string-match-p "off" (flan-dev-mode-line)))) + (flan-connect socket) (test-flan--check "connected" (process-live-p flan-dev--connection)) + (test-flan--check "the modeline says a program is there" + (and (eq (flan-dev-state) 'live) + (string-match-p "live" (flan-dev-mode-line)))) + (test-flan--check "and says nothing in a buffer that is not Flan's" + (with-temp-buffer (null (flan-dev-mode-line)))) + + ;; A daemon restarted while Emacs was not looking is the ordinary case. The + ;; socket outlives this connection, so dropping the process and asking again + ;; is the same situation the client meets after a restart, and it must come + ;; back rather than fail. + (delete-process flan-dev--connection) + (test-flan--check "a dead connection reads as lost, not as never-connected" + (and (eq (flan-dev-state) 'lost) + (string-match-p "lost" (flan-dev-mode-line)))) + (let ((r (flan-dev--request '(:op "describe")))) + (test-flan--check "the next request reconnects on its own" + (and (process-live-p flan-dev--connection) + (member "step" (plist-get r :fns))))) + + ;; But a socket nobody is listening on is refused by name, rather than + ;; retried forever or reported as some other failure. + (let ((flan-dev--connection nil) + (flan-dev--socket "/nonexistent/flan-dev-not-here.sock") + (raised nil)) + (condition-case err (flan-dev--request '(:op "describe")) + (error (setq raised (error-message-string err)))) + (test-flan--check "a socket that is gone is refused by name" + (and raised + (string-match-p "flan-dev-not-here.sock" raised) + (string-match-p "nothing is listening" raised)))) (let ((r (flan-dev--request '(:op "describe")))) (test-flan--check "describe lists the program's functions"