From 4197db6227c34d858af449432be9d992f4ffba3c Mon Sep 17 00:00:00 2001 From: dharmatech Date: Fri, 14 Aug 2026 05:27:12 -0700 Subject: [PATCH 1/2] Add buffer directory and named output infrastructure --- legmacs/buffer.lg | 1 + legmacs/buffers.lg | 32 +++++++++++++++++- legmacs/commands.lg | 39 +++++++++++++++++----- legmacs/modeline.lg | 2 +- legmacs/path.lg | 77 ++++++++++++++++++++++++++++++++++++++++++++ main.lg | 1 + test/buffers_test.lg | 16 +++++++++ 7 files changed, 158 insertions(+), 10 deletions(-) create mode 100644 legmacs/path.lg diff --git a/legmacs/buffer.lg b/legmacs/buffer.lg index 3ef72e7..64b9902 100644 --- a/legmacs/buffer.lg +++ b/legmacs/buffer.lg @@ -32,6 +32,7 @@ :scroll-col 0 :goal-col nil :filename filename + :default-directory nil :buffer-name nil :modified? false :message nil diff --git a/legmacs/buffers.lg b/legmacs/buffers.lg index 442eade..02a5fd2 100644 --- a/legmacs/buffers.lg +++ b/legmacs/buffers.lg @@ -26,7 +26,7 @@ ;; showing it resumes there). Window commands are just more :buffer-command ;; ops: {:op :split :dir :below}, {:op :other-window}, {:op :delete-window}, ;; {:op :delete-other-windows}. The buffer-switching ops (:switch, -;; :open-new, :next, :prev, :help) now mean "in the active window"; +;; :open-new, :next, :prev, :help, :append-named) now mean "in the active window"; ;; :kill also re-points any window that showed the killed buffer. ;; ;; :current (the active buffer id) is kept in sync with the active @@ -178,6 +178,22 @@ (update :next-id inc)) id])) +(defn- appended-buffer-state + "Append `addition`'s text to an existing generated buffer, separated by a + blank line, and leave point at the end. Process output is not a user edit: + the existing buffer's modified and undo state are deliberately preserved." + [existing addition] + (let [old-lines (:lines existing) + new-lines (:lines addition) + old-lines (if (= [""] old-lines) [] old-lines) + lines (vec (concat old-lines (when (seq old-lines) [""]) new-lines)) + row (dec (count lines))] + (assoc existing + :lines lines + :cursor-row row + :cursor-col (count (nth lines row)) + :goal-col nil))) + (defn- apply-buffer-command "Apply one :buffer-command to the workspace. The buffer-switching ops act on the active window; the window ops reshape the tree itself." @@ -187,6 +203,20 @@ :switch (set-window-buffer workspace awin (:id cmd)) :open-new (let [[ws id] (add-buffer workspace (:state cmd))] (set-window-buffer ws awin id)) + ;; A named, editable output buffer that accumulates blocks over time. + ;; The Acme extension uses this for directory-scoped +Errors buffers, + ;; but the operation is intentionally generic process-output plumbing. + :append-named + (if-let [existing (some (fn [id] + (when (= (:name cmd) + (:buffer-name (get-in workspace [:buffers id]))) + id)) + (:order workspace))] + (-> workspace + (update-in [:buffers existing] appended-buffer-state (:state cmd)) + (set-window-buffer awin existing)) + (let [[ws id] (add-buffer workspace (:state cmd))] + (set-window-buffer ws awin id))) ;; 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/commands.lg b/legmacs/commands.lg index 9437cc9..7277f5f 100644 --- a/legmacs/commands.lg +++ b/legmacs/commands.lg @@ -8,6 +8,7 @@ (:require [string] [os] [legmacs.buffer :as buf] + [legmacs.path :as path] [legmacs.keymap :as km :refer [defcommand]] [legmacs.minibuffer :as mb] [legmacs.completion :as completion] @@ -419,7 +420,15 @@ (defn write-buffer-to [state path] (spit path (buf/join-lines (:lines state))) (-> state - (assoc :filename path :modified? false) + ;; Saving a named/generated buffer turns it into an ordinary file + ;; buffer. In particular, saving an editable Acme directory listing + ;; must not leave the directory's display name or generated-kind marker + ;; attached to the newly written file. + (assoc :filename path + :default-directory (path/directory-of path) + :buffer-name nil + :modified? false) + (dissoc :directory-buffer?) (set-message (str "Wrote " path)))) (defcommand save-buffer @@ -464,9 +473,14 @@ file with. [state message] -- message says whether it was loaded or is a new file, for callers that want to show it." [path] - (if-let [content (try (slurp path) (catch e nil))] - [(with-auto-mode (buf/new-state path (buf/split-lines content)) path) (str "Loaded " path)] - [(with-auto-mode (buf/new-state path [""]) path) (str "New file " path)])) + (let [directory (path/directory-of path)] + (if-let [content (try (slurp path) (catch e nil))] + [(assoc (with-auto-mode (buf/new-state path (buf/split-lines content)) path) + :default-directory directory) + (str "Loaded " path)] + [(assoc (with-auto-mode (buf/new-state path [""]) path) + :default-directory directory) + (str "New file " path)]))) (defcommand find-file "Open a file in a new buffer, or switch to it if it's already open -- @@ -530,7 +544,10 @@ (if-let [existing (some #(when (= (:name %) name) %) (:buffer-list state))] (assoc state :buffer-command {:op :switch :id (:id existing)}) (assoc state :buffer-command - {:op :open-new :state (assoc (buf/new-state nil [""]) :buffer-name name)})))) + {:op :open-new + :state (assoc (buf/new-state nil [""]) + :buffer-name name + :default-directory (path/default-directory state))})))) {:submit-selected? true :completer (fn [input] (completion/fuzzy-filter input (map :name (:buffer-list state))))})) @@ -544,7 +561,10 @@ [state] (if-let [existing (some #(when (= (:name %) "*repl*") %) (:buffer-list state))] (assoc state :buffer-command {:op :switch :id (:id existing)}) - (assoc state :buffer-command {:op :open-new :state (repl/new-repl-state)}))) + (assoc state :buffer-command + {:op :open-new + :state (assoc (repl/new-repl-state) + :default-directory (path/default-directory state))}))) (defcommand list-buffers "Show every open buffer: name, modified flag, mode." @@ -559,7 +579,9 @@ [state] (let [do-kill (fn [state] (assoc state :buffer-command - {:op :kill :id (:current-buffer-id state) :fallback (buf/new-state nil [""])}))] + {:op :kill :id (:current-buffer-id state) + :fallback (assoc (buf/new-state nil [""]) + :default-directory (path/default-directory state))}))] (if (:modified? state) (ask-yes-or-no state "Buffer modified; kill anyway? (y/n) " do-kill (fn [state] (set-message state ""))) (do-kill state)))) @@ -714,7 +736,8 @@ [state name lines] (let [buf (-> (buf/new-state nil (vec lines)) (modes/switch-to-mode :help) - (assoc :buffer-name name :read-only? true))] + (assoc :buffer-name name :read-only? true + :default-directory (path/default-directory state)))] (assoc state :buffer-command {:op :help :name name :state buf}))) (defcommand describe-bindings diff --git a/legmacs/modeline.lg b/legmacs/modeline.lg index ee76311..c24b5ba 100644 --- a/legmacs/modeline.lg +++ b/legmacs/modeline.lg @@ -109,7 +109,7 @@ ;; here is privileged. Remove or replace any of them from init.lg with ;; remove-modeline-segment!/register-modeline-segment!. -(defn- buffer-label [state] (or (:filename state) "*scratch*")) +(defn- buffer-label [state] (or (:buffer-name state) (:filename state) "*scratch*")) (defn- buffer-segment "A colored badge: dusty indigo when saved, warm red when there are diff --git a/legmacs/path.lg b/legmacs/path.lg new file mode 100644 index 0000000..d8bf31a --- /dev/null +++ b/legmacs/path.lg @@ -0,0 +1,77 @@ +;; legmacs.path — small path/context helpers shared by file-oriented +;; commands and optional extensions. The filesystem operations themselves +;; stay in their callers; this namespace only answers "what directory gives +;; this buffer's text meaning?" and joins paths using the host separator. + +(ns legmacs.path + (:require [string] + [os])) + +(defn absolute? + "True when `path` is absolute on the current host. Plan 9 and Unix use a + leading separator. The drive-letter case keeps this helper sensible if + let-go gains Windows terminal support later." + [path] + (and (string? path) (seq path) + (or (string/starts-with? path os/file-separator) + (and (= os/file-separator (str (char 92))) + (> (count path) 2) + (= (int (nth path 1)) 58))))) + +(defn strip-trailing-separators + "Remove trailing separators without turning the filesystem root into an + empty string." + [path] + (loop [p path] + (if (and (> (count p) 1) (string/ends-with? p os/file-separator)) + (recur (subs p 0 (dec (count p)))) + p))) + +(defn join + "Join `dir` and `child`, preserving an already-absolute child. This is a + deliberately textual join: the host filesystem remains responsible for + interpreting `.` and `..`." + [dir child] + (cond + (absolute? child) child + (string/blank? dir) child + (string/ends-with? dir os/file-separator) (str dir child) + :else (str dir os/file-separator child))) + +(defn absolute-path + "Interpret a relative path in the editor process's current directory." + [path] + (if (absolute? path) path (join (os/cwd) path))) + +(defn dirname + "The textual parent directory of `path`, or nil when it has no separator." + [path] + (let [path (strip-trailing-separators path)] + (when-let [i (string/last-index-of path os/file-separator)] + (if (= i 0) os/file-separator (subs path 0 i))))) + +(defn directory-of + "The absolute directory containing `filename`." + [filename] + (or (dirname (absolute-path filename)) (os/cwd))) + +(defn default-directory + "The directory context for `state`: an explicit per-buffer value wins, + then the containing directory of its file, then the process directory." + [state] + (or (:default-directory state) + (when-let [filename (:filename state)] (directory-of filename)) + (os/cwd))) + +(defn resolve + "Interpret `target` in `state`'s directory context." + [state target] + (if (absolute? target) target (join (default-directory state) target))) + +(defn display-directory + "A directory name ending in a separator, matching Acme's visual convention." + [dir] + (let [dir (strip-trailing-separators dir)] + (if (string/ends-with? dir os/file-separator) + dir + (str dir os/file-separator)))) diff --git a/main.lg b/main.lg index d2ebf98..4379bf5 100644 --- a/main.lg +++ b/main.lg @@ -77,6 +77,7 @@ (first (commands/new-file-state path)) (-> (buf/new-state nil scratch-banner) (modes/switch-to-mode :let-go) + (assoc :default-directory (os/cwd)) (assoc :cursor-row (dec (count scratch-banner)))))) (defn- load-user-config! [] diff --git a/test/buffers_test.lg b/test/buffers_test.lg index 6fd2937..97d39fd 100644 --- a/test/buffers_test.lg +++ b/test/buffers_test.lg @@ -122,6 +122,22 @@ (defn- send [ws cmd] (bufs/put-current ws (assoc (bufs/current ws) :buffer-command cmd))) +(deftest append-named-creates-reuses-and-accumulates-output + (let [first-state (assoc (buf/new-state nil ["; pwd" "/tmp"]) + :buffer-name "/tmp/+Errors") + second-state (assoc (buf/new-state nil ["; echo hi" "hi"]) + :buffer-name "/tmp/+Errors") + ws (bufs/new-workspace (buf/new-state nil ["source"])) + ws (send ws {:op :append-named :name "/tmp/+Errors" :state first-state}) + output-id (:current ws) + ws (send ws {:op :append-named :name "/tmp/+Errors" :state second-state})] + (is (= output-id (:current ws))) + (is (= 2 (count (:order ws)))) + (is (= ["; pwd" "/tmp" "" "; echo hi" "hi"] + (:lines (bufs/current ws)))) + (is (= 4 (:cursor-row (bufs/current ws)))) + (is (= 2 (:cursor-col (bufs/current ws)))))) + (deftest split-adds-a-window-on-the-same-buffer (testing "C-x 2's op leaves focus in the original window, both showing the buffer" (let [ws (bufs/new-workspace (buf/new-state "a.txt" ["one" "two"])) From 31b7a4afd08e1b4ef2956a42c7ffcc821f5db5b5 Mon Sep 17 00:00:00 2001 From: dharmatech Date: Fri, 14 Aug 2026 05:27:32 -0700 Subject: [PATCH 2/2] Add optional Acme Look and Execute extension --- docs/design/acme-look.md | 89 +++++++++++ examples/legmacs_acme_init.example.lg | 10 ++ legmacs/extensions/acme.lg | 207 ++++++++++++++++++++++++++ test/acme_extension_test.lg | 114 ++++++++++++++ test/run.lg | 3 +- 5 files changed, 422 insertions(+), 1 deletion(-) create mode 100644 docs/design/acme-look.md create mode 100644 examples/legmacs_acme_init.example.lg create mode 100644 legmacs/extensions/acme.lg create mode 100644 test/acme_extension_test.lg diff --git a/docs/design/acme-look.md b/docs/design/acme-look.md new file mode 100644 index 0000000..2f94839 --- /dev/null +++ b/docs/design/acme-look.md @@ -0,0 +1,89 @@ +# Acme-inspired Look and Execute experiment + +LegMacs can explore Acme's text-as-interface model without turning the whole +editor into an Acme clone and without precluding a future Dired mode. The +first experiments are optional keyboard-driven `Look` and `Execute` actions. + +## First slice + +`look-at-point` obtains a target from the active region, or from a +filename-like token touching point when there is no selection. It interprets +relative targets in the current buffer's `:default-directory`. + +- An existing regular file opens through LegMacs's normal file/buffer path. +- An existing directory opens as a plain writable text buffer containing one + entry per line; subdirectories carry a trailing slash. +- Missing text reports an error. Look never creates a new file. +- Re-looking an open file or directory reuses its buffer. +- Directory-buffer edits are only text edits and never mutate the filesystem. + +The directory listing has no special major mode and suppresses no ordinary +editing keys. This is the intentional contrast with Dired: it is contextual +text on which the same global Look action can operate. + +## Optional loading + +The extension is inert unless a user loads it. Requiring its namespace makes +`look-at-point` and `execute-at-point` available through `M-x`; calling +`enable!` additionally binds F7 to Execute and F8 to Look: + +```clojure +(ns legmacs-init + (:require [legmacs.extensions.acme :as acme])) + +(acme/enable!) ; F7 Execute, F8 Look +``` + +## Directory context + +Every buffer may carry `:default-directory`, analogous to Acme's window +directory and Emacs's buffer-local `default-directory`: + +- file buffers use the file's containing directory; +- directory listings use the listed directory; +- generated buffers can inherit the originating buffer's context; +- buffers without an explicit value fall back to their filename or the + editor process directory. + +This context is deliberately useful outside the extension: a future shell +command, compiler-output buffer, Dired mode, or REPL can use the same field. + +## Deferred behavior + +The first slice does not implement Acme addresses (`file.c:27`), literal-text +search, include lookup, plumber fallback, automatic filesystem mutation, or +Dired operations. Those should be separate additions +after the basic Look workflow has been tested interactively. + +Display policy is also separate from target resolution. This first command +uses the active LegMacs window. A future `look-at-point-other-window` can +split or focus another window without changing path recognition. + +## Execute slice + +`execute-at-point` is the keyboard analogue of Acme button 2 and is bound to +F7 by `enable!`. It uses the same text expansion as Look: a non-empty active +region wins; otherwise the conservative filename-like token touching point is +the command. This matches the expansion documented by 9front release 11554's +`acme(1)` and the Acme paper. + +The command is evaluated by `rc -p -c` in the originating buffer's +`:default-directory`. On Plan 9, `-p` prevents a new rc from importing +CPU-session `/env/fn#*` entries itself. The script creates a private +environment group with `rfork e` and removes copied `fn#*` entries there, so +nested rc scripts also start cleanly without changing LegMacs' environment. +It then establishes `path=(. /bin)` for Acme-like local-first lookup. A safely +quoted `cd` prefix gives the child its context without changing the LegMacs +process directory. Standard input is not connected; stdout and stderr are +captured after the command completes. + +Each directory has one ordinary writable buffer named `dir/+Errors`. F7 +opens or focuses that buffer, and later executions from the same directory +append a blank-line-separated block containing the command and its output. +Edits in this buffer are only text edits. + +This is deliberately a synchronous first slice: LegMacs pauses while the +command runs. It is intended initially for short commands such as `pwd`, +`ls`, `ps`, and pipelines. Asynchronous jobs, live streaming, interactive +stdin, cancellation, process status, and exact stdout/stderr interleaving are +deferred until this basic interaction has been exercised on Plan 9. diff --git a/examples/legmacs_acme_init.example.lg b/examples/legmacs_acme_init.example.lg new file mode 100644 index 0000000..5d1f901 --- /dev/null +++ b/examples/legmacs_acme_init.example.lg @@ -0,0 +1,10 @@ +;; Minimal opt-in for the Acme-inspired Look and Execute experiment. +;; +;; Copy this to ~/.config/legmacs/legmacs_init.lg, or merge the require and +;; enable! call into an existing config. The extension registers its commands +;; when required; enable! adds the default F7 Execute and F8 Look bindings. + +(ns legmacs-init + (:require [legmacs.extensions.acme :as acme])) + +(acme/enable!) diff --git a/legmacs/extensions/acme.lg b/legmacs/extensions/acme.lg new file mode 100644 index 0000000..b016c95 --- /dev/null +++ b/legmacs/extensions/acme.lg @@ -0,0 +1,207 @@ +;; legmacs.extensions.acme — an optional, keyboard-driven experiment with +;; Acme's Look and Execute interactions. Selected text wins; otherwise both +;; actions expand the path-like token at point, matching Acme's button-2/3 +;; click expansion. Look opens an existing file or directory. Execute runs +;; a short, non-interactive rc expression and appends its output to a plain +;; editable, directory-scoped +Errors buffer. + +(ns legmacs.extensions.acme + (:require [string] + [os] + [legmacs.buffer :as buf] + [legmacs.commands :as commands] + [legmacs.keymap :as km :refer [defcommand]] + [legmacs.path :as path])) + +(defn path-char? + "Acme's conservative single-click filename alphabet: alphanumerics plus + underscore, dot, dash, plus, and slash. A selected region can still name + a path containing other characters, including spaces." + [ch] + (or (buf/word-char? ch) + (contains? #{\. \- \+ \/} ch))) + +(defn path-bounds-at + "[start-col end-col] for the path-like token touching point on the current + line. Point immediately after a token still refers to that token." + [state] + (let [line (buf/current-line state) + col (:cursor-col state) + len (count line) + char-at (fn [i] (when (and (<= 0 i) (< i len)) (nth line i))) + anchor (cond + (path-char? (char-at col)) col + (path-char? (char-at (dec col))) (dec col) + :else nil)] + (when anchor + (let [start (loop [i anchor] + (if (path-char? (char-at (dec i))) (recur (dec i)) i)) + end (loop [i (inc anchor)] + (if (path-char? (char-at i)) (recur (inc i)) i))] + [start end])))) + +(defn target-text + "The active region's text when non-empty, otherwise the path token at + point. Trimming makes a deliberately swept path convenient without + changing the single-click/token rules." + [state] + (let [selected (when (buf/region-active? state) + (string/trim (buf/region-text state)))] + (if (seq selected) + selected + (when-let [[start end] (path-bounds-at state)] + (subs (buf/current-line state) start end))))) + +(defn- entry-line [dir entry] + (let [full (path/join dir entry) + info (try (os/stat full) (catch e nil))] + (if (:dir? info) (str entry os/file-separator) entry))) + +(defn directory-state + "A plain writable buffer listing `dir`. Its body is only text: editing or + deleting a line never changes the filesystem." + [dir] + (let [dir (path/strip-trailing-separators dir) + entries (os/ls dir) + lines (mapv (fn [entry] (entry-line dir entry)) entries)] + (assoc (buf/new-state nil lines) + :buffer-name (path/display-directory dir) + :default-directory dir + :directory-buffer? true))) + +(defn- existing-file-id [state filename] + (some (fn [entry] + (when-let [open-name (:filename entry)] + (when (= filename (path/absolute-path open-name)) (:id entry)))) + (:buffer-list state))) + +(defn- existing-directory-id [state dir] + (let [name (path/display-directory dir)] + (some (fn [entry] + (when (and (nil? (:filename entry)) (= name (:name entry))) + (:id entry))) + (:buffer-list state)))) + +(defn- open-file [state filename] + (if-let [id (existing-file-id state filename)] + (assoc state :buffer-command {:op :switch :id id} + :message (str "Look: switched to " filename)) + (let [[fresh message] (commands/new-file-state filename)] + ;; Look never creates a file. A path that existed at stat time but + ;; could not be read is an error, not an empty "new file" buffer. + (if (string/starts-with? message "New file ") + (assoc state :message (str "Look: could not read " filename)) + (assoc state :buffer-command {:op :open-new :state fresh} + :message message))))) + +(defn- open-directory [state dir] + (if-let [id (existing-directory-id state dir)] + (assoc state :buffer-command {:op :switch :id id} + :message (str "Look: switched to " (path/display-directory dir))) + (try + (assoc state :buffer-command {:op :open-new :state (directory-state dir)} + :message (str "Listed " (path/display-directory dir))) + (catch e + (assoc state :message (str "Look: could not list " dir)))))) + +(defcommand look-at-point + "Open the existing file or directory named by the active region or the + path-like token at point, interpreted in this buffer's directory context." + [state] + (if-let [target (target-text state)] + (let [resolved (path/resolve state target) + info (try (os/stat resolved) (catch e nil))] + (cond + (nil? info) (assoc state :message (str "Look: no file or directory: " target)) + (:dir? info) (open-directory state resolved) + :else (open-file state resolved))) + (assoc state :message "Look: no target at point"))) + +(defn rc-quote + "Quote one string for rc. Inside rc single quotes, an apostrophe is + represented by two apostrophes." + [text] + (str "'" (string/replace text "'" "''") "'")) + +(defn rc-script + "Wrap `command` so rc evaluates it in this buffer's directory context + without changing the LegMacs process's own working directory. `rc -p` + skips importing inherited CPU-session functions itself. A private + environment group then drops fn# entries before the command runs, so rc + scripts launched by the command also start cleanly. Finally the script + restores Acme-like local-first lookup explicitly." + [state command] + (str "rfork e; rm -f '/env/fn#'*; path=(. /bin); cd " + (rc-quote (path/default-directory state)) "; " command)) + +(defn- nonblank-lines [text] + (if (string/blank? text) [] (buf/split-lines text))) + +(defn execute-result-lines + "Render one completed command as an appendable +Errors block. os/sh + captures stdout and stderr separately, so stderr is labeled when present; + this first synchronous slice does not attempt stream interleaving." + [command result] + (let [out-lines (nonblank-lines (:out result)) + err-lines (nonblank-lines (:err result)) + exit (:exit result) + no-output? (and (empty? out-lines) (empty? err-lines))] + (vec (concat (buf/split-lines (str "; " command)) + out-lines + (when (seq err-lines) (concat ["[stderr]"] err-lines)) + (cond + (not (zero? exit)) [(format "[exit %d]" exit)] + no-output? ["(no output)"] + :else []))))) + +(defn errors-buffer-name [dir] + (str (path/display-directory dir) "+Errors")) + +(defn execute-output-state + "A writable buffer state containing one command's output block. The + workspace's :append-named operation creates or appends it to the matching + directory-scoped +Errors buffer." + [dir command result] + (let [lines (execute-result-lines command result) + row (dec (count lines))] + (assoc (buf/new-state nil lines) + :buffer-name (errors-buffer-name dir) + :default-directory dir + :acme-errors-buffer? true + :cursor-row row + :cursor-col (count (nth lines row))))) + +(defn apply-execute-result + "Turn a completed rc result into the buffer command consumed by the + workspace. Public separately from process launch so its state transition + can be tested without requiring rc on the host running the test suite." + [state command result] + (let [dir (path/default-directory state) + output (execute-output-state dir command result) + exit (:exit result)] + (assoc state + :buffer-command {:op :append-named + :name (:buffer-name output) + :state output} + :message (format "Execute: rc exited %d" exit)))) + +(defcommand execute-at-point + "Run the active region, or the path-like token at point, as a synchronous + non-interactive rc expression in this buffer's directory context. Output + is appended to an ordinary editable directory/+Errors buffer." + [state] + (if-let [command (target-text state)] + (let [result (try + (os/sh "rc" "-p" "-c" (rc-script state command)) + (catch e + {:exit 127 :out "" :err (str "could not start rc: " e)}))] + (apply-execute-result state command result)) + (assoc state :message "Execute: no command at point"))) + +(defn enable! + "Enable the Acme experiment's default bindings: F7 executes like button 2; + F8 looks like button 3. Requiring this namespace alone only registers the + two commands for M-x." + [] + (km/bind-key! "f7" :execute-at-point) + (km/bind-key! "f8" :look-at-point)) diff --git a/test/acme_extension_test.lg b/test/acme_extension_test.lg new file mode 100644 index 0000000..2de714d --- /dev/null +++ b/test/acme_extension_test.lg @@ -0,0 +1,114 @@ +(ns test.acme-extension-test + (:require [test :refer :all] + [string] + [os] + [legmacs.buffer :as buf] + [legmacs.extensions.acme :as acme] + [legmacs.keymap :as km] + [legmacs.path :as path])) + +(deftest target-text-prefers-selection-then-expands-point + (testing "a path-like token touching point is expanded without a region" + (let [line "see \"legmacs/buffer.lg\" now" + s (assoc (buf/new-state nil [line]) + :cursor-col (string/index-of line "buffer"))] + (is (= "legmacs/buffer.lg" (acme/target-text s))))) + + (testing "point immediately after the token still refers to it" + (let [line "legmacs/buffer.lg " + s (assoc (buf/new-state nil [line]) :cursor-col (dec (count line)))] + (is (= "legmacs/buffer.lg" (acme/target-text s))))) + + (testing "an active region wins and can contain characters token expansion excludes" + (let [line "prefix path with spaces suffix" + start (string/index-of line "path") + end (+ start (count "path with spaces")) + s (assoc (buf/new-state nil [line]) :mark [0 start] :cursor-col end)] + (is (= "path with spaces" (acme/target-text s)))))) + +(deftest path-context-resolves-relative-targets + (let [s (assoc (buf/new-state "/usr/glenda/src/legmacs/main.lg" [""]) + :default-directory "/usr/glenda/src/legmacs")] + (is (= "/usr/glenda/src/legmacs/legmacs/buffer.lg" + (path/resolve s "legmacs/buffer.lg"))) + (is (= "/sys/src/cmd/acme/acme.c" (path/resolve s "/sys/src/cmd/acme/acme.c"))))) + +(deftest look-opens-files-and-reuses-open-buffers + (let [filename (path/join (os/cwd) "legmacs/buffer.lg") + base (assoc (buf/new-state nil ["legmacs/buffer.lg"]) + :cursor-col 10 + :default-directory (os/cwd) + :buffer-list []) + opened (acme/look-at-point base)] + (is (= :open-new (:op (:buffer-command opened)))) + (is (= filename (:filename (:state (:buffer-command opened))))) + (is (= (path/directory-of filename) + (:default-directory (:state (:buffer-command opened))))) + + (let [reused (acme/look-at-point + (assoc base :buffer-list + [{:id 7 :name "buffer.lg" :filename filename :modified? false :mode nil}]))] + (is (= {:op :switch :id 7} (:buffer-command reused)))))) + +(deftest look-opens-directories-as-plain-editable-text + (let [dir (path/join (os/cwd) "legmacs") + s (assoc (buf/new-state nil ["legmacs/"]) + :cursor-col 3 + :default-directory (os/cwd) + :buffer-list []) + looked (acme/look-at-point s) + listing (:state (:buffer-command looked))] + (is (= :open-new (:op (:buffer-command looked)))) + (is (nil? (:filename listing))) + (is (= dir (:default-directory listing))) + (is (= (path/display-directory dir) (:buffer-name listing))) + (is (some #(= "buffer.lg" %) (:lines listing))) + (is (some #(= (str "modes" os/file-separator) %) (:lines listing))) + (is (not (:read-only? listing))) + (is (:modified? (buf/insert-string listing "note "))))) + +(deftest look-reuses-an-open-directory-buffer + (let [dir (path/join (os/cwd) "legmacs") + name (path/display-directory dir) + s (assoc (buf/new-state nil ["legmacs/"]) + :cursor-col 3 + :default-directory (os/cwd) + :buffer-list [{:id 8 :name name :filename nil :modified? true :mode nil}]) + looked (acme/look-at-point s)] + (is (= {:op :switch :id 8} (:buffer-command looked))))) + +(deftest look-never-creates-a-missing-target + (let [s (assoc (buf/new-state nil ["definitely-not-a-legmacs-path"]) + :cursor-col 5 + :default-directory (os/cwd) + :buffer-list []) + looked (acme/look-at-point s)] + (is (nil? (:buffer-command looked))) + (is (string/includes? (:message looked) "no file or directory")))) + +(deftest enabling-the-extension-binds-f7-and-f8 + (acme/enable!) + (is (= [:command :execute-at-point] (km/lookup @km/global-keymap "f7"))) + (is (= [:command :look-at-point] (km/lookup @km/global-keymap "f8")))) + +(deftest execute-builds-a-directory-scoped-rc-command + (let [s (assoc (buf/new-state nil [""]) + :default-directory "/tmp/we're-here")] + (is (= "rfork e; rm -f '/env/fn#'*; path=(. /bin); cd '/tmp/we''re-here'; pwd" + (acme/rc-script s "pwd"))))) + +(deftest execute-result-opens-an-editable-errors-buffer + (let [s (assoc (buf/new-state nil ["ls -l /"]) + :default-directory "/usr/glenda/src" + :buffer-list []) + result {:exit 1 :out "one\ntwo\n" :err "oops\n"} + executed (acme/apply-execute-result s "ls -l /" result) + cmd (:buffer-command executed) + output (:state cmd)] + (is (= :append-named (:op cmd))) + (is (= "/usr/glenda/src/+Errors" (:name cmd))) + (is (= ["; ls -l /" "one" "two" "[stderr]" "oops" "[exit 1]"] + (:lines output))) + (is (= "/usr/glenda/src" (:default-directory output))) + (is (not (:read-only? output))) + (is (:modified? (buf/insert-string output "note "))))) diff --git a/test/run.lg b/test/run.lg index 59f2df7..ab99982 100644 --- a/test/run.lg +++ b/test/run.lg @@ -24,6 +24,7 @@ [test.lisp-syntax-test] [test.buffers-test] [test.windows-test] - [test.kbd-macro-test])) + [test.kbd-macro-test] + [test.acme-extension-test])) (run-tests)