From c49bd13c58c56a81617dde28d3460ed78b671c92 Mon Sep 17 00:00:00 2001 From: Bozhidar Batsov Date: Thu, 1 Oct 2026 15:54:51 +0300 Subject: [PATCH 01/20] Refuse to encode nil instead of sending an empty list nil is ambiguous in elisp (empty list, empty dict, or a missing value), and quietly turning it into `le' put garbage on the wire. Vectors now encode as lists, so there's still a way to send an empty list, or a list of lists that would otherwise look like an alist. Now that encoding can fail on ordinary input, neat-send encodes before registering the callback, so a message that never went out leaves no pending callback or log entry behind. --- neat-bencode.el | 12 ++++++++++-- neat-client.el | 8 +++++--- test/neat-bencode-test.el | 23 ++++++++++++++++++++--- test/neat-client-test.el | 15 +++++++++++++++ 4 files changed, 50 insertions(+), 8 deletions(-) diff --git a/neat-bencode.el b/neat-bencode.el index f4f04aa..16d1e81 100644 --- a/neat-bencode.el +++ b/neat-bencode.el @@ -38,13 +38,21 @@ OBJ may be: - an integer - a string (encoded as a bytestring; multibyte strings are UTF-8 encoded) - - a list of encodable values + - a list or vector of encodable values - an alist whose keys are strings or symbols (encoded as a bencode dict with keys sorted lexicographically by their byte representation) +A list whose every element is a cons headed by a string or symbol +looks like an alist, so it goes out as a dict; use a vector to send +a list of lists. nil is rejected rather than guessed at, since it +could stand for an empty list, an empty dict or a missing value. +Send [] for an empty list. + Signals `neat-bencode-error' for values that do not match any of the above." (cond + ((null obj) + (signal 'neat-bencode-error (list "cannot encode nil"))) ((integerp obj) (neat-bencode--ascii (format "i%de" obj))) ((stringp obj) @@ -65,7 +73,7 @@ above." (neat-bencode-encode (cdr cell)))) pairs) ,(neat-bencode--ascii "e"))))) - ((listp obj) + ((or (listp obj) (vectorp obj)) (apply #'concat `(,(neat-bencode--ascii "l") ,@(mapcar #'neat-bencode-encode obj) diff --git a/neat-client.el b/neat-client.el index 41a02a4..7a5ad25 100644 --- a/neat-client.el +++ b/neat-client.el @@ -289,12 +289,14 @@ Returns the assigned id (a string)." (unless (neat-connection-live-p conn) (user-error "Neat: connection is not live")) (let* ((id (number-to-string (cl-incf (neat-connection-next-id conn)))) - (with-id (cons (cons "id" id) message))) + (with-id (cons (cons "id" id) message)) + ;; Encode first, so a message that can't be encoded leaves no + ;; callback or log entry behind. + (bytes (neat-bencode-encode with-id))) (when callback (puthash id callback (neat-connection-pending conn))) (neat-client--log conn :out with-id) - (process-send-string (neat-connection-process conn) - (neat-bencode-encode with-id)) + (process-send-string (neat-connection-process conn) bytes) id)) diff --git a/test/neat-bencode-test.el b/test/neat-bencode-test.el index 7f1399b..b5a4334 100644 --- a/test/neat-bencode-test.el +++ b/test/neat-bencode-test.el @@ -36,8 +36,25 @@ ;; "héllo" is 5 chars but 6 bytes when UTF-8 encoded (expect encoded :to-equal (neat-bencode-test--bytes "6:héllo")))) - (it "encodes the empty list" - (expect (neat-bencode-encode '()) :to-equal "le")) + (it "encodes an empty vector as the empty list" + (expect (neat-bencode-encode []) :to-equal "le")) + + (it "encodes a vector as a list" + (expect (neat-bencode-encode [1 "spam"]) :to-equal "li1e4:spame")) + + (it "encodes a vector of string-headed lists as a list, not a dict" + (expect (neat-bencode-encode [("a" "b") ("c" "d")]) + :to-equal "ll1:a1:bel1:c1:dee")) + + (it "rejects nil at the top level" + (expect (neat-bencode-encode nil) :to-throw 'neat-bencode-error)) + + (it "rejects a nil dict value" + (expect (neat-bencode-encode '((op . "eval") (ns . nil))) + :to-throw 'neat-bencode-error)) + + (it "rejects a nil list element" + (expect (neat-bencode-encode '(1 nil 2)) :to-throw 'neat-bencode-error)) (it "encodes a list of integers" (expect (neat-bencode-encode '(1 2 3)) :to-equal "li1ei2ei3ee")) @@ -141,7 +158,7 @@ (it "preserves common nREPL-shaped messages" (dolist (msg '(((op . "describe")) ((op . "eval") (code . "(+ 1 2)") (id . "1")) - ((id . "2") (session . "abc") (status ("done"))))) + ((id . "2") (session . "abc") (status "done")))) (let* ((encoded (neat-bencode-encode msg)) (decoded (neat-bencode-decode encoded)) (re-encoded (neat-bencode-encode (car decoded)))) diff --git a/test/neat-client-test.el b/test/neat-client-test.el index 15fdbde..d00bd9d 100644 --- a/test/neat-client-test.el +++ b/test/neat-client-test.el @@ -423,6 +423,21 @@ (push (neat-send conn '((op . "describe"))) ids) (expect (nreverse ids) :to-equal '("1" "2" "3"))))) + (it "leaves nothing behind when the message can't be encoded" + (let ((conn (neat-connection--make)) + (neat-log-messages t) + logged) + (cl-letf (((symbol-function 'process-live-p) (lambda (_) t)) + ((symbol-function 'process-send-string) + (lambda (&rest _) (error "Should not send"))) + ((symbol-function 'neat-client--log) + (lambda (&rest _) (setq logged t)))) + (expect (neat-send conn '((op . "eval") (ns . nil)) #'ignore) + :to-throw 'neat-bencode-error) + (expect (hash-table-count (neat-connection-pending conn)) + :to-equal 0) + (expect logged :to-be nil)))) + (it "errors when the connection is not live" (let ((conn (neat-connection--make))) (cl-letf (((symbol-function 'process-live-p) (lambda (_) nil))) From 5c30c7c2363d438b5c5cfb3736e372c83cbfbce8 Mon Sep 17 00:00:00 2001 From: Bozhidar Batsov Date: Thu, 1 Oct 2026 15:55:56 +0300 Subject: [PATCH 02/20] Don't let malformed server output break the process filter A non-dict message or a string status used to raise in dispatch and leave the rest of the chunk stuck until the next filter call. Anything that isn't a dict is now skipped, a status sent as a plain string is treated as a list of one, and any other non-list status is ignored. Malformed bencode drops the connection instead of clearing the buffer and carrying on mid-message, which could only mess up whatever came next. The dict check dispatch relies on is neat-bencode's own, now public as neat-bencode-dict-p. --- neat-bencode.el | 11 +++--- neat-client.el | 50 +++++++++++++++--------- test/neat-bencode-test.el | 8 ++++ test/neat-client-test.el | 82 ++++++++++++++++++++++++++++++++++----- 4 files changed, 118 insertions(+), 33 deletions(-) diff --git a/neat-bencode.el b/neat-bencode.el index 16d1e81..13729d6 100644 --- a/neat-bencode.el +++ b/neat-bencode.el @@ -60,7 +60,7 @@ above." (concat (neat-bencode--ascii (number-to-string (length bytes))) (neat-bencode--ascii ":") bytes))) - ((neat-bencode--alistp obj) + ((neat-bencode-dict-p obj) (let ((pairs (cl-sort (mapcar (lambda (cell) (cons (neat-bencode--key-string (car cell)) (cdr cell))) @@ -99,10 +99,11 @@ above." ((symbolp k) (symbol-name k)) (t (signal 'neat-bencode-error (list "non-string dict key" k))))) -(defun neat-bencode--alistp (obj) - "Return non-nil if OBJ has the shape of a dict-style alist. -That is, every cell of OBJ is a cons whose car is a string or symbol. -An empty list is not an alist (it encodes as a list)." +(defun neat-bencode-dict-p (obj) + "Return non-nil if OBJ has the shape of a bencode dict. +That is, every cell of OBJ is a cons whose car is a string or symbol: +what `neat-bencode-encode' sends as a dict, and what a decoded dict +looks like. An empty list is not a dict (it encodes as a list)." (and (consp obj) (consp (car obj)) (cl-every (lambda (cell) diff --git a/neat-client.el b/neat-client.el index 7a5ad25..786095c 100644 --- a/neat-client.el +++ b/neat-client.el @@ -493,8 +493,9 @@ bencode messages as it can." Malformed bencode signals `neat-bencode-error', which would otherwise propagate up out of the process filter and silently kill the cycle. We catch it here, log the offending bytes via the message log, and -clear the recv buffer -- the protocol state is unrecoverable past -the bad message, but at least the filter survives. As elsewhere, +disconnect. Past a bad byte there's no telling where the next +message starts, so reading on would only misparse whatever follows; +disconnecting at least flushes every pending callback. As elsewhere, `debug-on-error' steps the guard aside so the bug is visible during interactive debugging." (condition-case-unless-debug err @@ -512,29 +513,42 @@ interactive debugging." (neat-connection-recv-buffer conn) err)) (setf (neat-connection-recv-buffer conn) (unibyte-string)) - (message "neat: dropped malformed bencode from %s:%s (%S)" + (message "neat: malformed bencode from %s:%s, disconnecting (%S)" (neat-connection-host conn) (neat-connection-port conn) - err)))) + err) + (neat-disconnect conn)))) (defun neat-client--dispatch (conn message) "Look up MESSAGE's callback in CONN and invoke it. -When the response's status contains `done' the callback entry is -pruned afterwards." +A server can send any bencode value, so MESSAGE gets checked first: +anything other than a dict is logged and skipped, a `status' sent as +a plain string counts as a list of one, and any other `status' that +isn't a list is dropped as if it weren't there. Either would +otherwise blow up in here or in the callback. When the response's +status contains `done' the callback entry is pruned afterwards." (neat-client--log conn :in message) - (let* ((id (neat-bencode-get message "id")) - (status (neat-bencode-get message "status")) - (callback (and id (gethash id (neat-connection-pending conn))))) - (when callback - ;; Don't let a buggy callback nuke the whole filter. Skip the - ;; trap when the user is debugging, so `toggle-debug-on-error' - ;; reveals the underlying problem instead of swallowing it. - (condition-case-unless-debug err - (funcall callback message) - (error (message "neat: callback error: %S" err)))) - (when (and id (member "done" status)) - (remhash id (neat-connection-pending conn))))) + (if (not (neat-bencode-dict-p message)) + (neat-client--log conn :note '(skipped "not a dict")) + (let ((status (neat-bencode-get message "status"))) + (cond + ((stringp status) + (setf (alist-get "status" message nil nil #'equal) (list status))) + ((not (listp status)) + (setq message (cl-remove "status" message :key #'car :test #'equal))))) + (let* ((id (neat-bencode-get message "id")) + (status (neat-bencode-get message "status")) + (callback (and id (gethash id (neat-connection-pending conn))))) + (when callback + ;; Don't let a buggy callback nuke the whole filter. Skip the + ;; trap when the user is debugging, so `toggle-debug-on-error' + ;; reveals the underlying problem instead of swallowing it. + (condition-case-unless-debug err + (funcall callback message) + (error (message "neat: callback error: %S" err)))) + (when (and id (member "done" status)) + (remhash id (neat-connection-pending conn)))))) (defun neat-client--sentinel (proc _event) "Sentinel for nREPL connection PROC. Delegates to `neat-client--cleanup'." diff --git a/test/neat-bencode-test.el b/test/neat-bencode-test.el index b5a4334..f77f624 100644 --- a/test/neat-bencode-test.el +++ b/test/neat-bencode-test.el @@ -180,6 +180,14 @@ (expect (neat-bencode-get '(("foo" . 1)) "missing" 'fallback) :to-equal 'fallback))) +(describe "neat-bencode-dict-p" + (it "accepts alists with string or symbol keys" + (expect (neat-bencode-dict-p '(("id" . "1") (op . "eval"))) :to-be-truthy)) + + (it "rejects lists, the empty list and non-lists" + (dolist (obj '(("a" "b") nil 42 "id")) + (expect (neat-bencode-dict-p obj) :to-be nil)))) + (describe "neat-bencode-keys" (it "returns the keys in wire order" (expect (neat-bencode-keys '(("bar" . 2) ("foo" . 1))) diff --git a/test/neat-client-test.el b/test/neat-client-test.el index d00bd9d..31ad5db 100644 --- a/test/neat-client-test.el +++ b/test/neat-client-test.el @@ -72,17 +72,79 @@ ;; A stray `e' is the simplest malformed input: `neat-bencode-decode' ;; signals `neat-bencode-error' on it. The drain has to catch that ;; or the filter cycle dies silently. + (let* ((conn (neat-connection--make)) + (neat-connections (list conn)) + (debug-on-error nil)) + (expect (neat-client-test--push-bytes conn "e") :not :to-throw))) + + (it "dispatches what precedes malformed bytes, then disconnects" + ;; Past the bad byte there's no telling where the next message + ;; starts, so the trailing (valid-looking) message must not be + ;; dispatched; the pending callback hears about the disconnect + ;; instead. + (let* ((conn (neat-connection--make)) + (neat-connections (list conn)) + (neat-disconnect-functions nil) + (debug-on-error nil) + (got '())) + (puthash "1" (lambda (m) (push m got)) + (neat-connection-pending conn)) + (neat-client-test--push-bytes + conn (concat (neat-bencode-encode '(("id" . "1") ("value" . "ok"))) + "e" + (neat-bencode-encode '(("id" . "1") ("value" . "late"))))) + (setq got (nreverse got)) + (expect (length got) :to-equal 2) + (expect (neat-bencode-get (car got) "value") :to-equal "ok") + (expect (neat-bencode-get (cadr got) "value") :to-be nil) + (expect (member "done" (neat-bencode-get (cadr got) "status")) + :to-be-truthy) + (expect neat-connections :to-equal nil) + (expect (neat-connection-recv-buffer conn) :to-equal ""))) + + (it "skips top-level values that aren't dicts" (let ((conn (neat-connection--make)) - (debug-on-error nil)) - (expect (neat-client-test--push-bytes conn "e") :not :to-throw) - ;; And after dropping the bad bytes, a subsequent good message - ;; still dispatches normally. - (let ((got nil)) - (puthash "1" (lambda (m) (push m got)) - (neat-connection-pending conn)) - (neat-client-test--push-bytes - conn (neat-bencode-encode '(("id" . "1") ("value" . "ok")))) - (expect (length got) :to-equal 1)))) + (got '())) + (puthash "1" (lambda (m) (push m got)) + (neat-connection-pending conn)) + (expect (neat-client-test--push-bytes + conn (concat (neat-bencode-encode 42) + (neat-bencode-encode "id") + (neat-bencode-encode ["id" "1"]) + (neat-bencode-encode '(("id" . "1") + ("value" . "ok"))))) + :not :to-throw) + (expect (length got) :to-equal 1) + (expect (neat-bencode-get (car got) "value") :to-equal "ok"))) + + (it "treats a status sent as a plain string as a list of one" + (let ((conn (neat-connection--make)) + (got '())) + (puthash "1" (lambda (m) (push m got)) (neat-connection-pending conn)) + (neat-client-test--push-bytes + conn (neat-bencode-encode '(("id" . "1") ("status" . "done")))) + (expect (neat-bencode-get (car got) "status") :to-equal '("done")) + ;; So the request does finish. + (expect (gethash "1" (neat-connection-pending conn)) :to-be nil))) + + (it "treats any other status that isn't a list as no status" + (let ((conn (neat-connection--make)) + (got '())) + (puthash "1" (lambda (m) + ;; The usual callback idiom must not choke. + (member "done" (neat-bencode-get m "status")) + (push m got)) + (neat-connection-pending conn)) + (expect (neat-client-test--push-bytes + conn (concat (neat-bencode-encode '(("id" . "1") + ("status" . 7))) + (neat-bencode-encode '(("id" . "1") + ("value" . "next"))))) + :not :to-throw) + ;; The message behind the bad one still went through. + (expect (length got) :to-equal 2) + (expect (assoc "status" (cadr got)) :to-be nil) + (expect (gethash "1" (neat-connection-pending conn)) :not :to-be nil))) (it "shields the filter from a buggy callback (production semantics)" ;; The dispatch wraps callbacks in `condition-case-unless-debug', From 20981c5bfdcf5a8290738880466fab5be30c5ba1 Mon Sep 17 00:00:00 2001 From: Bozhidar Batsov Date: Thu, 1 Oct 2026 15:57:21 +0300 Subject: [PATCH 03/20] Mark flushed requests connection-closed and drop timed-out callbacks The fake reply neat sent when a connection closed reused nREPL's `interrupted' status and put an err without a newline in the REPL, so it looked like the server had said something. It now carries a neat-only `connection-closed' status and no text, and the first REPL prompt no longer goes up when that's all the clone gets back. The sync helpers now share neat-client--request-sync, which returns whatever arrived and, when it gives up, removes the callback instead of leaving it pending forever. --- neat-client.el | 98 ++++++++++++++++++++++------------------ neat-repl.el | 6 ++- neat.el | 10 ++-- test/neat-client-test.el | 66 +++++++++++++++++++++++++++ test/neat-repl-test.el | 29 ++++++++++++ test/neat-test.el | 42 +++++++++++++++++ 6 files changed, 204 insertions(+), 47 deletions(-) diff --git a/neat-client.el b/neat-client.el index 786095c..522490f 100644 --- a/neat-client.el +++ b/neat-client.el @@ -115,7 +115,7 @@ double-fire." (let ((proc (neat-connection-process conn))) (if (process-live-p proc) (delete-process proc) - (neat-client--cleanup conn "disconnected")))) + (neat-client--cleanup conn)))) (defun neat-connection-live-p (conn) "Return non-nil if CONN's underlying process is alive." @@ -282,9 +282,14 @@ MESSAGE is an alist of op fields (e.g. `((op . \"eval\") (code . \"...\"))'). A unique `id' field is added automatically. CALLBACK, if given, is called with the parsed response dict for every response sharing the assigned id. Callers should inspect the `status' field to detect -completion -- `done' indicates the server is finished with this +completion: `done' indicates the server is finished with this request, after which the callback is unregistered. +If the connection goes away before `done' arrives, CALLBACK gets one +last response made up by neat itself, with status +\(\"done\" \"connection-closed\") and nothing else. No server sends +`connection-closed'; it only ever comes from the client. + Returns the assigned id (a string)." (unless (neat-connection-live-p conn) (user-error "Neat: connection is not live")) @@ -436,44 +441,51 @@ CALLBACK, if given, fires for each response." ;; eldoc) can use them. They pump `accept-process-output' until the ;; response arrives or the timeout fires. -(defun neat-client--block-for-done (conn timeout done-p) - "Pump CONN's process output until calling DONE-P yields non-nil. -Give up after TIMEOUT seconds." - (let ((deadline (+ (float-time) timeout))) - (while (and (not (funcall done-p)) - (< (float-time) deadline)) - (accept-process-output (neat-connection-process conn) 0.05)))) +(defun neat-client--request-sync (conn timeout send) + "Send a request with SEND and block until CONN's server is done with it. +SEND is called with the callback to hand to the op function it calls, +and must return that request's id, as the op functions do. Pumps +CONN's process output for up to TIMEOUT seconds. + +Returns the responses that arrived, in the order they came: all of +them once `done' arrives, or whatever came before TIMEOUT ran out. +If the connection went away first, the last one is neat's own +`connection-closed' reply (see `neat-send'). Giving up unregisters +the callback, so a reply that never comes doesn't leave it behind in +the pending table." + (let ((deadline (+ (float-time) timeout)) + responses done) + (let ((id (funcall send + (lambda (resp) + (push resp responses) + (when (member "done" (neat-bencode-get resp "status")) + (setq done t)))))) + (while (and (not done) + (< (float-time) deadline)) + (accept-process-output (neat-connection-process conn) 0.05)) + (unless done + (remhash id (neat-connection-pending conn)))) + (nreverse responses))) (defun neat-completions-sync (conn prefix &optional ns timeout) "Block until `completions' for PREFIX (in NS) come back from CONN. Return the list of candidate dicts (typically `(\"candidate\" . \"foo\") -`(\"type\" . \"function\")' shaped) or nil on timeout. -TIMEOUT defaults to 1 second." - (let (candidates done) - (neat-completions - conn prefix ns - (lambda (resp) - (let ((c (neat-bencode-get resp "completions"))) - (when c (setq candidates (append candidates c)))) - (when (member "done" (neat-bencode-get resp "status")) - (setq done t)))) - (neat-client--block-for-done conn (or timeout 1) (lambda () done)) - candidates)) +`(\"type\" . \"function\")' shaped), as many as arrived within +TIMEOUT seconds (default 1)." + (mapcan (lambda (resp) + (copy-sequence (neat-bencode-get resp "completions"))) + (neat-client--request-sync + conn (or timeout 1) + (lambda (callback) (neat-completions conn prefix ns callback))))) (defun neat-lookup-sync (conn sym &optional ns timeout) "Block until CONN responds to a `lookup' for SYM (in NS). -Return the `info' dict, or nil if absent / on timeout. -TIMEOUT defaults to 1 second." - (let (info done) - (neat-lookup - conn sym ns - (lambda (resp) - (let ((i (neat-bencode-get resp "info"))) - (when i (setq info i))) - (when (member "done" (neat-bencode-get resp "status")) - (setq done t)))) - (neat-client--block-for-done conn (or timeout 1) (lambda () done)) - info)) +Return the `info' dict, or nil if none came within TIMEOUT seconds +\(default 1)." + (cl-some (lambda (resp) (neat-bencode-get resp "info")) + (neat-client--request-sync + conn (or timeout 1) + (lambda (callback) (neat-lookup conn sym ns callback))))) ;;;; Process filter / sentinel @@ -554,13 +566,12 @@ status contains `done' the callback entry is pruned afterwards." "Sentinel for nREPL connection PROC. Delegates to `neat-client--cleanup'." (unless (process-live-p proc) (when-let* ((conn (process-get proc 'neat-connection))) - (neat-client--cleanup conn "connection closed")))) + (neat-client--cleanup conn)))) -(defun neat-client--cleanup (conn reason) +(defun neat-client--cleanup (conn) "Single cleanup path for a dead CONN. Drops CONN from `neat-connections', demotes the default if needed, -flushes pending callbacks with REASON, and runs -`neat-disconnect-functions'. +flushes pending callbacks, and runs `neat-disconnect-functions'. Idempotent: the registry-membership check makes subsequent calls on the same connection no-ops, so `neat-disconnect' (synchronous) @@ -572,23 +583,24 @@ updates buffers built on top." (setq neat-connections (delq conn neat-connections)) (when (eq neat-default-connection conn) (setq neat-default-connection (car neat-connections))) - (neat-client--flush-pending conn reason) + (neat-client--flush-pending conn) (with-demoted-errors "neat: disconnect hook: %S" (run-hook-with-args 'neat-disconnect-functions conn)))) -(defun neat-client--flush-pending (conn reason) +(defun neat-client--flush-pending (conn) "Notify every pending callback on CONN that the connection is gone. -Each callback gets a synthesized response with a `done'/`interrupted' -status and an `err' field describing REASON." +Each callback gets a synthesized response whose status is +\(\"done\" \"connection-closed\"), as documented in `neat-send'. +It deliberately carries no `err' text: the caller decides how (and +whether) to tell the user." (let ((pending (neat-connection-pending conn))) (maphash (lambda (id callback) (condition-case-unless-debug _ (funcall callback `(("id" . ,id) - ("status" . ("done" "interrupted")) - ("err" . ,(format "neat: %s" reason)))) + ("status" . ("done" "connection-closed")))) (error nil))) pending) (clrhash pending))) diff --git a/neat-repl.el b/neat-repl.el index 9765d66..f123da7 100644 --- a/neat-repl.el +++ b/neat-repl.el @@ -272,7 +272,11 @@ on the same dead connection are no-ops." neat-current-connection (neat-connection-live-p neat-current-connection)) (neat-repl--handle-need-input neat-current-connection)) - (when (member "done" status) + ;; A dead connection gets its own marker from + ;; `neat-repl--handle-disconnect'; a prompt would only invite + ;; input that has nowhere to go. + (when (and (member "done" status) + (not (member "connection-closed" status))) (comint-output-filter proc (neat-repl--prompt)))))) (defun neat-repl--handle-need-input (conn) diff --git a/neat.el b/neat.el index 41b522f..9542e33 100644 --- a/neat.el +++ b/neat.el @@ -234,8 +234,10 @@ with `neat-mode' enabled will use it automatically." (neat-clone-session conn (lambda (resp) - (when (member "done" (neat-bencode-get resp "status")) - (when (buffer-live-p buffer) + (let ((status (neat-bencode-get resp "status"))) + (when (and (member "done" status) + (not (member "connection-closed" status)) + (buffer-live-p buffer)) (with-current-buffer buffer (neat-repl--insert-prompt)))))) (pop-to-buffer buffer) @@ -284,7 +286,9 @@ Empty input clears the override." (let ((value (neat-bencode-get resp "value")) (err (neat-bencode-get resp "err"))) (cond (err (message "neat: %s" (string-trim err))) - (value (message "=> %s" value))))))) + (value (message "=> %s" value)) + ((member "connection-closed" (neat-bencode-get resp "status")) + (message "neat: connection closed"))))))) (defun neat--eval-string (code &optional pos) "Evaluate CODE on the active connection. diff --git a/test/neat-client-test.el b/test/neat-client-test.el index 31ad5db..a7039fe 100644 --- a/test/neat-client-test.el +++ b/test/neat-client-test.el @@ -162,6 +162,72 @@ :not :to-throw) (expect (gethash "1" (neat-connection-pending conn)) :to-be nil)))) +(describe "neat-client--flush-pending" + (it "hands each pending callback a connection-closed done and no err" + (let* ((conn (neat-connection--make)) + (neat-connections (list conn)) + (neat-disconnect-functions nil) + got) + (puthash "7" (lambda (m) (push m got)) (neat-connection-pending conn)) + (neat-disconnect conn) + (expect got :to-equal + '((("id" . "7") ("status" "done" "connection-closed")))) + (expect (hash-table-count (neat-connection-pending conn)) + :to-equal 0)))) + +(describe "sync helpers" + (it "unregister the callback when the reply times out" + (let ((conn (neat-connection--make))) + (cl-letf (((symbol-function 'process-live-p) (lambda (_) t)) + ((symbol-function 'process-send-string) #'ignore) + ((symbol-function 'accept-process-output) #'ignore)) + (expect (neat-completions-sync conn "ma" nil 0.05) :to-be nil) + (expect (hash-table-count (neat-connection-pending conn)) + :to-equal 0) + (expect (neat-lookup-sync conn "map" nil 0.05) :to-be nil) + (expect (hash-table-count (neat-connection-pending conn)) + :to-equal 0)))) + + (it "treat a connection that closes mid-request as no answer" + (let ((conn (neat-connection--make))) + (cl-letf (((symbol-function 'process-live-p) (lambda (_) t)) + ((symbol-function 'process-send-string) #'ignore) + ((symbol-function 'accept-process-output) + (lambda (&rest _) (neat-client--flush-pending conn)))) + (expect (neat-lookup-sync conn "map" nil 1) :to-be nil)))) + + (it "keep what arrived before the timeout" + (let ((conn (neat-connection--make)) + (sent nil)) + (cl-letf (((symbol-function 'process-live-p) (lambda (_) t)) + ((symbol-function 'process-send-string) #'ignore) + ((symbol-function 'accept-process-output) + (lambda (&rest _) + (unless sent + (setq sent t) + (neat-client-test--push-bytes + conn (neat-bencode-encode + '(("id" . "1") + ("completions" . ((("candidate" . "map"))))))))))) + (expect (neat-completions-sync conn "ma" nil 0.1) + :to-equal '((("candidate" . "map")))) + (expect (hash-table-count (neat-connection-pending conn)) + :to-equal 0)))) + + (it "return what arrived before done" + (let ((conn (neat-connection--make))) + (cl-letf (((symbol-function 'process-live-p) (lambda (_) t)) + ((symbol-function 'process-send-string) #'ignore) + ((symbol-function 'accept-process-output) + (lambda (&rest _) + (neat-client-test--push-bytes + conn (neat-bencode-encode + '(("id" . "1") + ("completions" . ((("candidate" . "map")))) + ("status" "done"))))))) + (expect (neat-completions-sync conn "ma" nil 1) + :to-equal '((("candidate" . "map")))))))) + (describe "neat-clone-session" (it "captures new-session from the response and assigns it to the connection" (let ((conn (neat-connection--make)) diff --git a/test/neat-repl-test.el b/test/neat-repl-test.el index e6c62ad..2f5b86c 100644 --- a/test/neat-repl-test.el +++ b/test/neat-repl-test.el @@ -13,6 +13,23 @@ (require 'neat-bencode) (require 'neat-repl) +(defmacro neat-repl-test--with-repl (conn &rest body) + "Run BODY in a real `neat-repl-mode' buffer for a fake connection. +CONN is bound to the connection, which has no network process; the +buffer gets its usual comint pipe process, so rendering really +inserts text." + (declare (indent 1)) + `(let* ((neat-repl-history-file nil) + (,conn (neat-connection--make :host "h" :port 1)) + (buf (neat-repl-create-buffer ,conn))) + (unwind-protect + (with-current-buffer buf ,@body) + (kill-buffer buf)))) + +(defun neat-repl-test--text () + "Return the current buffer's text without properties." + (buffer-substring-no-properties (point-min) (point-max))) + (describe "neat-repl--input-complete-p" (it "accepts an empty string as complete" (expect (neat-repl--input-complete-p "") :to-be-truthy)) @@ -81,6 +98,18 @@ '(("id" . "1") ("value" . "nil") ("status" "done"))) (expect neat-repl--current-ns :to-equal "stays")))) +(describe "neat-repl--render-response (connection-closed)" + (it "inserts a prompt on a normal done" + (neat-repl-test--with-repl _conn + (neat-repl--render-response '(("id" . "1") ("status" "done"))) + (expect (neat-repl-test--text) :to-equal "neat> "))) + + (it "doesn't prompt for input on the synthesized connection-closed done" + (neat-repl-test--with-repl _conn + (neat-repl--render-response + '(("id" . "1") ("status" "done" "connection-closed"))) + (expect (neat-repl-test--text) :to-equal "")))) + (describe "neat-repl--handle-need-input" (it "reads input from the minibuffer and sends it via the stdin op" (let ((conn (neat-connection--make :host "h" :port 1)) diff --git a/test/neat-test.el b/test/neat-test.el index 55c4715..487c7fd 100644 --- a/test/neat-test.el +++ b/test/neat-test.el @@ -179,6 +179,48 @@ POS is a 1-indexed buffer position." (lambda () (neat--eval-string "(+ 1 2)"))))) (expect (plist-get plist :ns) :to-equal "derived.ns")))))) +(describe "neat--render-into-repl without a REPL buffer" + (it "reports a connection that closed under the request" + (let ((conn (neat-connection--make :host "nowhere" :port 1))) + (spy-on 'message) + (neat--render-into-repl + conn '(("id" . "1") ("status" "done" "connection-closed"))) + (expect 'message :to-have-been-called-with + "neat: connection closed")))) + +(describe "neat" + :var (conn clone-callback) + (before-each + (setq conn (neat-connection--make :host "h" :port 77) + clone-callback nil) + (spy-on 'neat-connect :and-return-value conn) + (spy-on 'neat-describe) + (spy-on 'neat-clone-session + :and-call-fake (lambda (_c cb) (setq clone-callback cb))) + (spy-on 'pop-to-buffer)) + + (after-each + (when-let* ((buf (neat-repl-buffer-for conn))) + (kill-buffer buf))) + + (it "puts up the first prompt once the session is cloned" + (let ((neat-repl-history-file nil) + (neat-default-connection nil)) + (neat "h" 77) + (funcall clone-callback '(("id" . "2") ("new-session" . "S") + ("status" "done"))) + (with-current-buffer (neat-repl-buffer-for conn) + (expect (buffer-string) :to-equal "neat> ")))) + + (it "doesn't put up a prompt when the connection closes first" + (let ((neat-repl-history-file nil) + (neat-default-connection nil)) + (neat "h" 77) + (funcall clone-callback '(("id" . "2") + ("status" "done" "connection-closed"))) + (with-current-buffer (neat-repl-buffer-for conn) + (expect (buffer-string) :to-equal ""))))) + (describe "neat--lookup-file-path" (it "returns plain paths unchanged" (expect (neat--lookup-file-path "/tmp/foo.clj") From 98aa67d518d92a41c58c17524bb0392bce9e90f0 Mon Sep 17 00:00:00 2001 From: Bozhidar Batsov Date: Thu, 1 Oct 2026 17:55:02 +0300 Subject: [PATCH 04/20] Show late and id-less output instead of dropping it Output for a request that already got its done (say, a future that prints after the eval returned) and output with no id at all used to vanish. Such messages now go to neat-unhandled-message-functions, and the REPL prints their out and err above the waiting prompt. That text goes in through comint-output-filter itself, with the process mark moved to the prompt for the duration, so filters, ANSI colors and carriage motion work as for any other output. It keeps its own ANSI color state, as the one streamed output uses points past the prompt, and a chunk that ends in a carriage return gets its line overwritten by the next one. When comint-move-point-for-output is set, point goes to the input, not onto the prompt. The connection-closed marker goes above a waiting prompt too, and a new prompt always starts on a line of its own, so reconnecting in the same buffer doesn't put it on the dead prompt's line. --- doc/design.md | 6 ++ neat-client.el | 32 +++++-- neat-repl.el | 134 ++++++++++++++++++++++++++-- test/neat-client-test.el | 60 ++++++++++++- test/neat-repl-test.el | 186 +++++++++++++++++++++++++++++++++++++++ 5 files changed, 401 insertions(+), 17 deletions(-) diff --git a/doc/design.md b/doc/design.md index e49fbf3..6e91940 100644 --- a/doc/design.md +++ b/doc/design.md @@ -94,6 +94,12 @@ The single-callback model is what every responding nREPL client we surveyed (monroe, CIDER, vim-fireplace) uses. We're not breaking that pattern. +Some messages don't belong to any pending request. Servers send `out` +with no `id` at all, or keep sending it for a request that's already +`done` (think of a `future` that prints after the eval has returned). +Those go to `neat-unhandled-message-functions`, and the REPL buffer +prints their output above the prompt. + ### Op discovery via `describe`, no hardcoded Clojurisms nREPL is a protocol; servers advertise the ops they implement via the diff --git a/neat-client.el b/neat-client.el index 522490f..6855fd8 100644 --- a/neat-client.el +++ b/neat-client.el @@ -54,6 +54,15 @@ the server going away. Use to update buffers that reference the connection (the REPL buffer adds a `connection closed' marker this way).") +(defvar neat-unhandled-message-functions nil + "Abnormal hook run for messages that no pending callback claims. +Each function is called with two arguments, the `neat-connection' and +the response dict. That covers messages with no `id', ids that were +never registered, and anything a server sends for a request after its +`done' (nREPL and Babashka both keep sending `out' from a `future' +that outlives the eval that started it). The REPL buffer uses this +to show such output above its prompt.") + (defun neat-active-connection () "Return the active connection for the current buffer, or nil. Prefers `neat-current-connection' when set buffer-locally and still @@ -538,8 +547,10 @@ A server can send any bencode value, so MESSAGE gets checked first: anything other than a dict is logged and skipped, a `status' sent as a plain string counts as a list of one, and any other `status' that isn't a list is dropped as if it weren't there. Either would -otherwise blow up in here or in the callback. When the response's -status contains `done' the callback entry is pruned afterwards." +otherwise blow up in here or in the callback. A message without a +callback goes to `neat-unhandled-message-functions'. When the +response's status contains `done' the callback entry is pruned +afterwards." (neat-client--log conn :in message) (if (not (neat-bencode-dict-p message)) (neat-client--log conn :note '(skipped "not a dict")) @@ -552,13 +563,16 @@ status contains `done' the callback entry is pruned afterwards." (let* ((id (neat-bencode-get message "id")) (status (neat-bencode-get message "status")) (callback (and id (gethash id (neat-connection-pending conn))))) - (when callback - ;; Don't let a buggy callback nuke the whole filter. Skip the - ;; trap when the user is debugging, so `toggle-debug-on-error' - ;; reveals the underlying problem instead of swallowing it. - (condition-case-unless-debug err - (funcall callback message) - (error (message "neat: callback error: %S" err)))) + (if callback + ;; Don't let a buggy callback nuke the whole filter. Skip the + ;; trap when the user is debugging, so `toggle-debug-on-error' + ;; reveals the underlying problem instead of swallowing it. + (condition-case-unless-debug err + (funcall callback message) + (error (message "neat: callback error: %S" err))) + (with-demoted-errors "neat: unhandled message hook: %S" + (run-hook-with-args 'neat-unhandled-message-functions + conn message))) (when (and id (member "done" status)) (remhash id (neat-connection-pending conn)))))) diff --git a/neat-repl.el b/neat-repl.el index f123da7..71df8a3 100644 --- a/neat-repl.el +++ b/neat-repl.el @@ -83,6 +83,12 @@ in a language with very different bracketing rules.") (defvar-local neat-repl--current-ns nil "Most-recent namespace reported by the server for this buffer.") +(defvar-local neat-repl--prompt-start nil + "Marker at the start of the prompt waiting for input, or nil. +Set whenever a prompt goes in and cleared once input is sent, so +output that turns up between evals can be put above the prompt +instead of after it.") + (defvar-local neat-repl--connection-dead nil "Non-nil once the buffer's connection has died. Set by `neat-repl--handle-disconnect'. The input sender consults this @@ -173,11 +179,107 @@ purpose is to satisfy `comint-output-filter' and friends." (or neat-repl--current-ns neat-repl-default-ns))) (defun neat-repl--insert-prompt () - "Insert a fresh prompt at the end of the buffer." + "Insert a fresh prompt at the end of the buffer. +It starts on a line of its own, even after output that didn't end one +or after the dead prompt of an earlier connection in a reused buffer." (let ((proc (get-buffer-process (current-buffer)))) (when proc + (unless (save-excursion (goto-char (process-mark proc)) (bolp)) + (comint-output-filter proc "\n")) + (setq neat-repl--prompt-start (copy-marker (process-mark proc))) (comint-output-filter proc (neat-repl--prompt))))) +(defun neat-repl--emit-output (text face) + "Insert TEXT in FACE above the prompt waiting for input. +With no prompt showing (an eval from this buffer is still running) +TEXT just streams in at the process mark like any other output. +Either way it goes through `comint-output-filter'. A chunk that +doesn't end in a newline gets one, so the prompt stays on its own +line; the next chunk picks up where that one left off." + (let ((proc (get-buffer-process (current-buffer)))) + (cond + ((not proc) nil) + ((and neat-repl--prompt-start (marker-position neat-repl--prompt-start)) + (neat-repl--insert-above-prompt proc text face)) + (t (comint-output-filter proc (propertize text 'face face)))))) + +(defvar ansi-color-context-region) + +(defvar-local neat-repl--ansi-context nil + "ANSI color state for text inserted above the prompt. +It plays the part of `ansi-color-context-region' for that text alone. +The context streamed output uses points past the prompt, so sharing +one would let a color left on at either end trip up the other.") + +(defun neat-repl--insert-above-prompt (proc text face) + "Insert TEXT in FACE right above the waiting prompt in PROC's buffer. +The text goes through `comint-output-filter' itself, with the process +mark moved to the start of the prompt for the duration, so it gets +what any other output gets: filters, ANSI colors, carriage motion. +A marker that moves along with insertions keeps track of the prompt, +and the process mark and comint's record of where the prompt is are +put back afterwards. ANSI colors keep their own state here (see +`neat-repl--ansi-context'), a chunk ending in a carriage return gets +its line overwritten by the next one, as comint does for streamed +output, and `comint-move-point-for-output' moves point to the input +rather than onto the prompt." + (unless (string-empty-p text) + (let* ((pmark (process-mark proc)) + (end (copy-marker (process-mark proc))) + (prompt (copy-marker neat-repl--prompt-start t)) + (streamed-ansi (and (boundp 'ansi-color-context-region) + ansi-color-context-region)) + (overwrite (string-suffix-p "\r" text)) + (text (if overwrite (string-trim-right text "\r+") text)) + (padded (not (string-suffix-p "\n" text)))) + (save-restriction + (widen) + (unwind-protect + (progn + (when (and (> prompt (point-min)) + (get-text-property (1- prompt) 'neat-repl-padding)) + (let ((inhibit-read-only t)) + (delete-region (1- prompt) prompt))) + (set-marker pmark prompt) + ;; A color still on from the last chunk carries on here. + (when-let* ((marker (cadr neat-repl--ansi-context)) + ((markerp marker)) + ((marker-position marker))) + (set-marker marker prompt)) + (setq-local ansi-color-context-region neat-repl--ansi-context) + ;; comint takes the last line of what it inserts for a + ;; prompt unless it ends in a newline, and with the + ;; process mark at the prompt it would move point there. + (let ((comint-move-point-for-output nil)) + (comint-output-filter + proc (propertize (if padded + (concat text (propertize + "\n" 'neat-repl-padding t)) + text) + 'face face))) + (when (and overwrite padded) + (let ((eol (1- prompt)) + (inhibit-field-text-motion t)) + (with-silent-modifications + (put-text-property (save-excursion + (goto-char eol) + (line-beginning-position)) + eol 'comint-must-overwrite t))))) + (setq neat-repl--ansi-context ansi-color-context-region) + (setq-local ansi-color-context-region streamed-ansi) + (set-marker pmark end) + (set-marker neat-repl--prompt-start prompt) + (setq comint-last-prompt + (cons (copy-marker prompt) (copy-marker end))) + (let ((inhibit-read-only t)) + (font-lock-append-text-property prompt end 'font-lock-face + 'comint-highlight-prompt)) + (set-marker prompt nil) + (set-marker end nil))) + (when comint-move-point-for-output + (dolist (window (get-buffer-window-list nil nil t)) + (comint-adjust-window-point window proc)))))) + (defun neat-repl--input-complete-p (input) "Return non-nil if INPUT is a balanced, complete form. @@ -208,6 +310,7 @@ Otherwise insert a newline so the user can keep typing the form." (let* ((buffer (current-buffer)) (conn neat-current-connection) (trimmed (string-trim-right (substring-no-properties input)))) + (setq neat-repl--prompt-start nil) (cond ((or neat-repl--connection-dead (and conn (not (neat-connection-live-p conn)))) @@ -233,11 +336,9 @@ on the same dead connection are no-ops." (with-current-buffer buf (unless neat-repl--connection-dead (setq neat-repl--connection-dead t) - (let ((proc (get-buffer-process (current-buffer)))) - (when (process-live-p proc) - (comint-output-filter - proc (propertize ";; connection closed\n" - 'face 'neat-repl-error)))))))) + (when (process-live-p (get-buffer-process (current-buffer))) + (neat-repl--emit-output ";; connection closed\n" + 'neat-repl-error)))))) ;;;###autoload (add-hook 'neat-disconnect-functions #'neat-repl--handle-disconnect) @@ -277,7 +378,26 @@ on the same dead connection are no-ops." ;; input that has nowhere to go. (when (and (member "done" status) (not (member "connection-closed" status))) - (comint-output-filter proc (neat-repl--prompt)))))) + (neat-repl--insert-prompt))))) + +(defun neat-repl--handle-unhandled-message (conn message) + "Show `out' and `err' from MESSAGE above the prompt in CONN's REPL. +Run from `neat-unhandled-message-functions', so MESSAGE belongs to no +pending request: output with no `id', or late output from an eval +that already finished." + (when-let* ((buf (neat-repl-buffer-for conn)) + ((buffer-live-p buf))) + (let ((out (neat-bencode-get message "out")) + (err (neat-bencode-get message "err"))) + (when (or out err) + (with-current-buffer buf + (when out (neat-repl--emit-output out 'neat-repl-output)) + (when err (neat-repl--emit-output err 'neat-repl-error))))))) + +;; Not autoloaded: the handler only exists once this file is loaded, +;; and a client used without the REPL has no buffer to show output in. +(add-hook 'neat-unhandled-message-functions + #'neat-repl--handle-unhandled-message) (defun neat-repl--handle-need-input (conn) "Prompt the user for a line of input and ship it to CONN via the `stdin' op. diff --git a/test/neat-client-test.el b/test/neat-client-test.el index a7039fe..ac92881 100644 --- a/test/neat-client-test.el +++ b/test/neat-client-test.el @@ -62,7 +62,8 @@ (expect (gethash "1" (neat-connection-pending conn)) :to-be nil))) (it "ignores messages whose id has no callback registered" - (let ((conn (neat-connection--make))) + (let ((conn (neat-connection--make)) + (neat-unhandled-message-functions nil)) (neat-client-test--push-bytes conn (neat-bencode-encode '(("id" . "99") ("value" . "?")))) ;; If we got here without throwing, we're good. @@ -162,6 +163,63 @@ :not :to-throw) (expect (gethash "1" (neat-connection-pending conn)) :to-be nil)))) +(describe "neat-unhandled-message-functions" + :var (conn seen) + (before-each + (setq conn (neat-connection--make) + seen nil)) + + (it "gets messages that carry no id" + (let ((neat-unhandled-message-functions + (list (lambda (c m) (push (cons c m) seen))))) + (neat-client-test--push-bytes + conn (neat-bencode-encode '(("out" . "hi\n")))) + (expect (length seen) :to-equal 1) + (expect (car (car seen)) :to-be conn) + (expect (neat-bencode-get (cdr (car seen)) "out") :to-equal "hi\n"))) + + (it "gets messages for an id that was never registered" + (let ((neat-unhandled-message-functions + (list (lambda (_c m) (push m seen))))) + (neat-client-test--push-bytes + conn (neat-bencode-encode '(("id" . "99") ("out" . "?")))) + (expect (length seen) :to-equal 1))) + + (it "gets output for a request that already finished, and a second done" + (let ((neat-unhandled-message-functions + (list (lambda (_c m) (push m seen)))) + (got 0)) + (puthash "1" (lambda (_) (cl-incf got)) (neat-connection-pending conn)) + (neat-client-test--push-bytes + conn (concat (neat-bencode-encode '(("id" . "1") ("status" "done"))) + (neat-bencode-encode '(("id" . "1") ("out" . "late\n"))) + (neat-bencode-encode '(("id" . "1") ("status" "done"))))) + (expect got :to-equal 1) + (setq seen (nreverse seen)) + (expect (length seen) :to-equal 2) + (expect (neat-bencode-get (car seen) "out") :to-equal "late\n") + (expect (neat-bencode-get (cadr seen) "status") :to-equal '("done")))) + + (it "doesn't get messages a pending callback claims" + (let ((neat-unhandled-message-functions + (list (lambda (_c m) (push m seen))))) + (puthash "1" #'ignore (neat-connection-pending conn)) + (neat-client-test--push-bytes + conn (neat-bencode-encode '(("id" . "1") ("out" . "x")))) + (expect seen :to-be nil))) + + (it "survives a hook function that errors (production semantics)" + (let ((neat-unhandled-message-functions + (list (lambda (_c _m) (error "boom")))) + (debug-on-error nil) + (got nil)) + (puthash "2" (lambda (m) (push m got)) (neat-connection-pending conn)) + (expect (neat-client-test--push-bytes + conn (concat (neat-bencode-encode '(("out" . "x"))) + (neat-bencode-encode '(("id" . "2") ("value" . "1"))))) + :not :to-throw) + (expect (length got) :to-equal 1)))) + (describe "neat-client--flush-pending" (it "hands each pending callback a connection-closed done and no err" (let* ((conn (neat-connection--make)) diff --git a/test/neat-repl-test.el b/test/neat-repl-test.el index 2f5b86c..793c3b0 100644 --- a/test/neat-repl-test.el +++ b/test/neat-repl-test.el @@ -110,6 +110,175 @@ inserts text." '(("id" . "1") ("status" "done" "connection-closed"))) (expect (neat-repl-test--text) :to-equal "")))) +(describe "neat-repl--handle-unhandled-message" + (it "puts late output above the waiting prompt" + (neat-repl-test--with-repl conn + (neat-repl--insert-prompt) + (neat-repl--handle-unhandled-message conn '(("out" . "late\n"))) + (expect (neat-repl-test--text) :to-equal "late\nneat> "))) + + (it "joins chunks that don't end in a newline" + (neat-repl-test--with-repl conn + (neat-repl--insert-prompt) + (neat-repl--handle-unhandled-message conn '(("out" . "la"))) + (expect (neat-repl-test--text) :to-equal "la\nneat> ") + (neat-repl--handle-unhandled-message conn '(("out" . "te\n"))) + (expect (neat-repl-test--text) :to-equal "late\nneat> "))) + + (it "leaves half-typed input alone" + (neat-repl-test--with-repl conn + (neat-repl--insert-prompt) + (goto-char (point-max)) + (insert "(foo") + (neat-repl--handle-unhandled-message conn '(("err" . "oops\n"))) + (expect (neat-repl-test--text) :to-equal "oops\nneat> (foo") + (expect (get-text-property 1 'face) :to-be 'neat-repl-error) + (expect (point) :to-equal (point-max)))) + + (it "keeps landing above the prompt after an eval finishes" + (neat-repl-test--with-repl conn + (neat-repl--insert-prompt) + (neat-repl--render-response '(("id" . "1") ("value" . "3"))) + (neat-repl--render-response '(("id" . "1") ("status" "done"))) + (neat-repl--handle-unhandled-message conn '(("out" . "late\n"))) + (expect (neat-repl-test--text) :to-equal "neat> 3\nlate\nneat> "))) + + (it "streams in at the end while an eval is still running" + (neat-repl-test--with-repl conn + (neat-repl--insert-prompt) + (setq neat-repl--prompt-start nil) + (neat-repl--handle-unhandled-message conn '(("out" . "x\n"))) + (expect (neat-repl-test--text) :to-equal "neat> x\n"))) + + (it "runs the text through comint's output filters" + (neat-repl-test--with-repl conn + (let (seen) + (neat-repl--insert-prompt) + (setq-local comint-preoutput-filter-functions (list #'upcase)) + (setq-local comint-output-filter-functions + (list (lambda (_s) + (push (buffer-substring-no-properties + comint-last-output-start + (process-mark (get-buffer-process + (current-buffer)))) + seen)))) + (neat-repl--handle-unhandled-message conn '(("out" . "late\n"))) + (expect seen :to-equal '("LATE\n")) + (expect (neat-repl-test--text) :to-equal "LATE\nneat> ") + ;; And the process mark is back after the prompt. + (expect (marker-position (process-mark (get-buffer-process buf))) + :to-equal (point-max))))) + + (it "renders ANSI colors like any other output" + (require 'ansi-color) + (neat-repl-test--with-repl conn + (let ((ansi-color-for-comint-mode t)) + (neat-repl--insert-prompt) + (setq-local comint-output-filter-functions + (list #'ansi-color-process-output)) + (neat-repl--handle-unhandled-message + conn '(("out" . "\e[31mred\e[0m\n"))) + (expect (neat-repl-test--text) :to-equal "red\nneat> ")))) + + (it "applies comint's carriage motion" + (neat-repl-test--with-repl conn + (neat-repl--insert-prompt) + (neat-repl--handle-unhandled-message conn '(("out" . "50%\r100%\n"))) + (expect (neat-repl-test--text) :to-equal "100%\nneat> "))) + + (it "works with the buffer narrowed away from the prompt" + (neat-repl-test--with-repl conn + (neat-repl--insert-prompt) + (narrow-to-region (point-min) (point-min)) + (neat-repl--handle-unhandled-message conn '(("out" . "late\n"))) + (widen) + (expect (neat-repl-test--text) :to-equal "late\nneat> "))) + + (it "leaves the prompt a highlighted, read-only prompt" + (neat-repl-test--with-repl conn + (neat-repl--insert-prompt) + (neat-repl--handle-unhandled-message conn '(("out" . "late"))) + (let ((start (marker-position neat-repl--prompt-start))) + (expect (buffer-substring-no-properties start (point-max)) + :to-equal "neat> ") + (expect (marker-position (car comint-last-prompt)) :to-equal start) + (expect (memq 'comint-highlight-prompt + (ensure-list (get-text-property start 'font-lock-face))) + :to-be-truthy) + (expect (get-text-property start 'read-only) :to-be-truthy) + (expect (get-text-property 1 'read-only) :to-be nil)))) + + (it "doesn't trip over a color that streamed output left on" + (require 'ansi-color) + (neat-repl-test--with-repl conn + (let ((ansi-color-for-comint-mode t) + (debug-on-error nil)) + (setq-local comint-output-filter-functions + (list #'ansi-color-process-output)) + (neat-repl--insert-prompt) + ;; An eval from the REPL is running and prints bold, never + ;; switching it off again. + (setq neat-repl--prompt-start nil) + (neat-repl--handle-unhandled-message conn '(("out" . "\e[1mbold\n"))) + (neat-repl--insert-prompt) + (expect (neat-repl--handle-unhandled-message conn '(("out" . "late\n"))) + :not :to-throw) + (expect (neat-repl--handle-unhandled-message conn '(("out" . "more\n"))) + :not :to-throw) + (expect (neat-repl-test--text) + :to-equal "neat> bold\nlate\nmore\nneat> ")))) + + (it "carries a color across two chunks above the prompt" + (require 'ansi-color) + (neat-repl-test--with-repl conn + (let ((ansi-color-for-comint-mode t)) + (neat-repl--insert-prompt) + (setq-local comint-output-filter-functions + (list #'ansi-color-process-output)) + (neat-repl--handle-unhandled-message conn '(("out" . "\e[31mred\n"))) + (neat-repl--handle-unhandled-message conn '(("out" . "still\e[0m\n"))) + (expect (neat-repl-test--text) :to-equal "red\nstill\nneat> ") + (expect (cl-some (lambda (o) (overlay-get o 'face)) + (overlays-at (+ (point-min) (length "red\n")))) + :to-be-truthy)))) + + (it "overwrites a line that ended in a carriage return" + (neat-repl-test--with-repl conn + (neat-repl--insert-prompt) + (dolist (chunk '("10%\r" "20%\r" "30%\r" "done\n")) + (neat-repl--handle-unhandled-message conn `(("out" . ,chunk)))) + (expect (neat-repl-test--text) :to-equal "done\nneat> "))) + + (it "moves point to the input, not onto the prompt" + (neat-repl-test--with-repl conn + (let ((window (selected-window))) + (neat-repl--insert-prompt) + (set-window-buffer window buf) + (setq-local comint-move-point-for-output t) + (goto-char (point-min)) + (set-window-point window (point-min)) + (neat-repl--handle-unhandled-message conn '(("out" . "late\n"))) + (expect (window-point window) :to-equal (point-max)) + (expect (with-selected-window window + (insert "x") + (neat-repl-test--text)) + :to-equal "late\nneat> x")))) + + (it "keeps a window that started at the prompt showing the new text" + (neat-repl-test--with-repl conn + (let ((window (selected-window))) + (neat-repl--insert-prompt) + (set-window-buffer window buf) + (set-window-start window (point-min)) + (neat-repl--handle-unhandled-message conn '(("out" . "late\n"))) + (expect (window-start window) :to-equal (point-min))))) + + (it "ignores messages with no output" + (neat-repl-test--with-repl conn + (neat-repl--insert-prompt) + (neat-repl--handle-unhandled-message conn '(("status" "done"))) + (expect (neat-repl-test--text) :to-equal "neat> ")))) + (describe "neat-repl--handle-need-input" (it "reads input from the minibuffer and sends it via the stdin op" (let ((conn (neat-connection--make :host "h" :port 1)) @@ -159,6 +328,23 @@ inserts text." :to-be-truthy)) (kill-buffer buf)))) + (it "lets a reconnect in the same buffer start on a fresh line" + (neat-repl-test--with-repl conn + (neat-repl--insert-prompt) + (neat-repl--handle-disconnect conn) + ;; What `neat' does with a buffer that's still around. + (neat-repl-create-buffer conn) + (neat-repl--insert-prompt) + (expect (neat-repl-test--text) + :to-equal ";; connection closed\nneat> \nneat> "))) + + (it "puts the marker above a waiting prompt" + (neat-repl-test--with-repl conn + (neat-repl--insert-prompt) + (neat-repl--handle-disconnect conn) + (expect (neat-repl-test--text) + :to-equal ";; connection closed\nneat> "))) + (it "is a no-op when no REPL buffer exists for the connection" (let ((conn (neat-connection--make :host "h" :port 999999))) (expect (neat-repl--handle-disconnect conn) :not :to-throw)))) From 43a64aeb7373e7c7c635637674d6651f379407ba Mon Sep 17 00:00:00 2001 From: Bozhidar Batsov Date: Thu, 1 Oct 2026 16:00:31 +0300 Subject: [PATCH 05/20] Print ex only when the request produced no err Basilisp and jank put the full stacktrace in both err and ex, so every error showed up twice. ex is now held until done and shown only if nothing came on err, which also keeps nREPL's bare exception class from trailing its own error message. --- neat-repl.el | 43 ++++++++++++++++++++++++--------- neat.el | 32 +++++++++++++----------- test/neat-repl-test.el | 55 ++++++++++++++++++++++++++++++++++++++++++ test/neat-test.el | 6 ++--- 4 files changed, 108 insertions(+), 28 deletions(-) diff --git a/neat-repl.el b/neat-repl.el index 71df8a3..3337c5c 100644 --- a/neat-repl.el +++ b/neat-repl.el @@ -320,12 +320,13 @@ Otherwise insert a newline so the user can keep typing the form." ((string-empty-p trimmed) (neat-repl--insert-prompt)) (t - (neat-eval - conn trimmed - :callback (lambda (resp) - (when (buffer-live-p buffer) - (with-current-buffer buffer - (neat-repl--render-response resp))))))))) + (let ((request (neat-repl--request-create))) + (neat-eval + conn trimmed + :callback (lambda (resp) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (neat-repl--render-response resp request)))))))))) (defun neat-repl--handle-disconnect (conn) "Mark CONN's REPL buffer as closed, if it has one. @@ -343,9 +344,23 @@ on the same dead connection are no-ops." ;;;###autoload (add-hook 'neat-disconnect-functions #'neat-repl--handle-disconnect) -(defun neat-repl--render-response (resp) - "Insert the user-visible parts of nREPL response RESP into the buffer." - (let ((proc (get-buffer-process (current-buffer))) +(cl-defstruct (neat-repl--request (:constructor neat-repl--request-create) + (:copier nil)) + "Rendering state for one request whose responses land in a REPL buffer. +SAW-ERR is set once the request has printed anything on `err'. EX +holds the last `ex' it reported, held back until `done' and dropped +if `err' had something to say: Basilisp and jank put the whole +traceback in both fields, and nREPL's `ex' is only the exception +class, so `err' is the better of the two whenever there is one." + saw-err ex) + +(defun neat-repl--render-response (resp &optional request) + "Insert the user-visible parts of nREPL response RESP into the buffer. +REQUEST is the `neat-repl--request' RESP answers; pass the same one +for every response to a request. Without it RESP is rendered on its +own, and an `ex' only shows up if `done' comes in the same message." + (let ((request (or request (neat-repl--request-create))) + (proc (get-buffer-process (current-buffer))) (value (neat-bencode-get resp "value")) (out (neat-bencode-get resp "out")) (err (neat-bencode-get resp "err")) @@ -356,19 +371,25 @@ on the same dead connection are no-ops." ;; reflects any `(in-ns ...)' or namespace-switching form. (when ns (setq neat-repl--current-ns ns)) + (when ex + (setf (neat-repl--request-ex request) ex)) (when proc (when out (comint-output-filter proc (propertize out 'face 'neat-repl-output))) (when err + (setf (neat-repl--request-saw-err request) t) (comint-output-filter proc (propertize err 'face 'neat-repl-error))) (when value (comint-output-filter proc (concat (propertize value 'face 'neat-repl-value) "\n"))) - (when ex + (when (and (member "done" status) + (neat-repl--request-ex request) + (not (neat-repl--request-saw-err request))) (comint-output-filter - proc (propertize (format "%s\n" ex) 'face 'neat-repl-error))) + proc (propertize (format "%s\n" (neat-repl--request-ex request)) + 'face 'neat-repl-error))) (when (and (member "need-input" status) neat-current-connection (neat-connection-live-p neat-current-connection)) diff --git a/neat.el b/neat.el index 9542e33..abfd3b9 100644 --- a/neat.el +++ b/neat.el @@ -277,18 +277,22 @@ Empty input clears the override." (or (neat-active-connection) (user-error "Neat: no active connection; M-x neat to start one"))) -(defun neat--render-into-repl (conn resp) - "If CONN has a REPL buffer, render RESP there; otherwise message a brief result." - (let ((repl (neat-repl-buffer-for conn))) - (if (buffer-live-p repl) - (with-current-buffer repl - (neat-repl--render-response resp)) - (let ((value (neat-bencode-get resp "value")) - (err (neat-bencode-get resp "err"))) - (cond (err (message "neat: %s" (string-trim err))) - (value (message "=> %s" value)) - ((member "connection-closed" (neat-bencode-get resp "status")) - (message "neat: connection closed"))))))) +(defun neat--eval-callback (conn) + "Return a callback that renders one request's responses from CONN. +Each response is rendered in CONN's REPL buffer if it has one; +otherwise a brief result is messaged." + (let ((request (neat-repl--request-create))) + (lambda (resp) + (let ((repl (neat-repl-buffer-for conn))) + (if (buffer-live-p repl) + (with-current-buffer repl + (neat-repl--render-response resp request)) + (let ((value (neat-bencode-get resp "value")) + (err (neat-bencode-get resp "err"))) + (cond (err (message "neat: %s" (string-trim err))) + (value (message "=> %s" value)) + ((member "connection-closed" (neat-bencode-get resp "status")) + (message "neat: connection closed"))))))))) (defun neat--eval-string (code &optional pos) "Evaluate CODE on the active connection. @@ -310,7 +314,7 @@ namespace is whatever `neat-buffer-ns-function' returns." (ns (funcall neat-buffer-ns-function))) (neat-eval conn code :file file :line line :column column :ns ns - :callback (lambda (resp) (neat--render-into-repl conn resp))))) + :callback (neat--eval-callback conn)))) (defun neat-eval-last-sexp () "Evaluate the sexp before point." @@ -364,7 +368,7 @@ not necessarily resolvable on the server side." conn contents :file-path buffer-file-name :file-name (file-name-nondirectory buffer-file-name) - :callback (lambda (resp) (neat--render-into-repl conn resp))))) + :callback (neat--eval-callback conn)))) (defun neat-switch-to-repl () "Pop to the REPL buffer for the active connection." diff --git a/test/neat-repl-test.el b/test/neat-repl-test.el index 793c3b0..0d89388 100644 --- a/test/neat-repl-test.el +++ b/test/neat-repl-test.el @@ -98,6 +98,61 @@ inserts text." '(("id" . "1") ("value" . "nil") ("status" "done"))) (expect neat-repl--current-ns :to-equal "stays")))) +(defun neat-repl-test--render-all (responses) + "Render RESPONSES in order as replies to one request." + (let ((request (neat-repl--request-create))) + (dolist (resp responses) + (neat-repl--render-response resp request)))) + +(describe "neat-repl--render-response (output)" + (it "renders a value and then a prompt on done" + (neat-repl-test--with-repl _conn + (neat-repl-test--render-all + '((("id" . "1") ("value" . "3")) + (("id" . "1") ("status" "done")))) + (expect (neat-repl-test--text) :to-equal "3\nneat> "))) + + (it "renders out before the value" + (neat-repl-test--with-repl _conn + (neat-repl-test--render-all + '((("id" . "1") ("out" . "hi\n")) + (("id" . "1") ("value" . ":ok")) + (("id" . "1") ("status" "done")))) + (expect (neat-repl-test--text) :to-equal "hi\n:ok\nneat> ") + (expect (get-text-property 1 'face) :to-be 'neat-repl-output))) + + (it "shows err and drops an ex that came after it" + (neat-repl-test--with-repl _conn + (neat-repl-test--render-all + '((("id" . "1") ("err" . "Traceback: boom\n")) + (("id" . "1") ("ex" . "Traceback: boom") ("status" "eval-error")) + (("id" . "1") ("status" "done")))) + (expect (neat-repl-test--text) :to-equal "Traceback: boom\nneat> "))) + + (it "drops an ex that came before err" + ;; nREPL sends the eval-error status with `ex' first, then `err'. + (neat-repl-test--with-repl _conn + (neat-repl-test--render-all + '((("id" . "1") ("ex" . "class java.lang.ArithmeticException") + ("status" "eval-error")) + (("id" . "1") ("err" . "Divide by zero\n")) + (("id" . "1") ("status" "done")))) + (expect (neat-repl-test--text) :to-equal "Divide by zero\nneat> "))) + + (it "shows ex at done when nothing came on err" + (neat-repl-test--with-repl _conn + (neat-repl-test--render-all + '((("id" . "1") ("ex" . "boom") ("status" "eval-error")) + (("id" . "1") ("status" "done")))) + (expect (neat-repl-test--text) :to-equal "boom\nneat> ") + (expect (get-text-property 1 'face) :to-be 'neat-repl-error))) + + (it "shows ex and done arriving together without a request" + (neat-repl-test--with-repl _conn + (neat-repl--render-response + '(("id" . "1") ("ex" . "boom") ("status" "eval-error" "done"))) + (expect (neat-repl-test--text) :to-equal "boom\nneat> ")))) + (describe "neat-repl--render-response (connection-closed)" (it "inserts a prompt on a normal done" (neat-repl-test--with-repl _conn diff --git a/test/neat-test.el b/test/neat-test.el index 487c7fd..0853ef8 100644 --- a/test/neat-test.el +++ b/test/neat-test.el @@ -179,12 +179,12 @@ POS is a 1-indexed buffer position." (lambda () (neat--eval-string "(+ 1 2)"))))) (expect (plist-get plist :ns) :to-equal "derived.ns")))))) -(describe "neat--render-into-repl without a REPL buffer" +(describe "neat--eval-callback without a REPL buffer" (it "reports a connection that closed under the request" (let ((conn (neat-connection--make :host "nowhere" :port 1))) (spy-on 'message) - (neat--render-into-repl - conn '(("id" . "1") ("status" "done" "connection-closed"))) + (funcall (neat--eval-callback conn) + '(("id" . "1") ("status" "done" "connection-closed"))) (expect 'message :to-have-been-called-with "neat: connection closed")))) From 6bc6c14efa5fa8d8e77408efd5003bc5637068d2 Mon Sep 17 00:00:00 2001 From: Bozhidar Batsov Date: Thu, 1 Oct 2026 16:01:05 +0300 Subject: [PATCH 06/20] Don't let the prompt follow an ns the eval named itself A source-buffer eval sent with an explicit ns reports that ns back, but the server only binds it for the one eval. Taking the ns from every response left the prompt claiming a namespace the REPL wasn't in. The prompt now follows a reply's ns only when the request named none, which still covers REPL input and source-buffer evals that move the session with (ns ...) or (in-ns ...). --- neat-repl.el | 12 ++++++++++-- neat.el | 9 +++++---- test/neat-repl-test.el | 41 ++++++++++++++++++++++++++++++++++++++--- test/neat-test.el | 27 +++++++++++++++++++++++++++ 4 files changed, 80 insertions(+), 9 deletions(-) diff --git a/neat-repl.el b/neat-repl.el index 3337c5c..1f6d423 100644 --- a/neat-repl.el +++ b/neat-repl.el @@ -347,12 +347,20 @@ on the same dead connection are no-ops." (cl-defstruct (neat-repl--request (:constructor neat-repl--request-create) (:copier nil)) "Rendering state for one request whose responses land in a REPL buffer. +NS is the namespace the request named explicitly, if any. The prompt +follows the `ns' a reply reports only when NS is nil. A request that +names its own `ns' gets it bound for that one eval and then dropped, +so following it would leave the prompt showing a namespace the REPL +isn't in. Without one the eval runs in the session's namespace, and +an `(ns ...)' or `(in-ns ...)' in it really does move the session, +whether it was typed into the REPL or sent from a source buffer. + SAW-ERR is set once the request has printed anything on `err'. EX holds the last `ex' it reported, held back until `done' and dropped if `err' had something to say: Basilisp and jank put the whole traceback in both fields, and nREPL's `ex' is only the exception class, so `err' is the better of the two whenever there is one." - saw-err ex) + ns saw-err ex) (defun neat-repl--render-response (resp &optional request) "Insert the user-visible parts of nREPL response RESP into the buffer. @@ -369,7 +377,7 @@ own, and an `ex' only shows up if `done' comes in the same message." (status (neat-bencode-get resp "status"))) ;; Track the namespace as soon as we see one so the next prompt ;; reflects any `(in-ns ...)' or namespace-switching form. - (when ns + (when (and ns (not (neat-repl--request-ns request))) (setq neat-repl--current-ns ns)) (when ex (setf (neat-repl--request-ex request) ex)) diff --git a/neat.el b/neat.el index abfd3b9..9b54a69 100644 --- a/neat.el +++ b/neat.el @@ -277,11 +277,12 @@ Empty input clears the override." (or (neat-active-connection) (user-error "Neat: no active connection; M-x neat to start one"))) -(defun neat--eval-callback (conn) +(defun neat--eval-callback (conn &optional ns) "Return a callback that renders one request's responses from CONN. Each response is rendered in CONN's REPL buffer if it has one; -otherwise a brief result is messaged." - (let ((request (neat-repl--request-create))) +otherwise a brief result is messaged. NS is the namespace the +request named, if any (see `neat-repl--request')." + (let ((request (neat-repl--request-create :ns ns))) (lambda (resp) (let ((repl (neat-repl-buffer-for conn))) (if (buffer-live-p repl) @@ -314,7 +315,7 @@ namespace is whatever `neat-buffer-ns-function' returns." (ns (funcall neat-buffer-ns-function))) (neat-eval conn code :file file :line line :column column :ns ns - :callback (neat--eval-callback conn)))) + :callback (neat--eval-callback conn ns)))) (defun neat-eval-last-sexp () "Evaluate the sexp before point." diff --git a/test/neat-repl-test.el b/test/neat-repl-test.el index 0d89388..6ee4e83 100644 --- a/test/neat-repl-test.el +++ b/test/neat-repl-test.el @@ -88,15 +88,50 @@ inserts text." '(("id" . "1") ("ns" . "myapp.core") ("value" . "nil") - ("status" "done"))) + ("status" "done")) + (neat-repl--request-create)) (expect neat-repl--current-ns :to-equal "myapp.core"))) (it "leaves `neat-repl--current-ns' alone when the response has no `ns'" (with-temp-buffer (setq-local neat-repl--current-ns "stays") (neat-repl--render-response - '(("id" . "1") ("value" . "nil") ("status" "done"))) - (expect neat-repl--current-ns :to-equal "stays")))) + '(("id" . "1") ("value" . "nil") ("status" "done")) + (neat-repl--request-create)) + (expect neat-repl--current-ns :to-equal "stays"))) + + (it "follows the `ns' reported for input typed into the REPL" + (neat-repl-test--with-repl _conn + (let (callback) + (cl-letf (((symbol-function 'neat-connection-live-p) (lambda (_) t)) + ((symbol-function 'neat-eval) + (lambda (_c _code &rest plist) + (setq callback (plist-get plist :callback))))) + (neat-repl--input-sender nil "(in-ns 'myapp.core)") + (funcall callback '(("id" . "1") ("ns" . "myapp.core") + ("value" . "nil"))) + (expect neat-repl--current-ns :to-equal "myapp.core"))))) + + (it "ignores the `ns' of an eval that named its own" + ;; The source buffer sent an explicit ns, which the server only + ;; binds for that eval; the REPL is still wherever it was. + (neat-repl-test--with-repl _conn + (setq neat-repl--current-ns "user") + (let ((request (neat-repl--request-create :ns "myapp.core"))) + (dolist (resp '((("id" . "1") ("ns" . "myapp.core") ("value" . "nil")) + (("id" . "1") ("status" "done")))) + (neat-repl--render-response resp request))) + (expect neat-repl--current-ns :to-equal "user") + (expect (neat-repl-test--text) :to-equal "nil\nuser> "))) + + (it "follows a source-buffer eval that named no ns" + ;; Say it ran `(ns myapp.core)': the session really moved. + (neat-repl-test--with-repl _conn + (setq neat-repl--current-ns "user") + (neat-repl-test--render-all + '((("id" . "1") ("ns" . "myapp.core") ("value" . "nil")) + (("id" . "1") ("status" "done")))) + (expect neat-repl--current-ns :to-equal "myapp.core")))) (defun neat-repl-test--render-all (responses) "Render RESPONSES in order as replies to one request." diff --git a/test/neat-test.el b/test/neat-test.el index 0853ef8..ca9c89d 100644 --- a/test/neat-test.el +++ b/test/neat-test.el @@ -221,6 +221,33 @@ POS is a 1-indexed buffer position." (with-current-buffer (neat-repl-buffer-for conn) (expect (buffer-string) :to-equal ""))))) +(describe "source-buffer evals and the REPL's ns" + (it "moves the prompt only when the buffer named no ns" + (let* ((neat-repl-history-file nil) + (conn (neat-connection--make :host "h" :port 78)) + (repl (neat-repl-create-buffer conn)) + callback) + (unwind-protect + (cl-letf (((symbol-function 'neat--require-connection) + (lambda () conn)) + ((symbol-function 'neat-eval) + (lambda (_c _code &rest plist) + (setq callback (plist-get plist :callback))))) + (with-temp-buffer + (setq neat-ns "my.ns") + (neat--eval-string "(+ 1 2)")) + (funcall callback '(("id" . "1") ("ns" . "my.ns") ("value" . "3"))) + (expect (buffer-local-value 'neat-repl--current-ns repl) + :to-be nil) + (with-temp-buffer + (neat--eval-string "(ns myapp.core)")) + (funcall callback '(("id" . "2") ("ns" . "myapp.core") + ("value" . "nil"))) + (expect (buffer-local-value 'neat-repl--current-ns repl) + :to-equal "myapp.core")) + (with-current-buffer repl (setq neat-current-connection nil)) + (kill-buffer repl))))) + (describe "neat--lookup-file-path" (it "returns plain paths unchanged" (expect (neat--lookup-file-path "/tmp/foo.clj") From 6acb613506cd212c699f60a313a5f4a58c43bd07 Mon Sep 17 00:00:00 2001 From: Bozhidar Batsov Date: Thu, 1 Oct 2026 17:55:51 +0300 Subject: [PATCH 07/20] Send an ns with completions and lookup They went out without one, and jank answers that with namespace-not-found or a bare error. The ns now comes from neat-buffer-ns-function, falling back to the namespace the REPL last reported, which is kept on the connection for this. A namespace the server hasn't loaded yet (one set from .dir-locals in a fresh buffer, say) may get turned down in turn, so a request whose ns comes back namespace-not-found, or a bare error, with no result goes out once more without it. Eldoc gets the same through the new neat-lookup-async, and now also calls back with nil when there's no doc, so eldoc isn't left waiting on it. --- neat-client.el | 71 ++++++++++++++++++++++++++------ neat-repl.el | 4 +- neat.el | 46 ++++++++++++++------- test/neat-client-test.el | 84 ++++++++++++++++++++++++++++++++++++++ test/neat-repl-test.el | 15 +++++-- test/neat-test.el | 87 ++++++++++++++++++++++++++++++++++++++++ 6 files changed, 276 insertions(+), 31 deletions(-) diff --git a/neat-client.el b/neat-client.el index 6855fd8..ede20db 100644 --- a/neat-client.el +++ b/neat-client.el @@ -83,11 +83,12 @@ Slots: PROCESS - the underlying network process HOST, PORT - the address we connected to SESSION - the nREPL session id (set by `neat-clone-session') + NS - the namespace the REPL last reported, if any CAPABILITIES - parsed response from a `describe' op PENDING - hash table mapping request id -> callback function NEXT-ID - integer counter used to mint fresh request ids RECV-BUFFER - accumulated, undecoded bytes from the wire" - process host port session capabilities + process host port session ns capabilities (pending (make-hash-table :test 'equal)) (next-id 0) (recv-buffer (unibyte-string))) @@ -476,25 +477,71 @@ the pending table." (remhash id (neat-connection-pending conn)))) (nreverse responses))) +(defun neat-client--ns-rejected-p (responses) + "Return non-nil if RESPONSES look like the server turned down their ns. +That's a `namespace-not-found' status, or a bare `error' with nothing +more specific next to it. Servers differ in what they do with a +namespace that isn't loaded yet, so a tooling request that named one +and got this back, with no results, is worth repeating without it. +An `unknown-op' or `unknown-session' comes with `error' as well, but +has nothing to do with the ns." + (cl-some (lambda (resp) + (let ((status (neat-bencode-get resp "status"))) + (or (member "namespace-not-found" status) + (and (member "error" status) + (cl-every (lambda (s) (member s '("error" "done"))) + status))))) + responses)) + (defun neat-completions-sync (conn prefix &optional ns timeout) "Block until `completions' for PREFIX (in NS) come back from CONN. Return the list of candidate dicts (typically `(\"candidate\" . \"foo\") `(\"type\" . \"function\")' shaped), as many as arrived within -TIMEOUT seconds (default 1)." - (mapcan (lambda (resp) - (copy-sequence (neat-bencode-get resp "completions"))) - (neat-client--request-sync - conn (or timeout 1) - (lambda (callback) (neat-completions conn prefix ns callback))))) +TIMEOUT seconds (default 1). If the server turns NS down +\(`namespace-not-found', or a bare `error'), the request goes out +again without it." + (let* ((responses (neat-client--request-sync + conn (or timeout 1) + (lambda (callback) + (neat-completions conn prefix ns callback)))) + (candidates (mapcan (lambda (resp) + (copy-sequence + (neat-bencode-get resp "completions"))) + responses))) + (if (and ns (not candidates) (neat-client--ns-rejected-p responses)) + (neat-completions-sync conn prefix nil timeout) + candidates))) (defun neat-lookup-sync (conn sym &optional ns timeout) "Block until CONN responds to a `lookup' for SYM (in NS). Return the `info' dict, or nil if none came within TIMEOUT seconds -\(default 1)." - (cl-some (lambda (resp) (neat-bencode-get resp "info")) - (neat-client--request-sync - conn (or timeout 1) - (lambda (callback) (neat-lookup conn sym ns callback))))) +\(default 1). If the server turns NS down (`namespace-not-found', or +a bare `error'), the request goes out again without it." + (let* ((responses (neat-client--request-sync + conn (or timeout 1) + (lambda (callback) (neat-lookup conn sym ns callback)))) + (info (cl-some (lambda (resp) (neat-bencode-get resp "info")) + responses))) + (if (and ns (not info) (neat-client--ns-rejected-p responses)) + (neat-lookup-sync conn sym nil timeout) + info))) + +(defun neat-lookup-async (conn sym ns callback) + "Look SYM up on CONN (in NS) and call CALLBACK with the `info' dict. +CALLBACK gets nil when the server has none. Like `neat-lookup-sync', +this asks again without NS when the server turns NS down." + (let (responses) + (neat-lookup + conn sym ns + (lambda (resp) + (push resp responses) + (when (member "done" (neat-bencode-get resp "status")) + (let* ((all (nreverse responses)) + (info (cl-some (lambda (r) (neat-bencode-get r "info")) all))) + (if (and ns (not info) (neat-client--ns-rejected-p all) + (neat-connection-live-p conn)) + (neat-lookup-async conn sym nil callback) + (funcall callback info)))))))) ;;;; Process filter / sentinel diff --git a/neat-repl.el b/neat-repl.el index 1f6d423..5c71c43 100644 --- a/neat-repl.el +++ b/neat-repl.el @@ -378,7 +378,9 @@ own, and an `ex' only shows up if `done' comes in the same message." ;; Track the namespace as soon as we see one so the next prompt ;; reflects any `(in-ns ...)' or namespace-switching form. (when (and ns (not (neat-repl--request-ns request))) - (setq neat-repl--current-ns ns)) + (setq neat-repl--current-ns ns) + (when neat-current-connection + (setf (neat-connection-ns neat-current-connection) ns))) (when ex (setf (neat-repl--request-ex request) ex)) (when proc diff --git a/neat.el b/neat.el index 9b54a69..607c479 100644 --- a/neat.el +++ b/neat.el @@ -261,7 +261,7 @@ explicitly via `neat-set-ns', in a major-mode hook, or via The default returns `neat-ns'. Replace with a parser that reads the buffer for languages where the namespace is declared in source (for example, a `(ns foo.bar)' form in Clojure). Whatever is returned -becomes the `ns' field on the `eval' op.") +becomes the `ns' field on the `eval', `completions' and `lookup' ops.") (defun neat-set-ns (ns) "Set the buffer-local namespace `neat-ns' to NS for subsequent evaluations. @@ -272,6 +272,16 @@ Empty input clears the override." (setq neat-ns (if (string-empty-p ns) nil ns)) (message "Neat: ns is %s" (or neat-ns "(unset)"))) +(defun neat--tooling-ns (conn) + "Return the ns to send with `completions' and `lookup' on CONN, or nil. +That's whatever `neat-buffer-ns-function' says, falling back to the +namespace CONN's REPL last reported. Some servers won't answer +either op without an ns, while others may not take one they haven't +loaded yet, so a request whose ns gets turned down is sent again +without it." + (or (funcall neat-buffer-ns-function) + (neat-connection-ns conn))) + (defun neat--require-connection () "Return the active connection, or signal a user-error." (or (neat-active-connection) @@ -447,7 +457,8 @@ point or the server doesn't know about the symbol." (let* ((conn (neat--require-connection)) (sym (or (thing-at-point 'symbol t) (user-error "Neat: no symbol at point"))) - (info (neat-lookup-sync conn sym nil neat-lookup-timeout))) + (info (neat-lookup-sync conn sym (neat--tooling-ns conn) + neat-lookup-timeout))) (unless info (user-error "Neat: no doc for `%s'" sym)) (neat--render-doc info))) @@ -482,7 +493,7 @@ surfaced via `:annotation-function' in the completion UI." (let ((cands (delq nil (mapcar #'neat--candidate-with-type (neat-completions-sync - conn prefix nil + conn prefix (neat--tooling-ns conn) neat-completion-timeout))))) (when cands (list start end cands @@ -620,21 +631,25 @@ override for servers that report arglists in a different syntax.") "Eldoc backend driven by the `lookup' op. Conforms to `eldoc-documentation-functions': fires the supplied -CALLBACK with the docstring once the server responds, so the UI -never blocks waiting on a lookup. When the user has moved point -by the time the response arrives, eldoc may briefly show stale -output -- acceptable trade-off for not blocking the editor." +CALLBACK with the docstring once the server responds, or with nil +when there's none, so the UI never blocks waiting on a lookup. When +the user has moved point by the time the response arrives, eldoc may +briefly show stale output, an acceptable trade-off for not blocking +the editor." (let ((conn (neat-active-connection)) (sym (neat--eldoc-thing-at-point)) (arg-index (funcall neat-eldoc-arg-index-function))) (when (and conn sym (neat-connection-live-p conn)) - (neat-lookup - conn sym nil - (lambda (resp) - (when-let* ((info (neat-bencode-get resp "info")) - (str (funcall neat-eldoc-arglist-formatter - info arg-index))) - (funcall callback str :thing sym)))) + (neat-lookup-async + conn sym (neat--tooling-ns conn) + (lambda (info) + (let ((str (and info (funcall neat-eldoc-arglist-formatter + info arg-index)))) + ;; A nil tells eldoc there's nothing to wait for, so other + ;; backends' docs can go up. + (if str + (funcall callback str :thing sym) + (funcall callback nil))))) ;; Tell eldoc we'll call the callback asynchronously. t))) @@ -692,7 +707,8 @@ in the current buffer, otherwise nil so the next backend gets a turn." (cl-defmethod xref-backend-definitions ((_backend (eql neat)) identifier) "Resolve IDENTIFIER to its definition via the `lookup' op." (when-let* ((conn (neat-active-connection)) - (info (neat-lookup-sync conn identifier nil + (info (neat-lookup-sync conn identifier + (neat--tooling-ns conn) neat-lookup-timeout)) (location (neat--xref-location-from-info info))) (list (xref-make identifier location)))) diff --git a/test/neat-client-test.el b/test/neat-client-test.el index ac92881..36e033f 100644 --- a/test/neat-client-test.el +++ b/test/neat-client-test.el @@ -286,6 +286,90 @@ (expect (neat-completions-sync conn "ma" nil 1) :to-equal '((("candidate" . "map")))))))) +(defun neat-client-test--fake-server (conn reply-fn) + "Make CONN's sends get an answer from REPLY-FN. +REPLY-FN gets each decoded request and returns the reply dicts; the +returned function goes in place of `process-send-string'." + (lambda (_proc bytes) + (let ((request (car (neat-bencode-decode bytes)))) + (dolist (reply (funcall reply-fn request)) + (neat-client-test--push-bytes + conn (neat-bencode-encode + (cons (cons "id" (neat-bencode-get request "id")) reply))))))) + +(describe "sync tooling ops and an ns the server turns down" + :var (conn sent-ns) + (before-each + (setq conn (neat-connection--make :host "h" :port 1) + sent-ns nil)) + + (it "retry completions without the ns" + (cl-letf (((symbol-function 'process-live-p) (lambda (_) t)) + ((symbol-function 'accept-process-output) #'ignore) + ((symbol-function 'process-send-string) + (neat-client-test--fake-server + conn (lambda (req) + (push (neat-bencode-get req "ns") sent-ns) + (if (neat-bencode-get req "ns") + '((("status" "done" "error" "namespace-not-found"))) + '((("completions" . ((("candidate" . "map")))) + ("status" "done")))))))) + (expect (neat-completions-sync conn "ma" "not.loaded") + :to-equal '((("candidate" . "map")))) + (expect (nreverse sent-ns) :to-equal '("not.loaded" nil)))) + + (it "retry lookup without the ns after a bare error" + (cl-letf (((symbol-function 'process-live-p) (lambda (_) t)) + ((symbol-function 'accept-process-output) #'ignore) + ((symbol-function 'process-send-string) + (neat-client-test--fake-server + conn (lambda (req) + (push (neat-bencode-get req "ns") sent-ns) + (if (neat-bencode-get req "ns") + '((("status" "error" "done"))) + '((("info" . (("name" . "map"))) + ("status" "done")))))))) + (expect (neat-lookup-sync conn "map" "not.loaded") + :to-equal '(("name" . "map"))) + (expect (nreverse sent-ns) :to-equal '("not.loaded" nil)))) + + (it "don't retry on an error that has nothing to do with the ns" + (cl-letf (((symbol-function 'process-live-p) (lambda (_) t)) + ((symbol-function 'accept-process-output) #'ignore) + ((symbol-function 'process-send-string) + (neat-client-test--fake-server + conn (lambda (req) + (push (neat-bencode-get req "ns") sent-ns) + '((("status" "done" "error" "unknown-op"))))))) + (expect (neat-completions-sync conn "ma" "user") :to-be nil) + (expect sent-ns :to-equal '("user")))) + + (it "retry the async lookup without the ns too" + (let (got) + (cl-letf (((symbol-function 'process-live-p) (lambda (_) t)) + ((symbol-function 'process-send-string) + (neat-client-test--fake-server + conn (lambda (req) + (push (neat-bencode-get req "ns") sent-ns) + (if (neat-bencode-get req "ns") + '((("status" "done" "error" "namespace-not-found"))) + '((("info" . (("name" . "map"))) + ("status" "done")))))))) + (neat-lookup-async conn "map" "not.loaded" (lambda (i) (setq got i)))) + (expect got :to-equal '(("name" . "map"))) + (expect (nreverse sent-ns) :to-equal '("not.loaded" nil)))) + + (it "don't retry when the ns was fine" + (cl-letf (((symbol-function 'process-live-p) (lambda (_) t)) + ((symbol-function 'accept-process-output) #'ignore) + ((symbol-function 'process-send-string) + (neat-client-test--fake-server + conn (lambda (req) + (push (neat-bencode-get req "ns") sent-ns) + '((("status" "done"))))))) + (expect (neat-completions-sync conn "zz" "user") :to-be nil) + (expect sent-ns :to-equal '("user"))))) + (describe "neat-clone-session" (it "captures new-session from the response and assigns it to the connection" (let ((conn (neat-connection--make)) diff --git a/test/neat-repl-test.el b/test/neat-repl-test.el index 6ee4e83..a3c50fd 100644 --- a/test/neat-repl-test.el +++ b/test/neat-repl-test.el @@ -112,26 +112,35 @@ inserts text." ("value" . "nil"))) (expect neat-repl--current-ns :to-equal "myapp.core"))))) + (it "remembers the REPL's ns on the connection for tooling ops" + (neat-repl-test--with-repl conn + (neat-repl--render-response + '(("id" . "1") ("ns" . "myapp.core") ("value" . "nil")) + (neat-repl--request-create)) + (expect (neat-connection-ns conn) :to-equal "myapp.core"))) + (it "ignores the `ns' of an eval that named its own" ;; The source buffer sent an explicit ns, which the server only ;; binds for that eval; the REPL is still wherever it was. - (neat-repl-test--with-repl _conn + (neat-repl-test--with-repl conn (setq neat-repl--current-ns "user") (let ((request (neat-repl--request-create :ns "myapp.core"))) (dolist (resp '((("id" . "1") ("ns" . "myapp.core") ("value" . "nil")) (("id" . "1") ("status" "done")))) (neat-repl--render-response resp request))) (expect neat-repl--current-ns :to-equal "user") + (expect (neat-connection-ns conn) :to-be nil) (expect (neat-repl-test--text) :to-equal "nil\nuser> "))) (it "follows a source-buffer eval that named no ns" ;; Say it ran `(ns myapp.core)': the session really moved. - (neat-repl-test--with-repl _conn + (neat-repl-test--with-repl conn (setq neat-repl--current-ns "user") (neat-repl-test--render-all '((("id" . "1") ("ns" . "myapp.core") ("value" . "nil")) (("id" . "1") ("status" "done")))) - (expect neat-repl--current-ns :to-equal "myapp.core")))) + (expect neat-repl--current-ns :to-equal "myapp.core") + (expect (neat-connection-ns conn) :to-equal "myapp.core")))) (defun neat-repl-test--render-all (responses) "Render RESPONSES in order as replies to one request." diff --git a/test/neat-test.el b/test/neat-test.el index ca9c89d..b44b91f 100644 --- a/test/neat-test.el +++ b/test/neat-test.el @@ -248,6 +248,93 @@ POS is a 1-indexed buffer position." (with-current-buffer repl (setq neat-current-connection nil)) (kill-buffer repl))))) +(describe "neat--tooling-ns" + (it "prefers the buffer's ns" + (with-temp-buffer + (setq neat-ns "my.ns") + (let ((conn (neat-connection--make :ns "user"))) + (expect (neat--tooling-ns conn) :to-equal "my.ns")))) + + (it "falls back to the ns the REPL last reported" + (with-temp-buffer + (let ((conn (neat-connection--make :ns "user"))) + (expect (neat--tooling-ns conn) :to-equal "user")))) + + (it "is nil when neither knows" + (with-temp-buffer + (expect (neat--tooling-ns (neat-connection--make)) :to-be nil)))) + +(describe "tooling ops send an ns" + :var (conn) + (before-each + (setq conn (neat-connection--make :host "h" :port 1 :ns "user")) + (spy-on 'neat-active-connection :and-return-value conn) + (spy-on 'neat-connection-live-p :and-return-value t)) + + (it "in completion-at-point" + (spy-on 'neat-completions-sync :and-return-value nil) + (with-temp-buffer + (insert "ma") + (neat-completion-at-point) + (expect 'neat-completions-sync + :to-have-been-called-with conn "ma" "user" + neat-completion-timeout))) + + (it "in eldoc" + (spy-on 'neat-lookup) + (with-temp-buffer + (insert "(map ") + (neat-eldoc-function #'ignore) + (expect (nth 2 (spy-calls-args-for 'neat-lookup 0)) :to-equal "user"))) + + (it "in eldoc, trying again without it when it's turned down" + (let (shown) + (spy-on 'neat-lookup + :and-call-fake + (lambda (_c _sym ns cb) + (funcall cb (if ns + '(("id" . "1") + ("status" "done" "error" "namespace-not-found")) + '(("id" . "2") ("info" . (("doc" . "Maps."))) + ("status" "done")))))) + (with-temp-buffer + (insert "(map ") + (neat-eldoc-function (lambda (str &rest _) (setq shown str)))) + (expect (mapcar (lambda (args) (nth 2 args)) + (reverse (spy-calls-all-args 'neat-lookup))) + :to-equal '("user" nil)) + (expect shown :to-equal "Maps."))) + + (it "in the doc lookup" + (spy-on 'neat-lookup-sync :and-return-value '(("name" . "map"))) + (spy-on 'neat--render-doc) + (with-temp-buffer + (insert "map") + (neat-show-doc-at-point) + (expect 'neat-lookup-sync + :to-have-been-called-with conn "map" "user" neat-lookup-timeout))) + + (it "in xref find-definitions" + (spy-on 'neat-lookup-sync :and-return-value nil) + (with-temp-buffer + (xref-backend-definitions 'neat "map") + (expect 'neat-lookup-sync + :to-have-been-called-with conn "map" "user" + neat-lookup-timeout)))) + +(describe "neat-eldoc-function" + (it "tells eldoc when there's nothing to show" + (let ((conn (neat-connection--make :host "h" :port 1)) + (calls nil)) + (spy-on 'neat-active-connection :and-return-value conn) + (spy-on 'neat-connection-live-p :and-return-value t) + (spy-on 'neat-lookup-async + :and-call-fake (lambda (_c _sym _ns cb) (funcall cb nil))) + (with-temp-buffer + (insert "(map ") + (neat-eldoc-function (lambda (&rest args) (push args calls)))) + (expect calls :to-equal '((nil)))))) + (describe "neat--lookup-file-path" (it "returns plain paths unchanged" (expect (neat--lookup-file-path "/tmp/foo.clj") From 37cb1f4661ecad50f1b7f5ebc2d8ba1778ae1203 Mon Sep 17 00:00:00 2001 From: Bozhidar Batsov Date: Fri, 2 Oct 2026 12:54:06 +0300 Subject: [PATCH 08/20] Consult describe before using completions, lookup and interrupt The describe reply was stored and never read, although the design doc said completion and eldoc used it. Basilisp lists no completions or lookup op, and Babashka and jank have no interrupt, so those features fired at ops that weren't there. neat-op-supported-p now decides. Completion, eldoc and xref step aside, while the doc lookup and interrupt commands say the server can't do it. A done that comes on its own no longer wipes out the stored ops. Interrupt replies are no longer ignored either: unknown-op, session-idle, session-ephemeral, interrupt-id-mismatch and plain errors all get reported. --- README.md | 13 ++++--- doc/design.md | 10 +++-- neat-client.el | 16 +++++++- neat-repl.el | 24 +++++++++++- neat.el | 30 ++++++++++----- test/neat-client-test.el | 80 ++++++++++++++++++++++++++++++++++++++ test/neat-test.el | 83 ++++++++++++++++++++++++++++++++++++++++ 7 files changed, 236 insertions(+), 20 deletions(-) diff --git a/README.md b/README.md index 3f6042f..f936ebc 100644 --- a/README.md +++ b/README.md @@ -205,12 +205,14 @@ the source (Clojure's `(ns foo.bar)`, etc.), swap in a parser via ### Eldoc, completion, or `M-.` quietly do nothing The CAPF, eldoc backend, and xref backend all rely on the standard -`completions` and `lookup` nREPL ops. If your server doesn't implement -them, our sync helpers return nil and we defer silently - that's by -design, a language-agnostic client can't assume anything. +`completions` and `lookup` nREPL ops. neat checks the ops the server +lists in its `describe` reply, and when one of them is missing these +features stay out of the way - that's by design, a language-agnostic +client can't assume anything. Diagnosis: turn on the message log (next-to-last entry below) and -look for `unknown-op` in the status. +look at the `ops` in the `describe` reply, or for `unknown-op` in a +status. ### Evaluation just sits there @@ -221,7 +223,8 @@ Three usual suspects: - The connection died. The mode-line shows `[closed]` and a `;; connection closed` line appears in the REPL buffer. - The eval is actually running, just slowly. `C-c C-c` in the REPL - (or `C-c C-k` in a source buffer) sends an `interrupt` op. + (or `C-c C-k` in a source buffer) sends an `interrupt` op. Not every + server has one, and neat tells you when yours doesn't. ### Evaluation lands in the wrong namespace diff --git a/doc/design.md b/doc/design.md index 6e91940..abd41c1 100644 --- a/doc/design.md +++ b/doc/design.md @@ -103,9 +103,13 @@ prints their output above the prompt. ### Op discovery via `describe`, no hardcoded Clojurisms nREPL is a protocol; servers advertise the ops they implement via the -`describe` op. neat sends `describe` on connect and stashes the response -on the connection. UI-level features like CAPF and eldoc consult that -capability map and silently no-op when the op they need is missing. +`describe` op. neat sends `describe` on connect and keeps the response +on the connection, and `neat-op-supported-p` answers from it. +Completion, eldoc and xref quietly step aside when the op they need is +missing. The doc lookup and interrupt commands tell you instead, as +you asked for them directly. A server that lists no ops at all gets +the benefit of the doubt, so we just send the request and see what +comes back. There are no hardcoded `clojure.repl/doc` forms, no assumption the server runs on a JVM, no Leiningen or Clojure CLI defaults baked into the connect command. diff --git a/neat-client.el b/neat-client.el index ede20db..0777d76 100644 --- a/neat-client.el +++ b/neat-client.el @@ -335,9 +335,23 @@ CALLBACK, if given, fires for each response message." (neat-send conn '((op . "describe")) (lambda (resp) - (setf (neat-connection-capabilities conn) resp) + ;; A `done' sent on its own mustn't wipe out the ops. + (when (or (assoc "ops" resp) + (not (neat-connection-capabilities conn))) + (setf (neat-connection-capabilities conn) resp)) (when callback (funcall callback resp))))) +(defun neat-op-supported-p (conn op) + "Return non-nil if CONN's server advertises the op named OP. +Looks at the `ops' of the stored `describe' reply, which servers send +either as a dict keyed by op name or as a plain list of names. With +no reply yet, or one that lists no ops, every op counts as supported: +better to try and get `unknown-op' back than to turn a feature off +on a guess." + (let ((ops (neat-bencode-get (neat-connection-capabilities conn) "ops"))) + (or (not (consp ops)) + (and (if (consp (car ops)) (assoc op ops) (member op ops)) t)))) + (defun neat-eval (conn code &rest plist) "Send an `eval' op on CONN to run CODE. diff --git a/neat-repl.el b/neat-repl.el index 5c71c43..3810dc5 100644 --- a/neat-repl.el +++ b/neat-repl.el @@ -441,11 +441,33 @@ finish. `C-g' at the prompt interrupts the eval instead." (neat-stdin conn (concat input "\n"))) (quit (neat-interrupt conn)))) +(defun neat-repl--interrupt (conn) + "Ask CONN's server to interrupt the eval it's running. +Signals a `user-error' up front when the server doesn't advertise +`interrupt', and reports any reply that says the interrupt didn't +happen. Without that the user would just see nothing happen." + (unless (neat-op-supported-p conn "interrupt") + (user-error "Neat: the server doesn't support interrupt")) + (neat-interrupt + conn nil nil + (lambda (resp) + (let ((status (neat-bencode-get resp "status"))) + (cond ((member "unknown-op" status) + (message "Neat: the server doesn't support interrupt")) + ((member "session-idle" status) + (message "Neat: nothing to interrupt")) + ((member "session-ephemeral" status) + (message "Neat: can't interrupt an eval with no session")) + ((member "interrupt-id-mismatch" status) + (message "Neat: that eval isn't the one running")) + ((member "error" status) + (message "Neat: the interrupt failed"))))))) + (defun neat-repl-interrupt () "Send an `interrupt' op to the REPL's connection." (interactive) (if neat-current-connection - (neat-interrupt neat-current-connection) + (neat-repl--interrupt neat-current-connection) (user-error "Neat: no connection in this buffer"))) (defun neat-repl-clear-buffer () diff --git a/neat.el b/neat.el index 607c479..0e819b6 100644 --- a/neat.el +++ b/neat.el @@ -393,15 +393,17 @@ not necessarily resolvable on the server side." (defun neat-interrupt-eval () "Interrupt the in-flight eval on the active connection." (interactive) - (neat-interrupt (neat--require-connection))) + (neat-repl--interrupt (neat--require-connection))) ;;;; Completion-at-point and eldoc ;; These rely on the standard `completions' and `lookup' nREPL ops. -;; Servers that don't implement them surface as `unknown-op' status -;; responses, the sync helpers return nil, and we quietly defer to -;; other backends. +;; When the server's `describe' reply doesn't list the op we need, +;; CAPF, eldoc and xref quietly step aside for other backends. A +;; server whose `describe' lists no ops at all gets the benefit of the +;; doubt: the request goes out, comes back `unknown-op' if the op isn't +;; there, the sync helpers return nil, and we end up in the same place. (defcustom neat-completion-timeout 1.0 "Seconds to wait for a `completions' response before giving up." @@ -451,10 +453,13 @@ which is the just-locked buffer." (defun neat-show-doc-at-point () "Pop a `*neat-doc*' help buffer with the docstring for the symbol at point. -Uses the `lookup' op. Signals a `user-error' if there's no symbol at -point or the server doesn't know about the symbol." +Uses the `lookup' op. Signals a `user-error' if the server doesn't +support `lookup', there's no symbol at point, or the server doesn't +know about the symbol." (interactive) (let* ((conn (neat--require-connection)) + (_ (unless (neat-op-supported-p conn "lookup") + (user-error "Neat: the server doesn't support lookup"))) (sym (or (thing-at-point 'symbol t) (user-error "Neat: no symbol at point"))) (info (neat-lookup-sync conn sym (neat--tooling-ns conn) @@ -489,6 +494,7 @@ surfaced via `:annotation-function' in the completion UI." (end (cdr bounds)) (prefix (buffer-substring-no-properties start end))) (when (and conn (neat-connection-live-p conn) + (neat-op-supported-p conn "completions") (>= (length prefix) 1)) (let ((cands (delq nil (mapcar #'neat--candidate-with-type @@ -639,7 +645,8 @@ the editor." (let ((conn (neat-active-connection)) (sym (neat--eldoc-thing-at-point)) (arg-index (funcall neat-eldoc-arg-index-function))) - (when (and conn sym (neat-connection-live-p conn)) + (when (and conn sym (neat-connection-live-p conn) + (neat-op-supported-p conn "lookup")) (neat-lookup-async conn sym (neat--tooling-ns conn) (lambda (info) @@ -695,10 +702,13 @@ nREPL reports columns 1-indexed; `xref-file-location' wants them (defun neat--xref-backend () "`xref-backend-functions' entry for `neat-mode'. -Returns the `neat' backend symbol when a live connection is available -in the current buffer, otherwise nil so the next backend gets a turn." +Returns the `neat' backend symbol when a live connection whose server +supports `lookup' is available in the current buffer, otherwise nil so +the next backend gets a turn." (when-let* ((conn (neat-active-connection))) - (and (neat-connection-live-p conn) 'neat))) + (and (neat-connection-live-p conn) + (neat-op-supported-p conn "lookup") + 'neat))) (cl-defmethod xref-backend-identifier-at-point ((_backend (eql neat))) "Return the symbol around point as the xref identifier." diff --git a/test/neat-client-test.el b/test/neat-client-test.el index 36e033f..05b0530 100644 --- a/test/neat-client-test.el +++ b/test/neat-client-test.el @@ -404,6 +404,86 @@ returned function goes in place of `process-send-string'." "versions") :not :to-be nil))))) +(describe "neat-describe (ops)" + (it "keeps the ops when done comes in a message of its own" + (let ((conn (neat-connection--make))) + (cl-letf (((symbol-function 'process-live-p) (lambda (_) t)) + ((symbol-function 'process-send-string) #'ignore)) + (neat-describe conn) + ;; Empty dicts can't be written as alists, so raw bencode it is. + (neat-client-test--push-bytes + conn (concat "d2:id1:13:opsd5:clonede4:evaldeee" + (neat-bencode-encode '(("id" . "1") ("status" "done"))))) + (expect (neat-op-supported-p conn "eval") :to-be-truthy) + (expect (neat-op-supported-p conn "interrupt") :to-be nil))))) + +(describe "neat-op-supported-p" + (it "reads ops sent as a dict" + (let ((conn (neat-connection--make + :capabilities (car (neat-bencode-decode + "d3:opsd5:clonede4:evald3:doc1:xeeee"))))) + (expect (neat-op-supported-p conn "eval") :to-be-truthy) + (expect (neat-op-supported-p conn "clone") :to-be-truthy) + (expect (neat-op-supported-p conn "interrupt") :to-be nil))) + + (it "reads ops sent as a list" + (let ((conn (neat-connection--make + :capabilities (car (neat-bencode-decode + "d3:opsl5:clone4:evalee"))))) + (expect (neat-op-supported-p conn "eval") :to-be-truthy) + (expect (neat-op-supported-p conn "lookup") :to-be nil))) + + (it "treats every op as supported before describe answers" + (expect (neat-op-supported-p (neat-connection--make) "interrupt") + :to-be-truthy)) + + (it "treats every op as supported when describe lists none" + (dolist (caps (list '(("versions" . (("nrepl" . (("major" . 1)))))) + (car (neat-bencode-decode "d3:opsdee")) + (car (neat-bencode-decode "d3:opslee")))) + (expect (neat-op-supported-p (neat-connection--make :capabilities caps) + "interrupt") + :to-be-truthy)))) + +(describe "neat-interrupt" + (it "builds an interrupt op with session and interrupt-id" + (let ((conn (neat-connection--make)) + sent) + (setf (neat-connection-session conn) "S-3") + (cl-letf (((symbol-function 'process-live-p) (lambda (_) t)) + ((symbol-function 'process-send-string) + (lambda (_p s) (setq sent s)))) + (neat-interrupt conn nil "42") + (let ((decoded (car (neat-bencode-decode sent)))) + (expect (neat-bencode-get decoded "op") :to-equal "interrupt") + (expect (neat-bencode-get decoded "session") :to-equal "S-3") + (expect (neat-bencode-get decoded "interrupt-id") + :to-equal "42"))))) + + (it "omits interrupt-id when none is given" + (let ((conn (neat-connection--make)) + sent) + (cl-letf (((symbol-function 'process-live-p) (lambda (_) t)) + ((symbol-function 'process-send-string) + (lambda (_p s) (setq sent s)))) + (neat-interrupt conn "S-4") + (let ((decoded (car (neat-bencode-decode sent)))) + (expect (neat-bencode-get decoded "session") :to-equal "S-4") + (expect (assoc "interrupt-id" decoded) :to-be nil)))))) + +(describe "neat-close-session" + (it "builds a close op for the current session" + (let ((conn (neat-connection--make)) + sent) + (setf (neat-connection-session conn) "S-5") + (cl-letf (((symbol-function 'process-live-p) (lambda (_) t)) + ((symbol-function 'process-send-string) + (lambda (_p s) (setq sent s)))) + (neat-close-session conn) + (let ((decoded (car (neat-bencode-decode sent)))) + (expect (neat-bencode-get decoded "op") :to-equal "close") + (expect (neat-bencode-get decoded "session") :to-equal "S-5")))))) + (describe "neat-eval" (it "includes the session and code fields in the sent message" (let ((conn (neat-connection--make)) diff --git a/test/neat-test.el b/test/neat-test.el index b44b91f..b669bb1 100644 --- a/test/neat-test.el +++ b/test/neat-test.el @@ -335,6 +335,89 @@ POS is a 1-indexed buffer position." (neat-eldoc-function (lambda (&rest args) (push args calls)))) (expect calls :to-equal '((nil)))))) +(describe "features gated on describe" + :var (conn) + (before-each + ;; A server that advertises only eval, like Basilisp does for the + ;; tooling ops. + (setq conn (neat-connection--make + :host "h" :port 1 + :capabilities '(("ops" . (("eval") ("clone")))))) + (spy-on 'neat-active-connection :and-return-value conn) + (spy-on 'neat-connection-live-p :and-return-value t) + (spy-on 'neat-completions-sync) + (spy-on 'neat-lookup-sync) + (spy-on 'neat-lookup) + (spy-on 'neat-interrupt)) + + (it "keeps completion-at-point quiet without completions" + (with-temp-buffer + (insert "ma") + (expect (neat-completion-at-point) :to-be nil) + (expect 'neat-completions-sync :not :to-have-been-called))) + + (it "keeps eldoc quiet without lookup" + (with-temp-buffer + (insert "(map ") + (expect (neat-eldoc-function #'ignore) :to-be nil) + (expect 'neat-lookup :not :to-have-been-called))) + + (it "steps the xref backend aside without lookup" + (with-temp-buffer + (expect (neat--xref-backend) :to-be nil))) + + (it "tells the user the doc lookup isn't supported" + (with-temp-buffer + (insert "map") + (expect (neat-show-doc-at-point) :to-throw 'user-error) + (expect 'neat-lookup-sync :not :to-have-been-called))) + + (it "tells the user interrupt isn't supported" + (expect (neat-interrupt-eval) :to-throw 'user-error) + (expect 'neat-interrupt :not :to-have-been-called))) + +(describe "neat-interrupt-eval" + :var (conn callback) + (before-each + (setq conn (neat-connection--make :host "h" :port 1)) + (spy-on 'neat-active-connection :and-return-value conn) + (spy-on 'neat-interrupt + :and-call-fake (lambda (_c _s _id cb) (setq callback cb))) + (spy-on 'message)) + + (it "says so when there was nothing to interrupt" + (neat-interrupt-eval) + (funcall callback '(("id" . "2") ("status" "session-idle" "done"))) + (expect 'message :to-have-been-called-with "Neat: nothing to interrupt")) + + (it "says so when there's no session to interrupt in" + (neat-interrupt-eval) + (funcall callback '(("id" . "2") ("status" "session-ephemeral" "done"))) + (expect 'message :to-have-been-called-with + "Neat: can't interrupt an eval with no session")) + + (it "says so when the eval named isn't the one running" + (neat-interrupt-eval) + (funcall callback '(("id" . "2") ("status" "interrupt-id-mismatch" "done"))) + (expect 'message :to-have-been-called-with + "Neat: that eval isn't the one running")) + + (it "says so when the interrupt fails some other way" + (neat-interrupt-eval) + (funcall callback '(("id" . "2") ("status" "error" "done"))) + (expect 'message :to-have-been-called-with "Neat: the interrupt failed")) + + (it "stays quiet when the interrupt goes through" + (neat-interrupt-eval) + (funcall callback '(("id" . "2") ("status" "done"))) + (expect 'message :not :to-have-been-called)) + + (it "says so when the server turns out not to know the op" + (neat-interrupt-eval) + (funcall callback '(("id" . "2") ("status" "error" "unknown-op" "done"))) + (expect 'message :to-have-been-called-with + "Neat: the server doesn't support interrupt"))) + (describe "neat--lookup-file-path" (it "returns plain paths unchanged" (expect (neat--lookup-file-path "/tmp/foo.clj") From e94e812e2bede4c7ff2a28c3cb0561cd655db27e Mon Sep 17 00:00:00 2001 From: Bozhidar Batsov Date: Fri, 2 Oct 2026 12:54:44 +0300 Subject: [PATCH 09/20] Hold off completion and eldoc when requests wait behind an eval Babashka handles one request at a time per connection, so a completions request sent behind a long eval made Emacs freeze for the whole sync timeout on every try, and eldoc lookups piled up and all answered once the eval was over. Holding off whenever an eval is pending would cost nREPL, which answers tooling ops mid-eval, its completion for as long as an eval runs, and for good if a done never comes. So the connection learns instead. It tracks evals in flight, and a tooling request that times out while one is running marks the connection as stuck (neat-tooling-stalled-p). Completion and eldoc skip their requests while it is, except for one test request every neat-tooling-probe-interval seconds. The mark goes once the evals are done or a request is answered mid-eval. Eldoc lookups now time out too, through neat-lookup-async, and only one goes out at a time per connection; one that fails to go out doesn't keep the next ones from going. --- neat-client.el | 128 +++++++++++++++++++++++++++++++++------ neat.el | 49 +++++++++++---- test/neat-client-test.el | 118 +++++++++++++++++++++++++++++++++++- test/neat-test.el | 59 +++++++++++++++++- 4 files changed, 320 insertions(+), 34 deletions(-) diff --git a/neat-client.el b/neat-client.el index 0777d76..c917b65 100644 --- a/neat-client.el +++ b/neat-client.el @@ -86,10 +86,14 @@ Slots: NS - the namespace the REPL last reported, if any CAPABILITIES - parsed response from a `describe' op PENDING - hash table mapping request id -> callback function + EVALS - ids of `eval' and `load-file' requests awaiting `done' + STALLED - when a tooling request last timed out behind an eval + (a `float-time'), or nil; see `neat-tooling-stalled-p' NEXT-ID - integer counter used to mint fresh request ids RECV-BUFFER - accumulated, undecoded bytes from the wire" process host port session ns capabilities (pending (make-hash-table :test 'equal)) + evals stalled (next-id 0) (recv-buffer (unibyte-string))) @@ -375,7 +379,7 @@ PLIST is a property list of optional fields: ,@(when file `((file . ,file))) ,@(when line `((line . ,line))) ,@(when column `((column . ,column)))))) - (neat-send conn msg callback))) + (neat-client--track-eval conn (neat-send conn msg callback)))) (defun neat-load-file (conn file-contents &rest plist) "Send a `load-file' op on CONN carrying FILE-CONTENTS. @@ -397,7 +401,55 @@ to errors and other diagnostics." ,@(when file-path `((file-path . ,file-path))) ,@(when file-name `((file-name . ,file-name))) ,@(when session `((session . ,session)))))) - (neat-send conn msg callback))) + (neat-client--track-eval conn (neat-send conn msg callback)))) + +(defun neat-client--track-eval (conn id) + "Note request ID as an eval in flight on CONN and return ID." + (push id (neat-connection-evals conn)) + id) + +(defun neat-eval-pending-p (conn) + "Return non-nil while an `eval' or `load-file' on CONN awaits `done'." + (and (neat-connection-evals conn) t)) + +(defcustom neat-tooling-probe-interval 5 + "Seconds between probes of a connection whose tooling requests stall. +See `neat-tooling-stalled-p'." + :type 'number + :group 'neat) + +(defun neat-tooling-stalled-p (conn) + "Return non-nil if tooling requests on CONN should hold off for now. +Some servers (Babashka among them) work through one request at a time +per connection, so anything sent behind a running eval waits for it +to finish. There's no telling from `describe', so this goes by what +happened: a tooling request that timed out while an eval was in +flight marks CONN, and the mark goes once no evals are left or a +tooling request does get answered mid-eval. Servers that answer +tooling ops while an eval runs, nREPL included, never get marked. + +So the mark can go while the eval keeps running, or when its `done' +never comes, the answer is nil once every +`neat-tooling-probe-interval' seconds: that lets one request through +to see whether the server answers now. Ask right before sending." + (let ((since (neat-connection-stalled conn))) + (cond + ((not since) nil) + ((not (neat-eval-pending-p conn)) + (setf (neat-connection-stalled conn) nil) + nil) + ((< (- (float-time) since) neat-tooling-probe-interval) t) + (t + (setf (neat-connection-stalled conn) (float-time)) + nil)))) + +(defun neat-client--note-tooling (conn answered) + "Update CONN's stall mark after a tooling request. +ANSWERED nil means the request timed out, which only counts while an +eval is in flight; see `neat-tooling-stalled-p'." + (cond (answered (setf (neat-connection-stalled conn) nil)) + ((neat-eval-pending-p conn) + (setf (neat-connection-stalled conn) (float-time))))) (defun neat-stdin (conn input &rest plist) "Send a `stdin' op on CONN delivering INPUT to a paused eval. @@ -488,9 +540,39 @@ the pending table." (< (float-time) deadline)) (accept-process-output (neat-connection-process conn) 0.05)) (unless done - (remhash id (neat-connection-pending conn)))) + (remhash id (neat-connection-pending conn))) + (neat-client--note-tooling conn done)) (nreverse responses))) +(defun neat-client--request-async (conn timeout send callback) + "Send a request with SEND and call CALLBACK with CONN's responses. +SEND is as for `neat-client--request-sync'. CALLBACK gets the +responses in the order they came once `done' arrives, or whatever +came before TIMEOUT seconds ran out. Either way it counts toward +`neat-tooling-stalled-p', and a timeout unregisters the request, so +a late reply goes nowhere." + (let (responses finished timer id) + (setq id (funcall + send + (lambda (resp) + (push resp responses) + (when (and (not finished) + (member "done" (neat-bencode-get resp "status"))) + (setq finished t) + (when timer (cancel-timer timer)) + (neat-client--note-tooling conn t) + (funcall callback (nreverse responses)))))) + (unless finished + (setq timer (run-at-time + timeout nil + (lambda () + (unless finished + (setq finished t) + (remhash id (neat-connection-pending conn)) + (neat-client--note-tooling conn nil) + (funcall callback (nreverse responses))))))) + id)) + (defun neat-client--ns-rejected-p (responses) "Return non-nil if RESPONSES look like the server turned down their ns. That's a `namespace-not-found' status, or a bare `error' with nothing @@ -540,22 +622,22 @@ a bare `error'), the request goes out again without it." (neat-lookup-sync conn sym nil timeout) info))) -(defun neat-lookup-async (conn sym ns callback) +(defun neat-lookup-async (conn sym ns timeout callback) "Look SYM up on CONN (in NS) and call CALLBACK with the `info' dict. -CALLBACK gets nil when the server has none. Like `neat-lookup-sync', -this asks again without NS when the server turns NS down." - (let (responses) - (neat-lookup - conn sym ns - (lambda (resp) - (push resp responses) - (when (member "done" (neat-bencode-get resp "status")) - (let* ((all (nreverse responses)) - (info (cl-some (lambda (r) (neat-bencode-get r "info")) all))) - (if (and ns (not info) (neat-client--ns-rejected-p all) - (neat-connection-live-p conn)) - (neat-lookup-async conn sym nil callback) - (funcall callback info)))))))) +CALLBACK gets nil when the server has none or doesn't answer within +TIMEOUT seconds; a timeout counts toward `neat-tooling-stalled-p'. +Like `neat-lookup-sync', this asks again without NS when the server +turns NS down." + (neat-client--request-async + conn timeout + (lambda (cb) (neat-lookup conn sym ns cb)) + (lambda (responses) + (let ((info (cl-some (lambda (r) (neat-bencode-get r "info")) + responses))) + (if (and ns (not info) (neat-client--ns-rejected-p responses) + (neat-connection-live-p conn)) + (neat-lookup-async conn sym nil timeout callback) + (funcall callback info)))))) ;;;; Process filter / sentinel @@ -635,7 +717,11 @@ afterwards." (run-hook-with-args 'neat-unhandled-message-functions conn message))) (when (and id (member "done" status)) - (remhash id (neat-connection-pending conn)))))) + (remhash id (neat-connection-pending conn)) + (setf (neat-connection-evals conn) + (delete id (neat-connection-evals conn))) + (unless (neat-connection-evals conn) + (setf (neat-connection-stalled conn) nil)))))) (defun neat-client--sentinel (proc _event) "Sentinel for nREPL connection PROC. Delegates to `neat-client--cleanup'." @@ -678,7 +764,9 @@ whether) to tell the user." ("status" . ("done" "connection-closed")))) (error nil))) pending) - (clrhash pending))) + (clrhash pending) + (setf (neat-connection-evals conn) nil + (neat-connection-stalled conn) nil))) (provide 'neat-client) ;;; neat-client.el ends here diff --git a/neat.el b/neat.el index 0e819b6..b07a2f7 100644 --- a/neat.el +++ b/neat.el @@ -404,6 +404,12 @@ not necessarily resolvable on the server side." ;; server whose `describe' lists no ops at all gets the benefit of the ;; doubt: the request goes out, comes back `unknown-op' if the op isn't ;; there, the sync helpers return nil, and we end up in the same place. +;; +;; Completion and eldoc also hold off while `neat-tooling-stalled-p' +;; says requests would only queue up behind a running eval, and eldoc +;; keeps to one lookup in flight per connection. Otherwise every +;; completion attempt would sit out its full timeout, and eldoc +;; lookups would pile up and all answer long after point moved on. (defcustom neat-completion-timeout 1.0 "Seconds to wait for a `completions' response before giving up." @@ -495,7 +501,8 @@ surfaced via `:annotation-function' in the completion UI." (prefix (buffer-substring-no-properties start end))) (when (and conn (neat-connection-live-p conn) (neat-op-supported-p conn "completions") - (>= (length prefix) 1)) + (>= (length prefix) 1) + (not (neat-tooling-stalled-p conn))) (let ((cands (delq nil (mapcar #'neat--candidate-with-type (neat-completions-sync @@ -633,6 +640,11 @@ Produces the eldoc display string from a `lookup' INFO dict. The default understands Clojure/Lisp-shape arglists `[a b & rest]'; override for servers that report arglists in a different syntax.") +(defvar neat--eldoc-in-flight (make-hash-table :test 'eq :weakness 'key) + "Connections with an eldoc lookup still waiting for its answer. +Only one goes out at a time per connection, so lookups can't pile up +behind a server that's busy with something else.") + (defun neat-eldoc-function (callback &rest _ignored) "Eldoc backend driven by the `lookup' op. @@ -646,17 +658,30 @@ the editor." (sym (neat--eldoc-thing-at-point)) (arg-index (funcall neat-eldoc-arg-index-function))) (when (and conn sym (neat-connection-live-p conn) - (neat-op-supported-p conn "lookup")) - (neat-lookup-async - conn sym (neat--tooling-ns conn) - (lambda (info) - (let ((str (and info (funcall neat-eldoc-arglist-formatter - info arg-index)))) - ;; A nil tells eldoc there's nothing to wait for, so other - ;; backends' docs can go up. - (if str - (funcall callback str :thing sym) - (funcall callback nil))))) + (neat-op-supported-p conn "lookup") + (not (gethash conn neat--eldoc-in-flight)) + (not (neat-tooling-stalled-p conn))) + (let ((ns (neat--tooling-ns conn)) + (sent nil)) + (puthash conn t neat--eldoc-in-flight) + (unwind-protect + (progn + (neat-lookup-async + conn sym ns neat-lookup-timeout + (lambda (info) + (remhash conn neat--eldoc-in-flight) + (let ((str (and info (funcall neat-eldoc-arglist-formatter + info arg-index)))) + ;; A nil tells eldoc there's nothing to wait for, so + ;; other backends' docs can go up. + (if str + (funcall callback str :thing sym) + (funcall callback nil))))) + (setq sent t)) + ;; If the lookup never went out, no answer will come to + ;; clear the flag. + (unless sent + (remhash conn neat--eldoc-in-flight)))) ;; Tell eldoc we'll call the callback asynchronously. t))) diff --git a/test/neat-client-test.el b/test/neat-client-test.el index 05b0530..45a125a 100644 --- a/test/neat-client-test.el +++ b/test/neat-client-test.el @@ -355,7 +355,8 @@ returned function goes in place of `process-send-string'." '((("status" "done" "error" "namespace-not-found"))) '((("info" . (("name" . "map"))) ("status" "done")))))))) - (neat-lookup-async conn "map" "not.loaded" (lambda (i) (setq got i)))) + (neat-lookup-async conn "map" "not.loaded" 1 + (lambda (i) (setq got i)))) (expect got :to-equal '(("name" . "map"))) (expect (nreverse sent-ns) :to-equal '("not.loaded" nil)))) @@ -526,6 +527,121 @@ returned function goes in place of `process-send-string'." (expect (assoc "column" decoded) :to-be nil) (expect (assoc "ns" decoded) :to-be nil)))))) +(describe "neat-eval-pending-p" + :var (conn) + (before-each + (setq conn (neat-connection--make :host "h" :port 1))) + + (it "is true from an eval until its done" + (cl-letf (((symbol-function 'process-live-p) (lambda (_) t)) + ((symbol-function 'process-send-string) #'ignore)) + (expect (neat-eval-pending-p conn) :to-be nil) + (neat-eval conn "(+ 1 2)") + (expect (neat-eval-pending-p conn) :to-be-truthy) + (neat-client-test--push-bytes + conn (neat-bencode-encode '(("id" . "1") ("value" . "3")))) + (expect (neat-eval-pending-p conn) :to-be-truthy) + (neat-client-test--push-bytes + conn (neat-bencode-encode '(("id" . "1") ("status" "done")))) + (expect (neat-eval-pending-p conn) :to-be nil))) + + (it "counts load-file but not tooling ops" + (cl-letf (((symbol-function 'process-live-p) (lambda (_) t)) + ((symbol-function 'process-send-string) #'ignore)) + (neat-completions conn "ma") + (neat-lookup conn "map") + (expect (neat-eval-pending-p conn) :to-be nil) + (neat-load-file conn "(def x 1)") + (expect (neat-eval-pending-p conn) :to-be-truthy))) + + (it "clears when the connection goes away" + (let ((neat-connections (list conn)) + (neat-disconnect-functions nil)) + (cl-letf (((symbol-function 'process-live-p) (lambda (_) t)) + ((symbol-function 'process-send-string) #'ignore)) + (neat-eval conn "(Thread/sleep 10000)" :callback #'ignore)) + (neat-disconnect conn) + (expect (neat-eval-pending-p conn) :to-be nil)))) + +(describe "neat-tooling-stalled-p" + :var (conn) + (before-each + (setq conn (neat-connection--make :host "h" :port 1))) + + (it "turns on when a sync request times out behind an eval" + (setf (neat-connection-evals conn) '("5")) + (cl-letf (((symbol-function 'process-live-p) (lambda (_) t)) + ((symbol-function 'process-send-string) #'ignore) + ((symbol-function 'accept-process-output) #'ignore)) + (neat-completions-sync conn "ma" nil 0.05)) + (expect (neat-tooling-stalled-p conn) :to-be-truthy)) + + (it "stays off when the timeout had no eval to blame" + (cl-letf (((symbol-function 'process-live-p) (lambda (_) t)) + ((symbol-function 'process-send-string) #'ignore) + ((symbol-function 'accept-process-output) #'ignore)) + (neat-completions-sync conn "ma" nil 0.05)) + (expect (neat-connection-stalled conn) :to-be nil)) + + (it "turns off once the evals are done" + (setf (neat-connection-evals conn) '("5") + (neat-connection-stalled conn) (float-time)) + (neat-client-test--push-bytes + conn (neat-bencode-encode '(("id" . "5") ("status" "done")))) + (expect (neat-tooling-stalled-p conn) :to-be nil)) + + (it "turns off when a sync request gets answered mid-eval" + (setf (neat-connection-evals conn) '("5") + (neat-connection-stalled conn) (float-time)) + (cl-letf (((symbol-function 'process-live-p) (lambda (_) t)) + ((symbol-function 'accept-process-output) #'ignore) + ((symbol-function 'process-send-string) + (neat-client-test--fake-server + conn (lambda (_req) '((("info" . (("name" . "map"))) + ("status" "done"))))))) + (neat-lookup-sync conn "map")) + (expect (neat-tooling-stalled-p conn) :to-be nil)) + + (it "lets one request through as a probe every so often" + (let ((neat-tooling-probe-interval 5)) + (setf (neat-connection-evals conn) '("5") + (neat-connection-stalled conn) (- (float-time) 10)) + (expect (neat-tooling-stalled-p conn) :to-be nil) + ;; The probe restarted the clock, so the next one has to wait. + (expect (neat-tooling-stalled-p conn) :to-be-truthy))) + + (it "turns on when an async lookup times out behind an eval" + (let (got (called nil)) + (setf (neat-connection-evals conn) '("5")) + (cl-letf (((symbol-function 'process-live-p) (lambda (_) t)) + ((symbol-function 'process-send-string) #'ignore)) + (neat-lookup-async conn "map" nil 0.01 + (lambda (info) (setq called t got info))) + (sleep-for 0.1)) + (expect called :to-be-truthy) + (expect got :to-be nil) + (expect (hash-table-count (neat-connection-pending conn)) :to-equal 0) + (expect (neat-tooling-stalled-p conn) :to-be-truthy))) + + (it "turns off when an async lookup is answered mid-eval" + (setf (neat-connection-evals conn) '("5") + (neat-connection-stalled conn) (float-time)) + (cl-letf (((symbol-function 'process-live-p) (lambda (_) t)) + ((symbol-function 'process-send-string) + (neat-client-test--fake-server + conn (lambda (_req) '((("info" . (("name" . "map"))) + ("status" "done"))))))) + (neat-lookup-async conn "map" nil 1 #'ignore)) + (expect (neat-tooling-stalled-p conn) :to-be nil)) + + (it "turns off when the connection goes away" + (let ((neat-connections (list conn)) + (neat-disconnect-functions nil)) + (setf (neat-connection-evals conn) '("5") + (neat-connection-stalled conn) (float-time)) + (neat-disconnect conn) + (expect (neat-connection-stalled conn) :to-be nil)))) + (describe "neat-load-file" (it "builds a load-file op with contents and metadata" (let ((conn (neat-connection--make)) diff --git a/test/neat-test.el b/test/neat-test.el index b669bb1..813811c 100644 --- a/test/neat-test.el +++ b/test/neat-test.el @@ -329,7 +329,7 @@ POS is a 1-indexed buffer position." (spy-on 'neat-active-connection :and-return-value conn) (spy-on 'neat-connection-live-p :and-return-value t) (spy-on 'neat-lookup-async - :and-call-fake (lambda (_c _sym _ns cb) (funcall cb nil))) + :and-call-fake (lambda (_c _sym _ns _timeout cb) (funcall cb nil))) (with-temp-buffer (insert "(map ") (neat-eldoc-function (lambda (&rest args) (push args calls)))) @@ -376,6 +376,63 @@ POS is a 1-indexed buffer position." (expect (neat-interrupt-eval) :to-throw 'user-error) (expect 'neat-interrupt :not :to-have-been-called))) +(describe "tooling while an eval is in flight" + :var (conn) + (before-each + (setq conn (neat-connection--make :host "h" :port 1 :evals '("5"))) + (spy-on 'neat-active-connection :and-return-value conn) + (spy-on 'neat-connection-live-p :and-return-value t) + (spy-on 'neat-completions-sync) + (spy-on 'neat-lookup)) + + (it "goes ahead while the server keeps answering" + ;; nREPL answers tooling ops mid-eval, so nothing gets held back. + (with-temp-buffer + (insert "ma") + (neat-completion-at-point) + (expect 'neat-completions-sync :to-have-been-called))) + + (it "skips completion-at-point once requests stall" + (setf (neat-connection-stalled conn) (float-time)) + (with-temp-buffer + (insert "ma") + (expect (neat-completion-at-point) :to-be nil) + (expect 'neat-completions-sync :not :to-have-been-called))) + + (it "keeps eldoc to one lookup in flight" + (let (pending-callback) + (spy-on 'neat-lookup-async + :and-call-fake (lambda (_c _sym _ns _timeout cb) + (setq pending-callback cb))) + (with-temp-buffer + (insert "(map ") + (expect (neat-eldoc-function #'ignore) :to-be-truthy) + (expect (neat-eldoc-function #'ignore) :to-be nil) + (expect 'neat-lookup-async :to-have-been-called-times 1) + ;; Once the first one is answered the next can go. + (funcall pending-callback nil) + (expect (neat-eldoc-function #'ignore) :to-be-truthy) + (expect 'neat-lookup-async :to-have-been-called-times 2) + (funcall pending-callback nil)))) + + (it "doesn't leave eldoc stuck when the ns or the send fails" + (with-temp-buffer + (insert "(map ") + (let ((neat-buffer-ns-function (lambda () (error "No ns here")))) + (expect (neat-eldoc-function #'ignore) :to-throw 'error)) + (expect (gethash conn neat--eldoc-in-flight) :to-be nil) + (spy-on 'neat-lookup-async + :and-call-fake (lambda (&rest _) (error "Can't send"))) + (expect (neat-eldoc-function #'ignore) :to-throw 'error) + (expect (gethash conn neat--eldoc-in-flight) :to-be nil))) + + (it "skips eldoc once requests stall" + (setf (neat-connection-stalled conn) (float-time)) + (with-temp-buffer + (insert "(map ") + (expect (neat-eldoc-function #'ignore) :to-be nil) + (expect 'neat-lookup :not :to-have-been-called)))) + (describe "neat-interrupt-eval" :var (conn callback) (before-each From d049d92dc5b0ab43821939586913a07824d73dac Mon Sep 17 00:00:00 2001 From: Bozhidar Batsov Date: Thu, 1 Oct 2026 16:06:08 +0300 Subject: [PATCH 10/20] Show error statuses instead of a silent prompt An eval in a missing namespace comes back as nothing but namespace-not-found/done/error, so a typo in neat-ns just printed a new prompt, and without a REPL buffer nothing showed at all. namespace-not-found, unknown-session, unknown-op and a bare error now render as a ;; line in the REPL or an echo-area message. A bare error after the request already showed an err or ex gets no line of its own, in the REPL or the echo area, which now also shows an ex when nothing came on err. The missing namespace never becomes the prompt's. Closing the connection's session now clears it from the connection, and an unknown-session reply drops the dead session, and the namespace it was in, then offers to clone a new one rather than failing every eval after it. --- README.md | 4 ++ neat-client.el | 30 +++++++++++++- neat-repl.el | 78 ++++++++++++++++++++++++++++--------- neat.el | 12 ++++-- test/neat-client-test.el | 56 ++++++++++++++++++++++++++- test/neat-repl-test.el | 84 ++++++++++++++++++++++++++++++++++++++++ test/neat-test.el | 29 +++++++++++++- 7 files changed, 269 insertions(+), 24 deletions(-) diff --git a/README.md b/README.md index f936ebc..33435ff 100644 --- a/README.md +++ b/README.md @@ -237,6 +237,10 @@ its current namespace is. To pin a source buffer: - Or swap `neat-buffer-ns-function` for one that derives the ns from the buffer (parsing a `(ns ...)` form, reading file metadata, etc.). +A namespace the server doesn't know (a typo in `neat-ns`, say) shows +up as a `;; namespace not found: ...` line in the REPL, or in the echo +area when there's no REPL buffer. + ### `M-x neat` doesn't autofill the port The port comes from the nearest `.nrepl-port` file walking up from diff --git a/neat-client.el b/neat-client.el index c917b65..3a0cd27 100644 --- a/neat-client.el +++ b/neat-client.el @@ -484,11 +484,39 @@ for each response message." (defun neat-close-session (conn &optional session callback) "Send a `close' op on CONN to close SESSION (defaults to the current one). +Closing CONN's current session also clears it from CONN, so later +requests don't go out with a session the server has thrown away. CALLBACK, if given, fires for each response message." (let* ((sess (or session (neat-connection-session conn))) (msg `((op . "close") ,@(when sess `((session . ,sess)))))) - (neat-send conn msg callback))) + (prog1 (neat-send conn msg callback) + (when (and sess (equal sess (neat-connection-session conn))) + (setf (neat-connection-session conn) nil))))) + +(defun neat-response-error (resp &optional explained) + "Return a short description of the error status in RESP, or nil. +Picks out the statuses servers send in place of any output, which +would otherwise leave nothing to see: `namespace-not-found', +`unknown-session', `unknown-op', and a bare `error' with no `err' or +`ex' next to it. EXPLAINED non-nil means the request already showed +an `err' or `ex' earlier, so a bare `error' needs no line of its own. +Statuses are matched by membership, as servers pair them with `done' +and `error' in no fixed order." + (let ((status (neat-bencode-get resp "status"))) + (cl-flet ((detailed (text key) + (let ((detail (neat-bencode-get resp key))) + (if (stringp detail) (format "%s: %s" text detail) text)))) + (cond + ((member "namespace-not-found" status) + (detailed "namespace not found" "ns")) + ((member "unknown-session" status) "unknown session") + ((member "unknown-op" status) (detailed "unknown op" "op")) + ((and (member "error" status) + (not explained) + (not (neat-bencode-get resp "err")) + (not (neat-bencode-get resp "ex"))) + "error"))))) (defun neat-completions (conn prefix &optional ns callback) "Send a `completions' op on CONN for PREFIX (and optionally NS). diff --git a/neat-repl.el b/neat-repl.el index 3810dc5..8c5db5b 100644 --- a/neat-repl.el +++ b/neat-repl.el @@ -362,48 +362,66 @@ traceback in both fields, and nREPL's `ex' is only the exception class, so `err' is the better of the two whenever there is one." ns saw-err ex) +(defun neat-repl--request-update (request resp) + "Note RESP's `err' and `ex' on REQUEST and return what's due now. +The result is (EX . PROBLEM). EX is an `ex' to show now: at `done', +when nothing came on `err'. PROBLEM is the error status line from +`neat-response-error', leaving out a bare `error' that an earlier +`err' or `ex' already explained." + (when (neat-bencode-get resp "err") + (setf (neat-repl--request-saw-err request) t)) + (when-let* ((ex (neat-bencode-get resp "ex"))) + (setf (neat-repl--request-ex request) ex)) + (let ((saw-err (neat-repl--request-saw-err request)) + (ex (neat-repl--request-ex request))) + (cons (and (member "done" (neat-bencode-get resp "status")) + (not saw-err) + ex) + (neat-response-error resp (or saw-err ex))))) + (defun neat-repl--render-response (resp &optional request) "Insert the user-visible parts of nREPL response RESP into the buffer. REQUEST is the `neat-repl--request' RESP answers; pass the same one for every response to a request. Without it RESP is rendered on its own, and an `ex' only shows up if `done' comes in the same message." - (let ((request (or request (neat-repl--request-create))) - (proc (get-buffer-process (current-buffer))) - (value (neat-bencode-get resp "value")) - (out (neat-bencode-get resp "out")) - (err (neat-bencode-get resp "err")) - (ex (neat-bencode-get resp "ex")) - (ns (neat-bencode-get resp "ns")) - (status (neat-bencode-get resp "status"))) + (let* ((request (or request (neat-repl--request-create))) + (proc (get-buffer-process (current-buffer))) + (value (neat-bencode-get resp "value")) + (out (neat-bencode-get resp "out")) + (err (neat-bencode-get resp "err")) + (ns (neat-bencode-get resp "ns")) + (status (neat-bencode-get resp "status")) + (due (neat-repl--request-update request resp))) ;; Track the namespace as soon as we see one so the next prompt - ;; reflects any `(in-ns ...)' or namespace-switching form. - (when (and ns (not (neat-repl--request-ns request))) + ;; reflects any `(in-ns ...)' or namespace-switching form. A + ;; `namespace-not-found' reply names the namespace that isn't there. + (when (and ns (not (neat-repl--request-ns request)) + (not (member "namespace-not-found" status))) (setq neat-repl--current-ns ns) (when neat-current-connection (setf (neat-connection-ns neat-current-connection) ns))) - (when ex - (setf (neat-repl--request-ex request) ex)) (when proc (when out (comint-output-filter proc (propertize out 'face 'neat-repl-output))) (when err - (setf (neat-repl--request-saw-err request) t) (comint-output-filter proc (propertize err 'face 'neat-repl-error))) (when value (comint-output-filter proc (concat (propertize value 'face 'neat-repl-value) "\n"))) - (when (and (member "done" status) - (neat-repl--request-ex request) - (not (neat-repl--request-saw-err request))) + (when (car due) + (comint-output-filter + proc (propertize (format "%s\n" (car due)) 'face 'neat-repl-error))) + (when (cdr due) (comint-output-filter - proc (propertize (format "%s\n" (neat-repl--request-ex request)) - 'face 'neat-repl-error))) + proc (propertize (format ";; %s\n" (cdr due)) 'face 'neat-repl-error))) (when (and (member "need-input" status) neat-current-connection (neat-connection-live-p neat-current-connection)) (neat-repl--handle-need-input neat-current-connection)) + (when (and (member "unknown-session" status) neat-current-connection) + (neat-repl--offer-new-session neat-current-connection resp)) ;; A dead connection gets its own marker from ;; `neat-repl--handle-disconnect'; a prompt would only invite ;; input that has nowhere to go. @@ -411,6 +429,30 @@ own, and an `ex' only shows up if `done' comes in the same message." (not (member "connection-closed" status))) (neat-repl--insert-prompt))))) +(defun neat-repl--offer-new-session (conn resp) + "Offer to clone a fresh session after CONN's server disowned one. +RESP is the `unknown-session' reply. When it's about CONN's current +session that session is dropped from CONN, so later requests stop +sending it, and the user gets asked whether to clone a new one. +Declining leaves CONN without a session, which nREPL answers with a +throwaway session for every request. Either way the namespace the +old session was in is forgotten too, by CONN and by its REPL, since +whatever comes next starts out somewhere else." + (let ((session (neat-bencode-get resp "session")) + (current (neat-connection-session conn))) + (when (and current + (or (null session) (equal session current)) + (neat-connection-live-p conn)) + (setf (neat-connection-session conn) nil + (neat-connection-ns conn) nil) + (when-let* ((buf (neat-repl-buffer-for conn)) + ((buffer-live-p buf))) + (with-current-buffer buf + (setq neat-repl--current-ns nil))) + (when (y-or-n-p + "Neat: the server doesn't know this session; clone a new one? ") + (neat-clone-session conn))))) + (defun neat-repl--handle-unhandled-message (conn message) "Show `out' and `err' from MESSAGE above the prompt in CONN's REPL. Run from `neat-unhandled-message-functions', so MESSAGE belongs to no diff --git a/neat.el b/neat.el index b07a2f7..d8b3509 100644 --- a/neat.el +++ b/neat.el @@ -299,11 +299,17 @@ request named, if any (see `neat-repl--request')." (with-current-buffer repl (neat-repl--render-response resp request)) (let ((value (neat-bencode-get resp "value")) - (err (neat-bencode-get resp "err"))) + (err (neat-bencode-get resp "err")) + (status (neat-bencode-get resp "status")) + (due (neat-repl--request-update request resp))) (cond (err (message "neat: %s" (string-trim err))) (value (message "=> %s" value)) - ((member "connection-closed" (neat-bencode-get resp "status")) - (message "neat: connection closed"))))))))) + ((car due) (message "neat: %s" (string-trim (car due)))) + ((cdr due) (message "neat: %s" (cdr due))) + ((member "connection-closed" status) + (message "neat: connection closed"))) + (when (member "unknown-session" status) + (neat-repl--offer-new-session conn resp)))))))) (defun neat--eval-string (code &optional pos) "Evaluate CODE on the active connection. diff --git a/test/neat-client-test.el b/test/neat-client-test.el index 45a125a..741c282 100644 --- a/test/neat-client-test.el +++ b/test/neat-client-test.el @@ -483,7 +483,61 @@ returned function goes in place of `process-send-string'." (neat-close-session conn) (let ((decoded (car (neat-bencode-decode sent)))) (expect (neat-bencode-get decoded "op") :to-equal "close") - (expect (neat-bencode-get decoded "session") :to-equal "S-5")))))) + (expect (neat-bencode-get decoded "session") :to-equal "S-5"))))) + + (it "clears the connection's session when closing it" + (let ((conn (neat-connection--make :session "S-5"))) + (cl-letf (((symbol-function 'process-live-p) (lambda (_) t)) + ((symbol-function 'process-send-string) #'ignore)) + (neat-close-session conn) + (expect (neat-connection-session conn) :to-be nil)))) + + (it "keeps the connection's session when closing another one" + (let ((conn (neat-connection--make :session "S-5")) + sent) + (cl-letf (((symbol-function 'process-live-p) (lambda (_) t)) + ((symbol-function 'process-send-string) + (lambda (_p s) (setq sent s)))) + (neat-close-session conn "S-6") + (expect (neat-bencode-get (car (neat-bencode-decode sent)) "session") + :to-equal "S-6") + (expect (neat-connection-session conn) :to-equal "S-5"))))) + +(describe "neat-response-error" + (it "describes namespace-not-found, naming the ns when the server does" + (expect (neat-response-error + '(("status" "done" "error" "namespace-not-found") + ("ns" . "my.typo"))) + :to-equal "namespace not found: my.typo") + (expect (neat-response-error + '(("status" "namespace-not-found" "done" "error"))) + :to-equal "namespace not found")) + + (it "describes unknown-session" + (expect (neat-response-error '(("status" "error" "unknown-session" "done"))) + :to-equal "unknown session")) + + (it "describes unknown-op, naming the op when the server does" + (expect (neat-response-error + '(("status" "done" "error" "unknown-op") ("op" . "load-file"))) + :to-equal "unknown op: load-file")) + + (it "describes a bare error" + (expect (neat-response-error '(("status" "error" "done"))) + :to-equal "error")) + + (it "leaves a bare error alone when the request already explained it" + (expect (neat-response-error '(("status" "error" "done")) t) :to-be nil)) + + (it "leaves an error that comes with its own explanation alone" + (expect (neat-response-error '(("status" "error") ("err" . "boom\n"))) + :to-be nil) + (expect (neat-response-error '(("status" "error") ("ex" . "boom"))) + :to-be nil)) + + (it "is nil for ordinary statuses" + (dolist (status '(("done") ("eval-error") ("need-input") nil)) + (expect (neat-response-error `(("status" . ,status))) :to-be nil)))) (describe "neat-eval" (it "includes the session and code fields in the sent message" diff --git a/test/neat-repl-test.el b/test/neat-repl-test.el index a3c50fd..bd924cb 100644 --- a/test/neat-repl-test.el +++ b/test/neat-repl-test.el @@ -197,6 +197,90 @@ inserts text." '(("id" . "1") ("ex" . "boom") ("status" "eval-error" "done"))) (expect (neat-repl-test--text) :to-equal "boom\nneat> ")))) +(describe "neat-repl--render-response (error statuses)" + (it "shows namespace-not-found as a comment line" + (neat-repl-test--with-repl _conn + (neat-repl--render-response + '(("id" . "1") ("ns" . "my.typo") + ("status" "done" "error" "namespace-not-found"))) + (expect (neat-repl-test--text) + :to-equal ";; namespace not found: my.typo\nneat> "))) + + (it "shows unknown-op as a comment line" + (neat-repl-test--with-repl _conn + (neat-repl--render-response + '(("id" . "1") ("status" "error" "unknown-op" "done"))) + (expect (neat-repl-test--text) :to-equal ";; unknown op\nneat> "))) + + (it "shows a bare error as a comment line" + (neat-repl-test--with-repl _conn + (neat-repl--render-response '(("id" . "1") ("status" "error" "done"))) + (expect (neat-repl-test--text) :to-equal ";; error\nneat> "))) + + (it "doesn't add a bare error line after err already explained it" + (neat-repl-test--with-repl _conn + (neat-repl-test--render-all + '((("id" . "1") ("err" . "boom\n")) + (("id" . "1") ("status" "error" "done")))) + (expect (neat-repl-test--text) :to-equal "boom\nneat> "))) + + (it "doesn't add a bare error line after an ex" + (neat-repl-test--with-repl _conn + (neat-repl-test--render-all + '((("id" . "1") ("ex" . "boom") ("status" "eval-error")) + (("id" . "1") ("status" "error" "done")))) + (expect (neat-repl-test--text) :to-equal "boom\nneat> "))) + + (it "forgets the old session's namespace when it's gone" + (neat-repl-test--with-repl conn + (setf (neat-connection-session conn) "gone" + (neat-connection-ns conn) "myapp.core") + (setq neat-repl--current-ns "myapp.core") + (spy-on 'neat-connection-live-p :and-return-value t) + (spy-on 'y-or-n-p :and-return-value t) + (spy-on 'neat-clone-session) + (neat-repl-test--render-all + '((("id" . "1") ("status" "error" "unknown-session" "done")))) + (expect (neat-connection-ns conn) :to-be nil) + (expect neat-repl--current-ns :to-be nil) + ;; The new prompt doesn't claim the old namespace either. + (expect (neat-repl-test--text) :to-equal ";; unknown session\nneat> "))) + + (it "offers a fresh session on unknown-session" + (neat-repl-test--with-repl conn + (setf (neat-connection-session conn) "gone") + (spy-on 'neat-connection-live-p :and-return-value t) + (spy-on 'y-or-n-p :and-return-value t) + (spy-on 'neat-clone-session) + (neat-repl--render-response + '(("id" . "1") ("session" . "gone") + ("status" "error" "unknown-session" "done"))) + (expect (neat-repl-test--text) :to-equal ";; unknown session\nneat> ") + (expect (neat-connection-session conn) :to-be nil) + (expect 'neat-clone-session :to-have-been-called-with conn))) + + (it "drops the dead session even when the offer is declined" + (neat-repl-test--with-repl conn + (setf (neat-connection-session conn) "gone") + (spy-on 'neat-connection-live-p :and-return-value t) + (spy-on 'y-or-n-p :and-return-value nil) + (spy-on 'neat-clone-session) + (neat-repl--render-response + '(("id" . "1") ("status" "error" "unknown-session" "done"))) + (expect (neat-connection-session conn) :to-be nil) + (expect 'neat-clone-session :not :to-have-been-called))) + + (it "leaves the session alone when the reply names a different one" + (neat-repl-test--with-repl conn + (setf (neat-connection-session conn) "mine") + (spy-on 'neat-connection-live-p :and-return-value t) + (spy-on 'y-or-n-p) + (neat-repl--render-response + '(("id" . "1") ("session" . "other") + ("status" "error" "unknown-session" "done"))) + (expect (neat-connection-session conn) :to-equal "mine") + (expect 'y-or-n-p :not :to-have-been-called)))) + (describe "neat-repl--render-response (connection-closed)" (it "inserts a prompt on a normal done" (neat-repl-test--with-repl _conn diff --git a/test/neat-test.el b/test/neat-test.el index 813811c..14ac6a0 100644 --- a/test/neat-test.el +++ b/test/neat-test.el @@ -186,7 +186,34 @@ POS is a 1-indexed buffer position." (funcall (neat--eval-callback conn) '(("id" . "1") ("status" "done" "connection-closed"))) (expect 'message :to-have-been-called-with - "neat: connection closed")))) + "neat: connection closed"))) + + (it "doesn't follow an err with a bare error" + (let* ((conn (neat-connection--make :host "nowhere" :port 1)) + (callback (neat--eval-callback conn))) + (spy-on 'message) + (funcall callback '(("id" . "1") ("err" . "boom\n"))) + (funcall callback '(("id" . "1") ("status" "error" "done"))) + (expect 'message :to-have-been-called-with "neat: %s" "boom") + (expect 'message :not :to-have-been-called-with "neat: %s" "error"))) + + (it "shows an ex when nothing came on err" + (let* ((conn (neat-connection--make :host "nowhere" :port 1)) + (callback (neat--eval-callback conn))) + (spy-on 'message) + (funcall callback '(("id" . "1") ("ex" . "boom") ("status" "eval-error"))) + (funcall callback '(("id" . "1") ("status" "error" "done"))) + (expect 'message :to-have-been-called-with "neat: %s" "boom") + (expect 'message :not :to-have-been-called-with "neat: %s" "error"))) + + (it "reports an error status in the echo area" + (let ((conn (neat-connection--make :host "nowhere" :port 1))) + (spy-on 'message) + (funcall (neat--eval-callback conn) + '(("id" . "1") ("ns" . "my.typo") + ("status" "done" "error" "namespace-not-found"))) + (expect 'message :to-have-been-called-with + "neat: %s" "namespace not found: my.typo")))) (describe "neat" :var (conn clone-callback) From 8082ac8f865098b39322bdbd19b6a7fc5307d1b7 Mon Sep 17 00:00:00 2001 From: Bozhidar Batsov Date: Thu, 1 Oct 2026 17:59:26 +0300 Subject: [PATCH 11/20] Let stdin prompts send EOF and answer the session that asked There was no way to give a reading eval end-of-file, the reply always went to the connection's session rather than the eval's, and a need-input from a source-buffer eval with no REPL buffer was never answered, so the eval got stuck. The stdin prompt now takes C-c C-d for EOF, replies in the asking eval's session, also comes up without a REPL, and on C-g interrupts that eval, reporting an interrupt that didn't happen, or sends EOF when the server can't interrupt. The REPL and the no-REPL path share neat-repl--answer-status for the statuses that need the user. --- README.md | 4 +- neat-repl.el | 80 ++++++++++++++++++++++++-------- neat.el | 3 +- test/neat-repl-test.el | 101 +++++++++++++++++++++++++++++++++-------- test/neat-test.el | 9 ++++ 5 files changed, 154 insertions(+), 43 deletions(-) diff --git a/README.md b/README.md index 33435ff..d8264f2 100644 --- a/README.md +++ b/README.md @@ -219,7 +219,9 @@ status. Three usual suspects: - The eval is reading from stdin. Look at the minibuffer for a - `stdin:` prompt and answer it. `C-g` interrupts the read. + `stdin` prompt and answer it, REPL buffer or not. `C-c C-d` there + sends end-of-file, and `C-g` interrupts the eval (or sends + end-of-file, if the server can't interrupt). - The connection died. The mode-line shows `[closed]` and a `;; connection closed` line appears in the REPL buffer. - The eval is actually running, just slowly. `C-c C-c` in the REPL diff --git a/neat-repl.el b/neat-repl.el index 8c5db5b..68d1ef0 100644 --- a/neat-repl.el +++ b/neat-repl.el @@ -416,12 +416,8 @@ own, and an `ex' only shows up if `done' comes in the same message." (when (cdr due) (comint-output-filter proc (propertize (format ";; %s\n" (cdr due)) 'face 'neat-repl-error))) - (when (and (member "need-input" status) - neat-current-connection - (neat-connection-live-p neat-current-connection)) - (neat-repl--handle-need-input neat-current-connection)) - (when (and (member "unknown-session" status) neat-current-connection) - (neat-repl--offer-new-session neat-current-connection resp)) + (when neat-current-connection + (neat-repl--answer-status neat-current-connection resp)) ;; A dead connection gets its own marker from ;; `neat-repl--handle-disconnect'; a prompt would only invite ;; input that has nowhere to go. @@ -429,6 +425,18 @@ own, and an `ex' only shows up if `done' comes in the same message." (not (member "connection-closed" status))) (neat-repl--insert-prompt))))) +(defun neat-repl--answer-status (conn resp) + "Deal with the statuses in RESP from CONN that need the user. +A `need-input' gets answered from the minibuffer and an +`unknown-session' brings up the offer of a new session. Shared by +the REPL and by source-buffer evals with no REPL buffer to go to." + (let ((status (neat-bencode-get resp "status"))) + (when (and (member "need-input" status) + (neat-connection-live-p conn)) + (neat-repl--handle-need-input conn resp)) + (when (member "unknown-session" status) + (neat-repl--offer-new-session conn resp)))) + (defun neat-repl--offer-new-session (conn resp) "Offer to clone a fresh session after CONN's server disowned one. RESP is the `unknown-session' reply. When it's about CONN's current @@ -472,26 +480,58 @@ that already finished." (add-hook 'neat-unhandled-message-functions #'neat-repl--handle-unhandled-message) -(defun neat-repl--handle-need-input (conn) +(defvar neat-repl-stdin-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map minibuffer-local-map) + (define-key map (kbd "C-c C-d") #'neat-repl-stdin-eof) + map) + "Keymap for the minibuffer prompt that answers a `need-input'.") + +(defvar neat-repl--stdin-eof nil + "Non-nil once the `stdin' prompt has been answered with end-of-file.") + +(defun neat-repl-stdin-eof () + "Answer the pending `stdin' prompt with end-of-file instead of a line." + (interactive) + (setq neat-repl--stdin-eof t) + (exit-minibuffer)) + +(defun neat-repl--handle-need-input (conn resp) "Prompt the user for a line of input and ship it to CONN via the `stdin' op. Server-side reads (`read-line', `input', ...) trigger a `need-input' -status response that pauses the eval until the client replies with a -`stdin' op. A trailing newline is appended so `read-line'-style readers -finish. `C-g' at the prompt interrupts the eval instead." - (condition-case nil - (let ((input (read-string "stdin: "))) - (neat-stdin conn (concat input "\n"))) - (quit (neat-interrupt conn)))) - -(defun neat-repl--interrupt (conn) +status response RESP that pauses the eval until the client replies +with a `stdin' op. The reply goes to RESP's session, which needn't +be CONN's current one. A trailing newline is appended so +`read-line'-style readers finish. + +\\\\[neat-repl-stdin-eof] at the prompt sends \ +end-of-file (an empty `stdin') instead. +`C-g' interrupts the eval, or sends end-of-file when the server can't +interrupt, so the eval doesn't sit waiting forever." + (let ((session (neat-bencode-get resp "session")) + (neat-repl--stdin-eof nil)) + (condition-case nil + (let ((input (read-from-minibuffer + (substitute-command-keys + (concat "stdin (\\" + "\\[neat-repl-stdin-eof] for EOF): ")) + nil neat-repl-stdin-map))) + (neat-stdin conn (if neat-repl--stdin-eof "" (concat input "\n")) + :session session)) + (quit (if (neat-op-supported-p conn "interrupt") + (neat-repl--interrupt conn session (neat-bencode-get resp "id")) + (neat-stdin conn "" :session session)))))) + +(defun neat-repl--interrupt (conn &optional session interrupt-id) "Ask CONN's server to interrupt the eval it's running. -Signals a `user-error' up front when the server doesn't advertise -`interrupt', and reports any reply that says the interrupt didn't -happen. Without that the user would just see nothing happen." +SESSION and INTERRUPT-ID go to `neat-interrupt'. Signals a +`user-error' up front when the server doesn't advertise `interrupt', +and reports any reply that says the interrupt didn't happen. Without +that the user would just see nothing happen." (unless (neat-op-supported-p conn "interrupt") (user-error "Neat: the server doesn't support interrupt")) (neat-interrupt - conn nil nil + conn session interrupt-id (lambda (resp) (let ((status (neat-bencode-get resp "status"))) (cond ((member "unknown-op" status) diff --git a/neat.el b/neat.el index d8b3509..7e90ed8 100644 --- a/neat.el +++ b/neat.el @@ -308,8 +308,7 @@ request named, if any (see `neat-repl--request')." ((cdr due) (message "neat: %s" (cdr due))) ((member "connection-closed" status) (message "neat: connection closed"))) - (when (member "unknown-session" status) - (neat-repl--offer-new-session conn resp)))))))) + (neat-repl--answer-status conn resp))))))) (defun neat--eval-string (code &optional pos) "Evaluate CODE on the active connection. diff --git a/test/neat-repl-test.el b/test/neat-repl-test.el index bd924cb..80a54fa 100644 --- a/test/neat-repl-test.el +++ b/test/neat-repl-test.el @@ -463,29 +463,90 @@ inserts text." (expect (neat-repl-test--text) :to-equal "neat> ")))) (describe "neat-repl--handle-need-input" + :var (conn need-input) + (before-each + (setq conn (neat-connection--make :host "h" :port 1 :session "S-conn") + need-input '(("id" . "7") ("session" . "S-eval") + ("status" "need-input")))) + (it "reads input from the minibuffer and sends it via the stdin op" - (let ((conn (neat-connection--make :host "h" :port 1)) - captured) - (cl-letf (((symbol-function 'read-string) - (lambda (&rest _) "world")) - ((symbol-function 'neat-stdin) - (lambda (_c input &rest _) (setq captured input)))) - (neat-repl--handle-need-input conn) - ;; The handler must append a trailing newline so read-line-style - ;; readers actually finish. - (expect captured :to-equal "world\n")))) + (spy-on 'read-from-minibuffer :and-return-value "world") + (spy-on 'neat-stdin) + (neat-repl--handle-need-input conn need-input) + ;; The handler must append a trailing newline so read-line-style + ;; readers actually finish, and answer in the session that asked. + (expect 'neat-stdin + :to-have-been-called-with conn "world\n" :session "S-eval")) + + (it "falls back to the connection's session" + (let (sent) + (spy-on 'read-from-minibuffer :and-return-value "x") + (cl-letf (((symbol-function 'process-live-p) (lambda (_) t)) + ((symbol-function 'process-send-string) + (lambda (_p s) (setq sent s)))) + (neat-repl--handle-need-input + conn '(("id" . "7") ("status" "need-input"))) + (expect (neat-bencode-get (car (neat-bencode-decode sent)) "session") + :to-equal "S-conn")))) + + (it "sends an empty stdin as end-of-file" + (spy-on 'read-from-minibuffer + :and-call-fake (lambda (&rest _) + ;; What `neat-repl-stdin-eof' does. + (setq neat-repl--stdin-eof t) + "half a line")) + (spy-on 'neat-stdin) + (neat-repl--handle-need-input conn need-input) + (expect 'neat-stdin :to-have-been-called-with conn "" :session "S-eval")) + + (it "binds the end-of-file key in the prompt's keymap" + (expect (lookup-key neat-repl-stdin-map (kbd "C-c C-d")) + :to-be 'neat-repl-stdin-eof)) (it "interrupts the eval when the user hits C-g at the prompt" - (let ((conn (neat-connection--make :host "h" :port 1)) - interrupted) - (cl-letf (((symbol-function 'read-string) - (lambda (&rest _) (signal 'quit nil))) - ((symbol-function 'neat-interrupt) - (lambda (c &rest _) (setq interrupted c))) - ((symbol-function 'neat-stdin) - (lambda (&rest _) (error "should not send stdin")))) - (neat-repl--handle-need-input conn) - (expect interrupted :to-be conn))))) + (spy-on 'read-from-minibuffer :and-call-fake + (lambda (&rest _) (signal 'quit nil))) + (spy-on 'neat-interrupt) + (spy-on 'neat-stdin) + (neat-repl--handle-need-input conn need-input) + (expect (butlast (spy-calls-args-for 'neat-interrupt 0)) + :to-equal (list conn "S-eval" "7")) + (expect 'neat-stdin :not :to-have-been-called)) + + (it "reports an interrupt from the prompt that didn't happen" + (spy-on 'read-from-minibuffer :and-call-fake + (lambda (&rest _) (signal 'quit nil))) + (spy-on 'neat-interrupt + :and-call-fake (lambda (_c _s _id cb) + (funcall cb '(("id" . "9") + ("status" "interrupt-id-mismatch" + "done"))))) + (spy-on 'message) + (neat-repl--handle-need-input conn need-input) + (expect 'message :to-have-been-called-with + "Neat: that eval isn't the one running")) + + (it "sends end-of-file on C-g when the server can't interrupt" + (setf (neat-connection-capabilities conn) '(("ops" . (("eval") ("stdin"))))) + (spy-on 'read-from-minibuffer :and-call-fake + (lambda (&rest _) (signal 'quit nil))) + (spy-on 'neat-interrupt) + (spy-on 'neat-stdin) + (neat-repl--handle-need-input conn need-input) + (expect 'neat-interrupt :not :to-have-been-called) + (expect 'neat-stdin :to-have-been-called-with conn "" :session "S-eval"))) + +(describe "neat-repl--render-response (need-input)" + (it "hands need-input to the stdin prompt, with the response" + (neat-repl-test--with-repl conn + (spy-on 'neat-connection-live-p :and-return-value t) + (spy-on 'neat-repl--handle-need-input) + (let ((resp '(("id" . "1") ("session" . "S") ("status" "need-input")))) + (neat-repl--render-response resp) + (expect 'neat-repl--handle-need-input + :to-have-been-called-with conn resp) + ;; Still waiting on the eval, so no prompt yet. + (expect (neat-repl-test--text) :to-equal ""))))) (describe "neat-repl--handle-disconnect" (it "sets the dead flag on the conn's REPL buffer" diff --git a/test/neat-test.el b/test/neat-test.el index 14ac6a0..f70927c 100644 --- a/test/neat-test.el +++ b/test/neat-test.el @@ -206,6 +206,15 @@ POS is a 1-indexed buffer position." (expect 'message :to-have-been-called-with "neat: %s" "boom") (expect 'message :not :to-have-been-called-with "neat: %s" "error"))) + (it "prompts in the minibuffer when the eval needs input" + (let ((conn (neat-connection--make :host "nowhere" :port 1)) + (resp '(("id" . "1") ("session" . "S") ("status" "need-input")))) + (spy-on 'neat-connection-live-p :and-return-value t) + (spy-on 'neat-repl--handle-need-input) + (funcall (neat--eval-callback conn) resp) + (expect 'neat-repl--handle-need-input + :to-have-been-called-with conn resp))) + (it "reports an error status in the echo area" (let ((conn (neat-connection--make :host "nowhere" :port 1))) (spy-on 'message) From 60d4369046f91f5ba61477a96be41aff541bc77a Mon Sep 17 00:00:00 2001 From: Bozhidar Batsov Date: Thu, 1 Oct 2026 17:59:46 +0300 Subject: [PATCH 12/20] Close the REPL's session on the server when quitting Quitting the REPL or killing its buffer only dropped the socket, so every REPL left a session behind on the server. Both now send close for the session first, when the server has the op. Quitting waits briefly for the reply, through the new neat-close-session-sync. Killing the buffer doesn't, so a busy or stuck server can't hold it up. --- neat-client.el | 15 +++++++++++++ neat-repl.el | 25 +++++++++++++++++---- test/neat-client-test.el | 30 +++++++++++++++++++++++++ test/neat-repl-test.el | 47 ++++++++++++++++++++++++++++++++++++++++ 4 files changed, 113 insertions(+), 4 deletions(-) diff --git a/neat-client.el b/neat-client.el index 3a0cd27..c45c85c 100644 --- a/neat-client.el +++ b/neat-client.el @@ -667,6 +667,21 @@ turns NS down." (neat-lookup-async conn sym nil timeout callback) (funcall callback info)))))) +(defun neat-close-session-sync (conn &optional session timeout) + "Close SESSION on CONN and block until the server confirms. +SESSION defaults to CONN's current one. Return non-nil if the server +confirmed within TIMEOUT seconds, which defaults to 1 second; a +connection that goes away first doesn't count." + (let ((status (neat-bencode-get + (car (last (neat-client--request-sync + conn (or timeout 1) + (lambda (callback) + (neat-close-session conn session callback))))) + "status"))) + (and (member "done" status) + (not (member "connection-closed" status)) + t))) + ;;;; Process filter / sentinel diff --git a/neat-repl.el b/neat-repl.el index 68d1ef0..1cae3b5 100644 --- a/neat-repl.el +++ b/neat-repl.el @@ -561,11 +561,25 @@ underlying connection." (erase-buffer) (neat-repl--insert-prompt))) +(defun neat-repl--close-connection (conn &optional no-wait) + "Close CONN's session on the server, then disconnect CONN. +Without the `close' the session would outlive the REPL on the server. +Unless NO-WAIT is non-nil we wait briefly for the server to confirm, +so its reply doesn't run into a socket that's already gone." + (when (and (neat-connection-live-p conn) + (neat-connection-session conn) + (neat-op-supported-p conn "close")) + (ignore-errors + (if no-wait + (neat-close-session conn) + (neat-close-session-sync conn)))) + (neat-disconnect conn)) + (defun neat-repl-quit () - "Disconnect from the nREPL server and bury this buffer." + "Close the REPL's session, disconnect, and bury this buffer." (interactive) (when neat-current-connection - (neat-disconnect neat-current-connection) + (neat-repl--close-connection neat-current-connection) (setq neat-current-connection nil)) (let ((proc (get-buffer-process (current-buffer)))) (when (process-live-p proc) @@ -573,12 +587,15 @@ underlying connection." (bury-buffer)) (defun neat-repl--kill-buffer-cleanup () - "Tear down the connection, persist history, and stop the pipe process." + "Persist history, close the session, disconnect, and stop the pipe process. +The `close' goes out without waiting for the reply: a kill shouldn't +stall on a busy or wedged server." (when comint-input-ring-file-name (ignore-errors (comint-write-input-ring))) (when (and neat-current-connection (neat-connection-live-p neat-current-connection)) - (ignore-errors (neat-disconnect neat-current-connection))) + (ignore-errors + (neat-repl--close-connection neat-current-connection 'no-wait))) (let ((proc (get-buffer-process (current-buffer)))) (when (process-live-p proc) (delete-process proc)))) diff --git a/test/neat-client-test.el b/test/neat-client-test.el index 741c282..27a12d1 100644 --- a/test/neat-client-test.el +++ b/test/neat-client-test.el @@ -371,6 +371,36 @@ returned function goes in place of `process-send-string'." (expect (neat-completions-sync conn "zz" "user") :to-be nil) (expect sent-ns :to-equal '("user"))))) +(describe "neat-close-session-sync" + (it "returns non-nil once the server confirms the close" + (let ((conn (neat-connection--make :session "S-1"))) + (cl-letf (((symbol-function 'process-live-p) (lambda (_) t)) + ((symbol-function 'process-send-string) #'ignore) + ((symbol-function 'accept-process-output) + (lambda (&rest _) + (neat-client-test--push-bytes + conn (neat-bencode-encode + '(("id" . "1") ("status" "done" "session-closed"))))))) + (expect (neat-close-session-sync conn) :to-be-truthy) + (expect (neat-connection-session conn) :to-be nil)))) + + (it "gives up after the timeout" + (let ((conn (neat-connection--make :session "S-1"))) + (cl-letf (((symbol-function 'process-live-p) (lambda (_) t)) + ((symbol-function 'process-send-string) #'ignore) + ((symbol-function 'accept-process-output) #'ignore)) + (expect (neat-close-session-sync conn nil 0.05) :to-be nil) + (expect (hash-table-count (neat-connection-pending conn)) + :to-equal 0)))) + + (it "doesn't count a connection that went away as confirmation" + (let ((conn (neat-connection--make :session "S-1"))) + (cl-letf (((symbol-function 'process-live-p) (lambda (_) t)) + ((symbol-function 'process-send-string) #'ignore) + ((symbol-function 'accept-process-output) + (lambda (&rest _) (neat-client--flush-pending conn)))) + (expect (neat-close-session-sync conn) :to-be nil))))) + (describe "neat-clone-session" (it "captures new-session from the response and assigns it to the connection" (let ((conn (neat-connection--make)) diff --git a/test/neat-repl-test.el b/test/neat-repl-test.el index 80a54fa..85d5993 100644 --- a/test/neat-repl-test.el +++ b/test/neat-repl-test.el @@ -24,6 +24,8 @@ inserts text." (buf (neat-repl-create-buffer ,conn))) (unwind-protect (with-current-buffer buf ,@body) + ;; Keep the kill-buffer cleanup away from the fake connection. + (with-current-buffer buf (setq neat-current-connection nil)) (kill-buffer buf)))) (defun neat-repl-test--text () @@ -548,6 +550,51 @@ inserts text." ;; Still waiting on the eval, so no prompt yet. (expect (neat-repl-test--text) :to-equal ""))))) +(describe "closing the REPL" + :var (calls) + (before-each + (setq calls nil) + (spy-on 'neat-connection-live-p :and-return-value t) + (spy-on 'neat-close-session-sync + :and-call-fake (lambda (c &rest _) + (push (list 'close (neat-connection-session c)) + calls))) + (spy-on 'neat-close-session + :and-call-fake (lambda (c &rest _) + (push (list 'close-no-wait + (neat-connection-session c)) + calls))) + (spy-on 'neat-disconnect + :and-call-fake (lambda (_c) (push 'disconnect calls)))) + + (it "closes the session before disconnecting on quit" + (neat-repl-test--with-repl conn + (setf (neat-connection-session conn) "S-1") + (spy-on 'bury-buffer) + (neat-repl-quit) + (expect (nreverse calls) :to-equal '((close "S-1") disconnect)) + (expect neat-current-connection :to-be nil))) + + (it "closes the session without waiting when the buffer is killed" + (neat-repl-test--with-repl conn + (setf (neat-connection-session conn) "S-2") + (neat-repl--kill-buffer-cleanup) + (expect (nreverse calls) :to-equal '((close-no-wait "S-2") disconnect)))) + + (it "just disconnects when there's no session to close" + (neat-repl-test--with-repl _conn + (spy-on 'bury-buffer) + (neat-repl-quit) + (expect calls :to-equal '(disconnect)))) + + (it "just disconnects when the server doesn't support close" + (neat-repl-test--with-repl conn + (setf (neat-connection-session conn) "S-3" + (neat-connection-capabilities conn) '(("ops" "eval" "clone"))) + (spy-on 'bury-buffer) + (neat-repl-quit) + (expect calls :to-equal '(disconnect))))) + (describe "neat-repl--handle-disconnect" (it "sets the dead flag on the conn's REPL buffer" (let* ((conn (neat-connection--make :host "h" :port 1)) From 14300a6662d08f87a3e71216011a95f2e174e290 Mon Sep 17 00:00:00 2001 From: Bozhidar Batsov Date: Thu, 1 Oct 2026 18:00:28 +0300 Subject: [PATCH 13/20] Treat an unknown-session reply as the end of its request Nothing more can arrive for a request the server has no session for, but if the reply leaves done off, the callback stays pending and the eval stays in flight for good: no REPL prompt, and completion and eldoc stay off. Such replies now get a done added. --- neat-client.el | 17 ++++++++++++----- test/neat-client-test.el | 11 +++++++++++ 2 files changed, 23 insertions(+), 5 deletions(-) diff --git a/neat-client.el b/neat-client.el index c45c85c..602d0d3 100644 --- a/neat-client.el +++ b/neat-client.el @@ -733,19 +733,26 @@ A server can send any bencode value, so MESSAGE gets checked first: anything other than a dict is logged and skipped, a `status' sent as a plain string counts as a list of one, and any other `status' that isn't a list is dropped as if it weren't there. Either would -otherwise blow up in here or in the callback. A message without a -callback goes to `neat-unhandled-message-functions'. When the +otherwise blow up in here or in the callback. An `unknown-session' +reply gets a `done' added if it lacks one, since nothing more can +come for a request the server has no session for. A message without +a callback goes to `neat-unhandled-message-functions'. When the response's status contains `done' the callback entry is pruned afterwards." (neat-client--log conn :in message) (if (not (neat-bencode-dict-p message)) (neat-client--log conn :note '(skipped "not a dict")) (let ((status (neat-bencode-get message "status"))) + (when (stringp status) + (setq status (list status)) + (setf (alist-get "status" message nil nil #'equal) status)) (cond - ((stringp status) - (setf (alist-get "status" message nil nil #'equal) (list status))) ((not (listp status)) - (setq message (cl-remove "status" message :key #'car :test #'equal))))) + (setq message (cl-remove "status" message :key #'car :test #'equal))) + ((and (member "unknown-session" status) + (not (member "done" status))) + (setf (alist-get "status" message nil nil #'equal) + (append status '("done")))))) (let* ((id (neat-bencode-get message "id")) (status (neat-bencode-get message "status")) (callback (and id (gethash id (neat-connection-pending conn))))) diff --git a/test/neat-client-test.el b/test/neat-client-test.el index 27a12d1..d3e01e5 100644 --- a/test/neat-client-test.el +++ b/test/neat-client-test.el @@ -118,6 +118,17 @@ (expect (length got) :to-equal 1) (expect (neat-bencode-get (car got) "value") :to-equal "ok"))) + (it "ends a request on unknown-session even without done" + (let ((conn (neat-connection--make :host "h" :port 1)) + got) + (puthash "1" (lambda (m) (push m got)) (neat-connection-pending conn)) + (neat-client-test--push-bytes + conn (neat-bencode-encode '(("id" . "1") + ("status" "error" "unknown-session")))) + (expect (neat-bencode-get (car got) "status") + :to-equal '("error" "unknown-session" "done")) + (expect (gethash "1" (neat-connection-pending conn)) :to-be nil))) + (it "treats a status sent as a plain string as a list of one" (let ((conn (neat-connection--make)) (got '())) From d9af21174c8ee588d9d7d4d623b1d2cee7fdef8b Mon Sep 17 00:00:00 2001 From: Bozhidar Batsov Date: Thu, 1 Oct 2026 16:13:19 +0300 Subject: [PATCH 14/20] Narrow the integration suite to the client, leave servers to proof Checking servers against each other is proof's job now, so the suite drops its table of implementations and runs against nREPL alone. It now covers what only a real wire shows: REPL rendering, the stdin round trip, interrupts, error statuses and late output. README and the design doc point server authors at proof. --- README.md | 45 ++-- doc/design.md | 29 ++- test/neat-integration-test.el | 416 +++++++++++++++------------------- 3 files changed, 215 insertions(+), 275 deletions(-) diff --git a/README.md b/README.md index d8264f2..64899f2 100644 --- a/README.md +++ b/README.md @@ -33,25 +33,24 @@ edges - this is the start of the road, not the end. ecosystem rather than a Clojure-only protocol. That effort has three strands: -1. **An official nREPL specification.** Today the [nREPL][nrepl] project +1. An official nREPL specification. Today the [nREPL][nrepl] project is the de facto spec; a formal version is being drafted at [nrepl/spec.nrepl.org][spec]. `neat` aims to keep pressure on the spec to stay genuinely language-agnostic by being a client that refuses to silently assume Clojure. -2. **Reference clients.** A spec without independent client +2. Reference clients. A spec without independent client implementations is wishful thinking. `neat` is one such reference client, intentionally built on Emacs builtins and free of Clojure-specific helpers, so it can act as a baseline for what "compliant" should mean on the client side. -3. **A compatibility test suite.** The parameterised integration suite - under [`test/neat-integration-test.el`](test/neat-integration-test.el) - already runs the same assertions against multiple servers (Clojure, - Babashka, Basilisp), and divergences between them get surfaced as - real findings rather than mysterious bugs. The long-term goal is - to grow this into a portable suite any nREPL server can self-check - against. +3. A compatibility test suite. That one lives in its own project, + [proof][proof]. It talks to a server the way clients do, runs a set + of checks and tells you what's broken and which clients it breaks. + If you work on an nREPL server, that's the tool to reach for. + neat's own integration suite only tests the client. [spec]: https://github.com/nrepl/spec.nrepl.org +[proof]: https://github.com/nrepl/proof ## Installation @@ -318,31 +317,19 @@ eldev lint # lint eldev test # run Buttercup suites ``` -The default suite is the fast one. There's also an integration suite that -boots real nREPL servers as subprocesses and exercises the full client. -It's gated behind an env var since starting a server adds a few seconds: +The default suite is the fast one. There's also an integration suite +that starts an nREPL server (`nrepl/nrepl`, through the Clojure CLI) +and drives the client and the REPL buffer end to end: rendering, +stdin, interrupts, error statuses and late output. It's gated behind +an env var since starting the JVM adds a few seconds, and it's +skipped when `clojure` isn't on your PATH: ``` NEAT_INTEGRATION=1 eldev test ``` -The integration suite walks `neat-it--server-impls` in -`test/neat-integration-test.el` and registers a block per implementation -that's installed on PATH. Currently: - -| Implementation | Executable | How to install | -|----------------|------------|----------------| -| Clojure (`nrepl/nrepl`) | `clojure` | [clojure.org/guides/install_clojure](https://clojure.org/guides/install_clojure) | -| [Babashka](https://babashka.org) | `bb` | `brew install borkdude/brew/babashka` | -| [Basilisp](https://basilisp.readthedocs.io) (Python) | `basilisp` | `pipx install basilisp` | -| [let-go](https://github.com/nooga/let-go) (Go) | `let-go` | `go install github.com/nooga/let-go@latest` | - -Add more entries to the list to teach the suite about your favorite -nREPL implementation. Most servers just need an executable that prints -a port banner on stdout; for ones that can't or won't announce an -OS-assigned port (let-go, currently), the entry can supply a -`:port-fn` that pre-allocates a free port for the framework to pass -in. +The suite tests neat, not the server. To find out how well a server +speaks nREPL, run [proof][proof] against it. ## License diff --git a/doc/design.md b/doc/design.md index abd41c1..1669763 100644 --- a/doc/design.md +++ b/doc/design.md @@ -178,19 +178,16 @@ Supporting Emacs 27 would mean fallbacks for each of those and worse UX where the modern API does the right thing. Not worth it for a young project. -## Integration testing as a compatibility tool - -The parameterised suite at `test/neat-integration-test.el` runs the -same assertions against every nREPL implementation whose executable -is on PATH. Today: Clojure (`nrepl/nrepl`), Babashka, Basilisp. - -This isn't just nice-to-have; it's a first step toward a real nREPL -compatibility test suite. The contract under test is what we believe -any conformant server should support, and concrete divergences (for -example, Basilisp chunking `(println "hi")` into two `out` messages -where Clojure batches them into `"hi\n"`) are exactly the findings -that should feed back into the nREPL specification work. - -Adding a new implementation is a single plist entry in -`neat-it--server-impls`: name, executable, command builder, and a -regex for the port banner. +## Integration tests + +The suite at `test/neat-integration-test.el` runs neat end to end +against the reference nREPL server. It types into a real REPL buffer +and checks what comes back, which covers the parts unit tests can +only fake: the stdin round trip, interrupts, error statuses and +output that arrives after `done`. + +It used to run the same checks against several servers, with the +idea of growing into a compatibility suite for nREPL servers. That +job has moved to [proof](https://github.com/nrepl/proof), which is +built for it, so this suite sticks to one server and tests the +client. diff --git a/test/neat-integration-test.el b/test/neat-integration-test.el index 6738260..bd7c7c9 100644 --- a/test/neat-integration-test.el +++ b/test/neat-integration-test.el @@ -1,18 +1,20 @@ -;;; neat-integration-test.el --- Live nREPL integration tests -*- lexical-binding: t; -*- +;;; neat-integration-test.el --- End-to-end tests against nREPL -*- lexical-binding: t; -*- ;;; Commentary: -;; Live integration tests against real nREPL implementations. Gated -;; behind NEAT_INTEGRATION because spinning up real servers adds a few -;; seconds to the suite and may need network access on the first run -;; (e.g. to fetch the Clojure nREPL dependency). +;; End-to-end tests that drive the client and the REPL buffer against +;; a real nREPL server (the reference implementation, started through +;; the Clojure CLI). They cover what the unit tests can only fake with +;; canned messages: REPL rendering, the need-input round trip, +;; interrupts, error statuses and late output, as they come off a real +;; wire. ;; -;; Each entry in `neat-it--server-impls' below describes one -;; implementation. At load time we walk the list, and for every impl -;; whose executable is on PATH we register a `describe' block that -;; runs the same set of assertions. Implementations that aren't -;; installed locally are silently skipped, so contributors can run -;; whichever subset they have. +;; Whether a server speaks nREPL properly is a different question, and +;; proof (https://github.com/nrepl/proof) is the tool for that one. +;; +;; Gated behind NEAT_INTEGRATION because booting the JVM adds a few +;; seconds to the suite and the first run needs network access to +;; fetch nREPL. Skipped when `clojure' isn't on PATH. ;; ;; Run with: ;; @@ -22,133 +24,53 @@ (require 'buttercup) (require 'cl-lib) -(require 'neat-bencode) -(require 'neat-client) - - -;;;; Server descriptors - -(defconst neat-it--clojure-deps - "{:deps {nrepl/nrepl {:mvn/version \"1.3.0\"}}}") - -(defconst neat-it--server-impls - `((:name "Clojure" - :executable "clojure" - :command-fn ,(lambda () - (list "clojure" "-Sdeps" neat-it--clojure-deps - "-M" "-m" "nrepl.cmdline" "--port" "0")) - :port-regexp "nREPL server started on port \\([0-9]+\\)" - :startup-timeout 120) - (:name "Babashka" - :executable "bb" - :command-fn ,(lambda () (list "bb" "nrepl-server" "localhost:0")) - :port-regexp "Started nREPL server at [^:]+:\\([0-9]+\\)" - :startup-timeout 30) - (:name "Basilisp" - :executable "basilisp" - :command-fn ,(lambda () (list "basilisp" "nrepl-server")) - ;; Basilisp prints the same banner shape as nrepl/nrepl, so we - ;; can reuse the Clojure regex verbatim. - :port-regexp "nREPL server started on port \\([0-9]+\\)" - :startup-timeout 30) - (:name "let-go" - :executable "let-go" - ;; let-go's `-p 0' is broken upstream (banner and .nrepl-port both - ;; say `0' while the server listens on a random ephemeral port), so - ;; we pre-allocate a free port and pass it explicitly. The regex - ;; here is just a readiness signal -- the port we use is the one - ;; we picked, not whatever's in the banner. - :port-fn ,#'neat-it--free-port - :command-fn ,(lambda (port) - (list "let-go" "-n" "-p" (number-to-string port))) - :port-regexp "nREPL server started" - :startup-timeout 30)) - "Implementations the integration suite knows how to drive. - -Each entry is a plist: - :name human-readable label. - :executable the binary the suite skips if absent from PATH. - :command-fn returns the process command list. Called with no - args by default, or with a pre-allocated port when - `:port-fn' is provided. - :port-regexp regex matched against stdout. When `:port-fn' is - absent, group 1 must capture the port the server - chose; when `:port-fn' is provided, the match just - signals \"server is up\". - :port-fn optional zero-arg fn returning a free port the - framework reserves before launching. Use for - servers that don't reliably announce the OS-assigned - port back on stdout. - :startup-timeout seconds to wait for the readiness signal.") - - -;;;; Subprocess lifecycle +(require 'neat) + +(defconst neat-it--command + '("clojure" "-Sdeps" "{:deps {nrepl/nrepl {:mvn/version \"1.3.0\"}}}" + "-M" "-m" "nrepl.cmdline" "--port" "0") + "Command that starts the nREPL server the suite talks to.") + +(defconst neat-it--port-regexp "nREPL server started on port \\([0-9]+\\)" + "Regexp matching the server's banner; group 1 is the port.") + +(defconst neat-it--startup-timeout 120 + "Seconds to wait for the server banner.") + + +;;;; Server lifecycle (defvar neat-it--server-process nil) (defvar neat-it--server-port nil) (defvar neat-it--server-output "") -(defvar neat-it--server-ready nil) -(defvar neat-it--port-regexp nil) - -(defun neat-it--free-port () - "Return a TCP port number that's free on 127.0.0.1 right now. -There's a small race window between us closing the listener and the -subprocess claiming the port; on a quiet test machine it doesn't bite." - (let* ((proc (make-network-process - :name "neat-it-port-finder" - :host "127.0.0.1" - :service t - :server t - :family 'ipv4 - :noquery t)) - (port (process-contact proc :service))) - (delete-process proc) - port)) (defun neat-it--server-filter (_proc chunk) - "Watch the server's output CHUNK for the readiness signal. -Captures the port from regex group 1 when the port wasn't -pre-allocated; otherwise just flips `neat-it--server-ready' once -the banner appears." + "Collect the server's output CHUNK and pick the port out of the banner." (setq neat-it--server-output (concat neat-it--server-output chunk)) - (when (and (not neat-it--server-ready) + (when (and (not neat-it--server-port) (string-match neat-it--port-regexp neat-it--server-output)) - (unless neat-it--server-port - (setq neat-it--server-port - (string-to-number (match-string 1 neat-it--server-output)))) - (setq neat-it--server-ready t))) - -(defun neat-it--start-server (impl) - "Boot the nREPL server described by IMPL and return its port. -Errors out if the readiness banner doesn't appear within the impl's -timeout." - (let* ((port-fn (plist-get impl :port-fn)) - (port (and port-fn (funcall port-fn))) - (cmd (if port - (funcall (plist-get impl :command-fn) port) - (funcall (plist-get impl :command-fn)))) - (timeout (or (plist-get impl :startup-timeout) 60))) - (setq neat-it--server-port port - neat-it--server-output "" - neat-it--server-ready nil - neat-it--port-regexp (plist-get impl :port-regexp)) - (let ((proc (make-process - :name (format "neat-it-%s" (plist-get impl :name)) - :buffer nil - :command cmd - :filter #'neat-it--server-filter - :noquery t - :connection-type 'pipe))) - (setq neat-it--server-process proc) - (let ((deadline (+ (float-time) timeout))) - (while (and (not neat-it--server-ready) - (process-live-p proc) - (< (float-time) deadline)) - (accept-process-output proc 0.5)))) - (unless neat-it--server-ready - (error "Neat: %s nREPL server failed to start: %s" - (plist-get impl :name) neat-it--server-output)) - neat-it--server-port)) + (setq neat-it--server-port + (string-to-number (match-string 1 neat-it--server-output))))) + +(defun neat-it--start-server () + "Boot the nREPL server and return its port." + (setq neat-it--server-port nil + neat-it--server-output "" + neat-it--server-process + (make-process :name "neat-it-nrepl" + :buffer nil + :command neat-it--command + :filter #'neat-it--server-filter + :noquery t + :connection-type 'pipe)) + (let ((deadline (+ (float-time) neat-it--startup-timeout))) + (while (and (not neat-it--server-port) + (process-live-p neat-it--server-process) + (< (float-time) deadline)) + (accept-process-output neat-it--server-process 0.5))) + (or neat-it--server-port + (error "Neat: nREPL server failed to start: %s" + neat-it--server-output))) (defun neat-it--stop-server () "Terminate the test nREPL server, if any." @@ -156,108 +78,142 @@ timeout." (kill-process neat-it--server-process)) (setq neat-it--server-process nil neat-it--server-port nil - neat-it--server-output "" - neat-it--server-ready nil - neat-it--port-regexp nil)) + neat-it--server-output "")) + + +;;;; Helpers -(defun neat-it--wait-until (conn predicate &optional timeout) - "Pump CONN's process output until PREDICATE returns non-nil or TIMEOUT elapses. -TIMEOUT defaults to 10 seconds." - (let ((deadline (+ (float-time) (or timeout 10)))) +(defun neat-it--wait-until (predicate &optional timeout) + "Pump process output until PREDICATE returns non-nil. +Give up after TIMEOUT seconds (default 15). Return PREDICATE's +last value." + (let ((deadline (+ (float-time) (or timeout 15)))) (while (and (not (funcall predicate)) (< (float-time) deadline)) - (accept-process-output (neat-connection-process conn) 0.1)))) - - -;;;; Suite registration - -(when (getenv "NEAT_INTEGRATION") - (dolist (impl neat-it--server-impls) - (when (executable-find (plist-get impl :executable)) - ;; Fresh per-iteration binding so the lambdas inside the - ;; describe block close over THIS impl, not the dolist's - ;; shared slot. - (let ((impl impl)) - (describe (format "integration against %s nREPL" - (plist-get impl :name)) - :var (conn responses) - - (before-all - (neat-it--start-server impl)) - - (after-all - (neat-it--stop-server)) - - (before-each - (setq responses nil) - (setq conn (neat-connect "127.0.0.1" neat-it--server-port))) - - (after-each - (when conn - (ignore-errors (neat-disconnect conn)) - (setq conn nil))) - - (it "describes the server's capabilities" - (let (done) - (neat-describe - conn - (lambda (r) - (push r responses) - (when (member "done" (neat-bencode-get r "status")) - (setq done t)))) - (neat-it--wait-until conn (lambda () done) 15) - (expect done :to-be-truthy) - (expect (or (neat-bencode-get - (neat-connection-capabilities conn) "versions") - (neat-bencode-get - (neat-connection-capabilities conn) "ops")) - :not :to-be nil))) - - (it "clones a session and evaluates an expression" - (neat-clone-session conn) - (neat-it--wait-until - conn (lambda () (neat-connection-session conn)) 15) - (expect (neat-connection-session conn) :not :to-be nil) - - (let ((id (neat-eval - conn "(+ 1 2)" - :callback (lambda (r) (push r responses))))) - (neat-it--wait-until - conn (lambda () - (not (gethash id (neat-connection-pending conn)))) - 15) - (let ((value-resp (cl-find-if (lambda (r) - (neat-bencode-get r "value")) - responses))) - (expect value-resp :not :to-be nil) - (expect (neat-bencode-get value-resp "value") - :to-equal "3")))) - - (it "captures stdout from the evaluated code" - (neat-clone-session conn) - (neat-it--wait-until - conn (lambda () (neat-connection-session conn)) 15) - - (let ((id (neat-eval - conn "(do (println \"hi\") :ok)" - :callback (lambda (r) (push r responses))))) - (neat-it--wait-until - conn (lambda () - (not (gethash id (neat-connection-pending conn)))) - 15) - ;; Different implementations chunk `out' differently: - ;; Clojure batches "hi\\n", Basilisp splits it into "hi" - ;; and "\\n" messages. Concatenate everything we got. - (let ((all-out (mapconcat - (lambda (r) (or (neat-bencode-get r "out") "")) - (reverse responses) - "")) - (val-resp (cl-find-if - (lambda (r) (neat-bencode-get r "value")) - responses))) - (expect all-out :to-match "hi") - (expect val-resp :not :to-be nil) - (expect (neat-bencode-get val-resp "value") - :to-equal ":ok"))))))))) + (accept-process-output nil 0.1)) + (funcall predicate))) + +(defun neat-it--text () + "Return the current buffer's text without properties." + (buffer-substring-no-properties (point-min) (point-max))) + +(defun neat-it--type (code) + "Type CODE at the REPL prompt and submit it." + (goto-char (point-max)) + (insert code) + (neat-repl-return)) + +(defun neat-it--send (code) + "Submit CODE at the REPL prompt and wait for the next prompt." + (neat-it--type code) + (neat-it--wait-until (lambda () neat-repl--prompt-start))) + + +;;;; Suite + +(when (and (getenv "NEAT_INTEGRATION") + (executable-find (car neat-it--command))) + (describe "neat against nREPL" + :var (conn repl) + + (before-all + (neat-it--start-server)) + + (after-all + (neat-it--stop-server)) + + (before-each + (let ((neat-repl-history-file nil)) + (setq conn (neat "127.0.0.1" neat-it--server-port))) + (setq repl (neat-repl-buffer-for conn)) + (neat-it--wait-until + (lambda () + (and (neat-connection-session conn) + (neat-connection-capabilities conn) + (buffer-local-value 'neat-repl--prompt-start repl))))) + + (after-each + (when (buffer-live-p repl) + (kill-buffer repl)) + (when (neat-connection-live-p conn) + (neat-disconnect conn)) + (setq neat-default-connection nil + conn nil + repl nil)) + + (it "renders a value and a prompt in the REPL's namespace" + (with-current-buffer repl + (neat-it--send "(+ 1 2)") + (expect (neat-it--text) :to-match "\n3\nuser> \\'"))) + + (it "renders stdout ahead of the value" + (with-current-buffer repl + (neat-it--send "(do (println \"hi\") :ok)") + (expect (neat-it--text) :to-match "\nhi\n:ok\nuser> \\'"))) + + (it "follows in-ns in the prompt and in tooling ops" + (with-current-buffer repl + (neat-it--send "(in-ns 'neat.it)") + (expect (neat-it--text) :to-match "neat\\.it> \\'") + (expect (neat-connection-ns conn) :to-equal "neat.it"))) + + (it "answers need-input from the minibuffer" + (spy-on 'read-from-minibuffer :and-return-value "hello") + (with-current-buffer repl + (neat-it--send "(read-line)") + (expect 'read-from-minibuffer :to-have-been-called) + (expect (neat-it--text) :to-match "\n\"hello\"\nuser> \\'"))) + + (it "sends end-of-file from the stdin prompt" + (spy-on 'read-from-minibuffer + :and-call-fake (lambda (&rest _) + (setq neat-repl--stdin-eof t) + "")) + (with-current-buffer repl + (neat-it--send "(read-line)") + (expect (neat-it--text) :to-match "\nnil\nuser> \\'"))) + + (it "interrupts a running eval" + (with-current-buffer repl + (neat-it--type "(Thread/sleep 60000)") + ;; Give the eval a moment to actually start running. + (neat-it--wait-until #'ignore 1) + (expect (neat-eval-pending-p conn) :to-be-truthy) + (neat-repl-interrupt) + (expect (neat-it--wait-until (lambda () neat-repl--prompt-start)) + :to-be-truthy) + (expect (neat-eval-pending-p conn) :to-be nil))) + + (it "reports a namespace that doesn't exist" + (with-temp-buffer + (setq neat-ns "neat.no-such-ns") + (insert "(+ 1 2)") + (neat-eval-buffer)) + (with-current-buffer repl + (expect (neat-it--wait-until + (lambda () + (string-match-p ";; namespace not found: neat\\.no-such-ns" + (neat-it--text)))) + :to-be-truthy))) + + (it "reports an unknown session and clones a new one" + (spy-on 'y-or-n-p :and-return-value t) + (setf (neat-connection-session conn) "neat-no-such-session") + (with-current-buffer repl + (neat-it--send "(+ 1 2)") + (expect (neat-it--text) :to-match ";; unknown session\n") + (expect (neat-it--wait-until (lambda () (neat-connection-session conn))) + :to-be-truthy) + (neat-it--send "(+ 40 2)") + (expect (neat-it--text) :to-match "\n42\nuser> \\'"))) + + (it "shows output that arrives after the eval is done" + (with-current-buffer repl + (neat-it--send "(do (future (Thread/sleep 300) (println \"late\")) :ok)") + (expect (neat-it--wait-until + (lambda () (string-match-p "^late$" (neat-it--text)))) + :to-be-truthy) + ;; Above the prompt, not tacked on after it. + (expect (neat-it--text) :to-match "\n:ok\nlate\nuser> \\'"))))) ;;; neat-integration-test.el ends here From 9f0af3b74e313deb2b27ee58979ee81a5aa96093 Mon Sep 17 00:00:00 2001 From: Bozhidar Batsov Date: Thu, 1 Oct 2026 18:02:59 +0300 Subject: [PATCH 15/20] Put source-buffer results above the REPL prompt comint stopped dropping repeated prompts back in Emacs 27, so a source-buffer eval that finished while the REPL sat at a prompt stacked a second prompt on the same line, and any result went after the waiting prompt. That also left the prompt marker mid-line, so late output landed in the wrong place. Results of source-buffer evals now go above a waiting prompt, only input typed into the REPL gets a new prompt at done, and a prompt never goes in while another is waiting. When such an eval moves the session to another namespace, the waiting prompt gets updated to match. --- neat-repl.el | 56 ++++++++++++++------- test/neat-repl-test.el | 112 +++++++++++++++++++++++++++++++++-------- 2 files changed, 130 insertions(+), 38 deletions(-) diff --git a/neat-repl.el b/neat-repl.el index 1cae3b5..f6dff19 100644 --- a/neat-repl.el +++ b/neat-repl.el @@ -181,14 +181,30 @@ purpose is to satisfy `comint-output-filter' and friends." (defun neat-repl--insert-prompt () "Insert a fresh prompt at the end of the buffer. It starts on a line of its own, even after output that didn't end one -or after the dead prompt of an earlier connection in a reused buffer." +or after the dead prompt of an earlier connection in a reused buffer. +Does nothing while a prompt is already waiting for input, so two +requests finishing back to back don't leave two prompts behind." (let ((proc (get-buffer-process (current-buffer)))) - (when proc + (when (and proc (not neat-repl--prompt-start)) (unless (save-excursion (goto-char (process-mark proc)) (bolp)) (comint-output-filter proc "\n")) (setq neat-repl--prompt-start (copy-marker (process-mark proc))) (comint-output-filter proc (neat-repl--prompt))))) +(defun neat-repl--redraw-prompt () + "Bring a waiting prompt up to date with `neat-repl--current-ns'. +A source-buffer eval can move the session to another namespace while +the prompt sits there showing the old one. Anything typed after the +prompt stays as it is." + (let ((proc (get-buffer-process (current-buffer)))) + (when (and proc neat-repl--prompt-start + (marker-position neat-repl--prompt-start)) + (let ((inhibit-read-only t)) + (save-restriction + (widen) + (delete-region neat-repl--prompt-start (process-mark proc)))) + (comint-output-filter proc (neat-repl--prompt))))) + (defun neat-repl--emit-output (text face) "Insert TEXT in FACE above the prompt waiting for input. With no prompt showing (an eval from this buffer is still running) @@ -320,7 +336,7 @@ Otherwise insert a newline so the user can keep typing the form." ((string-empty-p trimmed) (neat-repl--insert-prompt)) (t - (let ((request (neat-repl--request-create))) + (let ((request (neat-repl--request-create :from-repl t))) (neat-eval conn trimmed :callback (lambda (resp) @@ -347,6 +363,9 @@ on the same dead connection are no-ops." (cl-defstruct (neat-repl--request (:constructor neat-repl--request-create) (:copier nil)) "Rendering state for one request whose responses land in a REPL buffer. +FROM-REPL is non-nil when the request is input typed into the REPL; +only those get a fresh prompt at `done'. + NS is the namespace the request named explicitly, if any. The prompt follows the `ns' a reply reports only when NS is nil. A request that names its own `ns' gets it bound for that one eval and then dropped, @@ -360,7 +379,7 @@ holds the last `ex' it reported, held back until `done' and dropped if `err' had something to say: Basilisp and jank put the whole traceback in both fields, and nREPL's `ex' is only the exception class, so `err' is the better of the two whenever there is one." - ns saw-err ex) + from-repl ns saw-err ex) (defun neat-repl--request-update (request resp) "Note RESP's `err' and `ex' on REQUEST and return what's due now. @@ -383,7 +402,11 @@ when nothing came on `err'. PROBLEM is the error status line from "Insert the user-visible parts of nREPL response RESP into the buffer. REQUEST is the `neat-repl--request' RESP answers; pass the same one for every response to a request. Without it RESP is rendered on its -own, and an `ex' only shows up if `done' comes in the same message." +own, and an `ex' only shows up if `done' comes in the same message. + +Output goes above the prompt when one is waiting for input, which is +where results of source-buffer evals land; only input typed into the +REPL gets a fresh prompt at `done'." (let* ((request (or request (neat-repl--request-create))) (proc (get-buffer-process (current-buffer))) (value (neat-bencode-get resp "value")) @@ -397,32 +420,30 @@ own, and an `ex' only shows up if `done' comes in the same message." ;; `namespace-not-found' reply names the namespace that isn't there. (when (and ns (not (neat-repl--request-ns request)) (not (member "namespace-not-found" status))) - (setq neat-repl--current-ns ns) + (unless (equal ns neat-repl--current-ns) + (setq neat-repl--current-ns ns) + (neat-repl--redraw-prompt)) (when neat-current-connection (setf (neat-connection-ns neat-current-connection) ns))) (when proc (when out - (comint-output-filter - proc (propertize out 'face 'neat-repl-output))) + (neat-repl--emit-output out 'neat-repl-output)) (when err - (comint-output-filter - proc (propertize err 'face 'neat-repl-error))) + (neat-repl--emit-output err 'neat-repl-error)) (when value - (comint-output-filter - proc (concat (propertize value 'face 'neat-repl-value) "\n"))) + (neat-repl--emit-output (concat value "\n") 'neat-repl-value)) (when (car due) - (comint-output-filter - proc (propertize (format "%s\n" (car due)) 'face 'neat-repl-error))) + (neat-repl--emit-output (format "%s\n" (car due)) 'neat-repl-error)) (when (cdr due) - (comint-output-filter - proc (propertize (format ";; %s\n" (cdr due)) 'face 'neat-repl-error))) + (neat-repl--emit-output (format ";; %s\n" (cdr due)) 'neat-repl-error)) (when neat-current-connection (neat-repl--answer-status neat-current-connection resp)) ;; A dead connection gets its own marker from ;; `neat-repl--handle-disconnect'; a prompt would only invite ;; input that has nowhere to go. (when (and (member "done" status) - (not (member "connection-closed" status))) + (not (member "connection-closed" status)) + (neat-repl--request-from-repl request)) (neat-repl--insert-prompt))))) (defun neat-repl--answer-status (conn resp) @@ -559,6 +580,7 @@ underlying connection." (interactive) (let ((inhibit-read-only t)) (erase-buffer) + (setq neat-repl--prompt-start nil) (neat-repl--insert-prompt))) (defun neat-repl--close-connection (conn &optional no-wait) diff --git a/test/neat-repl-test.el b/test/neat-repl-test.el index 85d5993..20c72f2 100644 --- a/test/neat-repl-test.el +++ b/test/neat-repl-test.el @@ -126,6 +126,7 @@ inserts text." ;; binds for that eval; the REPL is still wherever it was. (neat-repl-test--with-repl conn (setq neat-repl--current-ns "user") + (neat-repl--insert-prompt) (let ((request (neat-repl--request-create :ns "myapp.core"))) (dolist (resp '((("id" . "1") ("ns" . "myapp.core") ("value" . "nil")) (("id" . "1") ("status" "done")))) @@ -134,19 +135,38 @@ inserts text." (expect (neat-connection-ns conn) :to-be nil) (expect (neat-repl-test--text) :to-equal "nil\nuser> "))) + (it "redraws a waiting prompt when a source-buffer eval moves the session" + (neat-repl-test--with-repl _conn + (setq neat-repl--current-ns "user") + (neat-repl--insert-prompt) + (goto-char (point-max)) + (insert "(foo") + (neat-repl-test--render-all + '((("id" . "1") ("ns" . "myapp.core") ("value" . "nil")) + (("id" . "1") ("status" "done"))) + 'source) + (expect (neat-repl-test--text) :to-equal "nil\nmyapp.core> (foo") + (expect (buffer-substring-no-properties + neat-repl--prompt-start + (process-mark (get-buffer-process (current-buffer)))) + :to-equal "myapp.core> "))) + (it "follows a source-buffer eval that named no ns" ;; Say it ran `(ns myapp.core)': the session really moved. (neat-repl-test--with-repl conn (setq neat-repl--current-ns "user") (neat-repl-test--render-all '((("id" . "1") ("ns" . "myapp.core") ("value" . "nil")) - (("id" . "1") ("status" "done")))) + (("id" . "1") ("status" "done"))) + 'source) (expect neat-repl--current-ns :to-equal "myapp.core") (expect (neat-connection-ns conn) :to-equal "myapp.core")))) -(defun neat-repl-test--render-all (responses) - "Render RESPONSES in order as replies to one request." - (let ((request (neat-repl--request-create))) +(defun neat-repl-test--render-all (responses &optional source) + "Render RESPONSES in order as replies to one request. +The request counts as input typed into the REPL, unless SOURCE is +non-nil, in which case it's a source-buffer eval." + (let ((request (neat-repl--request-create :from-repl (not source)))) (dolist (resp responses) (neat-repl--render-response resp request)))) @@ -193,30 +213,78 @@ inserts text." (expect (neat-repl-test--text) :to-equal "boom\nneat> ") (expect (get-text-property 1 'face) :to-be 'neat-repl-error))) - (it "shows ex and done arriving together without a request" + (it "shows ex and done arriving together in one message" (neat-repl-test--with-repl _conn - (neat-repl--render-response - '(("id" . "1") ("ex" . "boom") ("status" "eval-error" "done"))) + (neat-repl-test--render-all + '((("id" . "1") ("ex" . "boom") ("status" "eval-error" "done")))) (expect (neat-repl-test--text) :to-equal "boom\nneat> ")))) +(describe "neat-repl--render-response (source-buffer evals)" + (it "puts the result above the waiting prompt instead of after it" + (neat-repl-test--with-repl _conn + (neat-repl--insert-prompt) + (neat-repl-test--render-all + '((("id" . "1") ("out" . "hi\n")) + (("id" . "1") ("value" . "3")) + (("id" . "1") ("status" "done"))) + 'source) + (expect (neat-repl-test--text) :to-equal "hi\n3\nneat> "))) + + (it "leaves a single prompt when there's nothing to show" + (neat-repl-test--with-repl _conn + (neat-repl--insert-prompt) + (neat-repl-test--render-all '((("id" . "1") ("status" "done"))) 'source) + (expect (neat-repl-test--text) :to-equal "neat> "))) + + (it "doesn't prompt while input typed into the REPL is still running" + (neat-repl-test--with-repl _conn + (neat-repl--insert-prompt) + ;; What sending input does. + (setq neat-repl--prompt-start nil) + (neat-repl-test--render-all + '((("id" . "2") ("value" . "3")) (("id" . "2") ("status" "done"))) + 'source) + (expect (neat-repl-test--text) :to-equal "neat> 3\n") + (neat-repl-test--render-all '((("id" . "1") ("status" "done")))) + (expect (neat-repl-test--text) :to-equal "neat> 3\nneat> ")))) + +(describe "neat-repl--insert-prompt" + (it "doesn't stack a second prompt on one that's waiting" + (neat-repl-test--with-repl _conn + (neat-repl--insert-prompt) + (neat-repl--insert-prompt) + (expect (neat-repl-test--text) :to-equal "neat> "))) + + (it "comes back after clearing the buffer" + (neat-repl-test--with-repl conn + (neat-repl--insert-prompt) + (neat-repl--handle-unhandled-message conn '(("out" . "noise\n"))) + (neat-repl-clear-buffer) + (expect (neat-repl-test--text) :to-equal "neat> ") + (neat-repl--handle-unhandled-message conn '(("out" . "late\n"))) + (expect (neat-repl-test--text) :to-equal "late\nneat> ")))) + (describe "neat-repl--render-response (error statuses)" (it "shows namespace-not-found as a comment line" + ;; Typically a source buffer's `neat-ns' with a typo in it. (neat-repl-test--with-repl _conn - (neat-repl--render-response - '(("id" . "1") ("ns" . "my.typo") - ("status" "done" "error" "namespace-not-found"))) + (neat-repl--insert-prompt) + (neat-repl-test--render-all + '((("id" . "1") ("ns" . "my.typo") + ("status" "done" "error" "namespace-not-found"))) + 'source) (expect (neat-repl-test--text) :to-equal ";; namespace not found: my.typo\nneat> "))) (it "shows unknown-op as a comment line" (neat-repl-test--with-repl _conn - (neat-repl--render-response - '(("id" . "1") ("status" "error" "unknown-op" "done"))) + (neat-repl-test--render-all + '((("id" . "1") ("status" "error" "unknown-op" "done")))) (expect (neat-repl-test--text) :to-equal ";; unknown op\nneat> "))) (it "shows a bare error as a comment line" (neat-repl-test--with-repl _conn - (neat-repl--render-response '(("id" . "1") ("status" "error" "done"))) + (neat-repl-test--render-all '((("id" . "1") ("status" "error" "done")))) (expect (neat-repl-test--text) :to-equal ";; error\nneat> "))) (it "doesn't add a bare error line after err already explained it" @@ -254,9 +322,9 @@ inserts text." (spy-on 'neat-connection-live-p :and-return-value t) (spy-on 'y-or-n-p :and-return-value t) (spy-on 'neat-clone-session) - (neat-repl--render-response - '(("id" . "1") ("session" . "gone") - ("status" "error" "unknown-session" "done"))) + (neat-repl-test--render-all + '((("id" . "1") ("session" . "gone") + ("status" "error" "unknown-session" "done")))) (expect (neat-repl-test--text) :to-equal ";; unknown session\nneat> ") (expect (neat-connection-session conn) :to-be nil) (expect 'neat-clone-session :to-have-been-called-with conn))) @@ -286,13 +354,13 @@ inserts text." (describe "neat-repl--render-response (connection-closed)" (it "inserts a prompt on a normal done" (neat-repl-test--with-repl _conn - (neat-repl--render-response '(("id" . "1") ("status" "done"))) + (neat-repl-test--render-all '((("id" . "1") ("status" "done")))) (expect (neat-repl-test--text) :to-equal "neat> "))) (it "doesn't prompt for input on the synthesized connection-closed done" (neat-repl-test--with-repl _conn - (neat-repl--render-response - '(("id" . "1") ("status" "done" "connection-closed"))) + (neat-repl-test--render-all + '((("id" . "1") ("status" "done" "connection-closed")))) (expect (neat-repl-test--text) :to-equal "")))) (describe "neat-repl--handle-unhandled-message" @@ -323,8 +391,10 @@ inserts text." (it "keeps landing above the prompt after an eval finishes" (neat-repl-test--with-repl conn (neat-repl--insert-prompt) - (neat-repl--render-response '(("id" . "1") ("value" . "3"))) - (neat-repl--render-response '(("id" . "1") ("status" "done"))) + ;; What sending input does. + (setq neat-repl--prompt-start nil) + (neat-repl-test--render-all + '((("id" . "1") ("value" . "3")) (("id" . "1") ("status" "done")))) (neat-repl--handle-unhandled-message conn '(("out" . "late\n"))) (expect (neat-repl-test--text) :to-equal "neat> 3\nlate\nneat> "))) From 67c3497bc53868fb828d6a94e4b719172ce70ad1 Mon Sep 17 00:00:00 2001 From: Bozhidar Batsov Date: Thu, 1 Oct 2026 17:18:30 +0300 Subject: [PATCH 16/20] Don't let C-g at a callback's prompt leave the request stuck quit isn't an error, so C-g at the clone-a-new-session prompt went straight past the callback guard and skipped the cleanup after it. The request stayed pending and looked like an eval in flight, which kept completion and eldoc off until the connection closed. Finished requests are now removed before the callback runs, and C-g at that prompt just means no. --- neat-client.el | 18 ++++++++++-------- neat-repl.el | 7 +++++-- test/neat-client-test.el | 11 +++++++++++ test/neat-repl-test.el | 12 ++++++++++++ 4 files changed, 38 insertions(+), 10 deletions(-) diff --git a/neat-client.el b/neat-client.el index 602d0d3..6ee6cfd 100644 --- a/neat-client.el +++ b/neat-client.el @@ -738,7 +738,7 @@ reply gets a `done' added if it lacks one, since nothing more can come for a request the server has no session for. A message without a callback goes to `neat-unhandled-message-functions'. When the response's status contains `done' the callback entry is pruned -afterwards." +before the callback runs." (neat-client--log conn :in message) (if (not (neat-bencode-dict-p message)) (neat-client--log conn :note '(skipped "not a dict")) @@ -756,6 +756,14 @@ afterwards." (let* ((id (neat-bencode-get message "id")) (status (neat-bencode-get message "status")) (callback (and id (gethash id (neat-connection-pending conn))))) + ;; Prune before the callback runs: one that gets quit out of + ;; (C-g at a prompt it opened) must not leave its request behind. + (when (and id (member "done" status)) + (remhash id (neat-connection-pending conn)) + (setf (neat-connection-evals conn) + (delete id (neat-connection-evals conn))) + (unless (neat-connection-evals conn) + (setf (neat-connection-stalled conn) nil))) (if callback ;; Don't let a buggy callback nuke the whole filter. Skip the ;; trap when the user is debugging, so `toggle-debug-on-error' @@ -765,13 +773,7 @@ afterwards." (error (message "neat: callback error: %S" err))) (with-demoted-errors "neat: unhandled message hook: %S" (run-hook-with-args 'neat-unhandled-message-functions - conn message))) - (when (and id (member "done" status)) - (remhash id (neat-connection-pending conn)) - (setf (neat-connection-evals conn) - (delete id (neat-connection-evals conn))) - (unless (neat-connection-evals conn) - (setf (neat-connection-stalled conn) nil)))))) + conn message)))))) (defun neat-client--sentinel (proc _event) "Sentinel for nREPL connection PROC. Delegates to `neat-client--cleanup'." diff --git a/neat-repl.el b/neat-repl.el index f6dff19..8e3cae4 100644 --- a/neat-repl.el +++ b/neat-repl.el @@ -478,8 +478,11 @@ whatever comes next starts out somewhere else." ((buffer-live-p buf))) (with-current-buffer buf (setq neat-repl--current-ns nil))) - (when (y-or-n-p - "Neat: the server doesn't know this session; clone a new one? ") + ;; C-g here means no, not a quit out of the process filter. + (when (condition-case nil + (y-or-n-p + "Neat: the server doesn't know this session; clone a new one? ") + (quit nil)) (neat-clone-session conn))))) (defun neat-repl--handle-unhandled-message (conn message) diff --git a/test/neat-client-test.el b/test/neat-client-test.el index d3e01e5..8d028f2 100644 --- a/test/neat-client-test.el +++ b/test/neat-client-test.el @@ -219,6 +219,17 @@ conn (neat-bencode-encode '(("id" . "1") ("out" . "x")))) (expect seen :to-be nil))) + (it "prunes a finished request even when its callback is quit out of" + (let ((conn (neat-connection--make :host "h" :port 1 :evals '("1")))) + (puthash "1" (lambda (_) (signal 'quit nil)) + (neat-connection-pending conn)) + (condition-case nil + (neat-client-test--push-bytes + conn (neat-bencode-encode '(("id" . "1") ("status" "done")))) + (quit nil)) + (expect (gethash "1" (neat-connection-pending conn)) :to-be nil) + (expect (neat-eval-pending-p conn) :to-be nil))) + (it "survives a hook function that errors (production semantics)" (let ((neat-unhandled-message-functions (list (lambda (_c _m) (error "boom")))) diff --git a/test/neat-repl-test.el b/test/neat-repl-test.el index 20c72f2..28783d9 100644 --- a/test/neat-repl-test.el +++ b/test/neat-repl-test.el @@ -340,6 +340,18 @@ non-nil, in which case it's a source-buffer eval." (expect (neat-connection-session conn) :to-be nil) (expect 'neat-clone-session :not :to-have-been-called))) + (it "takes C-g at the offer as a no" + (neat-repl-test--with-repl conn + (setf (neat-connection-session conn) "gone") + (spy-on 'neat-connection-live-p :and-return-value t) + (spy-on 'y-or-n-p :and-call-fake (lambda (&rest _) (signal 'quit nil))) + (spy-on 'neat-clone-session) + (expect (neat-repl-test--render-all + '((("id" . "1") ("status" "error" "unknown-session" "done")))) + :not :to-throw) + (expect (neat-connection-session conn) :to-be nil) + (expect 'neat-clone-session :not :to-have-been-called))) + (it "leaves the session alone when the reply names a different one" (neat-repl-test--with-repl conn (setf (neat-connection-session conn) "mine") From e3353fef2d91f2a46a4a51f914405cda9a2cca10 Mon Sep 17 00:00:00 2001 From: Bozhidar Batsov Date: Thu, 1 Oct 2026 18:02:15 +0300 Subject: [PATCH 17/20] Drop the connection even when the close-on-quit wait is interrupted C-g during the short wait for the close reply went past ignore-errors, so the REPL never disconnected and the connection stayed up with its session already cleared. The shared sync helper also skipped removing its callback on C-g. Both cleanups now run from unwind-protect, while a wait that's cut short (a quit, or a completion UI's while-no-input) still isn't treated as the server being stuck. --- neat-client.el | 21 +++++++++++++-------- neat-repl.el | 20 +++++++++++--------- test/neat-client-test.el | 32 ++++++++++++++++++++++++++++++++ test/neat-repl-test.el | 10 ++++++++++ 4 files changed, 66 insertions(+), 17 deletions(-) diff --git a/neat-client.el b/neat-client.el index 6ee6cfd..037ace3 100644 --- a/neat-client.el +++ b/neat-client.el @@ -554,9 +554,10 @@ CONN's process output for up to TIMEOUT seconds. Returns the responses that arrived, in the order they came: all of them once `done' arrives, or whatever came before TIMEOUT ran out. If the connection went away first, the last one is neat's own -`connection-closed' reply (see `neat-send'). Giving up unregisters -the callback, so a reply that never comes doesn't leave it behind in -the pending table." +`connection-closed' reply (see `neat-send'). Giving up, on the +timeout or on \\[keyboard-quit], unregisters the callback, so a reply +that never comes doesn't leave it behind in the pending table. Only +a real timeout counts toward `neat-tooling-stalled-p'." (let ((deadline (+ (float-time) timeout)) responses done) (let ((id (funcall send @@ -564,11 +565,15 @@ the pending table." (push resp responses) (when (member "done" (neat-bencode-get resp "status")) (setq done t)))))) - (while (and (not done) - (< (float-time) deadline)) - (accept-process-output (neat-connection-process conn) 0.05)) - (unless done - (remhash id (neat-connection-pending conn))) + (unwind-protect + (while (and (not done) + (< (float-time) deadline)) + (accept-process-output (neat-connection-process conn) 0.05)) + (unless done + (remhash id (neat-connection-pending conn)))) + ;; Only reached when the wait ended by itself: a quit, or the + ;; throw `while-no-input' does for a completion UI, says nothing + ;; about the server. (neat-client--note-tooling conn done)) (nreverse responses))) diff --git a/neat-repl.el b/neat-repl.el index 8e3cae4..426f890 100644 --- a/neat-repl.el +++ b/neat-repl.el @@ -590,15 +590,17 @@ underlying connection." "Close CONN's session on the server, then disconnect CONN. Without the `close' the session would outlive the REPL on the server. Unless NO-WAIT is non-nil we wait briefly for the server to confirm, -so its reply doesn't run into a socket that's already gone." - (when (and (neat-connection-live-p conn) - (neat-connection-session conn) - (neat-op-supported-p conn "close")) - (ignore-errors - (if no-wait - (neat-close-session conn) - (neat-close-session-sync conn)))) - (neat-disconnect conn)) +so its reply doesn't run into a socket that's already gone. Cutting +the wait short with \\[keyboard-quit] still disconnects." + (unwind-protect + (when (and (neat-connection-live-p conn) + (neat-connection-session conn) + (neat-op-supported-p conn "close")) + (ignore-errors + (if no-wait + (neat-close-session conn) + (neat-close-session-sync conn)))) + (neat-disconnect conn))) (defun neat-repl-quit () "Close the REPL's session, disconnect, and bury this buffer." diff --git a/test/neat-client-test.el b/test/neat-client-test.el index 8d028f2..adfd5ea 100644 --- a/test/neat-client-test.el +++ b/test/neat-client-test.el @@ -294,6 +294,38 @@ (expect (hash-table-count (neat-connection-pending conn)) :to-equal 0)))) + (it "don't take a wait cut short for a stalled server" + ;; A quit, or the throw `while-no-input' does when a completion UI + ;; gets new input, says nothing about the server. + (let ((conn (neat-connection--make :evals '("5")))) + (cl-letf (((symbol-function 'process-live-p) (lambda (_) t)) + ((symbol-function 'process-send-string) #'ignore) + ((symbol-function 'accept-process-output) + (lambda (&rest _) (throw 'neat-test-input t)))) + (catch 'neat-test-input + (neat-completions-sync conn "ma" nil 1)) + (expect (neat-connection-stalled conn) :to-be nil) + (condition-case nil + (cl-letf (((symbol-function 'accept-process-output) + (lambda (&rest _) (signal 'quit nil)))) + (neat-completions-sync conn "ma" nil 1)) + (quit nil)) + (expect (neat-connection-stalled conn) :to-be nil) + (expect (hash-table-count (neat-connection-pending conn)) + :to-equal 0)))) + + (it "unregister the callback when the wait is quit out of" + (let ((conn (neat-connection--make))) + (cl-letf (((symbol-function 'process-live-p) (lambda (_) t)) + ((symbol-function 'process-send-string) #'ignore) + ((symbol-function 'accept-process-output) + (lambda (&rest _) (signal 'quit nil)))) + (condition-case nil + (neat-completions-sync conn "ma" nil 1) + (quit nil)) + (expect (hash-table-count (neat-connection-pending conn)) + :to-equal 0)))) + (it "return what arrived before done" (let ((conn (neat-connection--make))) (cl-letf (((symbol-function 'process-live-p) (lambda (_) t)) diff --git a/test/neat-repl-test.el b/test/neat-repl-test.el index 28783d9..814ecf0 100644 --- a/test/neat-repl-test.el +++ b/test/neat-repl-test.el @@ -663,6 +663,16 @@ non-nil, in which case it's a source-buffer eval." (neat-repl--kill-buffer-cleanup) (expect (nreverse calls) :to-equal '((close-no-wait "S-2") disconnect)))) + (it "still disconnects when the close wait is quit out of" + (neat-repl-test--with-repl conn + (setf (neat-connection-session conn) "S-4") + (spy-on 'neat-close-session-sync + :and-call-fake (lambda (&rest _) (signal 'quit nil))) + (condition-case nil + (neat-repl--close-connection conn) + (quit nil)) + (expect calls :to-equal '(disconnect)))) + (it "just disconnects when there's no session to close" (neat-repl-test--with-repl _conn (spy-on 'bury-buffer) From faa21c35c2ef84d6e69c41c35885ce9f0f118c04 Mon Sep 17 00:00:00 2001 From: Bozhidar Batsov Date: Thu, 1 Oct 2026 16:34:05 +0300 Subject: [PATCH 18/20] Open the stdin and new-session prompts inside a busy minibuffer need-input can arrive while the user is in the minibuffer, and without recursive minibuffers read-from-minibuffer just signals. No stdin went out and the eval waited forever. Both prompts that come up from the process filter now allow a recursive minibuffer. --- neat-repl.el | 12 ++++++++---- test/neat-repl-test.el | 25 +++++++++++++++++++++++++ 2 files changed, 33 insertions(+), 4 deletions(-) diff --git a/neat-repl.el b/neat-repl.el index 426f890..3fd67da 100644 --- a/neat-repl.el +++ b/neat-repl.el @@ -480,8 +480,9 @@ whatever comes next starts out somewhere else." (setq neat-repl--current-ns nil))) ;; C-g here means no, not a quit out of the process filter. (when (condition-case nil - (y-or-n-p - "Neat: the server doesn't know this session; clone a new one? ") + (let ((enable-recursive-minibuffers t)) + (y-or-n-p + "Neat: the server lost this session; clone a new one? ")) (quit nil)) (neat-clone-session conn))))) @@ -531,9 +532,12 @@ be CONN's current one. A trailing newline is appended so \\\\[neat-repl-stdin-eof] at the prompt sends \ end-of-file (an empty `stdin') instead. `C-g' interrupts the eval, or sends end-of-file when the server can't -interrupt, so the eval doesn't sit waiting forever." +interrupt, so the eval doesn't sit waiting forever. The prompt opens +even when the minibuffer is already in use, since `need-input' can +turn up at any moment." (let ((session (neat-bencode-get resp "session")) - (neat-repl--stdin-eof nil)) + (neat-repl--stdin-eof nil) + (enable-recursive-minibuffers t)) (condition-case nil (let ((input (read-from-minibuffer (substitute-command-keys diff --git a/test/neat-repl-test.el b/test/neat-repl-test.el index 814ecf0..7a6f883 100644 --- a/test/neat-repl-test.el +++ b/test/neat-repl-test.el @@ -340,6 +340,20 @@ non-nil, in which case it's a source-buffer eval." (expect (neat-connection-session conn) :to-be nil) (expect 'neat-clone-session :not :to-have-been-called))) + (it "asks even when the minibuffer is already in use" + (neat-repl-test--with-repl conn + (let (recursive) + (setf (neat-connection-session conn) "gone") + (spy-on 'neat-connection-live-p :and-return-value t) + (spy-on 'y-or-n-p :and-call-fake + (lambda (&rest _) + (setq recursive enable-recursive-minibuffers) + nil)) + (let ((enable-recursive-minibuffers nil)) + (neat-repl-test--render-all + '((("id" . "1") ("status" "error" "unknown-session" "done"))))) + (expect recursive :to-be-truthy)))) + (it "takes C-g at the offer as a no" (neat-repl-test--with-repl conn (setf (neat-connection-session conn) "gone") @@ -583,6 +597,17 @@ non-nil, in which case it's a source-buffer eval." (neat-repl--handle-need-input conn need-input) (expect 'neat-stdin :to-have-been-called-with conn "" :session "S-eval")) + (it "prompts even when the minibuffer is already in use" + (let (recursive) + (spy-on 'read-from-minibuffer + :and-call-fake (lambda (&rest _) + (setq recursive enable-recursive-minibuffers) + "x")) + (spy-on 'neat-stdin) + (let ((enable-recursive-minibuffers nil)) + (neat-repl--handle-need-input conn need-input)) + (expect recursive :to-be-truthy))) + (it "binds the end-of-file key in the prompt's keymap" (expect (lookup-key neat-repl-stdin-map (kbd "C-c C-d")) :to-be 'neat-repl-stdin-eof)) From 333ecdc8fb0055eeffbceb0c8101c84b1237ae05 Mon Sep 17 00:00:00 2001 From: Bozhidar Batsov Date: Thu, 1 Oct 2026 18:03:23 +0300 Subject: [PATCH 19/20] Add the hooks for closed connections when their files load The autoloads put neat-repl--handle-disconnect and neat--connections-buffer-refresh on neat-disconnect-functions before either function exists, so code using neat-client on its own got a void-function error, turned into a message, every time a connection closed. Both hooks now go on when their file loads, as the unhandled-message hook does, instead of from the autoloads. --- neat-repl.el | 2 +- neat.el | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/neat-repl.el b/neat-repl.el index 3fd67da..afb0b7e 100644 --- a/neat-repl.el +++ b/neat-repl.el @@ -357,7 +357,7 @@ on the same dead connection are no-ops." (neat-repl--emit-output ";; connection closed\n" 'neat-repl-error)))))) -;;;###autoload +;; Not autoloaded, for the same reason as the hook below. (add-hook 'neat-disconnect-functions #'neat-repl--handle-disconnect) (cl-defstruct (neat-repl--request (:constructor neat-repl--request-create) diff --git a/neat.el b/neat.el index 7e90ed8..f18e70b 100644 --- a/neat.el +++ b/neat.el @@ -162,7 +162,8 @@ disconnects it, \\[neat-connections-refresh] reloads from (when (derived-mode-p 'neat-connections-mode) (neat-connections-refresh))))) -;;;###autoload +;; Not autoloaded: the function only exists once this file is loaded, +;; and the buffer it refreshes can't exist before that either. (add-hook 'neat-disconnect-functions #'neat--connections-buffer-refresh) ;;;###autoload From 006187376cf9c3771a24f4667df30b4d0935335a Mon Sep 17 00:00:00 2001 From: Bozhidar Batsov Date: Fri, 2 Oct 2026 12:57:40 +0300 Subject: [PATCH 20/20] Add CHANGELOG entry for the protocol fixes --- CHANGELOG.md | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index c0bae1d..41c70e1 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,6 +6,16 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.1.0/). ## [Unreleased] +### Changed + +- [#2](https://github.com/nrepl/neat/pull/2): Handle the less common parts of the protocol properly: + - Late and id-less output shows up above the REPL prompt, and so do the results of source-buffer evals. + - Error statuses that come without an `err` (`namespace-not-found`, `unknown-session`, `unknown-op`) are reported, and an `unknown-session` reply offers to clone a new session. + - The stdin prompt can send end of input with `C-c C-d`. + - Completion, eldoc and interrupt check `describe` first, and completion and eldoc back off on servers that answer one request at a time. + - Quitting the REPL closes its session on the server. + - Requests still pending when a connection drops get a `connection-closed` status instead of `interrupted`, and `neat-bencode-encode` signals on nil. + ## [0.1.0] - 2026-05-20 ### Added