diff --git a/legmacs/buffer.lg b/legmacs/buffer.lg index 3ef72e7..dda6172 100644 --- a/legmacs/buffer.lg +++ b/legmacs/buffer.lg @@ -396,12 +396,54 @@ (assoc state :scroll-row (max 0 scroll-row) :scroll-col (max 0 scroll-col)))) ;; --- whole-buffer text access (for eval, search-the-whole-thing, etc.) ----- +;; +;; Paren-match / electric-pair / auto-indent run after every keystroke and +;; used to string/join the whole buffer, then count/subs that string from +;; the start (both O(n) in let-go). Cursor motion doesn't replace :lines, +;; so we cache a char vector and per-line start offsets against that +;; vector's identity -- a move is then nth, not a rebuild. + +(def ^:private flat-cache (atom nil)) + +(defn- build-flat [lines] + (let [n (count lines)] + (loop [i 0, off 0, starts [], lens [], chars []] + (if (>= i n) + {:lines lines :starts starts :lens lens :chars chars} + (let [line (nth lines i) + chs (vec (seq line)) + len (count chs) + chars (reduce conj chars chs) + chars (if (< i (dec n)) (conj chars \newline) chars)] + (recur (inc i) + (+ off len (if (< i (dec n)) 1 0)) + (conj starts off) + (conj lens len) + chars)))))) + +(defn- flat-index + "Cached {:starts :lens :chars} for `state`'s current :lines." + [state] + (let [lines (:lines state) + cached @flat-cache] + (if (and cached (identical? lines (:lines cached))) + cached + (let [built (build-flat lines)] + (reset! flat-cache built) + built)))) + +(defn buffer-chars + "The buffer as a char vector (newlines between lines, no trailing + newline) -- the shape lisp-syntax/prog-syntax scan. Cached against + :lines identity so a cursor move doesn't rebuild it." + [state] + (:chars (flat-index state))) (defn buffer-text "The whole buffer joined with newlines -- no trailing newline, unlike join-lines (which is for writing files)." [state] - (string/join "\n" (:lines state))) + (apply str (buffer-chars state))) (defn text-before-cursor "Everything in the buffer up to (not including) the cursor, as one @@ -521,28 +563,28 @@ ;; --- offset <-> [row col] -------------------------------------------- ;; -;; legmacs.lisp-syntax scans the buffer as one flat string (buffer-text -- -;; string/join "\n" lines), since bracket-matching/sexp boundaries are -;; naturally a flat-text problem. These convert between that flat -;; character offset and the [row col] the rest of the editor speaks. +;; lisp-syntax/prog-syntax scan a flat char vector (buffer-chars). These +;; convert between that offset and the [row col] the rest of the editor +;; speaks, using the cached per-line lengths so we don't recount strings. (defn offset-of "The offset into (buffer-text state) of [row col]. Each line contributes (count line) + 1 for its joining newline." [state row col] - (let [lines (:lines state)] - (+ (reduce + 0 (map #(inc (count %)) (subvec lines 0 row))) col))) + (let [starts (:starts (flat-index state))] + (+ (nth starts row 0) col))) (defn row-col-of "The inverse of offset-of: the [row col] at flat offset `offset`." [state offset] - (loop [row 0, remaining offset, lines (:lines state)] - (if (empty? lines) - [row remaining] - (let [len (count (first lines))] - (if (<= remaining len) - [row remaining] - (recur (inc row) (- remaining len 1) (rest lines))))))) + (let [lens (:lens (flat-index state))] + (loop [row 0, remaining offset] + (if (>= row (count lens)) + [row remaining] + (let [len (nth lens row)] + (if (<= remaining len) + [row remaining] + (recur (inc row) (- remaining len 1)))))))) ;; --- symbol at point (word-level expand-region) ----------------------- diff --git a/legmacs/indent.lg b/legmacs/indent.lg index b44d70e..ad68462 100644 --- a/legmacs/indent.lg +++ b/legmacs/indent.lg @@ -161,8 +161,8 @@ "Bracket depth at the start of `row`, minus one level if the line pulls itself back (see dedents-itself?)." [state row code ws rules spec width] - (let [text (buf/buffer-text state) - depth (ps/depth-at text (buf/offset-of state row 0) spec) + (let [chars (buf/buffer-chars state) + depth (ps/depth-at chars (buf/offset-of state row 0) spec) level (- depth (if (dedents-itself? code ws rules spec) 1 0))] (* width (max 0 level)))) diff --git a/legmacs/lisp_syntax.lg b/legmacs/lisp_syntax.lg index 638ae35..8256230 100644 --- a/legmacs/lisp_syntax.lg +++ b/legmacs/lisp_syntax.lg @@ -14,6 +14,12 @@ (ns legmacs.lisp-syntax (:require [string])) +(defn- as-chars + "Scan input as a char vector. Callers that already have one (buffer-chars) + skip the copy; a string is converted once." + [text] + (if (vector? text) text (vec (seq text)))) + (def ^:private open->close {\( \) \[ \] \{ \}}) (def ^:private close->open {\) \( \] \[ \} \{}) @@ -58,9 +64,9 @@ :spans alone can't answer this because a string closed exactly at upto and a string still open at upto both end up with an identical trailing {:end upto} span" - ([text] (scan text (count text))) + ([text] (let [chars (as-chars text)] (scan chars (count chars)))) ([text upto] - (let [chars (vec (seq text)) + (let [chars (as-chars text) len (min upto (count chars))] (loop [i 0, stack (), pairs {}, spans [], str-start nil] (cond @@ -167,7 +173,7 @@ over everything above point, so it doesn't allocate what nobody is going to read." [text offset] - (let [chars (vec (seq text)) + (let [chars (as-chars text) n (count chars) len (min offset n)] ;; every skip is capped at `len`, so a string or comment that hasn't @@ -226,9 +232,9 @@ matching -- a closer's match is just the innermost bracket still open in front of it -- and the half that runs the instant you type one." [text offset] - (let [chars (vec (seq text)) + (let [chars (as-chars text) ch (when (< -1 offset (count chars)) (nth chars offset)) - {:keys [stack code?]} (open-stack-at* text offset) + {:keys [stack code?]} (open-stack-at* chars offset) [open-ch open-offset] (first stack)] (when (and ch code? open-ch (= ch (get open->close open-ch))) open-offset))) diff --git a/legmacs/modes/letgo.lg b/legmacs/modes/letgo.lg index 171aafc..7fdb398 100644 --- a/legmacs/modes/letgo.lg +++ b/legmacs/modes/letgo.lg @@ -160,18 +160,18 @@ ;; it stays current after every edit or cursor move while let-go-mode is ;; active -- see legmacs.modes/register-mode!. -(defn- char-at [text offset] - (when (< -1 offset (count text)) (first (subs text offset (inc offset))))) +(defn- char-at [chars offset] + (when (< -1 offset (count chars)) (nth chars offset))) (defn update-paren-match "Emacs show-paren-mode's rule: if the character *after* point is an open bracket, or the character *before* point is a close bracket, highlight it and its match. Otherwise clear :paren-match." [state] - (let [text (buf/buffer-text state) + (let [chars (buf/buffer-chars state) offset (buf/offset-of state (:cursor-row state) (:cursor-col state)) - after (char-at text offset) - before (char-at text (dec offset)) + after (char-at chars offset) + before (char-at chars (dec offset)) point (cond (and after (ls/open-bracket? after)) offset (and before (ls/close-bracket? before)) (dec offset) @@ -180,9 +180,9 @@ ;; which costs one lean pass up to point; only the open-bracket case ;; needs the full scan (and its bracket-pair map) to look forward match (when point - (if (ls/close-bracket? (char-at text point)) - (ls/match-for-closer text point) - (ls/matching (ls/scan text) point)))] + (if (ls/close-bracket? (char-at chars point)) + (ls/match-for-closer chars point) + (ls/matching (ls/scan chars) point)))] (assoc state :paren-match (when match [(buf/row-col-of state point) (buf/row-col-of state match)])))) @@ -211,15 +211,15 @@ (def ^:private open->close-char {\( \) \[ \] \{ \}}) -(defn- point-in-string-or-comment? [text offset] - (ls/point-in-string-or-comment-at? text offset)) +(defn- point-in-string-or-comment? [chars offset] + (ls/point-in-string-or-comment-at? chars offset)) (defn- point-info [state] - (let [text (buf/buffer-text state) + (let [chars (buf/buffer-chars state) offset (buf/offset-of state (:cursor-row state) (:cursor-col state))] - {:before (char-at text (dec offset)) - :after (char-at text offset) - :in-str-or-comment? (point-in-string-or-comment? text offset)})) + {:before (char-at chars (dec offset)) + :after (char-at chars offset) + :in-str-or-comment? (point-in-string-or-comment? chars offset)})) (defn- insert-pair [state open-ch close-ch] (if (:in-str-or-comment? (point-info state)) @@ -368,9 +368,9 @@ the first argument on the opener's own line (falling back to one past the bracket when the opener ends its line)." [state row] - (let [text (buf/buffer-text state) + (let [chars (buf/buffer-chars state) offset (buf/offset-of state row 0)] - (if-let [[open-ch open-offset] (ls/innermost-open-before text offset)] + (if-let [[open-ch open-offset] (ls/innermost-open-before chars offset)] (let [[open-row open-col] (buf/row-col-of state open-offset) line (nth (:lines state) open-row)] (if (contains? #{\[ \{} open-ch) @@ -432,7 +432,7 @@ [(buf/offset-of state sr sc) (buf/offset-of state er ec)])) (defn- next-region-to-select [state] - (let [scanned (ls/scan (buf/buffer-text state)) + (let [scanned (ls/scan (buf/buffer-chars state)) current (region-offsets state)] (if current (let [[s e] current] diff --git a/legmacs/modes/structural.lg b/legmacs/modes/structural.lg index 321f043..926a9a4 100644 --- a/legmacs/modes/structural.lg +++ b/legmacs/modes/structural.lg @@ -30,8 +30,8 @@ (defn- spec-for [state] (modes/mode-syntax-spec (:mode state))) -(defn- char-at [text offset] - (when (< -1 offset (count text)) (first (subs text offset (inc offset))))) +(defn- char-at [chars offset] + (when (< -1 offset (count chars)) (nth chars offset))) ;; --- paren matching -------------------------------------------------- @@ -41,10 +41,10 @@ (rather than erroring) when the mode has none." [state] (if-let [spec (spec-for state)] - (let [text (buf/buffer-text state) + (let [chars (buf/buffer-chars state) offset (buf/offset-of state (:cursor-row state) (:cursor-col state)) - after (char-at text offset) - before (char-at text (dec offset)) + after (char-at chars offset) + before (char-at chars (dec offset)) point (cond (and after (ps/open-bracket? spec after)) offset (and before (ps/close-bracket? spec before)) (dec offset) @@ -53,9 +53,9 @@ ;; bracket -- only needs the innermost open bracket in front of ;; point, so it skips the full scan (see ps/match-for-closer) match (when point - (if (ps/close-bracket? spec (char-at text point)) - (ps/match-for-closer text point spec) - (ps/matching (ps/scan text spec) point)))] + (if (ps/close-bracket? spec (char-at chars point)) + (ps/match-for-closer chars point spec) + (ps/matching (ps/scan chars spec) point)))] (assoc state :paren-match (when match [(buf/row-col-of state point) (buf/row-col-of state match)]))) @@ -64,11 +64,11 @@ ;; --- auto-pairing brackets ---------------------------------------------- (defn- point-info [state spec] - (let [text (buf/buffer-text state) + (let [chars (buf/buffer-chars state) offset (buf/offset-of state (:cursor-row state) (:cursor-col state))] - {:before (char-at text (dec offset)) - :after (char-at text offset) - :in-str-or-comment? (ps/point-in-string-or-comment-at? text offset spec)})) + {:before (char-at chars (dec offset)) + :after (char-at chars offset) + :in-str-or-comment? (ps/point-in-string-or-comment-at? chars offset spec)})) (defn- insert-pair [state open-ch close-ch] (if-let [spec (spec-for state)] diff --git a/legmacs/prog_syntax.lg b/legmacs/prog_syntax.lg index 70f4871..2dc40f7 100644 --- a/legmacs/prog_syntax.lg +++ b/legmacs/prog_syntax.lg @@ -22,6 +22,12 @@ (ns legmacs.prog-syntax (:require [string])) +(defn- as-chars + "Scan input as a char vector. Callers that already have one (buffer-chars) + skip the copy; a string is converted once." + [text] + (if (vector? text) text (vec (seq text)))) + (def ^:private default-brackets {\( \) \[ \] \{ \}}) (defn- marker-at? @@ -119,7 +125,7 @@ upto produce identically-shaped trailing spans, so a flag is the only way to tell them apart. Line comments don't share this ambiguity (nothing closes one early), so they don't need a matching flag." - ([text spec] (scan text (count text) spec)) + ([text spec] (let [chars (as-chars text)] (scan chars (count chars) spec))) ([text upto spec] (let [{:keys [line-comments block-comment string-delims multiline-strings brackets]} spec line-comment-markers (markers-of (or line-comments [])) @@ -135,7 +141,7 @@ block-open-v (when block-open (vec (seq block-open))) block-close-v (when block-close (vec (seq block-close))) block-first (when block-open-v (nth block-open-v 0)) - chars (vec (seq text)) + chars (as-chars text) len (min upto (count chars))] (loop [i 0, stack (), pairs {}, spans []] (if (>= i len) @@ -220,7 +226,7 @@ block-first (when block-open-v (nth block-open-v 0)) comment-firsts (first-chars line-comment-markers) ml-firsts (first-chars (mapv :open-v multiline-strings)) - chars (vec (seq text)) + chars (as-chars text) n (count chars) stop (min offset n)] ;; every skip is capped at `stop`, so a construct that hasn't closed by @@ -277,9 +283,9 @@ scan of the buffer -- and it's the half that runs the instant you *type* a closing bracket." [text offset spec] - (let [chars (vec (seq text)) + (let [chars (as-chars text) ch (when (< -1 offset (count chars)) (nth chars offset)) - {:keys [stack code?]} (open-stack-at text offset spec) + {:keys [stack code?]} (open-stack-at chars offset spec) [open-ch open-offset] (first stack)] (when (and ch code? open-ch (= ch (get (or (:brackets spec) default-brackets) open-ch))) diff --git a/legmacs/render.lg b/legmacs/render.lg index 192f713..0f46c16 100644 --- a/legmacs/render.lg +++ b/legmacs/render.lg @@ -148,6 +148,26 @@ what TAB inserts (that's tab-insert in legmacs.commands)." (atom 4)) +(defn- display-piece + "How character `ch` at display column `dc` expands, given tab width `tw`." + [ch dc tw] + (let [c (int ch)] + (cond + (= c 9) (apply str (repeat (- (* tw (inc (quot dc tw))) dc) \space)) + (< c 32) (str "^" (char (+ c 64))) + (= c 127) "^?" + :else (str ch)))) + +(defn- display-width + "Display columns `ch` occupies at display column `dc`." + [ch dc tw] + (let [c (int ch)] + (cond + (= c 9) (- (* tw (inc (quot dc tw))) dc) + (< c 32) 2 + (= c 127) 2 + :else 1))) + (defn line-display "Expand `line` for display: {:text expanded-string :cols mapping}. `mapping` has (inc (count line)) entries; entry i is the display @@ -159,25 +179,45 @@ (loop [i 0, dc 0, out [], cols []] (if (>= i n) {:text (apply str out) :cols (conj cols dc)} - (let [ch (nth chars i) - c (int ch) - piece (cond - (= c 9) (apply str (repeat (- (* tw (inc (quot dc tw))) dc) \space)) - (< c 32) (str "^" (char (+ c 64))) - (= c 127) "^?" - :else (str ch))] + (let [piece (display-piece (nth chars i) dc tw)] (recur (inc i) (+ dc (count piece)) (conj out piece) (conj cols dc))))))) +(defn line-display-window + "Like line-display, but :text is only the `width` display columns starting + at `scroll-col` (not padded). :cols is still the full char-index map so + highlight spans convert correctly. A 10k-char line that's scrolled to + column 0 of an 80-col window no longer builds a 10k-char expanded string." + [line tw scroll-col width] + (let [chars (vec (seq line)) + n (count chars) + lo (max 0 scroll-col) + hi (+ lo (max 0 width))] + (loop [i 0, dc 0, out [], cols []] + (if (>= i n) + {:text (apply str out) :cols (conj cols dc)} + (let [piece (display-piece (nth chars i) dc tw) + plen (count piece) + pe (+ dc plen) + out (if (or (>= dc hi) (<= pe lo)) + out + (let [from (max 0 (- lo dc)) + to (- (min pe hi) dc)] + (conj out (subs piece from to))))] + (recur (inc i) pe out (conj cols dc))))))) + (defn display-col "The display column where character index `col` of `line` lands. Past the end of the line the mapping continues one-for-one, so open-ended span ends and the append position both keep working." [line col tw] - (let [cols (:cols (line-display line tw)) - n (dec (count cols))] - (if (>= col n) - (+ (nth cols n) (- col n)) - (nth cols col)))) + (let [chars (vec (seq line)) + n (count chars) + col (if (neg? col) 0 col)] + (loop [i 0, dc 0] + (cond + (>= i n) (+ dc (- col n)) + (>= i col) dc + :else (recur (inc i) (+ dc (display-width (nth chars i) dc tw))))))) (defn- display-span "Re-express one {:start :end} span (char columns) in display columns @@ -297,12 +337,6 @@ (let [color (if is-current? (ui :gutter-current) (ui :gutter))] (str color (right-align (str line-no) (dec width)) reset \space))) -(defn- visible-slice [line scroll-col text-cols] - (let [len (count line)] - (if (>= scroll-col len) - "" - (subs line scroll-col (min len (+ scroll-col text-cols)))))) - ;; --- span compositor -------------------------------------------------- ;; ;; A row can carry several independent highlight layers at once (the @@ -456,13 +490,15 @@ (str (move-to (inc x) screen-row) (if (< buf-row total) (let [scroll-col (:scroll-col state) - {dtext :text cols :cols} (line-display (nth (:lines state) buf-row) @tab-width) + {dtext :text cols :cols} (line-display-window + (nth (:lines state) buf-row) + @tab-width scroll-col text-cols) ;; mapv, not map: in let-go, reducing over a lazy (map f ;; (concat ...)) that is *empty* still calls the reducing ;; fn once with nil (see CLAUDE.md gotchas); style-array ;; reduces over these, so materialize. conv (fn [spans] (mapv #(display-span % cols) spans)) - visible (pad-right (visible-slice dtext scroll-col text-cols) text-cols) + visible (pad-right dtext text-cols) bg-spans (conv (concat (region-spans-for-row state buf-row) (paren-match-spans-for-row state buf-row) (search-match-spans-for-row state buf-row))) diff --git a/test/offset_test.lg b/test/offset_test.lg index 1adade5..f59821f 100644 --- a/test/offset_test.lg +++ b/test/offset_test.lg @@ -28,3 +28,13 @@ col (range (inc (count (nth (:lines sample) row))))] (is (= [row col] (buf/row-col-of sample (buf/offset-of sample row col))) (str "row " row " col " col))))) + +(deftest buffer-chars-matches-buffer-text + (testing "the cached char vector is the same characters as joining the lines" + (is (= (seq (buf/buffer-text sample)) (seq (buf/buffer-chars sample))))) + + (testing "a cursor move reuses the same :lines, so offsets still round-trip" + (let [moved (assoc sample :cursor-row 2 :cursor-col 3)] + (is (identical? (:lines sample) (:lines moved))) + (is (= 10 (buf/offset-of moved 2 3))) + (is (= [2 3] (buf/row-col-of moved 10)))))) diff --git a/test/render_test.lg b/test/render_test.lg index 10a9e28..5c2d48f 100644 --- a/test/render_test.lg +++ b/test/render_test.lg @@ -387,6 +387,30 @@ (is (= "a^[b" (:text d))) (is (= [0 1 3 4] (:cols d)))))) +(deftest display-col-matches-line-display-map + (testing "display-col agrees with line-display's :cols without expanding the whole string" + (let [line (str (char 9) "ab" (char 9) "c") + cols (:cols (r/line-display line 4))] + (doseq [i (range (count cols))] + (is (= (nth cols i) (r/display-col line i 4)))))) + + (testing "past the end of the line continues one-for-one" + (let [line "ab"] + (is (= 2 (r/display-col line 2 4))) + (is (= 5 (r/display-col line 5 4)))))) + +(deftest line-display-window-is-the-visible-slice + (testing "the windowed expander's :text is the scrolled slice of a full expansion" + (let [line (str "hello" (char 9) "world-and-more") + full (:text (r/line-display line 4)) + win (:text (r/line-display-window line 4 4 8))] + (is (= (subs full 4 (min (count full) 12)) win)))) + + (testing ":cols still cover the whole line, same as line-display" + (let [line (str (char 9) "xyz")] + (is (= (:cols (r/line-display line 4)) + (:cols (r/line-display-window line 4 0 2))))))) + (deftest frames-never-contain-raw-buffer-control-characters (testing "a tab-indented line paints spaces; a raw tab would skip terminal cells and let the previous frame show through"