From 698af5cb7dae1b018f9ad6fe33cddf0f19b41250 Mon Sep 17 00:00:00 2001 From: Marcin Gasperowicz Date: Thu, 24 Sep 2026 00:42:23 +0100 Subject: [PATCH 1/5] test: make test/run.lg actually run the suite let-go's run-tests now defaults to *ns* like Clojure's, so the bare (run-tests) in test.run ran 0 tests and reported success. Co-Authored-By: Claude Opus 5.5 --- test/run.lg | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/test/run.lg b/test/run.lg index 76a8411..9cc55a7 100644 --- a/test/run.lg +++ b/test/run.lg @@ -1,5 +1,5 @@ (ns test.run - (:require [test :refer [run-tests]] + (:require [test :refer [run-all-tests]] [test.buffer-test] [test.keys-test] [test.keymap-test] @@ -31,4 +31,5 @@ [test.acme-extension-test] [test.vibe-test])) -(run-tests) +;; run-tests with no args only tests *ns* (test.run itself, which has none). +(run-all-tests #"test\..*-test") From e4ef3f0f8a252cd9c616f53130ee0b7c90c811aa Mon Sep 17 00:00:00 2001 From: Marcin Gasperowicz Date: Thu, 24 Sep 2026 00:47:44 +0100 Subject: [PATCH 2/5] feat: nREPL client as an eval backend for every let-go-mode eval command C-c M-c connects (pre-filled from the nearest .nrepl-port that lg -n writes), C-c C-q disconnects. While connected, C-x C-e, C-j, C-c C-v and C-c C-e send their source to the server; the let-go-mode lighter reads nrepl. - letgo: all eval commands now build one backend request (:op :eval/:load). In-process stays synchronous; any other backend runs the command through spawn-task. Remote results are printed-result (server's printed text plus captured output). C-j and C-c C-v verify the form is still in the same buffer before writing. - nrepl: blocking bencode round trips over net, serialized by a channel-token lock inside the job future, so no persistent reader goroutine for the main loop to poll. Errors are cleaned to the message plus caused-by chain; an eval in a namespace the server hasn't loaded (let-go falls back to user silently) gets a note. - tests against a fake bencode server on a loopback socket. Co-Authored-By: Claude Opus 5.5 --- CLAUDE.md | 21 ++- README.md | 2 + docs/GUIDE.md | 48 +++++-- legmacs/modes/letgo.lg | 285 +++++++++++++++++++++++++++++------------ legmacs/nrepl.lg | 272 +++++++++++++++++++++++++++++++++++++++ main.lg | 1 + test/nrepl_test.lg | 215 +++++++++++++++++++++++++++++++ test/run.lg | 3 +- 8 files changed, 754 insertions(+), 93 deletions(-) create mode 100644 legmacs/nrepl.lg create mode 100644 test/nrepl_test.lg diff --git a/CLAUDE.md b/CLAUDE.md index dde1fbc..5c27daa 100644 --- a/CLAUDE.md +++ b/CLAUDE.md @@ -42,9 +42,12 @@ lg test/run.lg Run a single test namespace (faster iteration than the full suite): ```sh -lg -e "(require '[test :refer [run-tests]] '[test.region-test]) (run-tests)" +lg -e "(require '[test :refer [run-tests]] '[test.region-test]) (run-tests 'test.region-test)" ``` +(`run-tests` with no arguments tests only `*ns*`, like Clojure's, so name +the namespace -- a bare `(run-tests)` reports 0 tests and success.) + There's no separate build/lint step — `lg` interprets `.lg` source directly. `test/run.lg` is a hand-maintained list of every test namespace; adding a new `test/*_test.lg` file means adding its namespace to that `:require` @@ -254,10 +257,18 @@ form at point, highlights it, snapshots its source, and evaluates it through `bufs/spawn-task`. Completion verifies that the source span is unchanged before replacing it. Ordinary values use `pr-str`; functions that need source-aware application return `replacement-result` with a registered -result-kind handler. This async/result seam is also the intended boundary -for a future nREPL backend: `register-eval-backend!` installs an async-safe -`(fn [request] -> value)` and `use-eval-backend!` selects it. Requests carry -the source plus filename/column/namespace context; backends never touch live +result-kind handler. The same seam carries every other eval command: all four build one +request (`:op` `:eval`/`:load`, `:source`, `:forms`, `:state`, and +filename/line/column/namespace `:context`) and hand it to the selected +backend. With `:in-process` selected, `C-x C-e`/`C-j`/`C-c C-e` still eval +synchronously on the main thread (so editor-scripting forms take effect +before the next frame); any other backend makes them `spawn-task` jobs too. +Remote backends return `printed-result` (text the server printed, plus +captured output) since the value never existed in this VM. `legmacs.nrepl` +is that backend for nREPL: one blocking bencode round trip per request, +serialized by a channel-token lock, inside the job's future -- so no +long-lived reader goroutine exists for `loop-wait` to keep polling. The +`*repl*` buffer deliberately stays in-process. Backends never touch live buffer state. `legmacs.vibe/vibe` uses that protocol rather than owning a special key diff --git a/README.md b/README.md index 8a8dade..a8ba06d 100644 --- a/README.md +++ b/README.md @@ -38,6 +38,8 @@ started: form (or select several), evaluate it without blocking the editor, and replace the source with its result; the active form is highlighted while it runs +- an nREPL client (`C-c M-c`): point it at `lg -n` and the same eval keys + run in that process instead of the editor's - a dedicated `*repl*` buffer (`C-c C-z`), for when you want an actual running transcript instead of building one by hand with `C-j` - `(vibe "...")`: write what you want where you want it, then use the same diff --git a/docs/GUIDE.md b/docs/GUIDE.md index 4509883..1f73285 100644 --- a/docs/GUIDE.md +++ b/docs/GUIDE.md @@ -236,6 +236,8 @@ forms that aren't also valid let-go: | `C-j` | evaluate the s-expression before point, insert the result right there | | `C-c C-v` | asynchronously evaluate the region or form at point and replace it with the result | | `C-c C-e` | evaluate the whole buffer | +| `C-c M-c` | connect to an nREPL server; every eval key above then runs there (see [nREPL](#nrepl)) | +| `C-c C-q` | disconnect from nREPL, back to in-process eval | | `RET` | newline, aligned under the form it's inside | | `TAB` | re-indent the current line the same way | | `C-c e` | expand the selection outward (word → sexp → next sexp up → ...) | @@ -412,14 +414,43 @@ frame is painted*, so the replacement shows up without a keystroke. C-g discards the result (it does not abort the request). A throw in the apply step is an echo-area message, not a crash. The mode line shows `evaluating...` so you still know work is in flight after the echo area has been cleared -by typing. The same async boundary is where a future nREPL evaluator plugs -in: form discovery, highlighting, stale-source checks, and main-thread -application do not depend on the in-process backend. Register an -async-safe `(fn [request] -> value)` with `register-eval-backend!` and select -it with `use-eval-backend!`; the request carries `:source` plus filename, -column, and namespace context. An nREPL backend can therefore send source -and map its response to a value or `(replacement-result :source text)` when -the server has already printed a replacement-ready value. +by typing. The same async boundary is where other evaluators plug in: form +discovery, highlighting, stale-source checks, and main-thread application +do not depend on the in-process backend. Register an async-safe +`(fn [request] -> value)` with `register-eval-backend!` and select it with +`use-eval-backend!`; the request carries `:op` (`:eval`, or `:load` for +`C-c C-e`), `:source`, and filename/line/column/namespace context. A +backend whose server has already printed the value returns +`(printed-result text out)`, which `C-c C-v` splices verbatim and the +other commands show verbatim. While any backend other than `:in-process` +is selected, `C-x C-e`, `C-j` and `C-c C-e` go through it asynchronously +too, and the let-go-mode lighter names it. + +### nREPL + +[`legmacs/nrepl.lg`](../legmacs/nrepl.lg) is the one such backend that +ships. Start a server next to your project with `lg -n` (it writes +`.nrepl-port`), then `C-c M-c` (`M-x nrepl-connect`) in a let-go buffer: +the prompt is pre-filled from the nearest `.nrepl-port` at or above the +buffer's directory, and a bare port means localhost. From then on: + +- `C-x C-e` / `C-j` / `C-c C-v` send the form with the buffer's `ns`, + file, line and column; `C-c C-e` is the server's `load-file` +- anything the form printed shows in the echo area above `=> value` +- a server error is an ordinary `Eval error:` with the message and its + `caused by:` chain on one line (the source excerpt and stack are dropped) +- evaluating in a namespace the server hasn't loaded yet says so: let-go's + server quietly falls back to `user` instead of failing, so defs would + otherwise land somewhere unexpected. `C-c C-e` the file once first +- `C-j` checks the form is still where it was before inserting, like + `C-c C-v` does, and both check you're still in the same buffer + +`C-c C-q` (`M-x nrepl-disconnect`) goes back to in-process eval. The +`*repl*` buffer always stays in-process: it is the editor's own REPL. +Requests are one blocking round trip at a time inside the usual +`spawn-task` future, so there is no background reader for the main loop to +poll; `C-g` drops a pending result but the server still finishes the +request (let-go's server doesn't implement `interrupt` yet). Any file ending in `.md` or `.markdown` opens into **markdown-mode** (highlighting only, no key bindings of its own, so every global key still @@ -819,6 +850,7 @@ Set `LEGMACS_CONFIG_DIR` to use a different directory than | [`legmacs/lisp_syntax.lg`](../legmacs/lisp_syntax.lg) | Pure bracket/string/comment scanner. What paren matching, syntax highlighting, auto-indent, and expand-region are all built on. | | [`legmacs/modes/letgo.lg`](../legmacs/modes/letgo.lg) | let-go-mode: structural form discovery, in-process eval, async eval-and-replace, syntax highlighting, paren matching, auto-indent, expand-region, auto-paired brackets. Registered for `*scratch*`, `.lg` files, and (syntax-only) `.clj`/`.cljc`/`.cljs`/`.bb`/`.edn` files. | | [`legmacs/modes/repl.lg`](../legmacs/modes/repl.lg) | The `*repl*` buffer (`C-c C-z`): plain let-go-mode plus a `:repl` minor mode that reinterprets `RET` as evaluate-if-complete, else newline-and-indent. | +| [`legmacs/nrepl.lg`](../legmacs/nrepl.lg) | nREPL client (`C-c M-c` / `C-c C-q`): bencode round trips over `net`, registered as the `:nrepl` eval backend so every let-go-mode eval command runs on the server while connected. | | [`legmacs/vibe.lg`](../legmacs/vibe.lg) | `(vibe "...")`: ask an LLM for let-go code, deriving surrounding-buffer context when invoked by generic `C-c C-v`, then use a tagged eval-result handler to rewrite namespaces and add missing `(:require ...)`s. | | [`legmacs/modes/markdown.lg`](../legmacs/modes/markdown.lg) | markdown-mode: syntax highlighting only (headers, emphasis, code, links, quotes, lists, rules, and fenced code blocks carried across lines). Registered for `.md`/`.markdown` files. | | [`legmacs/modes/prog.lg`](../legmacs/modes/prog.lg) | The language pack: one spec-driven line scanner (comments, strings, keyword/type/constant sets, `#directives`, `$variables`, call sites, and multi-line strings carried across lines) behind major modes for Go, JS/TS, Python, C/C++, shell, rc, Rust, JSON, YAML, TOML, Lua, Ruby, SQL, Dockerfile, CSS, HTML, Zig, Java, Kotlin, Swift, C#, PHP, and Makefile. `register-prog-mode!` is the one-call way to add a language; the same spec map also becomes the mode's `:syntax-spec`. | diff --git a/legmacs/modes/letgo.lg b/legmacs/modes/letgo.lg index 9f0f958..37e4c26 100644 --- a/legmacs/modes/letgo.lg +++ b/legmacs/modes/letgo.lg @@ -497,35 +497,189 @@ (defn- clear-highlight [state highlight] (if (= highlight (:eval-highlight state)) (dissoc state :eval-highlight) state)) -(defn- run-eval [state f] - (let [[status start end _source forms] (eval-selection state)] +;; --- eval backends ------------------------------------------------------ +;; +;; Every eval command builds one request map and hands it to the selected +;; backend: +;; +;; {:op :eval | :load ; :load is eval-buffer's whole-file load +;; :source the text to evaluate +;; :forms read forms (:eval only; the in-process backend wants them) +;; :state the buffer snapshot (in-process only; remote backends ignore it) +;; :context {:text :source :start :end :filename :line :column :namespace}} +;; +;; The in-process backend is also the synchronous one: while it is selected +;; C-x C-e / C-j / C-c C-e eval right on the main thread, exactly as before +;; backends existed, so editor-scripting forms like (km/bind-key! ...) take +;; effect before the next frame. Any other backend (nREPL) runs every +;; command through bufs/spawn-task and applies the result when it lands. +;; A remote result is a printed-result -- the text the server already +;; printed, plus any captured output -- since its value never existed in +;; this VM to pr-str. + +(defn- load-preserving-ns + "load-in-editor `source`, putting *ns* back afterwards. Its own named fn + so callers' conditionals contain a call, not a capturing fn literal + (let-go AOT hoist, nooga/let-go#766)." + [source] + (preserving-ns (fn [] (load-in-editor source)))) + +(defn- in-process-eval-backend + "The built-in evaluator backend: eval the request's forms in this VM." + [{:keys [op state forms source context]}] + (binding [*eval-replace-context* context] + (if (= op :load) + (load-preserving-ns source) + (reduce (fn [_ form] (eval-form-in-state state form)) nil forms)))) + +(def eval-backends + "Registered eval backend functions, each (fn [request-map] -> value). + Backends run inside the generic async job and must not mutate buffers." + (atom {:in-process in-process-eval-backend})) + +(def current-eval-backend + "The backend every eval command uses. Kept as data so an nREPL client can + install and select itself without replacing the command or key binding." + (atom :in-process)) + +(defn register-eval-backend! + "Register an async-safe evaluator function under `name`." + [name evaluator] + (swap! eval-backends assoc name evaluator) + name) + +(defn use-eval-backend! + "Select a registered evaluator backend. Returns name, or nil if unknown." + [name] + (when (contains? @eval-backends name) + (reset! current-eval-backend name))) + +(defn remote-eval-backend? + "True when evals leave this VM, i.e. go async through bufs/spawn-task." + [] + (not= :in-process @current-eval-backend)) + +(defn- eval-backend-status + "let-go-mode lighter: names the backend, but only when it isn't the + default in-process one." + [_state] + (when (remote-eval-backend?) (name @current-eval-backend))) + +(defn printed-result + "What a remote backend returns: `text` is the value as the server printed + it; `out` is output captured during the eval (nil or \"\" for none). + Spliced verbatim by C-c C-v, shown verbatim by the other commands." + ([text] (printed-result text nil)) + ([text out] + (cond-> (replacement-result :source text) + (not (string/blank? out)) (assoc :legmacs.eval/out out)))) + +(defn- result-text + "The printed form of an eval result: a printed-result's own text, or + pr-str of an ordinary value." + [v] + (if (and (replacement-result? v) (= :source (:legmacs.eval/kind v))) + (:legmacs.eval/text v) + (format-result v))) + +(defn- result-message + "Echo-area text for a result: captured output (if any), then `=> value`." + [v] + (let [out (when (map? v) (:legmacs.eval/out v)) + line (str "=> " (result-text v))] + (if out (str (string/trimr out) "\n" line) line))) + +(defn- eval-error-message [e] + (str "Eval error: " (or (ex-message e) (str e)))) + +(defn- eval-request + "The backend request for [start end) of `state`, read into `forms`." + [state op start end source forms] + (let [[row column] (buf/row-col-of state start)] + {:op op :state state :forms forms :source source + :context {:text (buf/buffer-text state) :source source :start start :end end + :filename (:filename state) :line (inc row) :column column + :namespace (buffer-ns-name state)}})) + +(defn- eval-backend-value [request] + (if-let [backend (get @eval-backends @current-eval-backend)] + (backend request) + (throw (str "Unknown eval backend " (pr-str @current-eval-backend))))) + +(defn- eval-backend-io [request] + (fn [] (eval-backend-value request))) + +(defn- span-intact? + "Did the job's source survive until its result landed? Same buffer, and + [start end) still holds exactly `source`." + [state buffer-id start end source] + (let [text (buf/buffer-text state)] + (and (= buffer-id (:current-buffer-id state)) + (<= end (count text)) + (= source (subs text start end))))) + +(defn- resolve-remote-eval + "Main-thread completion of an async C-x C-e / C-j. `f` is the same + (fn [state start end forms result]) the synchronous path calls; when + `needs-span?` (C-j inserts after the form), a moved form or a buffer + switch reports instead of inserting into the wrong place." + [state f needs-span? buffer-id start end source forms highlight outcome] + (let [state (clear-highlight state highlight)] + (cond + (contains? outcome :err) (assoc state :message (eval-error-message (:err outcome))) + (and needs-span? (not (span-intact? state buffer-id start end source))) + (assoc state :message (str "Eval: form moved before it completed; " + (result-message (:ok outcome)))) + :else (f state start end forms (:ok outcome))))) + +(defn- remote-eval-then [f needs-span? buffer-id start end source forms highlight] + (fn [state outcome] + (resolve-remote-eval state f needs-span? buffer-id start end source forms highlight outcome))) + +(defn- run-eval-remote [state f needs-span? start end source forms] + (let [highlight {:start start :end end :sticky? true}] + (bufs/spawn-task (assoc state :eval-highlight highlight) + (eval-backend-io (eval-request state :eval start end source forms)) + (remote-eval-then f needs-span? (:current-buffer-id state) + start end source forms highlight) + "evaluating..."))) + +(defn- run-eval-local [state f start end forms] + (try + (f (highlight-span state start end false) + start end forms + (reduce (fn [_ form] (eval-form-in-state state form)) nil forms)) + (catch e (-> state + (highlight-span start end false) + (assoc :message (eval-error-message e)))))) + +(defn- run-eval [state needs-span? f] + (let [[status start end source forms] (eval-selection state)] (case status :none (assoc state :message "No preceding sexp") :error (assoc state :message (str "Read error: " forms)) - (try - (f (highlight-span state start end false) - start end forms - (reduce (fn [_ form] (eval-form-in-state state form)) nil forms)) - (catch e (-> state - (highlight-span start end false) - (assoc :message (str "Eval error: " (or (ex-message e) (str e)))))))))) + (if (remote-eval-backend?) + (run-eval-remote state f needs-span? start end source forms) + (run-eval-local state f start end forms))))) (defcommand eval-last-sexp "Evaluate the s-expression immediately before point; show the result in the echo area, like Emacs's C-x C-e." [state] - (run-eval state (fn [state _start _end _form result] - (assoc state :message (str "=> " (format-result result)))))) + (run-eval state false + (fn [state _start _end _form result] + (assoc state :message (result-message result))))) (defcommand eval-print-last-sexp "Evaluate the s-expression immediately before point and insert the result right after it, like Emacs's C-j in lisp-interaction-mode -- this is what makes *scratch* feel like a REPL transcript." [state] - (run-eval state (fn [state _start end _form result] - (let [[row col] (buf/row-col-of state end)] - (buf/insert-string (assoc state :cursor-row row :cursor-col col) - (str "\n" (format-result result))))))) + (run-eval state true + (fn [state _start end _form result] + (let [[row col] (buf/row-col-of state end)] + (buf/insert-string (assoc state :cursor-row row :cursor-col col) + (str "\n" (result-text result))))))) (defn- splice-offsets "Replace a flat [start end) span with text as one undo step." @@ -543,7 +697,9 @@ (defn- apply-source-result [state start end result] (-> (splice-offsets state start end (:legmacs.eval/text result)) - (assoc :message "Evaluated and replaced"))) + (assoc :message (if-let [out (:legmacs.eval/out result)] + (str (string/trimr out) "\nEvaluated and replaced") + "Evaluated and replaced")))) (register-eval-result-handler! :source apply-source-result) @@ -555,54 +711,16 @@ (-> (splice-offsets state start end (format-result result)) (assoc :message "Evaluated and replaced")))) -(defn- in-process-eval-backend - "The built-in evaluator backend. A future nREPL backend receives the same - request map but can use :source/:namespace without touching editor state." - [{:keys [state forms context]}] - (binding [*eval-replace-context* context] - (reduce (fn [_ form] (eval-form-in-state state form)) nil forms))) - -(def eval-backends - "Registered eval backend functions, each (fn [request-map] -> value). - Backends run inside the generic async job and must not mutate buffers." - (atom {:in-process in-process-eval-backend})) - -(def current-eval-backend - "The backend used by C-c C-v. Kept as data so an nREPL client can install - and select itself without replacing the command or key binding." - (atom :in-process)) - -(defn register-eval-backend! - "Register an async-safe evaluator function under `name`." - [name evaluator] - (swap! eval-backends assoc name evaluator) - name) - -(defn use-eval-backend! - "Select a registered evaluator backend. Returns name, or nil if unknown." - [name] - (when (contains? @eval-backends name) - (reset! current-eval-backend name))) - -(defn- eval-replace-value [request] - (if-let [backend (get @eval-backends @current-eval-backend)] - (backend request) - (throw (str "Unknown eval backend " (pr-str @current-eval-backend))))) - -(defn- eval-replace-io [request] - (fn [] (eval-replace-value request))) - -(defn- resolve-eval-replace [state start end source highlight outcome] +(defn- resolve-eval-replace [state buffer-id start end source highlight outcome] (let [state (clear-highlight state highlight)] - (if-let [err (:err outcome)] - (assoc state :message (str "Eval error: " (or (ex-message err) (str err)))) - (let [text (buf/buffer-text state)] - (if-not (and (<= end (count text)) (= source (subs text start end))) - (assoc state :message "Eval: form moved before it completed") - (apply-replacement-result state start end (:ok outcome))))))) + (cond + (contains? outcome :err) (assoc state :message (eval-error-message (:err outcome))) + (not (span-intact? state buffer-id start end source)) + (assoc state :message "Eval: form moved before it completed") + :else (apply-replacement-result state start end (:ok outcome))))) -(defn- eval-replace-then [start end source highlight] - (fn [state outcome] (resolve-eval-replace state start end source highlight outcome))) +(defn- eval-replace-then [buffer-id start end source highlight] + (fn [state outcome] (resolve-eval-replace state buffer-id start end source highlight outcome))) (defcommand eval-replace-sexp "Evaluate the region or s-expression at point asynchronously and replace @@ -616,27 +734,35 @@ (case status :none (assoc state :message "No s-expression at point") :error (assoc state :message (str "Read error: " forms)) - (let [text (buf/buffer-text state) - [_row column] (buf/row-col-of state start) - context {:text text :source source :start start :end end - :filename (:filename state) :column column - :namespace (buffer-ns-name state)} - request {:state state :forms forms :source source :context context} - highlight {:start start :end end :sticky? true} - state (assoc state :eval-highlight highlight)] - (bufs/spawn-task state - (eval-replace-io request) - (eval-replace-then start end source highlight) + (let [highlight {:start start :end end :sticky? true}] + (bufs/spawn-task (assoc state :eval-highlight highlight) + (eval-backend-io (eval-request state :eval start end source forms)) + (eval-replace-then (:current-buffer-id state) start end source highlight) "evaluating...")))))) +(defn- resolve-eval-buffer [state outcome] + (if (contains? outcome :err) + (assoc state :message (eval-error-message (:err outcome))) + (assoc state :message (result-message (:ok outcome))))) + +(defn- eval-buffer-remote [state] + (let [text (buf/buffer-text state)] + (bufs/spawn-task state + (eval-backend-io (eval-request state :load 0 (count text) text nil)) + resolve-eval-buffer + "loading buffer..."))) + (defcommand eval-buffer "Evaluate the entire buffer, top to bottom, form by form in the current - namespace (or the buffer's ns form, restored afterwards)." + namespace (or the buffer's ns form, restored afterwards). With a remote + backend this is the server's load-file." [state] - (try - (let [result (preserving-ns (fn [] (load-in-editor (buf/buffer-text state))))] - (assoc state :message (str "=> " (format-result result)))) - (catch e (assoc state :message (str "Eval error: " (or (ex-message e) (str e))))))) + (if (remote-eval-backend?) + (eval-buffer-remote state) + (try + (let [result (load-preserving-ns (buf/buffer-text state))] + (assoc state :message (result-message result))) + (catch e (assoc state :message (eval-error-message e)))))) ;; --- auto-indent -------------------------------------------------------- ;; @@ -806,7 +932,8 @@ {:highlighter highlight-line :highlight-line highlight-line-carry :highlight-carry highlight-carry - :after-command update-paren-match}) + :after-command update-paren-match + :status eval-backend-status}) (modes/register-auto-mode! ".lg" :let-go) ;; let-go is a Clojure dialect, and shares its reader syntax closely enough ;; (parens/brackets/braces, `;` line comments, `"`-delimited strings) that diff --git a/legmacs/nrepl.lg b/legmacs/nrepl.lg new file mode 100644 index 0000000..2d50db5 --- /dev/null +++ b/legmacs/nrepl.lg @@ -0,0 +1,272 @@ +(ns legmacs.nrepl + "nREPL client: talk to a running let-go (or any bencode nREPL) server + and make it the eval backend for every let-go-mode eval command. + + M-x nrepl-connect (C-c M-c) reads host:port -- defaulting to the + nearest .nrepl-port above the buffer's directory, which `lg -n` writes + -- clones a session, and selects the :nrepl backend in + legmacs.modes.letgo. From then on C-x C-e, C-j, C-c C-v and C-c C-e + send their source to the server instead of evaluating in the editor's + own VM; the let-go-mode lighter reads `nrepl` while that holds. + M-x nrepl-disconnect (C-c C-q) closes the socket and goes back to + in-process eval. The *repl* buffer stays in-process on purpose: it is + the editor's own REPL. + + The wire half is deliberately one blocking round trip at a time: + `request` takes the connection's lock, writes one message, and reads + replies until the one carrying our id says `done`. Backends already + run inside a bufs/spawn-task future, so blocking there costs the editor + nothing, and there is no long-lived reader goroutine for the main loop + to keep polling for. C-g drops a pending result as it does for any + async job; the request itself still finishes on the server." + (:require [string] + [async] + [net] + [bencode] + [legmacs.buffer :as buf] + [legmacs.buffers :as bufs] + [legmacs.keymap :as km :refer [defcommand]] + [legmacs.minibuffer :as mb] + [legmacs.path :as path] + [legmacs.modes.letgo :as letgo])) + +(def default-port 2137) + +;; --- pure helpers -------------------------------------------------------- + +(defn parse-address + "\"7888\", \"host:7888\", or \"host\" -> [host port]; nil when the port + part isn't a number. Blank input means localhost on `fallback-port`." + [s fallback-port] + (let [s (string/trim (or s "")) + [host port] (if (string/includes? s ":") + (let [i (string/last-index-of s ":")] + [(subs s 0 i) (subs s (inc i))]) + (if (re-matches #"\d+" s) ["" s] [s nil])) + host (if (string/blank? host) "127.0.0.1" host) + port (if (string/blank? port) + fallback-port + (try (parse-long port) (catch e nil)))] + (when port [host port]))) + +(defn- ansi-free [s] + (string/replace s #"\x1b\[[0-9;]*m" "")) + +(defn- excerpt-line? + "Where let-go's diagnostic stops being message and starts being the + source excerpt / stack trace." + [line] + (or (string/starts-with? line "-->") + (string/starts-with? line "|") + (string/starts-with? line "stack trace") + (re-matches #"\d+\s*\|.*" line))) + +(defn clean-error + "let-go's `err` text is a colored, multi-line diagnostic: a message and + its `caused by:` chain, then a source excerpt and stack. The echo area + wants the chain on one uncolored line, without the redundant `error:` + tag -- the cause is usually the useful half (\"compiling function + position: Can't resolve sq in this context\")." + [err] + (let [lines (->> (string/split (ansi-free (or err "")) "\n") + (map string/trim) + (remove string/blank?) + (take-while (complement excerpt-line?)) + (map #(string/replace % #"^(error|caused by):\s*" "")))] + (if (seq lines) (string/join ": " lines) "nREPL error"))) + +(defn done? [reply] + (boolean (some #{"done"} (get reply "status")))) + +(defn combine-replies + "Fold every reply to one request into {:value :ns :out :err :ex :status}. + `value` and `ns` keep the last one (a multi-form eval answers once per + form); `out`/`err` concatenate; `status` collects every flag. Keys the + server never sent stay absent." + [replies] + (reduce (fn [acc r] + (cond-> acc + (get r "value") (assoc :value (get r "value")) + (get r "ns") (assoc :ns (get r "ns")) + (get r "out") (update :out str (get r "out")) + (get r "err") (update :err str (get r "err")) + (get r "ex") (assoc :ex (get r "ex")) + (get r "status") (update :status into (get r "status")))) + {:status #{}} + replies)) + +(defn eval-failed? + "An error reply: an explicit eval-error status, or err text with no value + (let-go's server sends the latter)." + [combined] + (boolean (or (contains? (:status combined) "eval-error") + (and (:err combined) (nil? (:value combined)))))) + +(defn- ns-note + "let-go's server evaluates in `user` rather than failing when asked for a + namespace it has never seen. Say so, since otherwise defs silently land + in the wrong place." + [requested combined] + (when (and requested (:ns combined) (not= (str requested) (:ns combined))) + (str "(evaluated in " (:ns combined) ": " requested + " isn't loaded on the server -- C-c C-e loads the buffer)"))) + +(defn reply->result + "A combined reply as what letgo's eval commands expect: a printed-result, + or a throw carrying the cleaned-up error. `requested-ns` (a symbol or + nil) is what the request asked for." + [combined requested-ns] + (if (eval-failed? combined) + (throw (ex-info (clean-error (:err combined)) combined)) + (let [note (ns-note requested-ns combined) + out (string/join "\n" (remove string/blank? [(:out combined) note]))] + (letgo/printed-result (or (:value combined) "nil") out)))) + +(defn eval-message + "The bencode message for an eval request map (see legmacs.modes.letgo's + eval-backends comment). Bencode has no nil, so absent context stays + absent rather than being sent empty." + [{:keys [op source context]}] + (let [{:keys [namespace filename line column]} context + file (when filename (path/absolute-path filename))] + (if (= op :load) + (cond-> {:op "load-file" :file source} + file (assoc :file-path file + :file-name (last (string/split file "/")))) + (cond-> {:op "eval" :code source} + namespace (assoc :ns (str namespace)) + file (assoc :file file) + line (assoc :line line) + column (assoc :column (inc column)))))) + +(defn find-port-file + "The nearest `.nrepl-port` at or above `dir`, as its trimmed contents, + or nil." + [dir] + (loop [dir (path/absolute-path (or dir "."))] + (let [text (try (slurp (path/join dir ".nrepl-port")) (catch e nil))] + (cond + (and text (not (string/blank? text))) (string/trim text) + (or (= dir "/") (string/blank? dir)) nil + :else (let [up (path/dirname dir)] + (when (not= up dir) (recur up))))))) + +;; --- the wire ------------------------------------------------------------ + +(defn- new-lock [] + (let [ch (async/chan 1)] + (async/>!! ch :token) + ch)) + +(defn- with-lock + "Run `thunk` holding `lock`. The reify-outcome shape (not `finally`) so + the token goes back even when thunk throws -- see CLAUDE.md's `finally` + gotcha." + [lock thunk] + (async/!! lock :token) + (if (contains? outcome :err) (throw (:err outcome)) (:ok outcome)))) + +(defn- read-replies + "Read until the reply for `id` that says done; replies for other ids + (stragglers from an earlier, abandoned request) are skipped." + [socket id] + (loop [acc []] + (let [reply (bencode/read! socket)] + (cond + (nil? reply) (throw "nREPL connection closed") + (not= id (get reply "id")) (recur acc) + (done? reply) (conj acc reply) + :else (recur (conj acc reply)))))) + +(defn- round-trip [conn msg] + (let [id (str (swap! (:next-id conn) inc))] + (bencode/write! (:socket conn) + (cond-> (assoc msg :id id) + (:session conn) (assoc :session (:session conn)))) + (read-replies (:socket conn) id))) + +(defn request + "Send `msg` (keyword keys, no nils) and return every reply to it, in order. + Blocks; one request at a time per connection." + [conn msg] + (with-lock (:lock conn) (fn [] (round-trip conn msg)))) + +(defn open-connection + "Dial host:port and clone a session. Throws when either fails." + [host port] + (let [conn {:socket (net/dial host port) :host host :port port + :lock (new-lock) :next-id (atom 0)} + session (some #(get % "new-session") (request conn {:op "clone"}))] + (assoc conn :session session))) + +(defn close-connection [conn] + (try (net/close! (:socket conn)) (catch e nil)) + nil) + +(def connection + "The live connection map, or nil. Global like the eval backend it feeds: + every let-go buffer evaluates against the same server." + (atom nil)) + +(defn connected? [] (some? @connection)) + +(defn nrepl-backend + "The :nrepl eval backend: (fn [request] -> printed-result)." + [req] + (let [conn (or @connection (throw "Not connected to nREPL"))] + (-> (combine-replies (request conn (eval-message req))) + ;; a load *is* the fix the ns note suggests, so it never gets one + (reply->result (when (not= :load (:op req)) + (get-in req [:context :namespace])))))) + +(letgo/register-eval-backend! :nrepl nrepl-backend) + +;; --- commands ------------------------------------------------------------ + +(defn- disconnect! [] + (when-let [conn @connection] + (close-connection conn)) + (reset! connection nil) + (letgo/use-eval-backend! :in-process)) + +(defn- label [conn] (str (:host conn) ":" (:port conn))) + +(defn- resolve-connect [state outcome] + (if-let [err (:err outcome)] + (assoc state :message (str "nREPL connect failed: " (or (ex-message err) (str err)))) + (let [conn (:ok outcome)] + (disconnect!) + (reset! connection conn) + (letgo/use-eval-backend! :nrepl) + (assoc state :message (str "Connected to nREPL at " (label conn)))))) + +(defn- connect-io [host port] + (fn [] (open-connection host port))) + +(defn- submit-address [state input] + (if-let [[host port] (parse-address input default-port)] + (bufs/spawn-task state (connect-io host port) resolve-connect + (str "Connecting to " host ":" port "...")) + (assoc state :message (str "Not a host:port: " input)))) + +(defcommand nrepl-connect + "Connect to an nREPL server and evaluate let-go buffers there. Prompts + for host:port, pre-filled from the nearest .nrepl-port (`lg -n` writes + one); a bare port means localhost." + [state] + (let [found (find-port-file (path/default-directory state))] + (mb/open state "nREPL (host:port): " submit-address + {:initial (if found (str "localhost:" found) "")}))) + +(defcommand nrepl-disconnect + "Close the nREPL connection; evaluation goes back to the editor's VM." + [state] + (if-let [conn @connection] + (do (disconnect!) + (assoc state :message (str "Disconnected from " (label conn)))) + (assoc state :message "Not connected to nREPL"))) + +(km/bind-key! letgo/keymap "C-c M-c" :nrepl-connect) +(km/bind-key! letgo/keymap "C-c C-q" :nrepl-disconnect) diff --git a/main.lg b/main.lg index c11e714..dd1f0e1 100644 --- a/main.lg +++ b/main.lg @@ -27,6 +27,7 @@ [legmacs.modes.crutch] [legmacs.modes.keycast] [legmacs.modes.help] + [legmacs.nrepl] ;; :refer, not just :as -- (vibe "...") typed into a buffer is ;; read and evaluated *in this namespace* (see legmacs.modes.letgo's ;; docstring). vibe.lg also intern's `vibe` into let-go.core so a diff --git a/test/nrepl_test.lg b/test/nrepl_test.lg new file mode 100644 index 0000000..32fc739 --- /dev/null +++ b/test/nrepl_test.lg @@ -0,0 +1,215 @@ +(ns test.nrepl-test + (:require [test :refer :all] + [string] + [os] + [net] + [bencode] + [legmacs.buffer :as buf] + [legmacs.modes :as modes] + [legmacs.modes.letgo :as lg-mode] + [legmacs.nrepl :as nrepl])) + +;; The pure half is tested directly; the wire half against a fake server +;; on a real loopback socket, so bencode framing, ids and sessions are the +;; genuine article. Nothing here needs `lg -n` running. + +(def esc (str (char 27))) + +(deftest parse-address-cases + (is (= ["127.0.0.1" 7888] (nrepl/parse-address "7888" 1))) + (is (= ["localhost" 7888] (nrepl/parse-address " localhost:7888 " 1))) + (is (= ["box" 2137] (nrepl/parse-address "box" 2137))) + (is (= ["127.0.0.1" 2137] (nrepl/parse-address "" 2137))) + (is (nil? (nrepl/parse-address "box:nope" 2137)))) + +(deftest clean-error-keeps-the-message-chain + (is (= "divide by zero" + (nrepl/clean-error (str esc "[1;31merror:" esc "[0m divide by zero\n" + " " esc "[1;34m-->" esc "[0m :1:1\n")))) + (is (= "compiling function position: Can't resolve sq in this context" + (nrepl/clean-error (str esc "[1;31merror:" esc "[0m compiling function position\n" + "caused by: Can't resolve sq in this context\n" + " " esc "[1;34m-->" esc "[0m :1:1\n" + " " esc "[1;34m|" esc "[0m\n" + " " esc "[1;34m1" esc "[0m " esc "[1;34m|" esc "[0m (sq 12)\n")))) + (is (= "Syntax error" (nrepl/clean-error "\n\n Syntax error\n"))) + (is (= "nREPL error" (nrepl/clean-error nil)))) + +(deftest combine-replies-folds-one-request + (let [c (nrepl/combine-replies [{"id" "2" "out" "a\n"} + {"id" "2" "value" "1" "ns" "user"} + {"id" "2" "out" "b\n"} + {"id" "2" "value" "#'user/f" "ns" "user"} + {"id" "2" "status" ["done"]}])] + (is (= "#'user/f" (:value c))) + (is (= "a\nb\n" (:out c))) + (is (= #{"done"} (:status c))) + (is (not (contains? c :err))) + (is (not (nrepl/eval-failed? c)))) + (testing "let-go signals failure as err with no value" + (is (nrepl/eval-failed? (nrepl/combine-replies [{"err" "boom"} {"status" ["done"]}])))) + (testing "other servers use an eval-error status" + (is (nrepl/eval-failed? (nrepl/combine-replies [{"status" ["eval-error"]} {"status" ["done"]}]))))) + +(deftest reply->result-cases + (testing "a value becomes a printed-result C-c C-v splices verbatim" + (let [r (nrepl/reply->result {:value "{:a 1}" :ns "user" :status #{"done"}} nil)] + (is (= "{:a 1}" (:legmacs.eval/text r))) + (is (= :source (:legmacs.eval/kind r))) + (is (nil? (:legmacs.eval/out r))))) + (testing "output rides along" + (is (= "hi\n" (:legmacs.eval/out (nrepl/reply->result {:value "nil" :out "hi\n"} nil))))) + (testing "an unknown ns fell back to user: say so" + (is (string/includes? (:legmacs.eval/out (nrepl/reply->result {:value "3" :ns "user"} 'my.ns)) + "my.ns isn't loaded"))) + (testing "an error throws its cleaned message" + (is (= "divide by zero" + (try (nrepl/reply->result {:err "error: divide by zero\n --> x"} nil) + (catch e (ex-message e))))))) + +(deftest eval-message-carries-context-and-no-nils + (is (= {:op "eval" :code "(+ 1 2)"} + (nrepl/eval-message {:op :eval :source "(+ 1 2)" :context {}}))) + (is (= {:op "eval" :code "(f)" :ns "my.ns" :file "/src/a.lg" :line 3 :column 5} + (nrepl/eval-message {:op :eval :source "(f)" + :context {:namespace 'my.ns :filename "/src/a.lg" + :line 3 :column 4}}))) + (is (= {:op "load-file" :file "(ns a)" :file-path "/src/a.lg" :file-name "a.lg"} + (nrepl/eval-message {:op :load :source "(ns a)" :context {:filename "/src/a.lg"}})))) + +(deftest find-port-file-walks-up + (let [root (str (os/temp-dir) "legmacs-nrepl-test-" (rand-int 1000000)) + deep (str root "/a/b")] + (os/sh "mkdir" "-p" deep) + (try + (spit (str root "/.nrepl-port") "7888\n") + (is (= "7888" (nrepl/find-port-file deep))) + (is (= "7888" (nrepl/find-port-file root))) + (finally (os/delete-tree root))))) + +;; --- fake server ---------------------------------------------------------- + +(defn- reply! [c msg m] + (bencode/write! c (assoc m "id" (get msg "id") "session" (get msg "session" "")))) + +(defn- serve-one! [c msg] + (let [op (get msg "op") + code (or (get msg "code") (get msg "file")) + ns (get msg "ns" "user")] + (case op + "clone" (reply! c msg {"new-session" "sess-1" "status" ["done"]}) + ("eval" "load-file") + (do + ;; a straggler for some other id first: the client must skip it + (bencode/write! c {"id" "stale" "value" "wrong"}) + (cond + (= code "(boom)") + (reply! c msg {"err" (str esc "[1;31merror:" esc "[0m kaboom\n --> x") "ex" "E"}) + :else + (do (when (string/includes? code "println") + (reply! c msg {"out" "hi\n"})) + (reply! c msg {"value" (str "v:" code) "ns" ns}))) + (reply! c msg {"status" ["done"]})) + (reply! c msg {"status" ["done" "unknown-op"]})))) + +(defn- start-fake-server + "Serve one connection on a free loopback port. Returns {:port :seen} where + :seen is an atom of every message received." + [] + (let [listener (net/listen "127.0.0.1" 0) + seen (atom [])] + (future + (let [c (net/accept listener)] + (loop [] + (when-let [msg (try (bencode/read! c) (catch e nil))] + (swap! seen conj msg) + (serve-one! c msg) + (recur))) + (net/close! listener))) + {:port (:port (net/local-address listener)) :seen seen})) + +(defn- settle-first-job [state] + (let [job (first (:async-jobs state)) + outcome (deref (:promise job))] + ((:then job) (assoc state :async-jobs nil) outcome))) + +(defn- with-fake-connection [f] + (let [{:keys [port seen]} (start-fake-server) + old @lg-mode/current-eval-backend + conn (nrepl/open-connection "127.0.0.1" port)] + (reset! nrepl/connection conn) + (lg-mode/use-eval-backend! :nrepl) + (let [outcome (try {:ok (f conn seen)} (catch e {:err e}))] + (nrepl/close-connection conn) + (reset! nrepl/connection nil) + (reset! lg-mode/current-eval-backend old) + (when (contains? outcome :err) (throw (:err outcome))) + (:ok outcome)))) + +(defn- lg-buffer [lines col] + (-> (buf/new-state "/src/demo.lg" lines) + (modes/switch-to-mode :let-go) + (assoc :cursor-col col))) + +(deftest wire-round-trips + (with-fake-connection + (fn [conn seen] + (testing "clone gave us a session every later message carries" + (is (= "sess-1" (:session conn))) + (nrepl/request conn {:op "eval" :code "(+ 1 2)"}) + (is (= "sess-1" (get (last @seen) "session")))) + (testing "replies are this request's only, ending at done" + (let [replies (nrepl/request conn {:op "eval" :code "(+ 1 2)"})] + (is (= ["v:(+ 1 2)" nil] (mapv #(get % "value") replies))) + (is (nrepl/done? (last replies)))))))) + +(deftest eval-commands-go-through-the-server + (with-fake-connection + (fn [_conn seen] + (testing "C-x C-e is async and shows the server's printed value" + (let [s (lg-buffer ["(ns demo.core)" "(+ 1 2)"] 0) + s (assoc s :cursor-row 1 :cursor-col 7) + running (lg-mode/eval-last-sexp s) + done (settle-first-job running)] + (is (= "evaluating..." (:message running))) + (is (:sticky? (:eval-highlight running))) + (is (= "=> v:(+ 1 2)" (:message done))) + (is (nil? (:eval-highlight done))) + (let [msg (last @seen)] + (is (= "demo.core" (get msg "ns"))) + (is (= "/src/demo.lg" (get msg "file"))) + (is (= 2 (get msg "line")))))) + (testing "output is shown above the value" + (let [done (settle-first-job (lg-mode/eval-last-sexp (lg-buffer ["(println 1)"] 11)))] + (is (= "hi\n=> v:(println 1)" (:message done))))) + (testing "C-j inserts the printed value, not a pr-str of a string" + (let [done (settle-first-job (lg-mode/eval-print-last-sexp (lg-buffer ["(+ 1 2)"] 7)))] + (is (= ["(+ 1 2)" "v:(+ 1 2)"] (:lines done))))) + (testing "C-j refuses to insert when the form moved meanwhile" + (let [running (lg-mode/eval-print-last-sexp (lg-buffer ["(+ 1 2)"] 7)) + edited (assoc running :lines ["x(+ 1 2)"]) + done (settle-first-job edited)] + (is (= ["x(+ 1 2)"] (:lines done))) + (is (string/includes? (:message done) "form moved")))) + (testing "C-c C-v splices the printed value" + (let [done (settle-first-job (lg-mode/eval-replace-sexp (lg-buffer ["a (+ 1 2) b"] 4)))] + (is (= ["a v:(+ 1 2) b"] (:lines done))))) + (testing "C-c C-e is load-file with the whole buffer" + (let [done (settle-first-job (lg-mode/eval-buffer (lg-buffer ["(ns demo.core)" "(def x 1)"] 0)))] + (is (= "=> v:(ns demo.core)\n(def x 1)" (:message done))) + (is (= "load-file" (get (last @seen) "op"))) + (is (= "demo.lg" (get (last @seen) "file-name"))))) + (testing "a server error is an ordinary eval error" + (let [done (settle-first-job (lg-mode/eval-last-sexp (lg-buffer ["(boom)"] 6)))] + (is (= "Eval error: kaboom" (:message done))))) + (testing "the let-go-mode lighter names the backend" + (is (= "nrepl" ((modes/mode-status :let-go) {}))))))) + +(deftest disconnected-means-in-process-again + (is (not (nrepl/connected?))) + (is (= :in-process @lg-mode/current-eval-backend)) + (let [s (lg-mode/eval-last-sexp (lg-buffer ["(+ 1 2)"] 7))] + (is (= "=> 3" (:message s))) + (is (nil? (:async-jobs s)))) + (is (nil? ((modes/mode-status :let-go) {}))) + (is (= "Not connected to nREPL" (:message (nrepl/nrepl-disconnect (lg-buffer [""] 0)))))) diff --git a/test/run.lg b/test/run.lg index 9cc55a7..931f3c6 100644 --- a/test/run.lg +++ b/test/run.lg @@ -29,7 +29,8 @@ [test.windows-test] [test.kbd-macro-test] [test.acme-extension-test] - [test.vibe-test])) + [test.vibe-test] + [test.nrepl-test])) ;; run-tests with no args only tests *ns* (test.run itself, which has none). (run-all-tests #"test\..*-test") From c851151d65ae417aa4e8834d45d117704a2af494 Mon Sep 17 00:00:00 2001 From: Marcin Gasperowicz Date: Thu, 24 Sep 2026 01:34:43 +0100 Subject: [PATCH 3/5] feat: CIDER-style jack-in, per-project nREPL connections, and completion C-c M-j starts the project's nREPL server, waits for it, connects, and stops it on C-c C-q or editor exit. Launch configs are data (register-launch-config!) for lgx (lgx.edn), Clojure CLI with cider-nrepl (deps.edn), Babashka (bb.edn) and plain lg (deps.edn or no project); the buffer's extension and :priority settle deps.edn/bb.edn ambiguity, a real tie prompts. nrepl-jack-in-command edits the command first; nrepl-server-log shows the server output. Processes: let-go interop can't reach cmd.Process, so servers run under sh -c writing a pid file and logging to a file, exec'ing the command, with stdin held open (lg -n exits on EOF). Stop = SIGTERM + close stdin; liveness via ps stat since kill -0 counts zombies. The editor picks the port (bb doesn't write .nrepl-port for port 0). New bufs exit hooks run after the terminal is restored. Connections are now per project root: buffers visiting files under a connected root evaluate there, via a backend resolver in letgo (eval-backend-for); fileless buffers like *scratch* stay in-process. Completion (legmacs.modes.letgo-complete): TAB completes when indenting changes nothing and point ends a symbol, M-TAB always. In-process from the VM (buffer ns, aliases incl. the ns form's requires, alias/ publics, special forms); on nREPL via cider's complete or completions. One candidate inserts, a longer common prefix extends, else the minibuffer picker with type/ns/arglists. Co-Authored-By: Claude Opus 5.5 --- CLAUDE.md | 40 +++- README.md | 8 +- docs/GUIDE.md | 84 ++++++-- legmacs/buffers.lg | 18 ++ legmacs/jack_in.lg | 347 ++++++++++++++++++++++++++++++++ legmacs/modes/letgo.lg | 64 ++++-- legmacs/modes/letgo_complete.lg | 285 ++++++++++++++++++++++++++ legmacs/nrepl.lg | 250 ++++++++++++++++++----- main.lg | 5 +- test/jack_in_test.lg | 95 +++++++++ test/letgo_complete_test.lg | 83 ++++++++ test/nrepl_test.lg | 26 ++- test/run.lg | 4 +- 13 files changed, 1204 insertions(+), 105 deletions(-) create mode 100644 legmacs/jack_in.lg create mode 100644 legmacs/modes/letgo_complete.lg create mode 100644 test/jack_in_test.lg create mode 100644 test/letgo_complete_test.lg diff --git a/CLAUDE.md b/CLAUDE.md index 5c27daa..ba85c0c 100644 --- a/CLAUDE.md +++ b/CLAUDE.md @@ -258,18 +258,36 @@ form at point, highlights it, snapshots its source, and evaluates it through before replacing it. Ordinary values use `pr-str`; functions that need source-aware application return `replacement-result` with a registered result-kind handler. The same seam carries every other eval command: all four build one -request (`:op` `:eval`/`:load`, `:source`, `:forms`, `:state`, and -filename/line/column/namespace `:context`) and hand it to the selected -backend. With `:in-process` selected, `C-x C-e`/`C-j`/`C-c C-e` still eval -synchronously on the main thread (so editor-scripting forms take effect -before the next frame); any other backend makes them `spawn-task` jobs too. -Remote backends return `printed-result` (text the server printed, plus -captured output) since the value never existed in this VM. `legmacs.nrepl` -is that backend for nREPL: one blocking bencode round trip per request, +request (`:op` `:eval`/`:load`, `:source`, `:forms`, `:state`, `:backend`, +and filename/directory/line/column/namespace `:context`) and hand it to +the buffer's backend. Which backend is `letgo/eval-backend-for`: the +first registered resolver that claims the buffer, else the global +`current-eval-backend` -- resolvers run every frame (the lighter), so they +must stay string checks, no filesystem. With `:in-process`, +`C-x C-e`/`C-j`/`C-c C-e` still eval synchronously on the main thread (so +editor-scripting forms take effect before the next frame); any other +backend makes them `spawn-task` jobs too. Remote backends return +`printed-result` (text the server printed, plus captured output) since +the value never existed in this VM. Completion +(`legmacs.modes.letgo-complete`, TAB/M-TAB) routes the same way through a +per-backend `completers` registry. + +`legmacs.nrepl` is the nREPL backend: one connection per project root +(buffers with a `:filename` under it resolve to it; fileless buffers like +`*scratch*` never do), one blocking bencode round trip per request, serialized by a channel-token lock, inside the job's future -- so no -long-lived reader goroutine exists for `loop-wait` to keep polling. The -`*repl*` buffer deliberately stays in-process. Backends never touch live -buffer state. +long-lived reader goroutine exists for `loop-wait` to keep polling. +`legmacs.jack-in` starts servers from data launch configs. let-go +interop can't reach `cmd.Process`, so a server runs under `sh -c` that +writes a pid file, redirects output to a log (an unread pipe would fill +and block it) and `exec`s the command; the editor holds its stdin pipe +open (`lg -n` exits on EOF) and stops it with SIGTERM + closing stdin. +Liveness is `ps -o stat=`, not `kill -0`: an exited child is a zombie +until Waited, and `kill -0` says a zombie is alive. `bufs/add-exit-hook!` +hooks run after `main.lg` restores the terminal; both namespaces use it +so no server outlives the editor. The editor picks the port +(`os/free-port`) rather than reading `.nrepl-port`, which Babashka +doesn't write for port 0. Backends never touch live buffer state. `legmacs.vibe/vibe` uses that protocol rather than owning a special key command. Under the dynamic `letgo/*eval-replace-context*` it derives its diff --git a/README.md b/README.md index a8ba06d..a81dfd0 100644 --- a/README.md +++ b/README.md @@ -38,8 +38,12 @@ started: form (or select several), evaluate it without blocking the editor, and replace the source with its result; the active form is highlighted while it runs -- an nREPL client (`C-c M-c`): point it at `lg -n` and the same eval keys - run in that process instead of the editor's +- CIDER-style nREPL: `C-c M-j` starts and connects the project's server + -- lgx, Clojure CLI (with cider-nrepl), Babashka, or plain `lg` -- and + that project's buffers then evaluate and complete there; the server + stops when you disconnect or quit +- symbol completion on `TAB`/`M-TAB`, from the editor's own VM or from + the connected server - a dedicated `*repl*` buffer (`C-c C-z`), for when you want an actual running transcript instead of building one by hand with `C-j` - `(vibe "...")`: write what you want where you want it, then use the same diff --git a/docs/GUIDE.md b/docs/GUIDE.md index 1f73285..f8cd73e 100644 --- a/docs/GUIDE.md +++ b/docs/GUIDE.md @@ -236,10 +236,12 @@ forms that aren't also valid let-go: | `C-j` | evaluate the s-expression before point, insert the result right there | | `C-c C-v` | asynchronously evaluate the region or form at point and replace it with the result | | `C-c C-e` | evaluate the whole buffer | -| `C-c M-c` | connect to an nREPL server; every eval key above then runs there (see [nREPL](#nrepl)) | -| `C-c C-q` | disconnect from nREPL, back to in-process eval | +| `C-c M-j` | jack in: start the project's nREPL server (lgx, Clojure CLI, Babashka or `lg`) and connect (see [nREPL](#nrepl)) | +| `C-c M-c` | connect to an nREPL server that is already running | +| `C-c C-q` | disconnect this project from nREPL (stopping a jacked-in server), back to in-process eval | | `RET` | newline, aligned under the form it's inside | -| `TAB` | re-indent the current line the same way | +| `TAB` | re-indent the current line the same way; if that changes nothing and point is after a symbol, complete it | +| `M-TAB` | complete the symbol at point (`C-M-i` sends this) | | `C-c e` | expand the selection outward (word → sexp → next sexp up → ...) | | `C-c u` | contract the selection back in, undoing the last expand | | `(` / `[` / `{` | insert the matching closer too, point left between them | @@ -426,13 +428,71 @@ other commands show verbatim. While any backend other than `:in-process` is selected, `C-x C-e`, `C-j` and `C-c C-e` go through it asynchronously too, and the let-go-mode lighter names it. +### Completion + +`TAB` in let-go-mode re-indents, and when the line is already indented +right and point sits just after a symbol, completes it instead (Emacs's +`tab-always-indent 'complete`); `M-TAB` always completes. One candidate +is inserted; several sharing a longer prefix insert that prefix; otherwise +they open in the minibuffer picker, fuzzy-filtered, with each candidate's +type and namespace beside it and arglists/doc on the selected one. + +Candidates come from wherever the buffer evaluates. In-process that is the +editor's own VM: the buffer's namespace if it's loaded (else the current +one), `alias/` prefixes from its aliases *and* from its `ns` form's +`:require`s (so a file you haven't evaluated still completes `str/`), and +special forms. On an nREPL connection the server answers, using +cider-nrepl's context-aware `complete` when it has it. A backend supplies +its own with +`(legmacs.modes.letgo-complete/register-completer! :backend f)`. + ### nREPL -[`legmacs/nrepl.lg`](../legmacs/nrepl.lg) is the one such backend that -ships. Start a server next to your project with `lg -n` (it writes -`.nrepl-port`), then `C-c M-c` (`M-x nrepl-connect`) in a let-go buffer: -the prompt is pre-filled from the nearest `.nrepl-port` at or above the -buffer's directory, and a bare port means localhost. From then on: +legmacs is an nREPL client +([`legmacs/nrepl.lg`](../legmacs/nrepl.lg)), and can start the server for +you ([`legmacs/jack_in.lg`](../legmacs/jack_in.lg)), CIDER-style. + +**Jack-in.** `C-c M-j` (`M-x nrepl-jack-in`) in a let-go/Clojure buffer +finds the project root (the nearest directory with a marker file), picks +how to start it, starts it on a free port, waits for it, and connects: + +| Project | Marker | Server command | +|---|---|---| +| lgx | `lgx.edn` | `lgx nrepl --port N` | +| Clojure CLI | `deps.edn` | `clojure -Sdeps '{nrepl + cider-nrepl}' -M -m nrepl.cmdline --port N --middleware '[cider.nrepl/cider-middleware]'` | +| Babashka | `bb.edn` | `bb nrepl-server N` | +| let-go (`lg`) | `deps.edn`, or none | `lg -n -p N` | + +`deps.edn` is both a Clojure CLI and a plain-`lg` project file, and +`bb.edn` often sits next to it, so the buffer's extension decides (`.lg` +→ lgx, else lg; `.clj`/`.cljc`/`.cljs` → Clojure CLI; `.bb` → Babashka); +a real tie asks. A lone `.lg` file with no project gets `lg -n` in its +own directory. `M-x nrepl-jack-in-command` shows the command line for +editing first (CIDER's `C-u C-c M-j`), and `M-x nrepl-server-log` shows +the server's output -- which is also where to look when a jack-in fails +(the echo area gets the log's last lines). The first Clojure CLI jack-in +in a project downloads nrepl and cider-nrepl, which can take a couple of +minutes; the editor stays usable meanwhile. Knobs: +`legmacs.jack-in/clojure-cli-aliases` (e.g. `":dev:test"`), +`nrepl-version`, `cider-nrepl-version` and `startup-timeout-ms` are atoms. +A new kind of project is one `register-launch-config!` call (see the +namespace docstring for the map's keys). + +**Connections are per project.** A buffer visiting a file under a +connected project's root evaluates and completes on that project's +server; the lighter says `nrepl:clj` (or `:bb`, `:lg`, `:lgx`, or plain +`nrepl` for a manual connection). Buffers without a file, `*scratch*` +and `*repl*` among them, stay in the editor's VM, so two projects on two +servers and editor scripting all work at once. `C-c C-q` disconnects the +buffer's project and stops its server if jack-in started it; every +connection and server is closed when the editor exits. + +**Connecting by hand.** For a server you started yourself, `C-c M-c` +(`M-x nrepl-connect`) prompts for host:port, pre-filled from the nearest +`.nrepl-port` (`lg -n` and `lgx nrepl` write one); a bare port means +localhost. + +While connected: - `C-x C-e` / `C-j` / `C-c C-v` send the form with the buffer's `ns`, file, line and column; `C-c C-e` is the server's `load-file` @@ -445,12 +505,10 @@ buffer's directory, and a bare port means localhost. From then on: - `C-j` checks the form is still where it was before inserting, like `C-c C-v` does, and both check you're still in the same buffer -`C-c C-q` (`M-x nrepl-disconnect`) goes back to in-process eval. The -`*repl*` buffer always stays in-process: it is the editor's own REPL. Requests are one blocking round trip at a time inside the usual `spawn-task` future, so there is no background reader for the main loop to poll; `C-g` drops a pending result but the server still finishes the -request (let-go's server doesn't implement `interrupt` yet). +request. Any file ending in `.md` or `.markdown` opens into **markdown-mode** (highlighting only, no key bindings of its own, so every global key still @@ -850,7 +908,9 @@ Set `LEGMACS_CONFIG_DIR` to use a different directory than | [`legmacs/lisp_syntax.lg`](../legmacs/lisp_syntax.lg) | Pure bracket/string/comment scanner. What paren matching, syntax highlighting, auto-indent, and expand-region are all built on. | | [`legmacs/modes/letgo.lg`](../legmacs/modes/letgo.lg) | let-go-mode: structural form discovery, in-process eval, async eval-and-replace, syntax highlighting, paren matching, auto-indent, expand-region, auto-paired brackets. Registered for `*scratch*`, `.lg` files, and (syntax-only) `.clj`/`.cljc`/`.cljs`/`.bb`/`.edn` files. | | [`legmacs/modes/repl.lg`](../legmacs/modes/repl.lg) | The `*repl*` buffer (`C-c C-z`): plain let-go-mode plus a `:repl` minor mode that reinterprets `RET` as evaluate-if-complete, else newline-and-indent. | -| [`legmacs/nrepl.lg`](../legmacs/nrepl.lg) | nREPL client (`C-c M-c` / `C-c C-q`): bencode round trips over `net`, registered as the `:nrepl` eval backend so every let-go-mode eval command runs on the server while connected. | +| [`legmacs/nrepl.lg`](../legmacs/nrepl.lg) | nREPL client (`C-c M-c` / `C-c C-q`): bencode round trips over `net`, one connection per project root, registered as the `:nrepl` eval backend and completer for buffers under a connected root. | +| [`legmacs/jack_in.lg`](../legmacs/jack_in.lg) | `C-c M-j`: launch configs (lgx, Clojure CLI, Babashka, lg), project detection, and the server process's lifecycle -- spawn under `sh`, wait for the port, stop on disconnect or exit. | +| [`legmacs/modes/letgo_complete.lg`](../legmacs/modes/letgo_complete.lg) | Symbol completion for let-go-mode (`TAB` / `M-TAB`): in-process from the editor's VM, or from the buffer's nREPL server. | | [`legmacs/vibe.lg`](../legmacs/vibe.lg) | `(vibe "...")`: ask an LLM for let-go code, deriving surrounding-buffer context when invoked by generic `C-c C-v`, then use a tagged eval-result handler to rewrite namespaces and add missing `(:require ...)`s. | | [`legmacs/modes/markdown.lg`](../legmacs/modes/markdown.lg) | markdown-mode: syntax highlighting only (headers, emphasis, code, links, quotes, lists, rules, and fenced code blocks carried across lines). Registered for `.md`/`.markdown` files. | | [`legmacs/modes/prog.lg`](../legmacs/modes/prog.lg) | The language pack: one spec-driven line scanner (comments, strings, keyword/type/constant sets, `#directives`, `$variables`, call sites, and multi-line strings carried across lines) behind major modes for Go, JS/TS, Python, C/C++, shell, rc, Rust, JSON, YAML, TOML, Lua, Ruby, SQL, Dockerfile, CSS, HTML, Zig, Java, Kotlin, Swift, C#, PHP, and Makefile. `register-prog-mode!` is the one-call way to add a language; the same spec map also becomes the mode's `:syntax-spec`. | diff --git a/legmacs/buffers.lg b/legmacs/buffers.lg index e9cde81..88c8e68 100644 --- a/legmacs/buffers.lg +++ b/legmacs/buffers.lg @@ -529,6 +529,24 @@ [v orig] (alter-var-root v (constantly (make-tracked-spawn orig)))) +(def exit-hooks + "name -> (fn [] ...) run once as the editor exits, after the terminal is + restored. For resources that must not outlive the editor -- a jacked-in + nREPL server process, for one." + (atom {})) + +(defn add-exit-hook! + "Register (or replace) the exit hook called `name`." + [name f] + (swap! exit-hooks assoc name f) + name) + +(defn run-exit-hooks! + "Run every exit hook; a throwing hook doesn't stop the others." + [] + (doseq [f (vals @exit-hooks)] + (try (f) (catch e nil)))) + (defn install-spawn-tracking! "Wrap go* and future* so loop-wait can poll while they run. Idempotent. async/go* is a copy of the native taken at boot, not the core var, so diff --git a/legmacs/jack_in.lg b/legmacs/jack_in.lg new file mode 100644 index 0000000..44729a9 --- /dev/null +++ b/legmacs/jack_in.lg @@ -0,0 +1,347 @@ +(ns legmacs.jack-in + "One-command nREPL: start the right server for this buffer's project, + wait for it, connect, and stop it again on disconnect or editor exit. + CIDER's cider-jack-in, for let-go, lgx, Clojure CLI and Babashka. + + C-c M-j (M-x nrepl-jack-in) finds the project root -- the nearest + directory with a launch config's marker file -- and picks the config: + one candidate is used as is; several (deps.edn is both a Clojure CLI + and a plain-lg project file) are narrowed by the buffer's extension, + then by :priority, and a real tie asks. A lone .lg file with no project + at all gets plain `lg -n` in its directory. M-x + nrepl-jack-in-command shows the command line for editing first (C-u + cider-jack-in). M-x nrepl-server-log shows the server's output. + + Launch configs are data in `launch-configs`, added with + `register-launch-config!` exactly as the built-ins below are: + + {:label \"Clojure CLI\" :short \"clj\" ; prompt text / lighter tag + :markers [\"deps.edn\"] ; project-root files + :extensions [\".clj\" ...] ; tie-breaker by buffer file + :priority 20 ; higher wins a remaining tie + :exe \"clojure\" ; checked on PATH first + :command (fn [port] -> argv)} ; port chosen by the editor + + The editor picks the port (os/free-port) and passes it on the command + line instead of discovering it afterwards, because not every server + writes .nrepl-port (Babashka doesn't with an OS-assigned port). + + Process handling works with what let-go interop reaches today. The + server runs under `sh -c`: it writes its pid to a file, sends all + output to a log file (a pipe nobody reads would fill and block the + server), and `exec`s the real command so that pid is the server's. + Its stdin is a pipe the editor holds open -- `lg -n` exits at EOF -- + and closing it is half of stopping it; SIGTERM to the pid is the other + half. Waiting for the port happens in an ordinary bufs/spawn-task job, + so the editor stays live through a first-run Clojure dependency + download." + (:require [string] + [os] + [legmacs.buffers :as bufs] + [legmacs.keymap :as km :refer [defcommand]] + [legmacs.minibuffer :as mb] + [legmacs.path :as path] + [legmacs.completion :as completion] + [legmacs.modes.help :as help] + [legmacs.modes.letgo :as letgo] + [legmacs.nrepl :as nrepl])) + +;; --- launch configs ------------------------------------------------------ + +(def launch-configs + "name keyword -> launch config (see this namespace's docstring)." + (atom {})) + +(defn register-launch-config! + "Add or replace a launch config; its markers also start counting as + project roots for nrepl-connect." + [name config] + (swap! launch-configs assoc name (assoc config :name name)) + (swap! nrepl/project-markers into (:markers config)) + name) + +(def nrepl-version + "The nrepl/nrepl version injected into a Clojure CLI jack-in." + (atom "1.3.1")) + +(def cider-nrepl-version + "The cider/cider-nrepl version injected into a Clojure CLI jack-in; its + middleware is what gives Clojure servers completion, doc lookup and + friends." + (atom "0.55.7")) + +(def clojure-cli-aliases + "Aliases for a Clojure CLI jack-in, e.g. \":dev:test\" (appended to -M), + or nil." + (atom nil)) + +(defn clojure-cli-command [port] + ["clojure" + "-Sdeps" (str "{:deps {nrepl/nrepl {:mvn/version \"" @nrepl-version "\"} " + "cider/cider-nrepl {:mvn/version \"" @cider-nrepl-version "\"}}}") + (str "-M" (or @clojure-cli-aliases "")) + "-m" "nrepl.cmdline" "--port" (str port) + "--middleware" "[cider.nrepl/cider-middleware]"]) + +(defn lgx-command [port] ["lgx" "nrepl" "--port" (str port)]) +(defn lg-command [port] ["lg" "-n" "-p" (str port)]) +(defn babashka-command [port] ["bb" "nrepl-server" (str port)]) + +(register-launch-config! :lgx + {:label "lgx" :short "lgx" :markers ["lgx.edn"] :extensions [".lg"] + :priority 30 :exe "lgx" :command lgx-command}) + +(register-launch-config! :clojure-cli + {:label "Clojure CLI" :short "clj" :markers ["deps.edn"] + :extensions [".clj" ".cljc" ".cljs" ".edn"] + :priority 20 :exe "clojure" :command clojure-cli-command}) + +(register-launch-config! :babashka + {:label "Babashka" :short "bb" :markers ["bb.edn"] :extensions [".bb"] + :priority 20 :exe "bb" :command babashka-command}) + +(register-launch-config! :let-go + {:label "let-go (lg)" :short "lg" :markers ["deps.edn"] :extensions [".lg"] + ;; plain `lg` reads deps.edn's :paths itself, and is the fallback for a + ;; lone .lg file with no project around it + :priority 10 :markerless? true :exe "lg" :command lg-command}) + +;; --- choosing one ---------------------------------------------------------- + +(defn- extension-of [filename] + (when filename + (when-let [i (string/last-index-of filename ".")] + (subs filename i)))) + +(defn- top-priority [configs] + (let [top (apply max (map #(or (:priority %) 0) configs))] + (filterv #(= top (or (:priority %) 0)) configs))) + +(defn rank-configs + "The configs that could launch `filename`'s project, best first; more + than one means it's genuinely ambiguous. Configs claiming the file's + extension win, then the highest :priority among them. When none claims + it, all stay in play." + [configs filename] + (let [ext (extension-of filename) + claimed (filterv #(some #{ext} (:extensions %)) configs)] + (cond + (empty? configs) [] + (seq claimed) (top-priority claimed) + (= 1 (count configs)) (vec configs) + :else (vec (sort-by #(- (or (:priority %) 0)) configs))))) + +(defn detect + "{:root dir :candidates [config ...]} for a buffer in `dir` visiting + `filename`: the nearest ancestor with any config's marker, and the + ranked configs whose markers it has. No project at all falls back to + :markerless? configs (plain lg) in `dir` itself. `exists?` is + (fn [path] -> bool), a parameter so tests needn't touch the disk." + [configs dir filename exists?] + (loop [d dir] + (let [here (filterv (fn [c] (some #(exists? (path/join d %)) (:markers c))) configs)] + (cond + (seq here) {:root d :candidates (rank-configs here filename)} + :else (let [up (path/dirname d)] + (if (and up (not= up d)) + (recur up) + {:root dir + :candidates (rank-configs (filterv :markerless? configs) filename)})))))) + +;; --- processes ------------------------------------------------------------- + +(defn shell-quote + "`s` as one single-quoted sh word." + [s] + (str "'" (string/replace (str s) "'" "'\\''") "'")) + +(defn command-line [argv] (string/join " " (map shell-quote argv))) + +(defn launch-script + "The sh -c script that runs `cmdline` in `root`: pid first (so a failed + cd is still a dead pid rather than an endless wait), then every byte of + output to `log`, then exec so the pid is the server's." + [root cmdline pid-file log-file] + (str "echo $$ > " (shell-quote pid-file) + "; exec >> " (shell-quote log-file) " 2>&1" + "; cd " (shell-quote root) " && exec " cmdline)) + +(def processes + "Servers jack-in started and hasn't stopped, by pid-file. The exit hook + stops whatever is left -- including one whose jack-in was C-g'd." + (atom {})) + +(defn- now-ms [] (.UnixMilli (now))) + +(defn spawn! + "Start `cmdline` in `root`. Returns the process map." + [root cmdline port] + (let [base (str (path/join (os/temp-dir) "legmacs-nrepl-") port "-" (now-ms)) + pid-file (str base ".pid") + log-file (str base ".log") + _ (spit log-file (str "$ " cmdline "\n")) + cmd (os/exec "sh" "-c" (launch-script root cmdline pid-file log-file)) + stdin (.StdinPipe cmd) + proc {:cmd cmd :stdin stdin :root root :command cmdline :port port + :pid-file pid-file :log-file log-file}] + (.Start cmd) + (swap! processes assoc pid-file proc) + proc)) + +(defn pid [proc] + (try (parse-long (string/trim (slurp (:pid-file proc)))) (catch e nil))) + +(defn- pid-alive? + "Running, per ps -- not `kill -0`, which also succeeds on a zombie, and + a server that exited is exactly that until someone Waits on it." + [p] + (let [stat (string/trim (or (:out (os/sh "ps" "-o" "stat=" "-p" (str p))) ""))] + (and (seq stat) (not (string/starts-with? stat "Z"))))) + +(defn alive? + "Still running? Before the pid file exists, yes." + [proc] + (let [p (pid proc)] + (or (nil? p) (pid-alive? p)))) + +(defn stop! + "SIGTERM the server and close its stdin. Idempotent." + [proc] + (when-let [p (pid proc)] + (when (pid-alive? p) (os/sh "kill" (str p)))) + (try (.Close (:stdin proc)) (catch e nil)) + (swap! processes dissoc (:pid-file proc)) + nil) + +(defn stop-all! [] + (doseq [proc (vals @processes)] (stop! proc))) + +(defn log-lines + "The server log, uncolored." + [proc] + (let [text (try (slurp (:log-file proc)) (catch e ""))] + (string/split (nrepl/strip-ansi text) "\n"))) + +(defn- log-tail [proc n] + (->> (log-lines proc) (map string/trim) (remove string/blank?) (take-last n) + (string/join " | "))) + +(def startup-timeout-ms + "How long jack-in waits for the port. Generous: a first Clojure CLI run + downloads its dependencies." + (atom 300000)) + +(defn await-server + "Poll until the server accepts an nREPL connection, then return it. + Throws with the log's last lines if the process dies, or on timeout." + [proc timeout-ms] + (let [deadline (+ (now-ms) timeout-ms)] + (loop [] + (let [conn (try (nrepl/open-connection "127.0.0.1" (:port proc)) (catch e nil))] + (cond + conn conn + (not (alive? proc)) (throw (str "server exited: " (log-tail proc 3))) + (> (now-ms) deadline) (throw (str "no nREPL on port " (:port proc) " after " + (quot timeout-ms 1000) "s")) + :else (do (sleep 250) (recur))))))) + +;; --- commands -------------------------------------------------------------- + +(def last-process + "The most recent jack-in's process, even a failed one, for + nrepl-server-log." + (atom nil)) + +(defn executable? [exe] + (zero? (:exit (os/sh "sh" "-c" (str "command -v " (shell-quote exe) " >/dev/null"))))) + +(defn- stopper [proc] (fn [] (stop! proc))) + +(defn- resolve-jack-in [root config proc state outcome] + (if-let [err (:err outcome)] + (do (stop! proc) + (assoc state :message (str "Jack-in failed: " (or (ex-message err) (str err)) + " (M-x nrepl-server-log)"))) + (let [conn (nrepl/register-connection! + root (assoc (:ok outcome) + :label (:label config) :short (:short config) + :process proc :on-close (stopper proc)))] + (assoc state :message (str "Jacked in: " (nrepl/conn-label conn) " for " root))))) + +(defn- jack-in-then [root config proc] + (fn [state outcome] (resolve-jack-in root config proc state outcome))) + +(defn- await-io [proc] + (fn [] (await-server proc @startup-timeout-ms))) + +(defn- launch [state root config cmdline port] + (let [proc (spawn! root cmdline port)] + (reset! last-process proc) + (bufs/spawn-task state (await-io proc) (jack-in-then root config proc) + (str "Starting " (:label config) " nREPL in " root "...")))) + +(defn- launch-default [state root config] + (if-not (executable? (:exe config)) + (assoc state :message (str (:exe config) " not found on PATH")) + (let [port (os/free-port)] + (launch state root config (command-line ((:command config) port)) port)))) + +(defn- edit-then-launch [root config port] + (fn [state input] + (if (string/blank? input) + (assoc state :message "Jack-in cancelled") + (launch state root config input port)))) + +(defn- launch-edited [state root config] + (let [port (os/free-port)] + (mb/open state "Jack-in command: " (edit-then-launch root config port) + {:initial (command-line ((:command config) port))}))) + +(defn- pick-then [root by-label launch-fn] + (fn [state input] + (if-let [config (get by-label (string/trim input))] + (launch-fn state root config) + (assoc state :message (str "No launch config " input))))) + +(defn- choose-config [state root candidates launch-fn] + (let [by-label (into {} (map (fn [c] [(:label c) c]) candidates)) + labels (mapv :label candidates)] + (mb/open state (str "Jack-in " root " with: ") (pick-then root by-label launch-fn) + {:submit-selected? true + :completer (fn [input] (completion/fuzzy-filter input labels))}))) + +(defn- jack-in-with [state launch-fn] + (let [dir (path/absolute-path (path/default-directory state)) + {:keys [root candidates]} (detect (vals @launch-configs) dir (:filename state) + (fn [p] (some? (os/stat p)))) + existing (get @nrepl/connections root)] + (cond + existing (assoc state :message (str "Already connected to " (nrepl/conn-label existing) + " for " root " (C-c C-q first)")) + (= 1 (count candidates)) (launch-fn state root (first candidates)) + (seq candidates) (choose-config state root candidates launch-fn) + :else (choose-config state root (vec (vals @launch-configs)) launch-fn)))) + +(defcommand nrepl-jack-in + "Start an nREPL server for this buffer's project (lgx, Clojure CLI, + Babashka or plain lg, chosen from the project's files), connect to it, + and stop it again on C-c C-q or when the editor exits." + [state] + (jack-in-with state launch-default)) + +(defcommand nrepl-jack-in-command + "nrepl-jack-in, but show the server command line for editing first." + [state] + (jack-in-with state launch-edited)) + +(defcommand nrepl-server-log + "Show the output of this buffer's jacked-in server (or of the most + recent jack-in, if that failed)." + [state] + (if-let [proc (or (:process (nrepl/connection-for state)) @last-process)] + (help/pop-to-help state "*nrepl-server*" (log-lines proc)) + (assoc state :message "No jacked-in server"))) + +(bufs/add-exit-hook! :jack-in stop-all!) + +(km/bind-key! letgo/keymap "C-c M-j" :nrepl-jack-in) diff --git a/legmacs/modes/letgo.lg b/legmacs/modes/letgo.lg index 37e4c26..f224477 100644 --- a/legmacs/modes/letgo.lg +++ b/legmacs/modes/letgo.lg @@ -27,6 +27,7 @@ [legmacs.indent :as indent] [legmacs.keymap :as km :refer [defcommand]] [legmacs.modes :as modes] + [legmacs.path :as path] [legmacs.lisp-syntax :as ls])) (def keymap (atom {})) @@ -358,7 +359,7 @@ (and (seq? n) (= 'with-meta (first n))) (second n) :else nil)))) -(defn- buffer-ns-name +(defn buffer-ns-name "The name in the first top-level `(ns ...)` form, or nil if the buffer has none (or can't be read)." [state] @@ -506,7 +507,15 @@ ;; :source the text to evaluate ;; :forms read forms (:eval only; the in-process backend wants them) ;; :state the buffer snapshot (in-process only; remote backends ignore it) -;; :context {:text :source :start :end :filename :line :column :namespace}} +;; :backend the backend chosen for this buffer when the command ran +;; :context {:text :source :start :end :filename :directory :line :column +;; :namespace}} +;; +;; Which backend a buffer uses is `eval-backend-for`: the first registered +;; resolver that claims the buffer (nREPL claims buffers visiting files +;; under a connected project's root), else the global +;; `current-eval-backend`. So two projects on two servers, and *scratch* +;; in the editor's own VM, all coexist. ;; ;; The in-process backend is also the synchronous one: while it is selected ;; C-x C-e / C-j / C-c C-e eval right on the main thread, exactly as before @@ -554,16 +563,41 @@ (when (contains? @eval-backends name) (reset! current-eval-backend name))) +(def eval-backend-resolvers + "Registered (fn [state] -> nil | {:backend kw :label str}) resolvers, + by name. Called for the lighter on every frame, so they must be cheap: + no filesystem, no network -- string checks against state they keep." + (atom {})) + +(defn register-eval-backend-resolver! + "Let `resolver` claim buffers for a backend (see eval-backend-resolvers)." + [name resolver] + (swap! eval-backend-resolvers assoc name resolver) + name) + +(defn- try-resolver [resolver state] + (try (resolver state) (catch e nil))) + +(defn eval-backend-for + "{:backend kw :label str-or-nil} for `state`: the first resolver that + claims it, else the global current-eval-backend." + [state] + (or (some (fn [r] (try-resolver r state)) (vals @eval-backend-resolvers)) + (let [b @current-eval-backend] + {:backend b :label (when (not= :in-process b) (name b))}))) + (defn remote-eval-backend? - "True when evals leave this VM, i.e. go async through bufs/spawn-task." - [] - (not= :in-process @current-eval-backend)) + "True when `state`'s evals leave this VM, i.e. go async through + bufs/spawn-task." + [state] + (not= :in-process (:backend (eval-backend-for state)))) (defn- eval-backend-status - "let-go-mode lighter: names the backend, but only when it isn't the - default in-process one." - [_state] - (when (remote-eval-backend?) (name @current-eval-backend))) + "let-go-mode lighter: names the buffer's backend, but only when it isn't + the default in-process one." + [state] + (let [{:keys [backend label]} (eval-backend-for state)] + (when (not= :in-process backend) (or label (name backend))))) (defn printed-result "What a remote backend returns: `text` is the value as the server printed @@ -597,14 +631,16 @@ [state op start end source forms] (let [[row column] (buf/row-col-of state start)] {:op op :state state :forms forms :source source + :backend (:backend (eval-backend-for state)) :context {:text (buf/buffer-text state) :source source :start start :end end - :filename (:filename state) :line (inc row) :column column + :filename (:filename state) :directory (path/default-directory state) + :line (inc row) :column column :namespace (buffer-ns-name state)}})) (defn- eval-backend-value [request] - (if-let [backend (get @eval-backends @current-eval-backend)] + (if-let [backend (get @eval-backends (:backend request))] (backend request) - (throw (str "Unknown eval backend " (pr-str @current-eval-backend))))) + (throw (str "Unknown eval backend " (pr-str (:backend request)))))) (defn- eval-backend-io [request] (fn [] (eval-backend-value request))) @@ -658,7 +694,7 @@ (case status :none (assoc state :message "No preceding sexp") :error (assoc state :message (str "Read error: " forms)) - (if (remote-eval-backend?) + (if (remote-eval-backend? state) (run-eval-remote state f needs-span? start end source forms) (run-eval-local state f start end forms))))) @@ -757,7 +793,7 @@ namespace (or the buffer's ns form, restored afterwards). With a remote backend this is the server's load-file." [state] - (if (remote-eval-backend?) + (if (remote-eval-backend? state) (eval-buffer-remote state) (try (let [result (load-preserving-ns (buf/buffer-text state))] diff --git a/legmacs/modes/letgo_complete.lg b/legmacs/modes/letgo_complete.lg new file mode 100644 index 0000000..7defb40 --- /dev/null +++ b/legmacs/modes/letgo_complete.lg @@ -0,0 +1,285 @@ +(ns legmacs.modes.letgo-complete + "Symbol completion for let-go-mode (and so for .clj/.cljc/.cljs/.bb + buffers, which open in it). + + TAB indents as before, and completes instead when indenting would change + nothing and point sits right after a symbol -- Emacs's + `tab-always-indent 'complete`. M-TAB (what C-M-i sends) always + completes. One candidate is inserted; several that share a longer + prefix insert that prefix; otherwise the candidates open in the + minibuffer picker (fuzzy-filtered, type/ns muted beside each name, + arglists and doc on the selected one). + + Candidates come from whichever backend the buffer evaluates with (see + legmacs.modes.letgo/eval-backend-for). In-process that is the editor's + own VM: the buffer's namespace if it is loaded (else the current one), + its aliases, plus the aliases its ns form requires; `alias/pre` + completes that namespace's publics. A remote backend registers a + completer with `register-completer!`; its answer arrives + asynchronously and is dropped if the symbol changed meanwhile." + (:require [string] + [legmacs.buffer :as buf] + [legmacs.buffers :as bufs] + [legmacs.completion :as completion] + [legmacs.keymap :as km :refer [defcommand]] + [legmacs.minibuffer :as mb] + [legmacs.path :as path] + [legmacs.lisp-syntax :as ls] + [legmacs.modes.letgo :as letgo])) + +;; --- symbol at point ------------------------------------------------------ + +(def ^:private non-symbol-chars + #{\space \tab \newline \return \, \( \) \[ \] \{ \} \" \; \' \` \~ \@ \^ \\}) + +(defn- symbol-char? [ch] + (and ch (not (contains? non-symbol-chars ch)))) + +(defn prefix-at-point + "{:row :start :end :prefix} for the symbol point is in or right after: + `prefix` is the part before point, [start end) the whole symbol (what a + chosen candidate replaces). nil where there is nothing to complete: no + symbol, a keyword, or a number." + [state] + (let [row (:cursor-row state) + col (:cursor-col state) + line (nth (:lines state) row) + chars (vec (seq line)) + n (count chars) + start (loop [c col] + (if (and (pos? c) (symbol-char? (nth chars (dec c)))) (recur (dec c)) c)) + ;; #'foo and #(foo): the dispatch char is syntax, not symbol + start (loop [c start] + (if (and (< c col) (= \# (nth chars c))) (recur (inc c)) c)) + end (loop [c col] + (if (and (< c n) (symbol-char? (nth chars c))) (recur (inc c)) c)) + prefix (subs line start col)] + (when (and (seq prefix) + (not (string/starts-with? prefix ":")) + (not (re-matches #"[+-]?\d.*" prefix))) + {:row row :start start :end end :prefix prefix}))) + +(defn- in-string-or-comment? [state] + (ls/point-in-string-or-comment-at? + (buf/buffer-chars state) + (buf/offset-of state (:cursor-row state) (:cursor-col state)))) + +(defn completable-here? + "Point is at the end of a symbol, outside strings and comments." + [state] + (let [line (nth (:lines state) (:cursor-row state)) + col (:cursor-col state) + at (when (< col (count line)) (nth (seq line) col))] + (boolean (and (not (symbol-char? at)) + (prefix-at-point state) + (not (in-string-or-comment? state)))))) + +;; --- in-process candidates ------------------------------------------------ + +(def ^:private special-forms + '[def if do let let* fn fn* loop loop* recur quote var throw try catch + finally new set! letfn case]) + +(defn- first-line [s] + (when (string? s) (string/trim (first (string/split s "\n"))))) + +(defn- var-candidate [label v] + (let [m (meta v) + value (try (deref v) (catch e nil))] + {:candidate label + :type (cond (:macro m) "macro" (fn? value) "function" :else "var") + :ns (when-let [n (:ns m)] (str (ns-name n))) + :doc (string/trim (str (when-let [a (:arglists m)] (string/join " " (map pr-str a))) + " " (or (first-line (:doc m)) "")))})) + +(defn- ns-form [state] + (let [text (buf/buffer-text state) + ns? (fn [f] (and (seq? f) (= 'ns (first f)))) + first-form (try (read-string text) (catch e nil))] + (if (ns? first-form) + first-form + (try (some (fn [f] (when (ns? f) f)) (read-all-string text)) (catch e nil))))) + +(defn- spec-alias [spec] + (when (vector? spec) + (let [opts (apply hash-map (rest spec))] + (when-let [a (:as opts)] + (when-let [target (find-ns (first spec))] [a target]))))) + +(defn require-aliases + "{alias-sym namespace} from the buffer's ns form's :require clauses, for + the required namespaces that exist in this VM -- so a file that was + never evaluated still completes `str/` after `[string :as str]`." + [state] + (into {} + (for [clause (rest (ns-form state)) + :when (and (seq? clause) (= :require (first clause))) + pair (keep spec-alias (rest clause))] + pair))) + +(defn in-process-candidates + "Candidate maps {:candidate :type :ns :doc} for `prefix` in `ns-sym` (or + the current namespace when it isn't loaded), with `extra-aliases`." + [prefix ns-sym extra-aliases] + (let [ns (or (when ns-sym (find-ns ns-sym)) *ns*) + aliases (merge extra-aliases (ns-aliases ns)) + slash (string/index-of prefix "/")] + (if (and slash (pos? slash)) + (let [q (subs prefix 0 slash) + p (subs prefix (inc slash)) + target (or (get aliases (symbol q)) (find-ns (symbol q)))] + (when target + (keep (fn [[s v]] + (when (string/starts-with? (name s) p) + (var-candidate (str q "/" (name s)) v))) + (ns-publics target)))) + (concat + (keep (fn [[s v]] + (when (and (var? v) (string/starts-with? (name s) prefix)) + (var-candidate (name s) v))) + (ns-map ns)) + (keep (fn [[a _]] + (when (string/starts-with? (name a) prefix) + {:candidate (str a "/") :type "alias"})) + aliases) + (keep (fn [n] + (let [nm (str (ns-name n))] + (when (string/starts-with? nm prefix) + {:candidate nm :type "namespace"}))) + (all-ns)) + (keep (fn [s] + (when (string/starts-with? (name s) prefix) + {:candidate (name s) :type "special form"})) + special-forms))))) + +(defn- in-process-completer [{:keys [prefix namespace state]}] + (in-process-candidates prefix namespace (require-aliases state))) + +(def completers + "backend keyword -> (fn [request] -> [candidate-map ...]). Remote + completers run inside a bufs/spawn-task future. The request is + {:prefix :namespace :state :backend :context {:filename :directory}}." + (atom {:in-process in-process-completer})) + +(defn register-completer! + "Supply completion for buffers evaluated by `backend`." + [backend completer] + (swap! completers assoc backend completer) + backend) + +;; --- offering them -------------------------------------------------------- + +(defn- replace-symbol [state row start end text] + (let [line (nth (:lines state) row)] + (-> (buf/push-undo state) + (assoc-in [:lines row] (str (subs line 0 start) text (subs line end))) + (assoc :modified? true :cursor-row row + :cursor-col (+ start (count text)) :goal-col nil)))) + +(defn- distinct-candidates [cands] + (->> cands + (reduce (fn [m c] (if (contains? m (:candidate c)) m (assoc m (:candidate c) c))) {}) + vals + (sort-by :candidate) + vec)) + +(defn- candidate-row [c] + {:label (:candidate c) :value (:candidate c) + :keys (string/join " " (remove string/blank? [(:type c) (:ns c)])) + :doc (:doc c)}) + +(defn- picker-on-change [by-name names] + (fn [state input] + (assoc-in state [:minibuffer :candidates] + (mapv (fn [n] (candidate-row (get by-name n))) + (completion/fuzzy-filter input names))))) + +(defn- picker-completer [names] + (fn [input] (completion/fuzzy-filter input names))) + +(defn- picker-submit [row start end] + (fn [state input] + (if (string/blank? input) state (replace-symbol state row start end input)))) + +(defn- open-picker [state {:keys [row start end prefix]} cands] + (let [names (mapv :candidate cands) + by-name (zipmap names cands)] + (mb/open state "Complete: " (picker-submit row start end) + {:submit-selected? true + :initial prefix + :completer (picker-completer names) + :on-change (picker-on-change by-name names)}))) + +(defn offer-completions + "Act on `cands` for the symbol at `at` (see prefix-at-point): insert the + only one, extend to a longer common prefix, or open the picker." + [state {:keys [row start end prefix] :as at} cands] + (let [cands (distinct-candidates cands) + names (mapv :candidate cands) + common (completion/longest-common-prefix names)] + (cond + (empty? cands) (assoc state :message (str "No completions for " prefix)) + (= 1 (count cands)) (replace-symbol state row start end (first names)) + (> (count common) (count prefix)) + (-> (replace-symbol state row start end common) + (assoc :message (str (count cands) " completions"))) + :else (open-picker state at cands)))) + +(defn- completion-request [state] + {:prefix (:prefix (prefix-at-point state)) + :namespace (letgo/buffer-ns-name state) + :state state + :backend (:backend (letgo/eval-backend-for state)) + :context {:filename (:filename state) + :directory (path/default-directory state)}}) + +(defn- still-there? + "The symbol an async completion was for is unchanged, point too." + [state buffer-id {:keys [row start prefix]}] + (and (= buffer-id (:current-buffer-id state)) + (= row (:cursor-row state)) + (= (+ start (count prefix)) (:cursor-col state)) + (< row (count (:lines state))) + (= (:prefix (prefix-at-point state)) prefix))) + +(defn- resolve-remote [state buffer-id at outcome] + (cond + (contains? outcome :err) + (assoc state :message (str "Completion failed: " (or (ex-message (:err outcome)) (str (:err outcome))))) + (not (still-there? state buffer-id at)) state + :else (offer-completions state at (:ok outcome)))) + +(defn- remote-then [buffer-id at] + (fn [state outcome] (resolve-remote state buffer-id at outcome))) + +(defn- completion-io [completer req] + (fn [] (vec (completer req)))) + +(defcommand complete-symbol + "Complete the symbol before point from the buffer's eval backend (the + editor's VM, or the connected nREPL server)." + [state] + (if-let [at (prefix-at-point state)] + (let [req (completion-request state) + backend (:backend req) + completer (get @completers backend)] + (cond + (= :in-process backend) (offer-completions state at (in-process-completer req)) + completer (bufs/spawn-task state (completion-io completer req) + (remote-then (:current-buffer-id state) at)) + :else (assoc state :message (str "No completion for " (name backend))))) + (assoc state :message "Nothing to complete here"))) + +(defcommand indent-or-complete + "TAB in let-go-mode: re-indent the line; if that changes nothing and + point is right after a symbol, complete it instead." + [state] + (let [indented (letgo/lisp-indent-line state)] + (if (and (= (:lines indented) (:lines state)) + (= (:cursor-col indented) (:cursor-col state)) + (completable-here? state)) + (complete-symbol state) + indented))) + +(km/bind-key! letgo/keymap "TAB" :indent-or-complete) +(km/bind-key! letgo/keymap "M-TAB" :complete-symbol) diff --git a/legmacs/nrepl.lg b/legmacs/nrepl.lg index 2d50db5..3ac0cab 100644 --- a/legmacs/nrepl.lg +++ b/legmacs/nrepl.lg @@ -1,16 +1,20 @@ (ns legmacs.nrepl "nREPL client: talk to a running let-go (or any bencode nREPL) server - and make it the eval backend for every let-go-mode eval command. - - M-x nrepl-connect (C-c M-c) reads host:port -- defaulting to the - nearest .nrepl-port above the buffer's directory, which `lg -n` writes - -- clones a session, and selects the :nrepl backend in - legmacs.modes.letgo. From then on C-x C-e, C-j, C-c C-v and C-c C-e - send their source to the server instead of evaluating in the editor's - own VM; the let-go-mode lighter reads `nrepl` while that holds. - M-x nrepl-disconnect (C-c C-q) closes the socket and goes back to - in-process eval. The *repl* buffer stays in-process on purpose: it is - the editor's own REPL. + and make it the eval and completion backend for a project's buffers. + + Connections belong to project roots (the nearest directory with a + project marker such as deps.edn, lgx.edn or bb.edn). A let-go-mode + buffer visiting a file under a connected root evaluates there -- C-x + C-e, C-j, C-c C-v, C-c C-e -- and completes there (TAB / M-TAB, see + legmacs.modes.letgo-complete); the lighter reads `nrepl` (or + `nrepl:clj` etc. when jack-in started the server). Everything else, + *scratch* and *repl* included, keeps evaluating in the editor's own VM. + + C-c M-j (legmacs.jack-in) starts a server and connects. M-x + nrepl-connect (C-c M-c) connects to one already running: it reads + host:port, pre-filled from the nearest .nrepl-port. C-c C-q + disconnects this buffer's project, stopping the server if jack-in + started it; every connection closes at editor exit. The wire half is deliberately one blocking round trip at a time: `request` takes the connection's lock, writes one message, and reads @@ -20,6 +24,7 @@ to keep polling for. C-g drops a pending result as it does for any async job; the request itself still finishes on the server." (:require [string] + [os] [async] [net] [bencode] @@ -28,7 +33,8 @@ [legmacs.keymap :as km :refer [defcommand]] [legmacs.minibuffer :as mb] [legmacs.path :as path] - [legmacs.modes.letgo :as letgo])) + [legmacs.modes.letgo :as letgo] + [legmacs.modes.letgo-complete :as complete])) (def default-port 2137) @@ -49,7 +55,9 @@ (try (parse-long port) (catch e nil)))] (when port [host port]))) -(defn- ansi-free [s] +(defn strip-ansi + "`s` without ANSI color escapes." + [s] (string/replace s #"\x1b\[[0-9;]*m" "")) (defn- excerpt-line? @@ -68,7 +76,7 @@ tag -- the cause is usually the useful half (\"compiling function position: Can't resolve sq in this context\")." [err] - (let [lines (->> (string/split (ansi-free (or err "")) "\n") + (let [lines (->> (string/split (strip-ansi (or err "")) "\n") (map string/trim) (remove string/blank?) (take-while (complement excerpt-line?)) @@ -193,80 +201,216 @@ [conn msg] (with-lock (:lock conn) (fn [] (round-trip conn msg)))) +(defn- reply-ops [replies] + (set (map name (keys (some #(get % "ops") replies))))) + (defn open-connection - "Dial host:port and clone a session. Throws when either fails." + "Dial host:port, clone a session, and ask which ops the server has + (`:ops`, a set of strings -- let-go's server has a handful, cider-nrepl + dozens). Throws when dialing or cloning fails." [host port] (let [conn {:socket (net/dial host port) :host host :port port :lock (new-lock) :next-id (atom 0)} - session (some #(get % "new-session") (request conn {:op "clone"}))] - (assoc conn :session session))) - -(defn close-connection [conn] + session (some #(get % "new-session") (request conn {:op "clone"})) + conn (assoc conn :session session) + ops (try (reply-ops (request conn {:op "describe"})) (catch e #{}))] + (assoc conn :ops ops))) + +(defn close-connection + "Close the socket, then run the connection's :on-close (jack-in uses it + to stop the server process it started)." + [conn] (try (net/close! (:socket conn)) (catch e nil)) + (when-let [f (:on-close conn)] (try (f) (catch e nil))) nil) -(def connection - "The live connection map, or nil. Global like the eval backend it feeds: - every let-go buffer evaluates against the same server." - (atom nil)) +;; --- connections, one per project --------------------------------------- +;; +;; Like CIDER's sesman, but only the part that matters day to day: each +;; connection belongs to a project root, and a buffer visiting a file +;; under that root evaluates there. Two projects on two servers, and +;; *scratch* in the editor's own VM, coexist without switching anything. + +(def project-markers + "Files that mark a project root. legmacs.jack-in adds each launch + config's markers here." + (atom #{"lgx.edn" "deps.edn" "bb.edn" "project.clj" "shadow-cljs.edn"})) -(defn connected? [] (some? @connection)) +(defn- has-marker? [dir markers] + (some (fn [m] (some? (os/stat (path/join dir m)))) markers)) + +(defn find-project-root + "The nearest directory at or above `dir` holding a project marker, or + nil." + [dir] + (loop [dir (path/absolute-path dir)] + (cond + (has-marker? dir @project-markers) dir + :else (let [up (path/dirname dir)] + (when (and up (not= up dir)) (recur up)))))) + +(def connections + "Live connections by project root (an absolute directory)." + (atom {})) + +(defn- under-root? [dir root] + (or (= dir root) + (string/starts-with? dir (if (string/ends-with? root os/file-separator) + root + (str root os/file-separator))))) + +(defn connection-for-dir + "The connection whose root is the longest one containing `dir`." + [dir] + (when dir + (->> @connections + (filter (fn [[root _]] (under-root? dir root))) + (sort-by (fn [[root _]] (- (count root)))) + first + second))) + +(defn connection-for + "The connection a buffer evaluates with: by the directory of the file it + visits. Buffers without a file (*scratch*, *repl*) have none -- they + stay in the editor's VM. Cheap: string prefixes, no filesystem, since + the lighter asks every frame." + [state] + (when-let [f (:filename state)] + (when (seq @connections) + (connection-for-dir (path/directory-of f))))) + +(defn- connection-for-request + "The connection for a backend request, from its :context. If the buffer + is under no root but exactly one connection exists (the global backend + was selected by hand), that one." + [req] + (let [{:keys [filename directory]} (:context req) + dir (if filename (path/directory-of filename) directory)] + (or (connection-for-dir dir) + (when (= 1 (count @connections)) (first (vals @connections))) + (throw "No nREPL connection for this buffer (C-c M-j jacks in)")))) + +(defn connected? [] (boolean (seq @connections))) + +(defn conn-label + "`host:port`, plus the jack-in type when there is one." + [conn] + (str (:host conn) ":" (:port conn) + (when-let [t (:label conn)] (str " (" t ")")))) + +(defn register-connection! + "Make `conn` the connection for `root`, closing whatever was there." + [root conn] + (when-let [old (get @connections root)] + (when-not (identical? old conn) (close-connection old))) + (swap! connections assoc root (assoc conn :root root)) + conn) + +(defn remove-connection! + "Close and forget the connection for `root`." + [root] + (when-let [conn (get @connections root)] + (swap! connections dissoc root) + (close-connection conn))) + +(defn close-all! + "Close every connection (and so stop every jacked-in server). Runs at + editor exit." + [] + (doseq [root (keys @connections)] (remove-connection! root))) (defn nrepl-backend "The :nrepl eval backend: (fn [request] -> printed-result)." [req] - (let [conn (or @connection (throw "Not connected to nREPL"))] + (let [conn (connection-for-request req)] (-> (combine-replies (request conn (eval-message req))) ;; a load *is* the fix the ns note suggests, so it never gets one (reply->result (when (not= :load (:op req)) (get-in req [:context :namespace])))))) +(defn- lighter [conn] + (str "nrepl" (when-let [s (:short conn)] (str ":" s)))) + +(defn- nrepl-resolver [state] + (when-let [conn (connection-for state)] + {:backend :nrepl :label (lighter conn)})) + (letgo/register-eval-backend! :nrepl nrepl-backend) +(letgo/register-eval-backend-resolver! :nrepl nrepl-resolver) -;; --- commands ------------------------------------------------------------ +;; --- completion ------------------------------------------------------------ + +(defn completion-message + "cider-nrepl's `complete` is context-aware, so prefer it; plain nREPL + (and let-go's server) have `completions` with the same reply shape." + [conn prefix ns] + (cond-> {:op (if (contains? (:ops conn) "complete") "complete" "completions") + :prefix prefix} + ns (assoc :ns (str ns)))) -(defn- disconnect! [] - (when-let [conn @connection] - (close-connection conn)) - (reset! connection nil) - (letgo/use-eval-backend! :in-process)) +(defn reply->completions [replies] + (vec (for [r replies + c (get r "completions")] + {:candidate (get c "candidate") :type (get c "type") :ns (get c "ns")}))) -(defn- label [conn] (str (:host conn) ":" (:port conn))) +(defn nrepl-completer [req] + (let [conn (connection-for-request req)] + (reply->completions + (request conn (completion-message conn (:prefix req) (:namespace req)))))) -(defn- resolve-connect [state outcome] +(complete/register-completer! :nrepl nrepl-completer) + +;; --- commands ------------------------------------------------------------ + +(defn root-for + "Where a connection made from `state` belongs: its project root, else + its directory." + [state] + (let [dir (path/default-directory state)] + (or (find-project-root dir) (path/absolute-path dir)))) + +(defn- resolve-connect [root state outcome] (if-let [err (:err outcome)] (assoc state :message (str "nREPL connect failed: " (or (ex-message err) (str err)))) - (let [conn (:ok outcome)] - (disconnect!) - (reset! connection conn) - (letgo/use-eval-backend! :nrepl) - (assoc state :message (str "Connected to nREPL at " (label conn)))))) + (let [conn (register-connection! root (:ok outcome))] + (assoc state :message (str "Connected to " (conn-label conn) " for " root))))) + +(defn- connect-then [root] + (fn [state outcome] (resolve-connect root state outcome))) (defn- connect-io [host port] (fn [] (open-connection host port))) -(defn- submit-address [state input] - (if-let [[host port] (parse-address input default-port)] - (bufs/spawn-task state (connect-io host port) resolve-connect - (str "Connecting to " host ":" port "...")) - (assoc state :message (str "Not a host:port: " input)))) +(defn- submit-address [root] + (fn [state input] + (if-let [[host port] (parse-address input default-port)] + (bufs/spawn-task state (connect-io host port) (connect-then root) + (str "Connecting to " host ":" port "...")) + (assoc state :message (str "Not a host:port: " input))))) (defcommand nrepl-connect - "Connect to an nREPL server and evaluate let-go buffers there. Prompts - for host:port, pre-filled from the nearest .nrepl-port (`lg -n` writes - one); a bare port means localhost." + "Connect to a running nREPL server for this buffer's project: files + under the project root evaluate and complete there. Prompts for + host:port, pre-filled from the nearest .nrepl-port; a bare port means + localhost." [state] - (let [found (find-port-file (path/default-directory state))] - (mb/open state "nREPL (host:port): " submit-address + (let [root (root-for state) + found (find-port-file (path/default-directory state))] + (mb/open state "nREPL (host:port): " (submit-address root) {:initial (if found (str "localhost:" found) "")}))) (defcommand nrepl-disconnect - "Close the nREPL connection; evaluation goes back to the editor's VM." + "Close this buffer's nREPL connection -- stopping the server too if + jack-in started it. Its files go back to evaluating in the editor." [state] - (if-let [conn @connection] - (do (disconnect!) - (assoc state :message (str "Disconnected from " (label conn)))) - (assoc state :message "Not connected to nREPL"))) + (let [conn (or (connection-for state) + (when (= 1 (count @connections)) (first (vals @connections))))] + (if conn + (do (remove-connection! (:root conn)) + (assoc state :message (str "Disconnected from " (conn-label conn)))) + (assoc state :message "Not connected to nREPL")))) + +(bufs/add-exit-hook! :nrepl close-all!) (km/bind-key! letgo/keymap "C-c M-c" :nrepl-connect) (km/bind-key! letgo/keymap "C-c C-q" :nrepl-disconnect) diff --git a/main.lg b/main.lg index dd1f0e1..d15704c 100644 --- a/main.lg +++ b/main.lg @@ -27,7 +27,9 @@ [legmacs.modes.crutch] [legmacs.modes.keycast] [legmacs.modes.help] + [legmacs.modes.letgo-complete] [legmacs.nrepl] + [legmacs.jack-in] ;; :refer, not just :as -- (vibe "...") typed into a buffer is ;; read and evaluated *in this namespace* (see legmacs.modes.letgo's ;; docstring). vibe.lg also intern's `vibe` into let-go.core so a @@ -171,7 +173,8 @@ (try (run workspace) (finally - (shutdown-terminal!))))) + (shutdown-terminal!) + (bufs/run-exit-hooks!))))) ;; Guard the launch so AOT compilation (`lg -c` / `lg -b`, which set ;; *compiling-aot* true before running top-level forms to harvest the diff --git a/test/jack_in_test.lg b/test/jack_in_test.lg new file mode 100644 index 0000000..f65f856 --- /dev/null +++ b/test/jack_in_test.lg @@ -0,0 +1,95 @@ +(ns test.jack-in-test + (:require [test :refer :all] + [string] + [os] + [legmacs.buffer :as buf] + [legmacs.modes :as modes] + [legmacs.modes.letgo :as lg-mode] + [legmacs.nrepl :as nrepl] + [legmacs.jack-in :as j])) + +(defn- configs [] (vals @j/launch-configs)) + +(defn- exists-in [files] + (let [files (set files)] (fn [p] (contains? files p)))) + +(defn- detected [files dir filename] + (let [{:keys [root candidates]} (j/detect (configs) dir filename (exists-in files))] + [root (mapv :name candidates)])) + +(deftest detection-picks-root-and-config + (testing "the nearest marker wins, and the extension picks between deps.edn users" + (is (= ["/p" [:let-go]] (detected ["/p/deps.edn"] "/p/src/a" "/p/src/a/core.lg"))) + (is (= ["/p" [:clojure-cli]] (detected ["/p/deps.edn"] "/p/src" "/p/src/core.clj")))) + (testing "lgx outranks plain lg for .lg files" + (is (= ["/p" [:lgx]] (detected ["/p/deps.edn" "/p/lgx.edn"] "/p" "/p/main.lg")))) + (testing "bb.edn next to deps.edn: .clj goes to the CLI, .bb to Babashka" + (is (= ["/p" [:clojure-cli]] (detected ["/p/deps.edn" "/p/bb.edn"] "/p" "/p/x.clj"))) + (is (= ["/p" [:babashka]] (detected ["/p/deps.edn" "/p/bb.edn"] "/p" "/p/tasks.bb")))) + (testing "a Babashka-only project takes any Clojure file" + (is (= ["/p" [:babashka]] (detected ["/p/bb.edn"] "/p" "/p/script.clj")))) + (testing "no file to go by is a genuine tie: ask, best guess first" + (is (= ["/p" [:clojure-cli :let-go]] (detected ["/p/deps.edn"] "/p" nil)))) + (testing "a lone .lg file with no project runs plain lg where it is" + (is (= ["/tmp/x" [:let-go]] (detected [] "/tmp/x" "/tmp/x/hack.lg"))))) + +(deftest commands-are-quoted-for-sh + (is (= "'it'\\''s'" (j/shell-quote "it's"))) + (is (= "'lg' '-n' '-p' '7000'" (j/command-line (j/lg-command 7000)))) + (let [argv (j/clojure-cli-command 7000)] + (is (= "clojure" (first argv))) + (is (some #{"-M"} argv)) + (is (string/includes? (nth argv 2) "cider/cider-nrepl")) + (is (= ["--port" "7000"] (take 2 (drop-while #(not= "--port" %) argv))))) + (let [old @j/clojure-cli-aliases] + (reset! j/clojure-cli-aliases ":dev:test") + (is (some #{"-M:dev:test"} (j/clojure-cli-command 1))) + (reset! j/clojure-cli-aliases old))) + +(defn- temp-project [] + (let [dir (str (os/temp-dir) "legmacs-jack-in-test-" (rand-int 1000000))] + (os/sh "mkdir" "-p" (str dir "/src")) + (spit (str dir "/deps.edn") "{:paths [\"src\"]}") + (spit (str dir "/src/demo.lg") "(ns demo)\n(defn sq [x] (* x x))\n(sq 7)") + dir)) + +(defn- settle [state] + (let [job (first (:async-jobs state))] + ((:then job) (assoc state :async-jobs nil) (deref (:promise job))))) + +(deftest a-server-that-dies-is-reported-not-waited-for + (let [dir (temp-project) + proc (j/spawn! dir "sh -c 'echo no such flag >&2; exit 3'" (os/free-port))] + (try + (is (= "server exited: $ sh -c 'echo no such flag >&2; exit 3' | no such flag" + (try (j/await-server proc 20000) (catch e (or (ex-message e) (str e)))))) + (is (not (j/alive? proc))) + (finally (j/stop! proc) (os/delete-tree dir))))) + +(deftest jack-in-starts-connects-and-stops-plain-lg + (let [dir (temp-project) + file (str dir "/src/demo.lg") + s (-> (buf/new-state file (buf/split-lines (slurp file))) + (modes/switch-to-mode :let-go))] + (try + (let [starting (j/nrepl-jack-in s) + connected (settle starting) + conn (nrepl/connection-for connected) + proc (:process conn)] + (is (string/starts-with? (:message starting) "Starting let-go (lg) nREPL in ")) + (is (string/starts-with? (:message connected) "Jacked in: 127.0.0.1:")) + (is (= dir (:root conn))) + (is (= "nrepl:lg" ((modes/mode-status :let-go) connected))) + (testing "the buffer now evaluates in the server" + (is (= "=> 49" (:message (settle (lg-mode/eval-buffer connected)))))) + (testing "a second jack-in for the same project refuses" + (is (string/starts-with? (:message (j/nrepl-jack-in connected)) "Already connected"))) + (testing "disconnecting stops the server" + (nrepl/nrepl-disconnect connected) + (sleep 300) + (is (not (j/alive? proc))) + (is (nil? (nrepl/connection-for connected))) + (is (not (contains? @j/processes (:pid-file proc)))))) + (finally + (nrepl/close-all!) + (os/delete-tree dir))))) diff --git a/test/letgo_complete_test.lg b/test/letgo_complete_test.lg new file mode 100644 index 0000000..eef01ce --- /dev/null +++ b/test/letgo_complete_test.lg @@ -0,0 +1,83 @@ +(ns test.letgo-complete-test + (:require [test :refer :all] + [string] + [legmacs.buffer :as buf] + [legmacs.modes :as modes] + [legmacs.bindings :as bindings] + [legmacs.dispatch :as dispatch] + [legmacs.modes.letgo] + [legmacs.modes.letgo-complete :as c])) + +(bindings/install!) + +(defn- lg-state [lines row col] + (-> (buf/new-state nil lines) + (modes/switch-to-mode :let-go) + (assoc :cursor-row row :cursor-col col))) + +(defn- at-end [lines] + (let [row (dec (count lines))] (lg-state lines row (count (nth lines row))))) + +(deftest prefix-at-point-cases + (is (= {:row 0 :start 1 :end 4 :prefix "map"} (c/prefix-at-point (lg-state ["(map"] 0 4)))) + (testing "mid-symbol: prefix up to point, bounds over the whole symbol" + (is (= {:row 0 :start 1 :end 5 :prefix "ma"} (c/prefix-at-point (lg-state ["(mapv x)"] 0 3))))) + (testing "reader syntax isn't part of it" + (is (= "foo" (:prefix (c/prefix-at-point (lg-state ["#'foo"] 0 5))))) + (is (= "str/sp" (:prefix (c/prefix-at-point (lg-state ["@str/sp"] 0 7)))))) + (testing "nothing to complete" + (is (nil? (c/prefix-at-point (lg-state ["(:foo"] 0 5)))) + (is (nil? (c/prefix-at-point (lg-state ["(+ 12"] 0 5)))) + (is (nil? (c/prefix-at-point (lg-state ["( "] 0 2)))))) + +(deftest in-process-candidates-cases + (let [names (fn [prefix aliases] + (set (map :candidate (c/in-process-candidates prefix nil aliases))))] + (is (contains? (names "mapc" {}) "mapcat")) + (is (contains? (names "string/spl" {}) "string/split")) + (testing "an alias from the buffer's ns form" + (is (contains? (names "s/spl" {'s (find-ns 'string)}) "s/split")) + (is (contains? (names "s" {'s (find-ns 'string)}) "s/"))) + (testing "special forms are there too" + (is (contains? (names "let" {}) "letfn"))))) + +(deftest require-aliases-come-from-the-ns-form + (let [s (lg-state ["(ns demo (:require [string :as str] [no.such.lib :as nope]))"] 0 0)] + (is (= {'str (find-ns 'string)} (c/require-aliases s))))) + +(deftest completing-in-the-buffer + (testing "one candidate is inserted" + (let [s (c/complete-symbol (at-end ["(mapca"]))] + (is (= ["(mapcat"] (:lines s))) + (is (= 7 (:cursor-col s))))) + (testing "a longer common prefix is inserted first" + (let [s (c/complete-symbol (at-end ["(string/split-l"]))] + (is (= ["(string/split-lines"] (:lines s))))) + (testing "otherwise the picker opens on the prefix, and RET replaces the symbol" + (let [s (c/complete-symbol (at-end ["(string/s"])) + values (set (map :value (get-in s [:minibuffer :candidates])))] + (is (= "Complete: " (get-in s [:minibuffer :prompt]))) + (is (= "string/s" (get-in s [:minibuffer :input]))) + (is (contains? values "string/split")) + (is (contains? values "string/starts-with?")) + (let [chosen (:value (first (get-in s [:minibuffer :candidates]))) + done (dispatch/dispatch s "RET")] + (is (nil? (:minibuffer done))) + (is (= [(str "(" chosen)] (:lines done)))))) + (testing "no match says so and leaves the buffer alone" + (let [s (c/complete-symbol (at-end ["(zzqqxx"]))] + (is (= ["(zzqqxx"] (:lines s))) + (is (= "No completions for zzqqxx" (:message s)))))) + +(deftest tab-indents-or-completes + (testing "TAB after a symbol on a well-indented line completes" + (let [s (dispatch/dispatch (at-end ["(mapca"]) "TAB")] + (is (= ["(mapcat"] (:lines s))))) + (testing "TAB on a mis-indented line still just indents" + (let [s (dispatch/dispatch (at-end ["(let [x 1]" " mapca"]) "TAB")] + (is (= " mapca" (second (:lines s)))))) + (testing "TAB inside a string or comment never completes" + (is (= ["(str \"mapca"] (:lines (dispatch/dispatch (at-end ["(str \"mapca"]) "TAB")))) + (is (= ["; mapca"] (:lines (dispatch/dispatch (at-end ["; mapca"]) "TAB"))))) + (testing "M-TAB always completes" + (is (= ["(mapcat"] (:lines (dispatch/dispatch (at-end ["(mapca"]) "M-TAB")))))) diff --git a/test/nrepl_test.lg b/test/nrepl_test.lg index 32fc739..7f7ae37 100644 --- a/test/nrepl_test.lg +++ b/test/nrepl_test.lg @@ -133,16 +133,13 @@ outcome (deref (:promise job))] ((:then job) (assoc state :async-jobs nil) outcome))) -(defn- with-fake-connection [f] +(defn- with-fake-connection + "Run (f conn seen) with a fake server connected for the /src project." + [f] (let [{:keys [port seen]} (start-fake-server) - old @lg-mode/current-eval-backend - conn (nrepl/open-connection "127.0.0.1" port)] - (reset! nrepl/connection conn) - (lg-mode/use-eval-backend! :nrepl) + conn (nrepl/register-connection! "/src" (nrepl/open-connection "127.0.0.1" port))] (let [outcome (try {:ok (f conn seen)} (catch e {:err e}))] - (nrepl/close-connection conn) - (reset! nrepl/connection nil) - (reset! lg-mode/current-eval-backend old) + (nrepl/remove-connection! "/src") (when (contains? outcome :err) (throw (:err outcome))) (:ok outcome)))) @@ -202,8 +199,15 @@ (testing "a server error is an ordinary eval error" (let [done (settle-first-job (lg-mode/eval-last-sexp (lg-buffer ["(boom)"] 6)))] (is (= "Eval error: kaboom" (:message done))))) - (testing "the let-go-mode lighter names the backend" - (is (= "nrepl" ((modes/mode-status :let-go) {}))))))) + (testing "the let-go-mode lighter names the backend, for this project only" + (is (= "nrepl" ((modes/mode-status :let-go) {:filename "/src/demo.lg"}))) + (is (nil? ((modes/mode-status :let-go) {:filename "/elsewhere/x.lg"}))) + (is (nil? ((modes/mode-status :let-go) {})))) + (testing "a buffer outside the project stays in-process" + (let [s (-> (buf/new-state "/elsewhere/x.lg" ["(+ 1 2)"]) + (modes/switch-to-mode :let-go) + (assoc :cursor-col 7))] + (is (= "=> 3" (:message (lg-mode/eval-last-sexp s))))))))) (deftest disconnected-means-in-process-again (is (not (nrepl/connected?))) @@ -211,5 +215,5 @@ (let [s (lg-mode/eval-last-sexp (lg-buffer ["(+ 1 2)"] 7))] (is (= "=> 3" (:message s))) (is (nil? (:async-jobs s)))) - (is (nil? ((modes/mode-status :let-go) {}))) + (is (nil? ((modes/mode-status :let-go) {:filename "/src/demo.lg"}))) (is (= "Not connected to nREPL" (:message (nrepl/nrepl-disconnect (lg-buffer [""] 0)))))) diff --git a/test/run.lg b/test/run.lg index 931f3c6..2a851d0 100644 --- a/test/run.lg +++ b/test/run.lg @@ -30,7 +30,9 @@ [test.kbd-macro-test] [test.acme-extension-test] [test.vibe-test] - [test.nrepl-test])) + [test.nrepl-test] + [test.jack-in-test] + [test.letgo-complete-test])) ;; run-tests with no args only tests *ns* (test.run itself, which has none). (run-all-tests #"test\..*-test") From da58f44c45c99cbb9c2620a89c48cb85ebc2b374 Mon Sep 17 00:00:00 2001 From: Marcin Gasperowicz Date: Thu, 24 Sep 2026 01:45:08 +0100 Subject: [PATCH 4/5] feat: eldoc, doc lookup, and M-./M-, goto-definition for let-go-mode legmacs.modes.letgo-lookup, routed per buffer like eval and completion through a lookups registry: - eldoc: an after-command hook shows the enclosing call's arglists in the echo area when nothing else claimed it. It scans back only to the top-level form and reads the ns form from the buffer's head, so it's cheap per key; remote answers come from a short-TTL cache filled by a quiet spawn-task. - C-c C-d d / C-c C-d C-d: arglists, doc and source location in *Help*. - M-.: jump to the definition -- the current buffer, an open one, a file opened fresh, or for Clojure libraries the source read out of the jar into a read-only buffer. M-, pops back across buffers. In-process answers come from var metadata, resolving relative :file paths from the buffer's directory upward, LG_SOURCE_PATHS and the cwd. nREPL answers use cider-nrepl's eldoc/info, or nREPL's built-in lookup. Plumbing: letgo after-command-hooks (run after paren-matching, each in a try); a :visit buffer-command (show a buffer by id/filename/name or open :state, at row/col, clamped); a shared :xref-stack. Co-Authored-By: Claude Opus 5.5 --- CLAUDE.md | 11 +- README.md | 5 +- docs/GUIDE.md | 37 ++++ legmacs/buffers.lg | 36 ++- legmacs/modes/letgo.lg | 20 +- legmacs/modes/letgo_complete.lg | 49 +++- legmacs/modes/letgo_lookup.lg | 381 ++++++++++++++++++++++++++++++++ legmacs/nrepl.lg | 52 ++++- main.lg | 1 + test/letgo_lookup_test.lg | 115 ++++++++++ test/nrepl_test.lg | 51 +++++ test/run.lg | 3 +- 12 files changed, 748 insertions(+), 13 deletions(-) create mode 100644 legmacs/modes/letgo_lookup.lg create mode 100644 test/letgo_lookup_test.lg diff --git a/CLAUDE.md b/CLAUDE.md index ba85c0c..d452127 100644 --- a/CLAUDE.md +++ b/CLAUDE.md @@ -270,7 +270,16 @@ backend makes them `spawn-task` jobs too. Remote backends return `printed-result` (text the server printed, plus captured output) since the value never existed in this VM. Completion (`legmacs.modes.letgo-complete`, TAB/M-TAB) routes the same way through a -per-backend `completers` registry. +per-backend `completers` registry, and so do eldoc, doc and `M-.` +(`legmacs.modes.letgo-lookup`, a `lookups` registry of `(fn [request] -> +info-map)`). let-go-mode's single `:after-command` now runs +paren-matching and then `letgo/after-command-hooks` (eldoc is one), each +in a try so a failing hook can't break editing. eldoc runs every key, so +it scans only back to the enclosing top-level form (a `(` in column 0) +and reads the ns form from the buffer's first 80 lines; remote answers +come from a short-TTL cache, fetched by a quiet `spawn-task`. Goto uses +a `:visit` buffer-command (show buffer by `:id`/`:filename`/`:name`, or +open `:state`, at `:row`/`:col`) and a shared `:xref-stack` for `M-,`. `legmacs.nrepl` is the nREPL backend: one connection per project root (buffers with a `:filename` under it resolve to it; fileless buffers like diff --git a/README.md b/README.md index a81dfd0..086c862 100644 --- a/README.md +++ b/README.md @@ -42,8 +42,9 @@ started: -- lgx, Clojure CLI (with cider-nrepl), Babashka, or plain `lg` -- and that project's buffers then evaluate and complete there; the server stops when you disconnect or quit -- symbol completion on `TAB`/`M-TAB`, from the editor's own VM or from - the connected server +- symbol completion on `TAB`/`M-TAB`, eldoc arglists as you type, doc + lookup (`C-c C-d d`) and goto-definition (`M-.`/`M-,`, into jars for + Clojure libraries), all from the editor's own VM or the connected server - a dedicated `*repl*` buffer (`C-c C-z`), for when you want an actual running transcript instead of building one by hand with `C-j` - `(vibe "...")`: write what you want where you want it, then use the same diff --git a/docs/GUIDE.md b/docs/GUIDE.md index f8cd73e..d98083c 100644 --- a/docs/GUIDE.md +++ b/docs/GUIDE.md @@ -242,6 +242,9 @@ forms that aren't also valid let-go: | `RET` | newline, aligned under the form it's inside | | `TAB` | re-indent the current line the same way; if that changes nothing and point is after a symbol, complete it | | `M-TAB` | complete the symbol at point (`C-M-i` sends this) | +| `M-.` | jump to the definition of the symbol at point (into a jar, read-only, for Clojure libraries) | +| `M-,` | jump back to where the last `M-.` came from | +| `C-c C-d d` | show the symbol at point's arglists, doc and source location in `*Help*` (also `C-c C-d C-d`) | | `C-c e` | expand the selection outward (word → sexp → next sexp up → ...) | | `C-c u` | contract the selection back in, undoing the last expand | | `(` / `[` / `{` | insert the matching closer too, point left between them | @@ -446,6 +449,39 @@ cider-nrepl's context-aware `complete` when it has it. A backend supplies its own with `(legmacs.modes.letgo-complete/register-completer! :backend f)`. +### Eldoc, doc, and definitions + +While you type inside a call, the echo area shows what's being called and +its arglists -- `legmacs.buffer/new-state: [filename lines]` -- whenever +nothing else is using it (a result or an error always wins). +`C-c C-d d` puts the symbol at point's arglists, docstring and source +location in `*Help*`. `M-.` jumps to its definition, opening the file if +it isn't open yet; `M-,` jumps back, across buffers, as many times as you +went forward. + +These answer from the same place as eval and completion. In the editor's +VM that's the var's own metadata, resolved through the buffer's `ns`, +its aliases, and its `ns` form's `:require`s; a relative `:file` (let-go +records `legmacs/buffer.lg`) is found from the buffer's directory +upward, then the let-go source path. On an nREPL connection the server +answers: with cider-nrepl (every Clojure CLI jack-in) that is full +arglists and docs for everything including `clojure.core`, and `M-.` +into a library opens its source straight out of the jar as a read-only +buffer. Remote eldoc answers are cached for a few seconds, so typing +doesn't mean a round trip per key. + +Two limits come from let-go rather than legmacs: its core functions +(`map`, `str`, ...) carry no arglists or docstrings, and live in the +runtime's embedded sources, so they get neither eldoc nor a file to +jump to; and its nREPL server's `info` returns only a name, so on an +`lg`/lgx connection doc and `M-.` have little to go on yet. The +AOT-built binary (`build.sh`) currently also loses `def` metadata, so +there in-process eldoc/doc/`M-.` know a var's name but not its arglists, +doc or file; running from source (`lg main.lg`, `bin/legmacs`) has all +of it. +`(reset! legmacs.modes.letgo-lookup/eldoc-enabled? false)` turns eldoc +off; a backend adds lookups with `register-lookup!`. + ### nREPL legmacs is an nREPL client @@ -910,6 +946,7 @@ Set `LEGMACS_CONFIG_DIR` to use a different directory than | [`legmacs/modes/repl.lg`](../legmacs/modes/repl.lg) | The `*repl*` buffer (`C-c C-z`): plain let-go-mode plus a `:repl` minor mode that reinterprets `RET` as evaluate-if-complete, else newline-and-indent. | | [`legmacs/nrepl.lg`](../legmacs/nrepl.lg) | nREPL client (`C-c M-c` / `C-c C-q`): bencode round trips over `net`, one connection per project root, registered as the `:nrepl` eval backend and completer for buffers under a connected root. | | [`legmacs/jack_in.lg`](../legmacs/jack_in.lg) | `C-c M-j`: launch configs (lgx, Clojure CLI, Babashka, lg), project detection, and the server process's lifecycle -- spawn under `sh`, wait for the port, stop on disconnect or exit. | +| [`legmacs/modes/letgo_lookup.lg`](../legmacs/modes/letgo_lookup.lg) | eldoc, `C-c C-d d` doc and `M-.`/`M-,` goto-definition for let-go-mode, from the editor's VM or the buffer's nREPL server. | | [`legmacs/modes/letgo_complete.lg`](../legmacs/modes/letgo_complete.lg) | Symbol completion for let-go-mode (`TAB` / `M-TAB`): in-process from the editor's VM, or from the buffer's nREPL server. | | [`legmacs/vibe.lg`](../legmacs/vibe.lg) | `(vibe "...")`: ask an LLM for let-go code, deriving surrounding-buffer context when invoked by generic `C-c C-v`, then use a tagged eval-result handler to rewrite namespaces and add missing `(:require ...)`s. | | [`legmacs/modes/markdown.lg`](../legmacs/modes/markdown.lg) | markdown-mode: syntax highlighting only (headers, emphasis, code, links, quotes, lists, rules, and fenced code blocks carried across lines). Registered for `.md`/`.markdown` files. | diff --git a/legmacs/buffers.lg b/legmacs/buffers.lg index 88c8e68..ae15453 100644 --- a/legmacs/buffers.lg +++ b/legmacs/buffers.lg @@ -68,7 +68,7 @@ ;; recording hook and legmacs.commands' start/end/call-last-kbd-macro. (def shared-keys [:clipboard :message :minibuffer :pending-prefix :pending-keys :overlay :kbd-macro-recording? :kbd-macro-chords :last-kbd-macro - :describe-key? :pending-task :async-jobs]) + :describe-key? :pending-task :async-jobs :xref-stack]) (defn new-workspace "A workspace holding one buffer (id 0, current) shown in one window @@ -234,6 +234,37 @@ (some (fn [id] (when (= name (:buffer-name (get-in workspace [:buffers id]))) id)) (:order workspace))) +(defn- find-buffer-by-filename [workspace filename] + (some (fn [id] (when (= filename (:filename (get-in workspace [:buffers id]))) id)) + (:order workspace))) + +(defn- place-cursor + "Put window `wid`'s point at row/col (clamped to its buffer), recentered." + [workspace wid row col] + (let [lines (:lines (get-in workspace [:buffers (:buffer (win/find-leaf (:windows workspace) wid))])) + row (max 0 (min (or row 0) (dec (count lines)))) + col (max 0 (min (or col 0) (count (nth lines row))))] + (update workspace :windows win/update-leaf wid + (fn [leaf] (update leaf :view assoc :cursor-row row :cursor-col col + :goal-col nil :recenter true))))) + +(defn- visit + "The :visit op: show a buffer in the active window with point at + :row/:col. The buffer is :id, else the one visiting :filename, else the + one named :name, else :state is opened as a new one (nil :state and no + match: nothing happens)." + [workspace awin cmd] + (let [id (or (:id cmd) + (when (:filename cmd) (find-buffer-by-filename workspace (:filename cmd))) + (when (:name cmd) (find-buffer-by-name workspace (:name cmd)))) + [ws id] (cond id [workspace id] + (:state cmd) (add-buffer workspace (:state cmd)) + :else [workspace nil])] + (if (and id (contains? (:buffers ws) id)) + (-> (set-window-buffer ws awin id) + (place-cursor awin (:row cmd) (:col cmd))) + ws))) + (defn- reuse-named-buffer "The find-or-create shape shared by :help and :append-named: focus the buffer named (:name cmd) with `reuse-fn` applied to it, or register @@ -261,6 +292,9 @@ ;; The Acme extension uses this for directory-scoped +Errors buffers, ;; but the operation is intentionally generic process-output plumbing. :append-named (reuse-named-buffer workspace awin cmd appended-buffer-state) + ;; show a buffer (open, or opened from :state) with point at a + ;; position: goto-definition and its way back + :visit (visit workspace awin cmd) ;; after the kill, every window that showed the dead buffer gets ;; re-pointed at whatever buffer kill-buffer-op picked as current ;; (or the fresh fallback) -- a window is never left on a buffer diff --git a/legmacs/modes/letgo.lg b/legmacs/modes/letgo.lg index f224477..4114e13 100644 --- a/legmacs/modes/letgo.lg +++ b/legmacs/modes/letgo.lg @@ -961,6 +961,24 @@ (km/bind-key! keymap "}" :auto-close-brace) (km/bind-key! keymap "DEL" :auto-delete-pair) +(def after-command-hooks + "name -> (fn [state] -> state), run after every command in let-go-mode, + after paren-matching. eldoc (legmacs.modes.letgo-lookup) is one. A + hook that throws is skipped for that command rather than breaking it." + (atom {})) + +(defn add-after-command-hook! + "Register (or replace) a let-go-mode after-command hook." + [name f] + (swap! after-command-hooks assoc name f) + name) + +(defn- run-hook [state f] + (try (f state) (catch e state))) + +(defn- let-go-after-command [state] + (reduce run-hook (update-paren-match state) (vals @after-command-hooks))) + (modes/register-mode! :let-go keymap (str "let-go-mode: C-x C-e eval-last-sexp, C-j eval-print-last-sexp, " "C-c C-v eval-and-replace, " @@ -968,7 +986,7 @@ {:highlighter highlight-line :highlight-line highlight-line-carry :highlight-carry highlight-carry - :after-command update-paren-match + :after-command let-go-after-command :status eval-backend-status}) (modes/register-auto-mode! ".lg" :let-go) ;; let-go is a Clojure dialect, and shares its reader syntax closely enough diff --git a/legmacs/modes/letgo_complete.lg b/legmacs/modes/letgo_complete.lg index 7defb40..1bd181e 100644 --- a/legmacs/modes/letgo_complete.lg +++ b/legmacs/modes/letgo_complete.lg @@ -59,6 +59,20 @@ (not (re-matches #"[+-]?\d.*" prefix))) {:row row :start start :end end :prefix prefix}))) +(defn symbol-at-point + "The whole symbol point is in, or right after, as a string; nil on a + keyword, a number, or nothing." + [state] + (let [line (nth (:lines state) (:cursor-row state)) + col (:cursor-col state) + ;; at the symbol's first char, prefix-at-point has nothing before + ;; point -- look from one char in instead + probe (if (and (< col (count line)) (symbol-char? (nth (seq line) col))) + (assoc state :cursor-col (inc col)) + state)] + (when-let [{:keys [start end]} (prefix-at-point probe)] + (subs line start end)))) + (defn- in-string-or-comment? [state] (ls/point-in-string-or-comment-at? (buf/buffer-chars state) @@ -92,13 +106,36 @@ :doc (string/trim (str (when-let [a (:arglists m)] (string/join " " (map pr-str a))) " " (or (first-line (:doc m)) "")))})) -(defn- ns-form [state] - (let [text (buf/buffer-text state) - ns? (fn [f] (and (seq? f) (= 'ns (first f)))) - first-form (try (read-string text) (catch e nil))] - (if (ns? first-form) +(def ^:private head-lines + "How far down the buffer ns-form looks before reading all of it. An ns + form is at the top and rarely this long; eldoc asks on every keystroke, + so reading only the head matters in a big file." + 80) + +(defn- ns-form? [f] (and (seq? f) (= 'ns (first f)))) + +(defn ns-form + "The buffer's (ns ...) form, or nil: the first form of its head if + that's it, else the first ns form anywhere." + [state] + (let [lines (:lines state) + head (string/join "\n" (take head-lines lines)) + first-form (try (read-string head) (catch e nil))] + (if (ns-form? first-form) first-form - (try (some (fn [f] (when (ns? f) f)) (read-all-string text)) (catch e nil))))) + (try (some (fn [f] (when (ns-form? f) f)) + (read-all-string (if (<= (count lines) head-lines) + head + (buf/buffer-text state)))) + (catch e nil))))) + +(defn ns-name-of + "The namespace symbol the buffer's ns form declares, or nil." + [state] + (let [n (second (ns-form state))] + (cond (symbol? n) n + (and (seq? n) (= 'with-meta (first n))) (second n) + :else nil))) (defn- spec-alias [spec] (when (vector? spec) diff --git a/legmacs/modes/letgo_lookup.lg b/legmacs/modes/letgo_lookup.lg new file mode 100644 index 0000000..54943e0 --- /dev/null +++ b/legmacs/modes/letgo_lookup.lg @@ -0,0 +1,381 @@ +(ns legmacs.modes.letgo-lookup + "Symbol lookup for let-go-mode: eldoc, doc, and goto-definition -- + CIDER's cider-eldoc, cider-doc (C-c C-d d), and M-. / M-,. + + - eldoc: while you type inside a call, the echo area shows the called + function's arglists, `ns/name: [x] [x y]` (only when nothing else + wants the echo area) + - C-c C-d d (also C-c C-d C-d): the symbol at point's arglists, doc, + and source location in *Help* + - M-.: jump to the definition of the symbol at point, opening its file + -- or, for a Clojure library, the file inside its jar, read-only. + M-, jumps back (a stack, across buffers) + + Like completion, lookups go to the buffer's eval backend (see + legmacs.modes.letgo/eval-backend-for): the editor's own VM resolves + the symbol in the buffer's namespace and aliases and reads the var's + metadata; an nREPL connection asks the server (cider-nrepl's `info` + and `eldoc`). A backend supplies its own with `register-lookup!`. + + An info map is {:name :ns :kind :arglists [str] :doc :file :line + :column}; any of it may be missing. let-go's own core vars carry no + arglists or docs yet, and live in the runtime's embedded sources, so + they have eldoc/doc only where the runtime provides it and no file to + jump to. The AOT-built binary also drops def metadata for now, so + there in-process lookups know names but not arglists, docs or files." + (:require [string] + [os] + [legmacs.buffer :as buf] + [legmacs.buffers :as bufs] + [legmacs.keymap :as km :refer [defcommand]] + [legmacs.path :as path] + [legmacs.commands :as commands] + [legmacs.modes :as modes] + [legmacs.modes.help :as help] + [legmacs.lisp-syntax :as ls] + [legmacs.modes.letgo :as letgo] + [legmacs.modes.letgo-complete :as complete])) + +;; --- in-process lookup ------------------------------------------------------ + +(def ^:private special-forms + #{"def" "if" "do" "let*" "fn*" "loop*" "recur" "quote" "var" "throw" "try" + "catch" "finally" "new" "set!" "letfn*" "case*"}) + +(defn- var-for + "The var `sym-str` names in `ns-sym` (or the current namespace), through + `aliases` too. Qualified names find private vars as well." + [sym-str ns-sym aliases] + (let [ns (or (when ns-sym (find-ns ns-sym)) *ns*) + aliases (merge aliases (ns-aliases ns)) + slash (string/index-of sym-str "/")] + (if (and slash (pos? slash) (< slash (dec (count sym-str)))) + (let [q (symbol (subs sym-str 0 slash)) + target (or (get aliases q) (find-ns q))] + (when target (get (ns-interns target) (symbol (subs sym-str (inc slash)))))) + (let [v (get (ns-map ns) (symbol sym-str))] + (when (var? v) v))))) + +(defn- var-name-parts + "[ns name] from the var's printed form, #'ns/name -- for when its + metadata is missing (the AOT-built binary keeps none today)." + [v] + (when-let [[_ n s] (re-matches #"#'([^/]+)/(.+)" (str v))] [n s])) + +(defn var-info + "The info map for a var, from its metadata." + [v] + (let [m (meta v) + [pns pname] (var-name-parts v) + value (try (deref v) (catch e nil))] + {:name (or (some-> (:name m) str) pname) + :ns (or (when-let [n (:ns m)] (str (ns-name n))) pns) + :kind (cond (:macro m) "macro" (fn? value) "function" :else "var") + :arglists (mapv pr-str (:arglists m)) + :doc (:doc m) + :file (:file m) :line (:line m) :column (:column m)})) + +(defn in-process-info + "Info for `sym-str` in the editor's VM, as the buffer `state` sees it." + [sym-str ns-sym state] + (if-let [v (var-for sym-str ns-sym (complete/require-aliases state))] + (var-info v) + (when (contains? special-forms sym-str) + {:name sym-str :kind "special form"}))) + +(defn- in-process-lookup [{:keys [symbol namespace state]}] + (in-process-info symbol namespace state)) + +(def lookups + "backend keyword -> (fn [request] -> info-map or nil). Remote lookups run + inside a bufs/spawn-task future. The request is {:symbol :namespace + :want (:eldoc or :info) :state :backend :context {:filename + :directory}}." + (atom {:in-process in-process-lookup})) + +(defn register-lookup! + "Supply lookups for buffers evaluated by `backend`." + [backend lookup] + (swap! lookups assoc backend lookup) + backend) + +(defn- lookup-request [state sym want] + {:symbol sym :namespace (complete/ns-name-of state) :want want :state state + :backend (:backend (letgo/eval-backend-for state)) + :context {:filename (:filename state) :directory (path/default-directory state)}}) + +;; --- running one: now in-process, or later from a server ------------------ + +(defn- lookup-io [f req] (fn [] (f req))) + +(defn- lookup-then [k sym] + (fn [state outcome] + (if-let [err (:err outcome)] + (assoc state :message (str "Lookup failed: " (or (ex-message err) (str err)))) + (k (assoc state :message nil) sym (:ok outcome))))) + +(defn- with-info + "Look `sym` up for `state` and continue with (k state sym info) -- right + away in-process, else when the backend answers." + [state sym want k] + (let [req (lookup-request state sym want) + f (get @lookups (:backend req))] + (cond + (= :in-process (:backend req)) (k state sym (in-process-lookup req)) + f (bufs/spawn-task state (lookup-io f req) (lookup-then k sym) "looking up...") + :else (assoc state :message (str "No lookup for " (name (:backend req))))))) + +(defn qualified-name [info] + (if (:ns info) (str (:ns info) "/" (:name info)) (str (:name info)))) + +;; --- eldoc --------------------------------------------------------------- + +(def ^:private scan-back-limit + "How many lines eldoc scans back for the start of the top-level form." + 300) + +(defn- top-level-start + "The nearest row at or above `row` that starts a top-level form (a `(` + in column 0), so eldoc scans one form rather than the whole file." + [lines row] + (let [floor (max 0 (- row scan-back-limit))] + (loop [r row] + (cond + (<= r floor) floor + (string/starts-with? (nth lines r) "(") r + :else (recur (dec r)))))) + +(defn call-at-point + "The symbol in function position of the innermost list around point -- + what eldoc describes -- or nil (point in a string or comment, or the + list's head isn't a symbol)." + [state] + (let [{:keys [lines cursor-row cursor-col]} state + r0 (top-level-start lines cursor-row) + text (str (string/join "\n" (subvec lines r0 cursor-row)) + (when (> cursor-row r0) "\n") + (subs (nth lines cursor-row) 0 cursor-col)) + {:keys [stack code?]} (ls/open-stack-at* text (count text)) + paren (first (filter (fn [[ch _]] (= ch \()) stack))] + (when (and code? paren) + (let [head (re-find #"^[^\s,()\[\]{}\"';`~@^\\]+" (subs text (inc (second paren))))] + (when (and head + (not (string/starts-with? head ":")) + (not (re-matches #"[+-]?\d.*" head))) + head))))) + +(defn eldoc-string + "`ns/name: [x] [x y]`, or nil when there are no arglists to show." + [info] + (when (seq (:arglists info)) + (str (qualified-name info) ": " (string/join " " (:arglists info))))) + +(def eldoc-enabled? + "Set to false to turn eldoc off." + (atom true)) + +(def ^:private eldoc-ttl-ms 15000) + +(def ^:private eldoc-cache + "Remote eldoc answers, [backend directory ns symbol] -> [time string-or-nil]. + Short-lived, since evaluating a new defn changes the answer." + (atom {})) + +(def ^:private eldoc-pending (atom #{})) + +(defn- now-ms [] (.UnixMilli (now))) + +(defn- cache-key [req] + [(:backend req) (get-in req [:context :directory]) (:namespace req) (:symbol req)]) + +(defn- cached [k] + (when-let [[t v] (get @eldoc-cache k)] + (when (< (- (now-ms) t) eldoc-ttl-ms) [v]))) + +(defn- fetch-eldoc + "Background half of a remote eldoc: ask, cache, clear the pending mark." + [f req k] + (fn [] + (let [v (try (eldoc-string (f req)) (catch e nil))] + (swap! eldoc-cache assoc k [(now-ms) v]) + (swap! eldoc-pending disj k) + v))) + +(declare eldoc) + +(defn- eldoc-arrived [state _outcome] (eldoc state)) + +(defn- remote-eldoc [state req] + (let [k (cache-key req) + f (get @lookups (:backend req))] + (if-let [[v] (cached k)] + (if v (assoc state :message v) state) + (if (or (nil? f) (contains? @eldoc-pending k)) + state + (do (swap! eldoc-pending conj k) + (bufs/spawn-task state (fetch-eldoc f req k) eldoc-arrived)))))) + +(defn eldoc + "let-go-mode after-command hook: show the enclosing call's arglists in + the echo area -- unless something already put a message there or the + minibuffer is open." + [state] + (if (or (not @eldoc-enabled?) (:message state) (:minibuffer state) (:overlay state)) + state + (if-let [sym (call-at-point state)] + (let [req (lookup-request state sym :eldoc)] + (if (= :in-process (:backend req)) + (if-let [s (eldoc-string (in-process-lookup req))] + (assoc state :message s) + state) + (remote-eldoc state req))) + state))) + +(letgo/add-after-command-hook! :eldoc eldoc) + +;; --- doc ------------------------------------------------------------------- + +(defn doc-lines + "The *Help* page for an info map." + [info] + (let [doc (when-let [d (:doc info)] (map #(str " " (string/trim %)) (string/split d "\n"))) + where (when (:file info) + (str "Defined in " (string/replace (:file info) #"^(jar:)?file:(//)?" "") + (when (:line info) (str ":" (:line info)))))] + (vec (concat [(qualified-name info)] + (when (:kind info) [(:kind info)]) + (when (seq (:arglists info)) [(string/join " " (:arglists info))]) + [""] + (or (seq doc) [" (no documentation)"]) + (when where ["" where]))))) + +(defn- show-doc-for [state sym info] + (if info + (help/pop-to-help state "*Help*" (doc-lines info)) + (assoc state :message (str "No documentation for " sym)))) + +(defcommand show-doc + "Show the doc, arglists and source location of the symbol at point in + *Help* (CIDER's C-c C-d d)." + [state] + (if-let [sym (complete/symbol-at-point state)] + (with-info state sym :info show-doc-for) + (assoc state :message "No symbol at point"))) + +;; --- goto definition ------------------------------------------------------- + +(defn- exists? [p] (some? (os/stat p))) + +(defn- ancestors-of [dir] + (loop [d (path/absolute-path dir), out []] + (let [up (path/dirname d)] + (if (and up (not= up d)) (recur up (conj out d)) (conj out d))))) + +(defn- source-roots + "Where a relative :file could live: the buffer's directory and its + ancestors (a project-relative path like src/demo/core.clj), then the + let-go source path, then the editor's cwd." + [state] + (let [env (os/getenv "LG_SOURCE_PATHS")] + (distinct + (concat (ancestors-of (path/default-directory state)) + (when (seq env) + (map path/absolute-path (remove string/blank? (string/split env os/path-separator)))) + [(os/cwd)])))) + +(defn locate + "Where a definition's :file is: {:path abs} for a file on disk, {:jar + :entry} for a file inside a jar, {:embedded name} for let-go's embedded + sources, or nil when it can't be found." + [file state] + (cond + (string/starts-with? file "jar:") + (let [s (string/replace (subs file 4) #"^file:(//)?" "") + i (string/index-of s "!/")] + (when i {:jar (subs s 0 i) :entry (subs s (+ i 2))})) + (string/starts-with? file "file:") {:path (string/replace file #"^file:(//)?" "")} + (string/starts-with? file "<") {:embedded file} + (path/absolute? file) (when (exists? file) {:path file}) + :else (some (fn [root] + (let [p (path/join root file)] (when (exists? p) {:path p}))) + (source-roots state)))) + +(def ^:private xref-depth 50) + +(defn- push-xref [state] + (assoc state :xref-stack + (take xref-depth (cons {:id (:current-buffer-id state) + :row (:cursor-row state) :col (:cursor-col state)} + (:xref-stack state))))) + +(defn- goto-here [state row col] + (-> state + buf/push-mark + (assoc :cursor-row row :cursor-col col :goal-col nil :recenter true) + buf/clamp-cursor)) + +(defn- open-buffer-id [state abs] + (some (fn [b] (when (and (:filename b) (= abs (path/absolute-path (:filename b)))) (:id b))) + (:buffer-list state))) + +(defn- visit-path [state abs row col] + (let [current (when (:filename state) (path/absolute-path (:filename state)))] + (if (= current abs) + (goto-here (push-xref state) row col) + (let [id (open-buffer-id state abs)] + (assoc (push-xref state) + :buffer-command (if id + {:op :visit :id id :row row :col col} + {:op :visit :filename abs :row row :col col + :state (first (commands/new-file-state abs))})))))) + +(defn- jar-buffer-state [jar entry name] + (let [text (:out (os/sh "unzip" "-p" jar entry))] + (when-not (string/blank? text) + (-> (buf/new-state nil (buf/split-lines text)) + (modes/switch-to-mode :let-go) + (assoc :buffer-name name :read-only? true + :default-directory (path/directory-of jar)))))) + +(defn- visit-jar [state jar entry row col] + (let [name (str entry " (" (last (string/split jar "/")) ")")] + (if (some #(= name (:name %)) (:buffer-list state)) + (assoc (push-xref state) :buffer-command {:op :visit :name name :row row :col col}) + (if-let [st (jar-buffer-state jar entry name)] + (assoc (push-xref state) :buffer-command {:op :visit :name name :state st :row row :col col}) + (assoc state :message (str "Couldn't read " entry " from " jar)))))) + +(defn- goto-info [state sym info] + (let [where (when-let [f (:file info)] (locate f state)) + row (dec (or (:line info) 1)) + col (dec (or (:column info) 1))] + (cond + (nil? info) (assoc state :message (str "No definition found for " sym)) + (nil? (:file info)) (assoc state :message (str "No source location for " (qualified-name info))) + (:embedded where) (assoc state :message (str (qualified-name info) " is in let-go's embedded " + (:embedded where) " (no file to open)")) + (:jar where) (visit-jar state (:jar where) (:entry where) row col) + (:path where) (visit-path state (:path where) row col) + :else (assoc state :message (str "Can't find " (:file info)))))) + +(defcommand find-definition + "Jump to the definition of the symbol at point (M-.); M-, comes back." + [state] + (if-let [sym (complete/symbol-at-point state)] + (with-info state sym :info goto-info) + (assoc state :message "No symbol at point"))) + +(defcommand pop-definition-stack + "Go back to where the last M-. jumped from (M-,)." + [state] + (if-let [{:keys [id row col]} (first (:xref-stack state))] + (let [state (assoc state :xref-stack (rest (:xref-stack state)))] + (if (= id (:current-buffer-id state)) + (goto-here state row col) + (assoc state :buffer-command {:op :visit :id id :row row :col col}))) + (assoc state :message "No previous location"))) + +(km/bind-key! letgo/keymap "M-." :find-definition) +(km/bind-key! letgo/keymap "M-," :pop-definition-stack) +(km/bind-key! letgo/keymap "C-c C-d d" :show-doc) +(km/bind-key! letgo/keymap "C-c C-d C-d" :show-doc) diff --git a/legmacs/nrepl.lg b/legmacs/nrepl.lg index 3ac0cab..0543de1 100644 --- a/legmacs/nrepl.lg +++ b/legmacs/nrepl.lg @@ -34,7 +34,8 @@ [legmacs.minibuffer :as mb] [legmacs.path :as path] [legmacs.modes.letgo :as letgo] - [legmacs.modes.letgo-complete :as complete])) + [legmacs.modes.letgo-complete :as complete] + [legmacs.modes.letgo-lookup :as lookup])) (def default-port 2137) @@ -360,6 +361,55 @@ (complete/register-completer! :nrepl nrepl-completer) +;; --- lookup (eldoc, doc, M-.) ---------------------------------------------- + +(defn lookup-message + "cider-nrepl's `eldoc` for eldoc when the server has it, else `info` + (cider-nrepl, let-go) or nREPL 1.x's built-in `lookup`." + [conn sym ns want] + (let [ops (:ops conn) + op (cond (and (= want :eldoc) (contains? ops "eldoc")) "eldoc" + (contains? ops "info") "info" + (contains? ops "lookup") "lookup" + :else "info")] + (cond-> {:op op :sym sym} + ns (assoc :ns (str ns))))) + +(defn- eldoc-arglist [args] + (str "[" (string/join " " args) "]")) + +(defn reply->info + "An info map (see legmacs.modes.letgo-lookup) from `info`, `lookup` + (which nests its answer under \"info\") or `eldoc` replies; nil when + the server knows nothing about the symbol." + [replies] + (let [r (reduce (fn [acc r] (merge acc (or (get r "info") r))) {} replies) + status (set (mapcat #(get % "status") replies)) + arglists (cond + (seq (get r "eldoc")) (mapv eldoc-arglist (get r "eldoc")) + (get r "arglists-str") (vec (remove string/blank? + (string/split (get r "arglists-str") "\n"))) + :else [])] + (when (and (not (contains? status "no-info")) (or (get r "name") (get r "doc"))) + {:name (get r "name") + :ns (get r "ns") + :kind (cond (get r "special-form") "special form" + (get r "macro") "macro" + (get r "type") (get r "type") + :else nil) + :arglists arglists + :doc (or (get r "doc") (get r "docstring")) + :file (get r "file") + :line (get r "line") + :column (get r "column")}))) + +(defn nrepl-lookup [req] + (let [conn (connection-for-request req)] + (reply->info + (request conn (lookup-message conn (:symbol req) (:namespace req) (:want req)))))) + +(lookup/register-lookup! :nrepl nrepl-lookup) + ;; --- commands ------------------------------------------------------------ (defn root-for diff --git a/main.lg b/main.lg index d15704c..6b35e82 100644 --- a/main.lg +++ b/main.lg @@ -28,6 +28,7 @@ [legmacs.modes.keycast] [legmacs.modes.help] [legmacs.modes.letgo-complete] + [legmacs.modes.letgo-lookup] [legmacs.nrepl] [legmacs.jack-in] ;; :refer, not just :as -- (vibe "...") typed into a buffer is diff --git a/test/letgo_lookup_test.lg b/test/letgo_lookup_test.lg new file mode 100644 index 0000000..ab4219a --- /dev/null +++ b/test/letgo_lookup_test.lg @@ -0,0 +1,115 @@ +(ns test.letgo-lookup-test + (:require [test :refer :all] + [string] + [legmacs.buffer :as buf] + [legmacs.buffers :as bufs] + [legmacs.modes :as modes] + [legmacs.bindings :as bindings] + [legmacs.dispatch :as dispatch] + [legmacs.path :as path] + [legmacs.modes.letgo] + [legmacs.modes.letgo-lookup :as l])) + +(bindings/install!) + +;; A buffer that requires legmacs.buffer under an alias: every lookup below +;; resolves through the editor's own VM, where that namespace is loaded +;; and its vars carry real :arglists/:doc/:file metadata. +(def src ["(ns demo (:require [legmacs.buffer :as b]))" + "(b/new-state nil [])" + "(b/clamp 1 2 3)" + "(str \"(b/clamp \")"]) + +(defn- lg-state + ([row col] (lg-state src row col)) + ([lines row col] + (-> (buf/new-state (str (os/cwd) "/demo.lg") lines) + (modes/switch-to-mode :let-go) + (assoc :cursor-row row :cursor-col col :current-buffer-id 7)))) + +(deftest call-at-point-finds-the-function-position + (is (= "b/new-state" (l/call-at-point (lg-state 1 13)))) + (is (= "b/new-state" (l/call-at-point (lg-state 1 18))) "inside a nested vector") + (is (nil? (l/call-at-point (lg-state 3 12))) "inside a string") + (is (nil? (l/call-at-point (lg-state ["(:k 1)"] 0 4))))) + +(deftest in-process-info-reads-var-metadata + (let [info (l/in-process-info "b/new-state" 'demo (lg-state 1 1))] + (is (= "legmacs.buffer" (:ns info))) + (is (= "new-state" (:name info))) + (is (= ["[filename lines]"] (:arglists info))) + (is (= "function" (:kind info))) + (is (= "legmacs/buffer.lg" (:file info))) + (is (number? (:line info)))) + (is (= "special form" (:kind (l/in-process-info "if" nil (lg-state 1 1))))) + (is (nil? (l/in-process-info "no-such-thing" nil (lg-state 1 1))))) + +(deftest eldoc-shows-arglists-when-the-echo-area-is-free + (is (= "legmacs.buffer/new-state: [filename lines]" (:message (l/eldoc (lg-state 1 13))))) + (is (= "=> 3" (:message (l/eldoc (assoc (lg-state 1 13) :message "=> 3"))))) + (is (nil? (:message (l/eldoc (lg-state 3 12))))) + (testing "it runs by itself after each command in let-go-mode" + (is (= "legmacs.buffer/new-state: [filename lines]" + (:message (dispatch/dispatch (lg-state 1 12) "C-f")))))) + +(deftest doc-opens-help + (let [s (l/show-doc (lg-state 2 4)) + lines (get-in s [:buffer-command :state :lines])] + (is (= :help (get-in s [:buffer-command :op]))) + (is (= "legmacs.buffer/clamp" (first lines))) + (is (some #(string/starts-with? % "Defined in legmacs/buffer.lg:") lines))) + (is (= "No documentation for zzz" (:message (l/show-doc (lg-state ["(zzz)"] 0 2)))))) + +(deftest locate-cases + (let [s (lg-state 1 1)] + (is (= {:jar "/m2/clojure.jar" :entry "clojure/core.clj"} + (l/locate "jar:file:/m2/clojure.jar!/clojure/core.clj" s))) + (is (= {:path "/src/a.clj"} (l/locate "file:/src/a.clj" s))) + (is (= {:embedded ""} (l/locate "" s))) + (testing "relative to the source path (here: the cwd the suite runs in)" + (is (= {:path (path/join (os/cwd) "legmacs/buffer.lg")} (l/locate "legmacs/buffer.lg" s)))) + (is (nil? (l/locate "nowhere/at/all.lg" s))))) + +(deftest find-definition-and-back + (testing "another file: a :visit of it at the def's line, with a way back" + (let [s (l/find-definition (lg-state 1 5)) + cmd (:buffer-command s)] + (is (= :visit (:op cmd))) + (is (string/ends-with? (:filename cmd) "legmacs/buffer.lg")) + (is (= (dec (:line (meta #'buf/new-state))) (:row cmd))) + (is (some #(string/starts-with? % "(ns legmacs.buffer") (:lines (:state cmd))) + "not yet open: loaded fresh") + (is (= [{:id 7 :row 1 :col 5}] (vec (:xref-stack s)))))) + (testing "already open: switch by id instead of loading again" + (let [abs (path/join (os/cwd) "legmacs/buffer.lg") + s (l/find-definition (assoc (lg-state 1 5) :buffer-list [{:id 3 :filename abs}]))] + (is (= 3 (get-in s [:buffer-command :id]))) + (is (nil? (get-in s [:buffer-command :state]))))) + (testing "M-, returns" + (let [s (-> (lg-state 1 5) (assoc :xref-stack (list {:id 7 :row 2 :col 3})) l/pop-definition-stack)] + (is (= [2 3] [(:cursor-row s) (:cursor-col s)])) + (is (empty? (:xref-stack s)))) + (let [s (-> (lg-state 1 5) (assoc :xref-stack (list {:id 2 :row 9 :col 0})) l/pop-definition-stack)] + (is (= {:op :visit :id 2 :row 9 :col 0} (:buffer-command s)))) + (is (= "No previous location" (:message (l/pop-definition-stack (lg-state 1 5)))))) + (testing "a core var has no file to open" + (is (string/includes? (:message (l/find-definition (lg-state ["(map inc [])"] 0 2))) + "embedded"))) + (testing "the keys" + (is (= :visit (get-in (dispatch/dispatch (lg-state 1 5) "M-.") [:buffer-command :op]))))) + +(deftest visit-op-shows-a-buffer-at-a-position + (let [ws (bufs/new-workspace (buf/new-state nil ["scratch"])) + other (buf/new-state "/tmp/other.lg" ["a" "bb" "ccc"]) + ws (bufs/put-current ws (assoc (bufs/current ws) :buffer-command + {:op :visit :filename "/tmp/other.lg" :state other :row 2 :col 1})) + cur (bufs/current ws)] + (is (= "/tmp/other.lg" (:filename cur))) + (is (= [2 1] [(:cursor-row cur) (:cursor-col cur)])) + (testing "visiting it again reuses the buffer, and clamps the position" + (let [ws (bufs/put-current ws (assoc cur :buffer-command {:op :switch :id 0})) + ws (bufs/put-current ws (assoc (bufs/current ws) :buffer-command + {:op :visit :filename "/tmp/other.lg" :row 99 :col 99})) + cur (bufs/current ws)] + (is (= 2 (count (:buffer-list cur)))) + (is (= [2 3] [(:cursor-row cur) (:cursor-col cur)])))))) diff --git a/test/nrepl_test.lg b/test/nrepl_test.lg index 7f7ae37..5fb3b72 100644 --- a/test/nrepl_test.lg +++ b/test/nrepl_test.lg @@ -7,6 +7,7 @@ [legmacs.buffer :as buf] [legmacs.modes :as modes] [legmacs.modes.letgo :as lg-mode] + [legmacs.modes.letgo-lookup :as lookup] [legmacs.nrepl :as nrepl])) ;; The pure half is tested directly; the wire half against a fake server @@ -98,6 +99,11 @@ ns (get msg "ns" "user")] (case op "clone" (reply! c msg {"new-session" "sess-1" "status" ["done"]}) + "info" (if (= "sq" (get msg "sym")) + (reply! c msg {"name" "sq" "ns" "demo.core" "doc" "Squares." + "arglists-str" "[x]" "file" "file:/src/demo.lg" + "line" 2 "column" 1 "status" ["done"]}) + (reply! c msg {"status" ["done" "no-info"]})) ("eval" "load-file") (do ;; a straggler for some other id first: the client must skip it @@ -209,6 +215,51 @@ (assoc :cursor-col 7))] (is (= "=> 3" (:message (lg-mode/eval-last-sexp s))))))))) +(deftest reply->info-shapes + (testing "cider-nrepl info" + (is (= {:name "sq" :ns "demo" :kind nil :arglists ["[x]" "[x y]"] :doc "Sq." + :file "file:/a.clj" :line 3 :column 1} + (nrepl/reply->info [{"name" "sq" "ns" "demo" "doc" "Sq." "arglists-str" "[x]\n[x y]" + "file" "file:/a.clj" "line" 3 "column" 1 "status" ["done"]}])))) + (testing "cider-nrepl eldoc" + (is (= ["[f]" "[f coll]"] + (:arglists (nrepl/reply->info [{"name" "map" "ns" "clojure.core" "type" "function" + "eldoc" [["f"] ["f" "coll"]] "status" ["done"]}]))))) + (testing "nREPL's built-in lookup nests its answer" + (is (= "Sq." (:doc (nrepl/reply->info [{"info" {"name" "sq" "doc" "Sq."} "status" ["done"]}]))))) + (testing "nothing known" + (is (nil? (nrepl/reply->info [{"status" ["done" "no-info"]}]))) + (is (nil? (nrepl/reply->info [{"status" ["done"]}]))))) + +(deftest lookup-message-picks-the-op + (is (= {:op "eldoc" :sym "map" :ns "demo"} + (nrepl/lookup-message {:ops #{"eldoc" "info"}} "map" 'demo :eldoc))) + (is (= {:op "info" :sym "map" :ns "demo"} + (nrepl/lookup-message {:ops #{"eldoc" "info"}} "map" 'demo :info))) + (is (= {:op "lookup" :sym "map"} (nrepl/lookup-message {:ops #{"lookup"}} "map" nil :eldoc)))) + +(deftest lookups-go-through-the-server + (with-fake-connection + (fn [_conn _seen] + (testing "eldoc: asks in the background, then shows the answer" + (let [s (-> (lg-buffer ["(sq 1)"] 3) (assoc :message nil)) + asking (lookup/eldoc s) + done (settle-first-job asking)] + (is (nil? (:message asking))) + (is (seq (:async-jobs asking))) + (is (= "demo.core/sq: [x]" (:message done))) + (testing "and answers from its cache next time, without asking" + (let [again (lookup/eldoc (assoc s :message nil))] + (is (= "demo.core/sq: [x]" (:message again))) + (is (empty? (:async-jobs again))))))) + (testing "doc" + (let [done (settle-first-job (lookup/show-doc (lg-buffer ["(sq 1)"] 2)))] + (is (= "demo.core/sq" (first (get-in done [:buffer-command :state :lines])))))) + (testing "M-. in the same file moves point" + (let [done (settle-first-job (lookup/find-definition (lg-buffer ["(sq 1)" "(defn sq [x])"] 2)))] + (is (= [1 0] [(:cursor-row done) (:cursor-col done)])) + (is (nil? (:message done)))))))) + (deftest disconnected-means-in-process-again (is (not (nrepl/connected?))) (is (= :in-process @lg-mode/current-eval-backend)) diff --git a/test/run.lg b/test/run.lg index 2a851d0..8ee3c0d 100644 --- a/test/run.lg +++ b/test/run.lg @@ -32,7 +32,8 @@ [test.vibe-test] [test.nrepl-test] [test.jack-in-test] - [test.letgo-complete-test])) + [test.letgo-complete-test] + [test.letgo-lookup-test])) ;; run-tests with no args only tests *ns* (test.run itself, which has none). (run-all-tests #"test\..*-test") From 16458631fe9b0feb9a2f3c0fda00e35581f3527b Mon Sep 17 00:00:00 2001 From: Marcin Gasperowicz Date: Thu, 24 Sep 2026 02:27:07 +0100 Subject: [PATCH 5/5] build: pin let-go main (36d57e3) for net/bencode, put lg on the test PATH The nREPL client needs let-go's net and bencode namespaces, which the old pin (a665761) predates. build/go.mod/go.sum are go mod tidy against the new pin. The suite now runs for real (it ran 0 tests before), and the jack-in tests start an actual lg -n server, so CI's test step puts the freshly built lg on PATH. Tests clean up with rm -rf rather than os/delete-tree for the same reason: not every lg has it. Co-Authored-By: Claude Opus 5.5 --- .github/workflows/test.yml | 4 +++- .let-go-version | 2 +- build/go.mod | 17 +++++++++++---- build/go.sum | 42 +++++++++++++++++++++++++------------- test/jack_in_test.lg | 4 ++-- test/nrepl_test.lg | 2 +- 6 files changed, 48 insertions(+), 23 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 6418c6b..b5c2142 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -37,9 +37,11 @@ jobs: run: | go build -C "$GITHUB_WORKSPACE/../let-go" -o "$GITHUB_WORKSPACE/../lg" . + # lg goes on PATH too: the jack-in tests start a real `lg -n` server + # the same way the editor does. - name: Run test suite run: | - "$GITHUB_WORKSPACE/../lg" test/run.lg + PATH="$GITHUB_WORKSPACE/..:$PATH" "$GITHUB_WORKSPACE/../lg" test/run.lg # Full AOT native build (build lg, lower legmacs.*, bundle, go build) -- the # same path release.yml ships. Guards against a build break landing on main. diff --git a/.let-go-version b/.let-go-version index a3f82af..40d9801 100644 --- a/.let-go-version +++ b/.let-go-version @@ -5,4 +5,4 @@ # May be a commit SHA (reproducible) or a branch name like `main` (tracks tip). # legmacs's AOT build needs the gogen lowering + scripts/lg-compile tooling, # which live on main; bump this SHA when you want newer let-go fixes. -a6657612002bd70b277617368985639992d1c11b +36d57e3693075f9e63e4aff49b220331ff3fea12 diff --git a/build/go.mod b/build/go.mod index db9031a..b676f90 100644 --- a/build/go.mod +++ b/build/go.mod @@ -1,15 +1,24 @@ module legmacs/build -go 1.26 +go 1.27 require github.com/nooga/let-go v0.0.0-00010101000000-000000000000 require ( - github.com/klauspost/cpuid/v2 v2.2.10 // indirect + github.com/ebitengine/gomobile v0.0.0-20260820040257-d11f821a26a6 // indirect + github.com/ebitengine/hideconsole v1.0.0 // indirect + github.com/ebitengine/purego v0.11.0 // indirect + github.com/go-gl/gl v0.0.0-20260331235117-4566fea9a276 // indirect + github.com/go-gl/glfw/v3.3/glfw v0.0.0-20260823155953-d41da22a9587 // indirect + github.com/hajimehoshi/ebiten/v2 v2.10.2 // indirect + github.com/klauspost/cpuid/v2 v2.4.0 // indirect github.com/zeebo/bencode v1.0.0 // indirect github.com/zeebo/xxh3 v1.1.0 // indirect - golang.org/x/sys v0.44.0 // indirect - golang.org/x/term v0.41.0 // indirect + golang.org/x/image v0.46.0 // indirect + golang.org/x/sync v0.23.0 // indirect + golang.org/x/sys v0.48.0 // indirect + golang.org/x/term v0.46.0 // indirect + golang.org/x/text v0.42.0 // indirect ) replace github.com/nooga/let-go => ../../let-go diff --git a/build/go.sum b/build/go.sum index 203ebc7..e0aacb4 100644 --- a/build/go.sum +++ b/build/go.sum @@ -1,20 +1,34 @@ -github.com/davecgh/go-spew v1.1.1 h1:vj9j/u1bqnvCEfJOwUhtlOARqs3+rkHYY13jYWTU97c= -github.com/davecgh/go-spew v1.1.1/go.mod h1:J7Y8YcW2NihsgmVo/mv3lAwl/skON4iLHjSsI+c5H38= -github.com/klauspost/cpuid/v2 v2.2.10 h1:tBs3QSyvjDyFTq3uoc/9xFpCuOsJQFNPiAhYdw2skhE= -github.com/klauspost/cpuid/v2 v2.2.10/go.mod h1:hqwkgyIinND0mEev00jJYCxPNVRVXFQeu1XKlok6oO0= -github.com/pmezard/go-difflib v1.0.0 h1:4DBwDE0NGyQoBHbLQYPwSUPoCMWR5BEzIk/f1lZbAQM= -github.com/pmezard/go-difflib v1.0.0/go.mod h1:iKH77koFhYxTK1pcRnkKkqfTogsbg7gZNVY4sRDYZ/4= -github.com/stretchr/testify v1.8.4 h1:CcVxjf3Q8PM0mHUKJCdn+eZZtm5yQwehR5yeSVQQcUk= -github.com/stretchr/testify v1.8.4/go.mod h1:sz/lmYIOXD/1dqDmKjjqLyZ2RngseejIcXlSw2iwfAo= +github.com/ebitengine/gomobile v0.0.0-20260820040257-d11f821a26a6 h1:Tnc3YtzxhgsvNdNrER9wWkGJbyjOwyUuzjUY5rZK72k= +github.com/ebitengine/gomobile v0.0.0-20260820040257-d11f821a26a6/go.mod h1:gwnFEwdzWZpNehgwkeK4756Ez58f58bXz6bgEAq+xqk= +github.com/ebitengine/hideconsole v1.0.0 h1:5J4U0kXF+pv/DhiXt5/lTz0eO5ogJ1iXb8Yj1yReDqE= +github.com/ebitengine/hideconsole v1.0.0/go.mod h1:hTTBTvVYWKBuxPr7peweneWdkUwEuHuB3C1R/ielR1A= +github.com/ebitengine/purego v0.11.0 h1:jhp/D+Nyv7UUW8HAcmcjt2N2rYrYi9m3SL21k0Ua/NI= +github.com/ebitengine/purego v0.11.0/go.mod h1:DCHPP08djqhNSoTfImcnHYQRZmd0qhakvrozqaEYhGQ= +github.com/go-gl/gl v0.0.0-20260331235117-4566fea9a276 h1:IO5P06Pcj9K04d+l4nrf3c2U56+dAotIFG6u4P1wAHI= +github.com/go-gl/gl v0.0.0-20260331235117-4566fea9a276/go.mod h1:9YTyiznxEY1fVinfM7RvRcjRHbw2xLBJ3AAGIT0I4Nw= +github.com/go-gl/glfw/v3.3/glfw v0.0.0-20260823155953-d41da22a9587 h1:yzPGEmWIlLQvQ0HvNHpRzLwyJ3pAmVXpa6pGclnH9Ks= +github.com/go-gl/glfw/v3.3/glfw v0.0.0-20260823155953-d41da22a9587/go.mod h1:SyRD8YfuKk+ZXlDqYiqe1qMSqjNgtHzBTG810KUagMc= +github.com/hajimehoshi/ebiten/v2 v2.10.2 h1:uNMOpfb/pW7GQRMsSn/pxwrk9rNcgSaIdjKwFZS11LM= +github.com/hajimehoshi/ebiten/v2 v2.10.2/go.mod h1:47QNgyS/y2ZRkjVUvlGLx8a+F7MSjcn8/GsjcCZ9Rc8= +github.com/klauspost/cpuid/v2 v2.4.0 h1:S6Hrbc7+ywsr0r+RLapfGBHfyefhCTwEh3A0tV913Dw= +github.com/klauspost/cpuid/v2 v2.4.0/go.mod h1:19jmZ9mjzoF//ddRSUsv0zfBTJWh3QJh9FNxZTMrGxU= +github.com/stretchr/testify v1.12.1 h1:EuwCh5fleGS7H32xRwO3wRGT7DxrDhLAT6FF8MpWDWE= +github.com/stretchr/testify v1.12.1/go.mod h1:MDEgiDPPsNp5cuIrHPPCyornHKgEVbtFUmoNlxoYthg= github.com/zeebo/assert v1.3.0 h1:g7C04CbJuIDKNPFHmsk4hwZDO5O+kntRxzaUoNXj+IQ= github.com/zeebo/assert v1.3.0/go.mod h1:Pq9JiuJQpG8JLJdtkwrJESF0Foym2/D9XMU5ciN/wJ0= github.com/zeebo/bencode v1.0.0 h1:zgop0Wu1nu4IexAZeCZ5qbsjU4O1vMrfCrVgUjbHVuA= github.com/zeebo/bencode v1.0.0/go.mod h1:Ct7CkrWIQuLWAy9M3atFHYq4kG9Ao/SsY5cdtCXmp9Y= github.com/zeebo/xxh3 v1.1.0 h1:s7DLGDK45Dyfg7++yxI0khrfwq9661w9EN78eP/UZVs= github.com/zeebo/xxh3 v1.1.0/go.mod h1:IisAie1LELR4xhVinxWS5+zf1lA4p0MW4T+w+W07F5s= -golang.org/x/sys v0.44.0 h1:ildZl3J4uzeKP07r2F++Op7E9B29JRUy+a27EibtBTQ= -golang.org/x/sys v0.44.0/go.mod h1:4GL1E5IUh+htKOUEOaiffhrAeqysfVGipDYzABqnCmw= -golang.org/x/term v0.41.0 h1:QCgPso/Q3RTJx2Th4bDLqML4W6iJiaXFq2/ftQF13YU= -golang.org/x/term v0.41.0/go.mod h1:3pfBgksrReYfZ5lvYM0kSO0LIkAl4Yl2bXOkKP7Ec2A= -gopkg.in/yaml.v3 v3.0.1 h1:fxVm/GzAzEWqLHuvctI91KS9hhNmmWOoWu0XTYJS7CA= -gopkg.in/yaml.v3 v3.0.1/go.mod h1:K4uyk7z7BCEPqu6E+C64Yfv1cQ7kz7rIZviUmN+EgEM= +go.yaml.in/yaml/v3 v3.0.5 h1:N6y/pJk8buWs9NY5ERU2HSMfm+IuD/OtfdAnq6kESPw= +go.yaml.in/yaml/v3 v3.0.5/go.mod h1:HVTZu1O7/Vkt2N+BFy8Zza+lnLsABggaTM2ZpNIGuKg= +golang.org/x/image v0.46.0 h1:b1+oYj0Jbp6K5MDT4i4/eZpYlk3V8SJhhDKh6LBHAyQ= +golang.org/x/image v0.46.0/go.mod h1:3B3W05VGVQyuXucLINLjXKrqISASfi4Xj+iCVkLMwew= +golang.org/x/sync v0.23.0 h1:KameEIfc1IkluZyXWLn39Wd4tURc6GbCiISGiZm2bQk= +golang.org/x/sync v0.23.0/go.mod h1:sUUOizhqBxiL6pEWpqNLUiaJn1ShEbZ6BBqskPbjZm0= +golang.org/x/sys v0.48.0 h1:bbX/i/6MgT9BVLM9RT1thmxL04yeTAhbEz4SyadbXoo= +golang.org/x/sys v0.48.0/go.mod h1:hNLxWAXmnKAxqDtdwIYC4bM9oQPEecfsnNMuSxOs3og= +golang.org/x/term v0.46.0 h1:3+OXuTbaKDgwk8jTi3aSLHRlmWqHEUDUtxnbFigO4YE= +golang.org/x/term v0.46.0/go.mod h1:+K02xbkittuwc0Am4abfA3Fc+XRGXkvBXNO88NCXPoc= +golang.org/x/text v0.42.0 h1:JbOZXgfeCPU9gacVtYliJqOhD+zhrEqK4LfdpmlUZqI= +golang.org/x/text v0.42.0/go.mod h1:ojzP1Z+2QtioaF8DTtO8K5q7JWVVYwZKenzujK0Zd0E= diff --git a/test/jack_in_test.lg b/test/jack_in_test.lg index f65f856..927695c 100644 --- a/test/jack_in_test.lg +++ b/test/jack_in_test.lg @@ -64,7 +64,7 @@ (is (= "server exited: $ sh -c 'echo no such flag >&2; exit 3' | no such flag" (try (j/await-server proc 20000) (catch e (or (ex-message e) (str e)))))) (is (not (j/alive? proc))) - (finally (j/stop! proc) (os/delete-tree dir))))) + (finally (j/stop! proc) (os/sh "rm" "-rf" dir))))) (deftest jack-in-starts-connects-and-stops-plain-lg (let [dir (temp-project) @@ -92,4 +92,4 @@ (is (not (contains? @j/processes (:pid-file proc)))))) (finally (nrepl/close-all!) - (os/delete-tree dir))))) + (os/sh "rm" "-rf" dir))))) diff --git a/test/nrepl_test.lg b/test/nrepl_test.lg index 5fb3b72..fa97b2c 100644 --- a/test/nrepl_test.lg +++ b/test/nrepl_test.lg @@ -86,7 +86,7 @@ (spit (str root "/.nrepl-port") "7888\n") (is (= "7888" (nrepl/find-port-file deep))) (is (= "7888" (nrepl/find-port-file root))) - (finally (os/delete-tree root))))) + (finally (os/sh "rm" "-rf" root))))) ;; --- fake server ----------------------------------------------------------